/[meta-cvs]/meta-cvs/F-FA1826D235E55390A70DEBE51DC3234B.lisp
ViewVC logotype

Contents of /meta-cvs/F-FA1826D235E55390A70DEBE51DC3234B.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (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.6: +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.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 "dirwalk")
6     (require "mapping")
7 kaz 1.7 (require "mcvs-package")
8 kaz 1.1 (provide "remap")
9 kaz 1.7
10     (in-package "META-CVS")
11 kaz 1.1
12     (defun mcvs-remap ()
13     (in-sandbox-root-dir
14 kaz 1.3 (let* ((old-mapping (mapping-read *mcvs-map-local*))
15     (cvs-mapping (mapping-read *mcvs-map*))
16     (inode-hash (make-hash-table :test #'eql))
17 kaz 1.4 (new-mapping (remove-if #'(lambda (entry)
18     (with-slots (path kind) entry
19     (and (eq kind :file)
20     (real-path-exists path))))
21     old-mapping)))
22 kaz 1.2 (restart-case
23 kaz 1.4 (when (not (equal-filemaps old-mapping cvs-mapping))
24 kaz 1.5 (error "local and repository mappings differ."))
25 kaz 1.2 (ignore () :report "remap anyway, clobbering repository mapping"))
26 kaz 1.1 (dolist (entry old-mapping)
27 kaz 1.4 (with-slots (id kind) entry
28     (when (eq kind :file)
29     (let ((file-info (stat id)))
30 kaz 1.6 (setf (gethash (inode file-info) inode-hash) entry)))))
31 kaz 1.1 (for-each-file-info (fi ".")
32 kaz 1.3 (let* ((path (canonicalize-path (file-name fi)))
33     (abs-path (real-to-abstract-path path)))
34 kaz 1.1 (cond
35     ((regular-p fi)
36 kaz 1.6 (let ((entry (gethash (inode fi) inode-hash)))
37     (when entry
38     (let ((new-entry (copy-mapping-entry entry)))
39     (setf (mapping-entry-executable new-entry)
40     (executable-p fi))
41     (setf (mapping-entry-path new-entry) abs-path)
42     (push new-entry new-mapping)
43     (setf (gethash (inode fi) inode-hash) nil)))))
44 kaz 1.4 ((symlink-p fi)
45     (chatter-info "skipping symbolic link ~a.~%" path))
46 kaz 1.1 ((directory-p fi)
47     (when (path-equal path *mcvs-dir*)
48     (skip))))))
49     (mapping-write new-mapping *mcvs-map-local* :sort-map t)
50     (mapping-write new-mapping *mcvs-map* :sort-map t))))
51    
52     (defun mcvs-remap-wrapper (global-options command-options args)
53     (declare (ignore global-options command-options))
54     (when args
55 kaz 1.5 (error "command takes no arguments."))
56 kaz 1.1 (mcvs-remap))

  ViewVC Help
Powered by ViewVC 1.1.5