/[meta-cvs]/meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0
ViewVC logotype

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (hide annotations)
Sat Jan 26 01:38:37 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
Changes since 1.5: +10 -2 lines
Moving closer toward delivery.
1 kaz 1.1 (require "system")
2     (require "mapping")
3     (require "chatter")
4     (provide "remove")
5    
6 kaz 1.6 (defun mcvs-remove (files)
7 kaz 1.5 (in-sandbox-root-dir
8     (let (filemap files-to-remove)
9 kaz 1.3 (when (null files)
10     (return-from mcvs-remove (values)))
11    
12 kaz 1.1 (with-open-file (file *mcvs-map* :direction :input)
13     (setf filemap (read file)))
14    
15     (chatter-info "Unmapping.~%")
16     (dolist (file files)
17     (can-restart-here ("Continue unmapping files.")
18 kaz 1.5 (let* ((full-name (sandbox-translate-path file))
19 kaz 1.6 (entries (filemap-prefix-matches filemap full-name)))
20 kaz 1.5 (if (not entries)
21     (error "mcvs-remove: ~a is not known to MCVS." full-name)
22     (setf files-to-remove (nconc files-to-remove entries))))))
23 kaz 1.1
24     (when files-to-remove
25     (chatter-info "Synchronizing.~%")
26     (mapping-synchronize)
27     (let ((new-filemap (set-difference filemap files-to-remove
28     :test #'filemap-same-object-p)))
29     (with-open-file (file *mcvs-map* :direction :output)
30     (let ((*print-right-margin* 1))
31 kaz 1.4 (prin1 (filemap-sort new-filemap) file)
32 kaz 1.1 (terpri file))))
33    
34     (chatter-info "Updating file structure.~%")
35     (mapping-update))))
36     (values))
37 kaz 1.6
38     (defun mcvs-remove-wrapper (cvs-options cvs-specific-options mcvs-args)
39     (when (cvs-options cvs-specific-options)
40     (error
41     #.(concatenate 'string
42     "mcvs-remove: CVS options specified, "
43     "but this operation does not invoke CVS.")))
44     (mcvs-remove mcvs-args))

  ViewVC Help
Powered by ViewVC 1.1.5