/[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.3 - (show annotations)
Sat Oct 5 18:09:48 2002 UTC (11 years, 6 months ago) by kaz
Branch: MAIN
Changes since 1.2: +1 -1 lines
Error messages no longer specify prefixes like "mcvs:" or
"mcvs-remove:".

When no restarts are available, the error handler now adds the "mcvs:"
prefix when dumping the error text to the standard error stream,
and also adds a terminating newline.

The inability to write to the MAP file is converted to a more
informative error message.

New --debug option is supported to set the chatter level to 3.
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 (real-to-abstract-path full-name))
24 (entries (mapping-prefix-matches filemap abs-name)))
25 (if (not entries)
26 (error "~a is not known to Meta-CVS." full-name)
27 (setf entries-to-process (nconc entries-to-process entries)))))))
28
29 (when entries-to-process
30 ;; do the property update
31 (chatter-debug "Updating properties.~%")
32 (dolist (entry entries-to-process)
33 (with-slots (raw-plist) entry
34 (loop for (option prop-name value) in prop-options do
35 (let ((indicator (intern (string-upcase prop-name) "KEYWORD")))
36 (cond
37 ((string= option "set")
38 (setf (getf raw-plist indicator) t))
39 ((string= option "clear")
40 (setf (getf raw-plist indicator) nil))
41 ((string= option "value")
42 (setf (getf raw-plist indicator) (read-from-string value)))
43 ((string= option "remove")
44 (remf raw-plist indicator)))
45 (mapping-entry-parse-plist entry)))))
46 (chatter-debug "Writing out map.~%")
47 (mapping-write filemap *mcvs-map*)
48 (chatter-debug "Updating file structure.~%")
49 (mapping-update)
50 (chatter-debug "Synchronizing.~%")
51 (mapping-synchronize))))
52 (values))
53
54 (defun mcvs-prop-wrapper (mcvs-opts command-opts command-args)
55 (declare (ignore mcvs-opts))
56 (mcvs-prop command-opts command-args))

  ViewVC Help
Powered by ViewVC 1.1.5