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

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Mon Jan 21 18:55:17 2002 UTC (12 years, 3 months ago) by kaz
Branch: MAIN
Changes since 1.2: +3 -2 lines
mcvs-remove: do nothing if no arguments
mcvs-update: resynchronize links after CVS update.
1 kaz 1.1 (require "system")
2     (require "mapping")
3     (require "chatter")
4     (provide "remove")
5    
6     (defun mcvs-remove (&rest files)
7     (current-dir-restore
8     (let ((down-path (mcvs-locate)) filemap files-to-remove)
9     (if (not down-path)
10     (error "mcvs-remove: could not locate ~a directory." *mcvs-dir*))
11    
12 kaz 1.3 (when (null files)
13     (return-from mcvs-remove (values)))
14    
15 kaz 1.1 (with-open-file (file *mcvs-map* :direction :input)
16     (setf filemap (read file)))
17    
18     (chatter-info "Unmapping.~%")
19     (dolist (file files)
20     (can-restart-here ("Continue unmapping files.")
21     (multiple-value-bind (full-name out-of-bounds)
22     (canonicalize-path (path-cat down-path file))
23     (let ((entries (filemap-prefix-lookup filemap full-name)))
24 kaz 1.2 (if out-of-bounds
25     (chatter-terse "mcvs-remove: path ~a is not within sandbox." full-name)
26     (if (not entries)
27     (chatter-terse "mcvs-remove: ~a is not known to MCVS." full-name)
28     (setf files-to-remove (nconc files-to-remove entries))))))))
29 kaz 1.1
30     (when files-to-remove
31     (chatter-info "Synchronizing.~%")
32     (mapping-synchronize)
33     (let ((new-filemap (set-difference filemap files-to-remove
34     :test #'filemap-same-object-p)))
35     (with-open-file (file *mcvs-map* :direction :output)
36     (let ((*print-right-margin* 1))
37     (prin1 new-filemap file)
38     (terpri file))))
39    
40     (chatter-info "Updating file structure.~%")
41     (mapping-update))))
42     (values))

  ViewVC Help
Powered by ViewVC 1.1.5