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

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Mon Jan 21 06:54:14 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
Adding mcvs-remove operation.
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 (if (not entries)
24 (chatter-terse "mcvs-remove: path ~a is not within sandbox." full-name)
25 (setf files-to-remove (nconc files-to-remove entries)))))))
26
27 (when files-to-remove
28 (chatter-info "Synchronizing.~%")
29 (mapping-synchronize)
30 (let ((new-filemap (set-difference filemap files-to-remove
31 :test #'filemap-same-object-p)))
32 (with-open-file (file *mcvs-map* :direction :output)
33 (let ((*print-right-margin* 1))
34 (prin1 new-filemap file)
35 (terpri file))))
36
37 (chatter-info "Updating file structure.~%")
38 (mapping-update))))
39 (values))

  ViewVC Help
Powered by ViewVC 1.1.5