/[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.1 - (show annotations)
Fri Sep 6 04:09:46 2002 UTC (11 years, 7 months ago) by kaz
Branch: MAIN
New prop command for manipulating property lists.

* code/mcvs-main.lisp (*prop-options*): New constant.
(*mcvs-command-table*): New entry.
(*usage*): Update.

* code/mapping.lisp (mapping-entry-parse-plist): Just unconditionally
set execute slot based on :exec property.

* code/prop.lisp: New file.
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 "mcvs: ~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 argument) in prop-options do
35 (let ((indicator (intern (string-upcase argument) "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 "remove")
42 (remf raw-plist indicator)))
43 (mapping-entry-parse-plist entry)))))
44 (chatter-debug "Writing out map.~%")
45 (mapping-write filemap *mcvs-map*)
46 (chatter-debug "Updating file structure.~%")
47 (mapping-update)
48 (chatter-debug "Synchronizing.~%")
49 (mapping-synchronize))))
50 (values))
51
52 (defun mcvs-prop-wrapper (mcvs-opts command-opts command-args)
53 (declare (ignore mcvs-opts))
54 (mcvs-prop command-opts command-args))

  ViewVC Help
Powered by ViewVC 1.1.5