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

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (hide annotations)
Tue Mar 12 19:54:58 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-9, mcvs-0-8
Changes since 1.12: +3 -3 lines
* update.lisp (mcvs-update): Changing level of chatter messages.
* move.lisp (mcvs-move): Likewise.
* add.lisp (mcvs-add): Likewise.
* remove.lisp (mcvs-remove): Likewise.
* checkout.lisp (mcvs-checkout): Likewise.
* generic.lisp (mcvs-generic): Likewise.
* import.lisp (mcvs-import): Likewise.
* mapping.lisp (mapping-dupe-check): Likewise.
(mapping-update): Likewise.
1 kaz 1.10 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.8 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.1 (require "system")
6     (require "mapping")
7     (require "chatter")
8     (provide "remove")
9    
10 kaz 1.6 (defun mcvs-remove (files)
11 kaz 1.11 (when (null files)
12     (return-from mcvs-remove (values)))
13    
14 kaz 1.5 (in-sandbox-root-dir
15 kaz 1.11 (let (files-to-remove (filemap (mapping-read *mcvs-map*)))
16 kaz 1.1
17 kaz 1.13 (chatter-debug "Unmapping.~%")
18 kaz 1.1 (dolist (file files)
19     (can-restart-here ("Continue unmapping files.")
20 kaz 1.5 (let* ((full-name (sandbox-translate-path file))
21 kaz 1.12 (entries (mapping-prefix-matches filemap full-name)))
22 kaz 1.5 (if (not entries)
23 kaz 1.10 (error "mcvs-remove: ~a is not known to Meta-CVS." full-name)
24 kaz 1.5 (setf files-to-remove (nconc files-to-remove entries))))))
25 kaz 1.1
26     (when files-to-remove
27 kaz 1.13 (chatter-debug "Synchronizing.~%")
28 kaz 1.1 (mapping-synchronize)
29     (let ((new-filemap (set-difference filemap files-to-remove
30 kaz 1.12 :test #'mapping-same-object-p)))
31 kaz 1.11 (mapping-write new-filemap *mcvs-map* :sort-map t))
32 kaz 1.1
33 kaz 1.13 (chatter-debug "Updating file structure.~%")
34 kaz 1.1 (mapping-update))))
35     (values))
36 kaz 1.6
37 kaz 1.9 (defun mcvs-remove-wrapper (cvs-options cvs-command-options mcvs-args)
38     (when (or cvs-options cvs-command-options)
39 kaz 1.6 (error
40     #.(concatenate 'string
41     "mcvs-remove: CVS options specified, "
42     "but this operation does not invoke CVS.")))
43     (mcvs-remove mcvs-args))

  ViewVC Help
Powered by ViewVC 1.1.5