ViewVC logotype

Diff of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision by kaz, Sun Aug 25 16:07:05 2002 UTC revision 1.30 by kaz, Tue Nov 28 07:47:22 2006 UTC
# Line 2  Line 2 
2  ;;; which is distributed under the GNU license.  ;;; which is distributed under the GNU license.
3  ;;; Copyright 2002 Kaz Kylheku  ;;; Copyright 2002 Kaz Kylheku
5  (require "system")  (in-package :meta-cvs)
 (require "mapping")  
 (require "chatter")  
 (require "find-bind")  
 (provide "remove")  
7  (defun mcvs-remove (recursivep files &key no-sync)  (defun rm (recursivep files &key no-sync)
8    (when (null files)    (when (null files)
9      (return-from mcvs-remove (values)))      (return-from rm (values)))
11    (in-sandbox-root-dir    (in-sandbox-root-dir
12      (let (files-to-remove (filemap (mapping-read *mcvs-map*)))      (let (files-to-remove (filemap (mapping-read *map-path*)))
14        (chatter-debug "Unmapping.~%")        (chatter-debug "Unmapping.~%")
15        (dolist (file files)        (dolist (file files)
16          (can-restart-here ("Continue unmapping files.")          (can-restart-here ("Continue unmapping files.")
17            (let* ((full-name (sandbox-translate-path file))            (let* ((full-name (sandbox-translate-path file))
18                   (abs-name (real-to-abstract-path full-name))                   (abs-name (canonicalize-path
19                                  (real-to-abstract-path full-name)))
20                   (entries (mapping-prefix-matches filemap abs-name)))                   (entries (mapping-prefix-matches filemap abs-name)))
21              (cond              (cond
22                ((path-prefix-equal *mcvs-dir* full-name)                ((path-prefix-equal *admin-dir* full-name)
23                   (error "mcvs-remove: path ~a is in a reserved Meta-CVS area."                   (error "cannot remove ~a: path is in a reserved Meta-CVS area."
24                          full-name))                          full-name))
25                ((and (second entries) (not recursivep))                ((and (second entries) (not recursivep))
26                   (error "mcvs-remove: ~a is a directory, use -R to remove."                   (error "cannot remove ~a: it is a directory, use -R to remove."
27                          full-name))                          full-name))
28                ((not entries)                ((not entries)
29                   (if (exists full-name)                   (if (exists full-name)
30                     (error "mcvs-remove: ~a is local, not versioned under Meta-CVS."                     (error "cannot remove ~a: it is local, not versioned under Meta-CVS."
31                            full-name)                            full-name)
32                     (error "mcvs-remove: ~a does not exist." full-name)))                     (error "cannot remove ~a: it does not exist." full-name)))
33                (t (setf files-to-remove (nconc files-to-remove entries)))))))                (t (setf files-to-remove (nconc files-to-remove entries)))))))
35        (when files-to-remove        (when files-to-remove
36            ;; Removed files might have unsynchronized local edits, which
37            ;; will be irretrievably lost if we don't synchronize.
38            ;; But the grab command does not need this, hence no-sync option.
39          (chatter-debug "Synchronizing.~%")          (chatter-debug "Synchronizing.~%")
40          (unless no-sync          (unless no-sync
41            (mapping-synchronize))            (mapping-synchronize :direction :left))
42          (let ((new-filemap (set-difference filemap files-to-remove          (let ((new-filemap (set-difference filemap files-to-remove
43                                             :test #'mapping-same-id-p)))                                             :test #'mapping-same-id-p)))
44            (mapping-write new-filemap *mcvs-map* :sort-map t))            (mapping-write new-filemap *map-path* :sort-map t))
46          (chatter-debug "Updating file structure.~%")          (chatter-debug "Updating file structure.~%")
47          (mapping-update :no-delete-removed no-sync))))          (mapping-update :no-delete-removed no-sync))))
48    (values))    (values))
50  (defun mcvs-remove-wrapper (cvs-options cvs-command-options mcvs-args)  (defun remove-wrapper (cvs-options cvs-command-options mcvs-args)
51    (declare (ignore cvs-options))    (declare (ignore cvs-options))
52    (find-bind (:test #'string= :key #'first)    (find-bind (:test #'string= :key #'first)
53               ((recursivep "R"))               ((recursivep "R"))
54               cvs-command-options               cvs-command-options
55      (mcvs-remove recursivep mcvs-args)))      (rm recursivep mcvs-args)))
57    (defconstant *remove-help*
58    "Syntax:
60      mcvs remove [ options ] objects ...
62    Options:
64      -R                Recursive behavior: recursively remove objects
65                        in subdirectories. By default, trying to remove
66                        a subdirectory signals a continuable error.
68    Semantics:
70      The remove command removes objects from the mapping. To propagate
71      the removal to the repository, a commit operation must be invoked.
73      Removed files are not actually subject to a CVS-level erasure; they are
74      merely removed from the map, but still exist in the MCVS subdirectory. Their
75      local modifications are not lost. To actually remove files from CVS,
76      use the purge command.  Removed files that have not been purged can be
77      recovered via the restore command which re-creates mapping entries for them
78      in the lost+found directory under machine-generated names; they can then be
79      renamed to more appropriate names. Symbolic links cannot be restored;
80      they exist as mapping entries only.")

Removed from v.  
changed lines
  Added in v.1.30

  ViewVC Help
Powered by ViewVC 1.1.5