ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.1 - (show annotations)
Mon May 20 17:49:12 2002 UTC (11 years, 11 months ago) by kaz
Branch: MAIN
Adding mcvs remap command.

* dirwalk.lisp (dirwalk-fi, dirwalk, for-each-file-info): Default
behavior is now preorder (visit directory before its entries).
A keyword is provided to select the old postorder behavior.
A catch is provided in dirwalk-fi that allows the caller to
skip processing the currently traversed directory. The for-each-*
macros provide a local function called (skip) to do this.
(delete-recursive): This function depends on postorder behavior
in for-each-file-info, so it explicitly selects it now.

* mcvs.lisp (*remap-options*): New constant.
(*mcvs-command-table*): Add entry for new function.
(*usage*): Describes new function.

* remap.lisp: New file.
(mcvs-remap, mcvs-remap-wrapper): New functions.
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
5 (require "dirwalk")
6 (require "mapping")
7 (provide "remap")
9 (defun mcvs-remap ()
10 (in-sandbox-root-dir
11 (let ((old-mapping (mapping-read *mcvs-map-local*))
12 (inode-hash (make-hash-table :test #'eql))
13 new-mapping)
14 (dolist (entry old-mapping)
15 (let ((file-info (stat (first entry))))
16 (setf (gethash (inode file-info) inode-hash) (first entry))))
17 (for-each-file-info (fi ".")
18 (let ((path (canonicalize-path (file-name fi))))
19 (cond
20 ((regular-p fi)
21 (let ((f-file (gethash (inode fi) inode-hash)))
22 (when f-file
23 (push (list f-file path) new-mapping)
24 (setf (gethash (inode fi) inode-hash) nil))))
25 ((directory-p fi)
26 (when (path-equal path *mcvs-dir*)
27 (skip))))))
28 (mapping-write new-mapping *mcvs-map-local* :sort-map t)
29 (mapping-write new-mapping *mcvs-map* :sort-map t))))
31 (defun mcvs-remap-wrapper (global-options command-options args)
32 (declare (ignore global-options command-options))
33 (when args
34 (error "mcvs-remap: command takes no arguments."))
35 (mcvs-remap))

  ViewVC Help
Powered by ViewVC 1.1.5