/[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.2.1 - (show annotations)
Sat Jul 6 15:56:28 2002 UTC (11 years, 9 months ago) by kaz
Branch: partial-sandbox-branch
CVS Tags: partial-sandbox-branch~merged-to-HEAD-0
Changes since 1.18: +2 -1 lines
* remove.lisp (mcvs-remove): Added path conversions to support
partial sandboxes.
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 (abs-name (real-to-abstract-path full-name))
23 (entries (mapping-prefix-matches filemap abs-name)))
24 (cond
25 ((path-prefix-equal *mcvs-dir* full-name)
26 (error "mcvs-remove: path ~a is in a reserved Meta-CVS area."
27 full-name))
28 ((and (second entries) (not recursivep))
29 (error "mcvs-remove: ~a is a directory, use -R to remove."
30 full-name))
31 ((not entries)
32 (if (exists full-name)
33 (error "mcvs-remove: ~a is local, not versioned under Meta-CVS."
34 full-name)
35 (error "mcvs-remove: ~a does not exist." full-name)))
36 (t (setf files-to-remove (nconc files-to-remove entries)))))))
37
38 (when files-to-remove
39 (chatter-debug "Synchronizing.~%")
40 (unless no-sync
41 (mapping-synchronize))
42 (let ((new-filemap (set-difference filemap files-to-remove
43 :test #'mapping-same-object-p)))
44 (mapping-write new-filemap *mcvs-map* :sort-map t))
45
46 (chatter-debug "Updating file structure.~%")
47 (mapping-update :no-delete-removed no-sync))))
48 (values))
49
50 (defun mcvs-remove-wrapper (cvs-options cvs-command-options mcvs-args)
51 (declare (ignore cvs-options))
52 (find-bind (:test #'string= :key #'first)
53 ((recursivep "R"))
54 cvs-command-options
55 (mcvs-remove recursivep mcvs-args)))

  ViewVC Help
Powered by ViewVC 1.1.5