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

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Mon Jan 21 07:04:24 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
Changes since 1.1: +5 -3 lines
Change to some error reporting.
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     (with-open-file (file *mcvs-map* :direction :input)
13     (setf filemap (read file)))
14    
15     (chatter-info "Unmapping.~%")
16     (when (null files)
17     (setf files '(".")))
18     (dolist (file files)
19     (can-restart-here ("Continue unmapping files.")
20     (multiple-value-bind (full-name out-of-bounds)
21     (canonicalize-path (path-cat down-path file))
22     (let ((entries (filemap-prefix-lookup filemap full-name)))
23 kaz 1.2 (if out-of-bounds
24     (chatter-terse "mcvs-remove: path ~a is not within sandbox." full-name)
25     (if (not entries)
26     (chatter-terse "mcvs-remove: ~a is not known to MCVS." full-name)
27     (setf files-to-remove (nconc files-to-remove entries))))))))
28 kaz 1.1
29     (when files-to-remove
30     (chatter-info "Synchronizing.~%")
31     (mapping-synchronize)
32     (let ((new-filemap (set-difference filemap files-to-remove
33     :test #'filemap-same-object-p)))
34     (with-open-file (file *mcvs-map* :direction :output)
35     (let ((*print-right-margin* 1))
36     (prin1 new-filemap file)
37     (terpri file))))
38    
39     (chatter-info "Updating file structure.~%")
40     (mapping-update))))
41     (values))

  ViewVC Help
Powered by ViewVC 1.1.5