/[meta-cvs]/meta-cvs/F-300FB44635F94930416CE1B06097B230.lisp
ViewVC logotype

Contents of /meta-cvs/F-300FB44635F94930416CE1B06097B230.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Mon Oct 7 02:44:30 2002 UTC (11 years, 6 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-1-0-branch~branch-point, mcvs-0-97
Branch point for: mcvs-1-0-branch
Changes since 1.3: +2 -1 lines
* code/prop.lisp (mcvs-prop): Result of real-to-abstract-path
must be canonicalized.

* code/remove.lisp (mcvs-remove): Likewise.

* code/generic.lisp (mcvs-generic): Likewise.
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 "system")
6 (require "mapping")
7 (require "chatter")
8 (provide "prop")
9
10 (defun mcvs-prop (prop-options files)
11 (in-sandbox-root-dir
12 (let (entries-to-process
13 (filemap (mapping-read *mcvs-map-local*)))
14 (chatter-debug "Preparing file list.~%")
15
16 (if (null files)
17 (setf entries-to-process
18 (mapping-prefix-matches filemap
19 (sandbox-translate-path ".")))
20 (dolist (file files)
21 (can-restart-here ("Continue preparing file list.")
22 (let* ((full-name (sandbox-translate-path file))
23 (abs-name (canonicalize-path
24 (real-to-abstract-path full-name)))
25 (entries (mapping-prefix-matches filemap abs-name)))
26 (if (not entries)
27 (error "~a is not known to Meta-CVS." full-name)
28 (setf entries-to-process (nconc entries-to-process entries)))))))
29
30 (when entries-to-process
31 ;; do the property update
32 (chatter-debug "Updating properties.~%")
33 (dolist (entry entries-to-process)
34 (with-slots (raw-plist) entry
35 (loop for (option prop-name value) in prop-options do
36 (let ((indicator (intern (string-upcase prop-name) "KEYWORD")))
37 (cond
38 ((string= option "set")
39 (setf (getf raw-plist indicator) t))
40 ((string= option "clear")
41 (setf (getf raw-plist indicator) nil))
42 ((string= option "value")
43 (setf (getf raw-plist indicator) (read-from-string value)))
44 ((string= option "remove")
45 (remf raw-plist indicator)))
46 (mapping-entry-parse-plist entry)))))
47 (chatter-debug "Writing out map.~%")
48 (mapping-write filemap *mcvs-map*)
49 (chatter-debug "Updating file structure.~%")
50 (mapping-update)
51 (chatter-debug "Synchronizing.~%")
52 (mapping-synchronize))))
53 (values))
54
55 (defun mcvs-prop-wrapper (mcvs-opts command-opts command-args)
56 (declare (ignore mcvs-opts))
57 (mcvs-prop command-opts command-args))

  ViewVC Help
Powered by ViewVC 1.1.5