/[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.9 - (hide annotations)
Mon Mar 8 06:11:40 2004 UTC (10 years, 1 month ago) by kaz
Branch: MAIN
CVS Tags: mcvs-1-1-0
Changes since 1.8: +0 -6 lines
Revamped loading system. Got rid of require/provide in all
Lisp source files.

* code/mcvs.lisp: New file. Responsible for compiling and loading
everything in the right order.

* code/mcvs-main.lisp: File renamed to main.lisp.

* code/mcvs-package.lisp: File renamed to package.lisp.

* code/system.lisp: File removed.
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.6 (in-package "META-CVS")
6 kaz 1.1
7     (defun mcvs-prop (prop-options files)
8     (in-sandbox-root-dir
9     (let (entries-to-process
10 kaz 1.5 (filemap (mapping-read *mcvs-map*)))
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     (mapping-write filemap *mcvs-map*)
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     (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