ViewVC logotype

Contents of /meta-cvs/F-993DC8DDEC493F0D641AC0C23DB6BAB0

Parent Directory Parent Directory | Revision Log Revision Log

Revision - (hide annotations)
Sun Aug 25 16:07:05 2002 UTC (11 years, 8 months ago) by kaz
Branch: symlink-branch
CVS Tags: symlink-branch~merged-to-HEAD-0
Changes since 1.19: +1 -1 lines
Support for symbolic links added to the mapping module.  The format of
the map file has changed to accomodate this.  The new format of the
list entries is (:keyword "id" "path" ...) where the keyword is either
:file or :symlink (for now, extensible obviously), "id" is a unique
identifier (for regular files, it is their MCVS/F-* name) and "path" is
the sandbox path. Other things can follow; for symlinks, there is a
string representing the symlink target.  Internally, a new data type
called mapping-entry is used; this is a struct. So the functions which
read and write maps now convert between the struct format and the above

* code/unix-bindings/unix.lisp (unix-funcs:readlink): New function.

* code/unix-bindings/impl.c (impl_readlink): New function.

* code/clisp-unix.lisp (readlink-error): New condition.
(initialize-instance readlink-error): New method for
initialize-instance generic function, specialized for readlink-error.
(readlink): New function.

* code/mapping.lisp (mapping-entry): New struct, with slots
file, id, path and target.
(mapping-same-object-p): Renamed to mapping-same-id-p.
(mapping-object-lookup, mapping-moved-p): Unused functions removed.
(mapping-extract-paths, mapping-lookup, mapping-prefix-lookup,
mapping-prefix-matches, mapping-same-path-p, mapping-rename-files,
mapping-removed-files): Functions updated to use the new data
(mapping-dupe-checks): Rewritten for new data structure, and to
use hashes rather than silly sorting.
(mapping-convert-old-style-in, mapping-convert-in,
mapping-convert-out): New functions.
(mapping-read): Handle new and old style representations,
handle conversion to internal representation.
(mapping-write): Convert to new-style external representation
before writing out.
(mapping-synchronize): Handle symbolic links. If a link is missing,
create it. If it's present but different from what it should be,
erase it and re-create it.
(mapping-update): Use new data structure. Handle symbolic links.

* code/remove.lisp (mcvs-remove): Refer to new function
name, mapping-same-id-p.
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
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")
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)))
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 :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