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

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.20 - (hide annotations)
Sat Aug 31 20:53:13 2002 UTC (11 years, 7 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-24, mcvs-0-22, mcvs-0-23, mcvs-0-95
Changes since 1.19: +1 -1 lines
Merging symlink-branch to main trunk.
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.18 (defun mcvs-remove (recursivep files &key no-sync)
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.19 (abs-name (real-to-abstract-path full-name))
23     (entries (mapping-prefix-matches filemap abs-name)))
24 kaz 1.16 (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 kaz 1.17 ((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 kaz 1.1
38     (when files-to-remove
39 kaz 1.13 (chatter-debug "Synchronizing.~%")
40 kaz 1.18 (unless no-sync
41     (mapping-synchronize))
42 kaz 1.1 (let ((new-filemap (set-difference filemap files-to-remove
43 kaz 1.20 :test #'mapping-same-id-p)))
44 kaz 1.11 (mapping-write new-filemap *mcvs-map* :sort-map t))
45 kaz 1.1
46 kaz 1.13 (chatter-debug "Updating file structure.~%")
47 kaz 1.18 (mapping-update :no-delete-removed no-sync))))
48 kaz 1.1 (values))
49 kaz 1.6
50 kaz 1.9 (defun mcvs-remove-wrapper (cvs-options cvs-command-options mcvs-args)
51 kaz 1.15 (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