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

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.18 - (show annotations)
Mon Jul 1 16:16:25 2002 UTC (11 years, 9 months ago) by kaz
Branch: MAIN
CVS Tags: partial-sandbox-branch~branch-point, mcvs-0-17
Branch point for: partial-sandbox-branch
Changes since 1.17: +4 -3 lines
Grab no longer synchronizes to recreate deleted files immediately
before blowing them away.

* grab.lisp (mcvs-grab): Specify :no-sync t when calling mcvs-remove.

* remove.lisp (mcvs-remove): Support new no-sync keyword. This tells
mcvs-remove that the files being removed from the mapping,
don't exist in the sandbox. So it's not necessary to call
mapping-synchronize, and mapping-update can be told via
:no-delete-removed t not to try to remove deleted files.

* mapping.lisp (mapping-update): New no-delete-removed keyword
parameter.
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (require "system")
6 (require "mapping")
7 (require "chatter")
8 (require "find-bind")
9 (provide "remove")
10
11 (defun mcvs-remove (recursivep files &key no-sync)
12 (when (null files)
13 (return-from mcvs-remove (values)))
14
15 (in-sandbox-root-dir
16 (let (files-to-remove (filemap (mapping-read *mcvs-map*)))
17
18 (chatter-debug "Unmapping.~%")
19 (dolist (file files)
20 (can-restart-here ("Continue unmapping files.")
21 (let* ((full-name (sandbox-translate-path file))
22 (entries (mapping-prefix-matches filemap full-name)))
23 (cond
24 ((path-prefix-equal *mcvs-dir* full-name)
25 (error "mcvs-remove: path ~a is in a reserved Meta-CVS area."
26 full-name))
27 ((and (second entries) (not recursivep))
28 (error "mcvs-remove: ~a is a directory, use -R to remove."
29 full-name))
30 ((not entries)
31 (if (exists full-name)
32 (error "mcvs-remove: ~a is local, not versioned under Meta-CVS."
33 full-name)
34 (error "mcvs-remove: ~a does not exist." full-name)))
35 (t (setf files-to-remove (nconc files-to-remove entries)))))))
36
37 (when files-to-remove
38 (chatter-debug "Synchronizing.~%")
39 (unless no-sync
40 (mapping-synchronize))
41 (let ((new-filemap (set-difference filemap files-to-remove
42 :test #'mapping-same-object-p)))
43 (mapping-write new-filemap *mcvs-map* :sort-map t))
44
45 (chatter-debug "Updating file structure.~%")
46 (mapping-update :no-delete-removed no-sync))))
47 (values))
48
49 (defun mcvs-remove-wrapper (cvs-options cvs-command-options mcvs-args)
50 (declare (ignore cvs-options))
51 (find-bind (:test #'string= :key #'first)
52 ((recursivep "R"))
53 cvs-command-options
54 (mcvs-remove recursivep mcvs-args)))

  ViewVC Help
Powered by ViewVC 1.1.5