/[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 - (show 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 ;;; 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 (in-package :meta-cvs)
6
7 (defun prop (prop-options files)
8 (in-sandbox-root-dir
9 (let (entries-to-process
10 (filemap (mapping-read *map-path*)))
11 (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 (abs-name (canonicalize-path
21 (real-to-abstract-path full-name)))
22 (entries (mapping-prefix-matches filemap abs-name)))
23 (if (not entries)
24 (error "~a is not known to Meta-CVS." full-name)
25 (setf entries-to-process (nconc entries-to-process entries)))))))
26
27 (when (and entries-to-process prop-options)
28 ;; do the property update
29 (chatter-debug "Updating properties.~%")
30 (dolist (entry entries-to-process)
31 (with-slots (raw-plist) entry
32 (loop for (option prop-name value) in prop-options do
33 (let ((indicator (intern (string-upcase prop-name) "KEYWORD")))
34 (cond
35 ((string= option "set")
36 (setf (getf raw-plist indicator) t))
37 ((string= option "clear")
38 (setf (getf raw-plist indicator) nil))
39 ((string= option "value")
40 (setf (getf raw-plist indicator) (read-from-string value)))
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 *map-path*)
46 ;; propagate changes to local map.
47 (chatter-debug "Updating file structure.~%")
48 (mapping-update)
49 ;; propagate permission changes to files.
50 (chatter-debug "Synchronizing.~%")
51 (mapping-synchronize))))
52 (values))
53
54 (defun prop-wrapper (mcvs-opts command-opts command-args)
55 (declare (ignore mcvs-opts))
56 (prop command-opts command-args))

  ViewVC Help
Powered by ViewVC 1.1.5