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

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.15 - (hide annotations)
Fri Mar 15 23:13:55 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
Changes since 1.14: +10 -2 lines
* add.lisp (mcvs-add): Error message changed to tell user to use
-R to add directory.

* remove.lisp (mcvs-remove): New generalized boolean parameter
indicates to do a recursive remove. This is controlled by the
-R option which already exists. Behavior changed to not act
on directories unless recursion is explicitly requested.
(mcvs-remove-wrapper): Extract "R" option, pass down new boolean
to mcvs-remove.
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 kaz 1.15 (require "find-bind")
9 kaz 1.1 (provide "remove")
10    
11 kaz 1.15 (defun mcvs-remove (recursivep files)
12 kaz 1.11 (when (null files)
13     (return-from mcvs-remove (values)))
14    
15 kaz 1.5 (in-sandbox-root-dir
16 kaz 1.11 (let (files-to-remove (filemap (mapping-read *mcvs-map*)))
17 kaz 1.1
18 kaz 1.13 (chatter-debug "Unmapping.~%")
19 kaz 1.1 (dolist (file files)
20     (can-restart-here ("Continue unmapping files.")
21 kaz 1.5 (let* ((full-name (sandbox-translate-path file))
22 kaz 1.12 (entries (mapping-prefix-matches filemap full-name)))
23 kaz 1.15 (when (and (second entries) (not recursivep))
24     (error "mcvs-remove: ~a is a directory, use -R to remove."
25     full-name))
26 kaz 1.5 (if (not entries)
27 kaz 1.10 (error "mcvs-remove: ~a is not known to Meta-CVS." full-name)
28 kaz 1.5 (setf files-to-remove (nconc files-to-remove entries))))))
29 kaz 1.1
30     (when files-to-remove
31 kaz 1.13 (chatter-debug "Synchronizing.~%")
32 kaz 1.1 (mapping-synchronize)
33     (let ((new-filemap (set-difference filemap files-to-remove
34 kaz 1.12 :test #'mapping-same-object-p)))
35 kaz 1.11 (mapping-write new-filemap *mcvs-map* :sort-map t))
36 kaz 1.1
37 kaz 1.13 (chatter-debug "Updating file structure.~%")
38 kaz 1.1 (mapping-update))))
39     (values))
40 kaz 1.6
41 kaz 1.9 (defun mcvs-remove-wrapper (cvs-options cvs-command-options mcvs-args)
42 kaz 1.15 (declare (ignore cvs-options))
43     (find-bind (:test #'string= :key #'first)
44     ((recursivep "R"))
45     cvs-command-options
46     (mcvs-remove recursivep mcvs-args)))

  ViewVC Help
Powered by ViewVC 1.1.5