/[meta-cvs]/meta-cvs/F-AFC09F145399B1273F4BF98702F5BE8C
ViewVC logotype

Contents of /meta-cvs/F-AFC09F145399B1273F4BF98702F5BE8C

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.38 - (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.37: +0 -8 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.9 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.6 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.31 (in-package "META-CVS")
6 kaz 1.1
7 kaz 1.21 (defun mcvs-generic (cvs-command cvs-options command-options command-args
8 kaz 1.34 files &key need-sync-before need-sync-after
9 kaz 1.37 need-update-after global-if-empty-file-list
10     no-invoke-cvs)
11     (when (and *metaonly-option* files)
12     (error "cannot specify both --metaonly option and file arguments."))
13 kaz 1.3 (in-sandbox-root-dir
14 kaz 1.13 (let (files-to-process
15 kaz 1.23 (filemap (mapping-read *mcvs-map-local*))
16 kaz 1.37 (do-meta-files (and (or *metaonly-option* *meta-option*)
17     (not *nometa-option*)
18     (or files
19     (not global-if-empty-file-list)
20     *metaonly-option*))))
21 kaz 1.1
22 kaz 1.37 (unless *metaonly-option*
23 kaz 1.23 (chatter-debug "Preparing file list.~%")
24 kaz 1.1
25 kaz 1.37 (cond
26     ((and (null files)
27     global-if-empty-file-list
28     *nometa-option*)
29     (setf files-to-process filemap))
30     ((and (null files)
31     (not global-if-empty-file-list))
32     (setf files-to-process
33     (mapping-prefix-matches filemap
34     (sandbox-translate-path "."))))
35     (files
36     (dolist (file files)
37     (can-restart-here ("Continue preparing file list.")
38     (let* ((full-name (sandbox-translate-path file))
39     (abs-name (canonicalize-path
40     (real-to-abstract-path full-name)))
41     (entries (mapping-prefix-matches filemap abs-name)))
42     (if (not entries)
43     (error "~a is not known to Meta-CVS." full-name)
44     (setf files-to-process (nconc files-to-process
45     entries)))))))))
46 kaz 1.22
47 kaz 1.27 (setf files-to-process (mapping-extract-kind files-to-process :file))
48    
49 kaz 1.26 (when (or files-to-process
50     do-meta-files
51 kaz 1.33 global-if-empty-file-list)
52 kaz 1.34 (when need-sync-before
53     (chatter-debug "Synchronizing.~%")
54     (mapping-synchronize :filemap files-to-process
55     :direction :left))
56 kaz 1.35 (unless no-invoke-cvs
57     (current-dir-restore
58     (chdir *mcvs-dir*)
59     (chatter-debug "Invoking CVS.~%")
60     (execute-program-xargs `("cvs" ,@(format-opt cvs-options)
61     ,cvs-command ,@(format-opt command-options)
62     ,@command-args)
63     `(,@(when do-meta-files
64     (let (metas)
65     (when (exists ".cvsignore")
66     (push ".cvsignore" metas))
67     (when (exists *mcvs-types-name*)
68     (push *mcvs-types-name* metas))
69     (cons *mcvs-map-name* metas)))
70     ,@(mapcar #'(lambda (x)
71     (basename
72     (mapping-entry-id x)))
73     files-to-process)))))
74 kaz 1.23 (when (and do-meta-files need-update-after)
75     (chatter-debug "Updating file structure.~%")
76     (mapping-update))
77 kaz 1.21 (when need-sync-after
78     (chatter-debug "Synchronizing again.~%")
79 kaz 1.36 (mapping-synchronize :filemap files-to-process
80     :direction :right))))
81 kaz 1.1 (values)))
82 kaz 1.18
83     (defun mcvs-commit-wrapper (cvs-options cvs-command-options mcvs-args)
84 kaz 1.23 (mcvs-generic "commit" cvs-options cvs-command-options nil mcvs-args
85 kaz 1.34 :need-sync-before t
86     :need-sync-after t
87 kaz 1.33 :global-if-empty-file-list t))
88 kaz 1.4
89 kaz 1.7 (defun mcvs-diff-wrapper (cvs-options cvs-command-options mcvs-args)
90 kaz 1.34 (mcvs-generic "diff" cvs-options cvs-command-options nil mcvs-args
91     :need-sync-before t))
92 kaz 1.13
93     (defun mcvs-tag-wrapper (cvs-options cvs-command-options mcvs-args)
94     (if (null mcvs-args)
95 kaz 1.28 (error "specify tag optionally followed by files."))
96 kaz 1.13 (mcvs-generic "tag" cvs-options
97 kaz 1.24 cvs-command-options (list (first mcvs-args)) (rest mcvs-args)
98 kaz 1.33 :global-if-empty-file-list t))
99 kaz 1.14
100     (defun mcvs-log-wrapper (cvs-options cvs-command-options mcvs-args)
101     (mcvs-generic "log" cvs-options cvs-command-options nil mcvs-args))
102    
103     (defun mcvs-status-wrapper (cvs-options cvs-command-options mcvs-args)
104 kaz 1.34 (mcvs-generic "status" cvs-options cvs-command-options nil mcvs-args
105     :need-sync-before t))
106 kaz 1.14
107     (defun mcvs-annotate-wrapper (cvs-options cvs-command-options mcvs-args)
108     (mcvs-generic "annotate" cvs-options cvs-command-options nil mcvs-args))
109 kaz 1.30
110     (defun mcvs-watchers-wrapper (cvs-options cvs-command-options mcvs-args)
111     (mcvs-generic "watchers" cvs-options cvs-command-options nil mcvs-args))
112    
113     (defun mcvs-edit-wrapper (cvs-options cvs-command-options mcvs-args)
114 kaz 1.34 (mcvs-generic "edit" cvs-options cvs-command-options nil mcvs-args
115     :need-sync-before t))
116 kaz 1.30
117     (defun mcvs-unedit-wrapper (cvs-options cvs-command-options mcvs-args)
118     (mcvs-generic "unedit" cvs-options cvs-command-options nil mcvs-args
119 kaz 1.34 :need-sync-before t
120 kaz 1.30 :need-sync-after t))
121    
122     (defun mcvs-editors-wrapper (cvs-options cvs-command-options mcvs-args)
123     (mcvs-generic "editors" cvs-options cvs-command-options nil mcvs-args))
124 kaz 1.35
125     (defun mcvs-sync-to-wrapper (cvs-options cvs-command-options mcvs-args)
126     (mcvs-generic "" cvs-options cvs-command-options nil mcvs-args
127     :need-sync-before t
128     :no-invoke-cvs t))
129    
130     (defun mcvs-sync-from-wrapper (cvs-options cvs-command-options mcvs-args)
131     (mcvs-generic "" cvs-options cvs-command-options nil mcvs-args
132     :need-sync-after t
133     :no-invoke-cvs t))

  ViewVC Help
Powered by ViewVC 1.1.5