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

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.25 - (hide annotations)
Thu Oct 31 04:06:01 2002 UTC (11 years, 5 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-1-0-3
Changes since 1.24: +3 -0 lines
* code/mcvs-package.lisp: New file, defines META-CVS package.

* code/purge.lisp: Put all symbols in new package.
* code/restore.lisp: Likewise.
* code/paths.lisp: Likewise.
* code/install.sh: Likewise.
* code/restart.lisp: Likewise.
* code/update.lisp: Likewise.
* code/move.lisp: Likewise.
* code/grab.lisp: Likewise.
* code/unix.lisp: Likewise.
* code/slot-refs.lisp: Likewise.
* code/prop.lisp: Likewise.
* code/multi-hash.lisp: Likewise.
* code/rcs-utils.lisp: Likewise.
* code/branch.lisp: Likewise.
* code/find-bind.lisp: Likewise.
* code/execute.lisp: Likewise.
* code/link.lisp: Likewise.
* code/split.lisp: Likewise.
* code/watch.lisp: Likewise.
* code/clisp-unix.lisp: Likewise.
* code/add.lisp: Likewise.
* code/chatter.lisp: Likewise.
* code/print.lisp: Likewise.
* code/types.lisp: Likewise.
* code/remove.lisp: Likewise.
* code/convert.lisp: Likewise.
* code/error.lisp: Likewise.
* code/options.lisp: Likewise.
* code/dirwalk.lisp: Likewise.
* code/checkout.lisp: Likewise.
* code/generic.lisp: Likewise.
* code/sync.lisp: Likewise.
* code/create.lisp: Likewise.
* code/memoize.lisp: Likewise.
* code/seqfuncs.lisp: Likewise.
* code/cmucl-unix.lisp: Likewise.
* code/remap.lisp: Likewise.

* code/mapping.lisp: Put symbols in new package. Replace use
of CLISP specific substring function with subseq.
* code/filt.lisp: Likewise.

* code/mcvs-main.lisp: Put symbols in new package. The mcvs
function is renamed to main.

* code/install.sh: Generate mcvs script that uses qualified name
of new startup functiont to start the software.
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.25 (require "mcvs-package")
10 kaz 1.1 (provide "remove")
11 kaz 1.25
12     (in-package "META-CVS")
13 kaz 1.1
14 kaz 1.18 (defun mcvs-remove (recursivep files &key no-sync)
15 kaz 1.11 (when (null files)
16     (return-from mcvs-remove (values)))
17    
18 kaz 1.5 (in-sandbox-root-dir
19 kaz 1.11 (let (files-to-remove (filemap (mapping-read *mcvs-map*)))
20 kaz 1.1
21 kaz 1.13 (chatter-debug "Unmapping.~%")
22 kaz 1.1 (dolist (file files)
23     (can-restart-here ("Continue unmapping files.")
24 kaz 1.5 (let* ((full-name (sandbox-translate-path file))
25 kaz 1.23 (abs-name (canonicalize-path
26     (real-to-abstract-path full-name)))
27 kaz 1.19 (entries (mapping-prefix-matches filemap abs-name)))
28 kaz 1.16 (cond
29     ((path-prefix-equal *mcvs-dir* full-name)
30 kaz 1.22 (error "cannot remove ~a: path is in a reserved Meta-CVS area."
31 kaz 1.16 full-name))
32     ((and (second entries) (not recursivep))
33 kaz 1.22 (error "cannot remove ~a: it is a directory, use -R to remove."
34 kaz 1.16 full-name))
35 kaz 1.17 ((not entries)
36     (if (exists full-name)
37 kaz 1.22 (error "cannot remove ~a: it is local, not versioned under Meta-CVS."
38 kaz 1.17 full-name)
39 kaz 1.22 (error "cannot remove ~a: it does not exist." full-name)))
40 kaz 1.17 (t (setf files-to-remove (nconc files-to-remove entries)))))))
41 kaz 1.1
42     (when files-to-remove
43 kaz 1.13 (chatter-debug "Synchronizing.~%")
44 kaz 1.18 (unless no-sync
45     (mapping-synchronize))
46 kaz 1.1 (let ((new-filemap (set-difference filemap files-to-remove
47 kaz 1.20 :test #'mapping-same-id-p)))
48 kaz 1.11 (mapping-write new-filemap *mcvs-map* :sort-map t))
49 kaz 1.1
50 kaz 1.13 (chatter-debug "Updating file structure.~%")
51 kaz 1.18 (mapping-update :no-delete-removed no-sync))))
52 kaz 1.1 (values))
53 kaz 1.6
54 kaz 1.9 (defun mcvs-remove-wrapper (cvs-options cvs-command-options mcvs-args)
55 kaz 1.15 (declare (ignore cvs-options))
56     (find-bind (:test #'string= :key #'first)
57     ((recursivep "R"))
58     cvs-command-options
59     (mcvs-remove recursivep mcvs-args)))
60 kaz 1.21
61     (defconstant *remove-help*
62     "Syntax:
63    
64     mcvs remove [ options ] objects ...
65    
66     Options:
67    
68 kaz 1.24 -R Recursive behavior: recursively remove objects
69     in subdirectories. By default, trying to remove
70     a subdirectory signals a continuable error.
71 kaz 1.21
72     Semantics:
73    
74     The remove command removes objects from the mapping. To propagate
75     the removal to the repository, a commit operation must be invoked.
76    
77     Removed files are not actually subject to a CVS-level erasure; they are
78     merely removed from the map, but still exist in the MCVS subdirectory. Their
79     local modifications are not lost. To actually remove files from CVS,
80     use the purge command. Removed files that have not been purged can be
81     recovered via the restore command which re-creates mapping entries for them
82     in the lost+found directory under machine-generated names; they can then be
83     renamed to more appropriate names. Symbolic links cannot be restored;
84     they exist as mapping entries only.")

  ViewVC Help
Powered by ViewVC 1.1.5