/[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.12 - (hide annotations)
Tue Nov 28 07:47:21 2006 UTC (7 years, 4 months ago) by kaz
Branch: MAIN
CVS Tags: asdf-import-branch~merged-to-HEAD-0, mcvs-1-1-98, asdf-import-branch~branch-point, HEAD
Branch point for: asdf-import-branch
Changes since 1.11: +2 -2 lines
More renaming to get rid of mcvs- prefix.

* code/chatter.lisp (*mcvs-debug*): Renamed to *chatter-debug*.
(*mcvs-info*, *mcvs-terse*, *mcvs-silent*): Similarly.
(*mcvs-chatter-level*): Renamed to *chatter-level*.

* code/unix.lisp (*mcvs-editor*): Renamed to *edit-program*.

* code/types.lisp (*mcvs-types-name*): Renamed to *types-file*.
(*mcvs-types*): Renamed to *types-path*.
(*mcvs-new-types*): Renamed to *types-new-path*.

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

  ViewVC Help
Powered by ViewVC 1.1.5