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

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (show annotations)
Sat Jan 26 01:40:35 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
Changes since 1.6: +1 -1 lines
Bugfix.
1 (require "system")
2 (require "mapping")
3 (require "chatter")
4 (provide "remove")
5
6 (defun mcvs-remove (files)
7 (in-sandbox-root-dir
8 (let (filemap files-to-remove)
9 (when (null files)
10 (return-from mcvs-remove (values)))
11
12 (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 (let* ((full-name (sandbox-translate-path file))
19 (entries (filemap-prefix-matches filemap full-name)))
20 (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
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 (prin1 (filemap-sort new-filemap) file)
32 (terpri file))))
33
34 (chatter-info "Updating file structure.~%")
35 (mapping-update))))
36 (values))
37
38 (defun mcvs-remove-wrapper (cvs-options cvs-specific-options mcvs-args)
39 (when (or 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