/[meta-cvs]/meta-cvs/F-233AD6EEE14894A7303F09519A2AB734
ViewVC logotype

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.69.2.1 - (hide annotations)
Sat Oct 12 22:32:23 2002 UTC (11 years, 6 months ago) by kaz
Branch: mcvs-1-0-branch
Changes since 1.69: +1 -1 lines
* code/mcvs-main.lisp (*update-options*): Added -C option.

* code/update.lisp (mcvs-update): Fall back on the mcvs-generic
if --metaonly or --nometa is specified to run CVS on specific
files.
1 kaz 1.16 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.7 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.45 (require "create")
6 kaz 1.1 (require "checkout")
7 kaz 1.46 (require "grab")
8 kaz 1.1 (require "add")
9 kaz 1.3 (require "remove")
10 kaz 1.4 (require "move")
11 kaz 1.1 (require "update")
12 kaz 1.12 (require "filt")
13 kaz 1.21 (require "generic")
14 kaz 1.25 (require "convert")
15 kaz 1.38 (require "branch")
16 kaz 1.44 (require "remap")
17 kaz 1.48 (require "purge")
18 kaz 1.49 (require "restore")
19 kaz 1.54 (require "prop")
20 kaz 1.8 (require "split")
21     (require "restart")
22 kaz 1.27 (require "error")
23 kaz 1.10 (require "options")
24 kaz 1.33 (require "find-bind")
25 kaz 1.6 (provide "mcvs-main")
26 kaz 1.5
27 kaz 1.55 (define-option-constant *cvs-options*
28     (0 arg "H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"
29 kaz 1.69 "meta" "metaonly" "nometa" "error-continue" "error-terminate"
30     "debug")
31 kaz 1.65 (1 arg "T" "e" "d" "r" "z" "s" "i"))
32 kaz 1.55
33 kaz 1.58 (define-option-constant *help-options*)
34    
35 kaz 1.55 (define-option-constant *create-options*
36     (0 arg "d")
37     (1 arg "k" "I" "b" "m" "W"))
38    
39     (define-option-constant *grab-options*
40     (0 arg "A")
41     (1 arg "r"))
42    
43     (define-option-constant *checkout-options*
44 kaz 1.61 (0 arg "f")
45 kaz 1.55 (1 arg "r" "D" "d" "k" "j"))
46    
47     (define-option-constant *add-options*
48     (0 arg "R")
49     (1 arg "k" "m"))
50    
51     (define-option-constant *remove-options*
52     (0 arg "R"))
53    
54     (define-option-constant *update-options*
55 kaz 1.69.2.1 (0 arg "A" "C" "f" "p")
56 kaz 1.55 (1 arg "k" "r" "D" "j" "I" "W"))
57    
58     (define-option-constant *switch-options*
59     (1 arg "k" "I" "W"))
60    
61     (define-option-constant *commit-options*
62     (0 arg "f")
63     (1 arg "F" "m" "r"))
64    
65     (define-option-constant *diff-options*
66     (0 arg "a" "b" "B" "brief" "c" "d" "e" "ed" "expand-tabs" "f" "forward-ed"
67     "H" "i" "ignore-all-space" "ignore-blank-lines" "ignore-case"
68     "ignore-space-change" "initial-tab" "l" "left-column" "minimal" "n"
69     "N" "new-file" "p" "P" "--paginate" "q" "rcs" "report-identical-files"
70     "s" "show-c-function" "side-by-side" "speed-large-files"
71     "suppress-common-lines" "t" "T" "text" "u" "unidirectional-new-file"
72     "w" "y")
73     (1 arg "C" "context" "D" "F" "horizon-lines" "ifdef" "ignore-matching-lines"
74     "L" "label" "line-format" "new-group-format" "new-line-format"
75     "old-group-format" "old-line-format" "r" "show-function-line"
76     "unchanged-group-format" "unchanged-line-format" "U" "unified" "W"
77     "width"))
78    
79     (define-option-constant *tag-options*
80     (0 arg "l" "d" "f" "b" "F" "c")
81     (1 arg "r" "D"))
82    
83     (define-option-constant *log-options*
84     (0 arg "R" "h" "t" "N" "b")
85     (1 arg "r" "d" "s" "w"))
86    
87     (define-option-constant *status-options*
88     (0 arg "v"))
89    
90     (define-option-constant *annotate-options*
91     (0 arg "f")
92     (1 arg "r" "D"))
93    
94     (define-option-constant *filt-options*
95     (1 arg "r" "D"))
96    
97 kaz 1.57 (define-option-constant *move-options*)
98 kaz 1.55 (define-option-constant *convert-options*)
99     (define-option-constant *branch-options*)
100     (define-option-constant *merge-options*)
101     (define-option-constant *remerge-options*)
102     (define-option-constant *list-branches-options*)
103     (define-option-constant *remap-options*)
104     (define-option-constant *purge-options*)
105     (define-option-constant *restore-options*)
106    
107     (define-option-constant *prop-options*
108     (1 arg "set" "clear" "remove")
109     (2 arg "value"))
110 kaz 1.18
111 kaz 1.58 (defun mcvs-help (global-options command-options args)
112     (declare (special *usage* *mcvs-command-table*)
113     (ignore global-options command-options))
114     (cond
115     ((null args)
116     (terpri)
117     (write-line *usage*)
118     (terpri))
119     ((= (length args) 1)
120     (let* ((command-name (first args))
121     (command (find command-name *mcvs-command-table*
122     :key #'first
123     :test #'string=)))
124     (when (null command)
125 kaz 1.69 (error "~a is not a recognized mcvs command."
126 kaz 1.58 command-name))
127 kaz 1.59 (let ((help-text (third command)))
128     (when (null help-text)
129 kaz 1.69 (error "sorry, no help available for ~a command."
130 kaz 1.58 command-name))
131 kaz 1.59 (terpri)
132     (write-line help-text)
133     (terpri))))
134 kaz 1.69 (t (error "try \"mcvs help <name-of-command>\"."))))
135 kaz 1.58
136 kaz 1.5 (defconstant *mcvs-command-table*
137 kaz 1.58 `(("help" ,#'mcvs-help nil ,*help-options*)
138 kaz 1.59 ("create" ,#'mcvs-create-wrapper ,*create-help* ,*create-options*)
139 kaz 1.60 ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
140 kaz 1.61 ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
141     ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
142     ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)
143 kaz 1.63 ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
144 kaz 1.64 ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
145 kaz 1.58 ("move" ,#'mcvs-move-wrapper nil ,*move-options*)
146     ("mv" ,#'mcvs-move-wrapper nil ,*move-options*)
147     ("update" ,#'mcvs-update-wrapper nil ,*update-options*)
148     ("up" ,#'mcvs-update-wrapper nil ,*update-options*)
149     ("commit" ,#'mcvs-commit-wrapper nil ,*commit-options*)
150     ("ci" ,#'mcvs-commit-wrapper nil ,*commit-options*)
151     ("diff" ,#'mcvs-diff-wrapper nil ,*diff-options*)
152     ("tag" ,#'mcvs-tag-wrapper nil ,*tag-options*)
153     ("log" ,#'mcvs-log-wrapper nil ,*log-options*)
154     ("status" ,#'mcvs-status-wrapper nil ,*status-options*)
155     ("stat" ,#'mcvs-status-wrapper nil ,*status-options*)
156     ("annotate" ,#'mcvs-annotate-wrapper nil ,*annotate-options*)
157     ("filt" ,#'mcvs-filt-wrapper nil ,*filt-options*)
158     ("fi" ,#'mcvs-filt-wrapper nil ,*filt-options*)
159     ("convert" ,#'mcvs-convert-wrapper nil ,*convert-options*)
160     ("branch" ,#'mcvs-branch-wrapper nil ,*branch-options*)
161     ("switch" ,#'mcvs-switch-wrapper nil ,*switch-options*)
162     ("sw" ,#'mcvs-switch-wrapper nil ,*switch-options*)
163     ("merge" ,#'mcvs-merge-wrapper nil ,*merge-options*)
164     ("remerge" ,#'mcvs-remerge-wrapper nil ,*remerge-options*)
165     ("list-branches" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
166     ("lb" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
167     ("purge" ,#'mcvs-purge-wrapper nil ,*purge-options*)
168     ("restore" ,#'mcvs-restore-wrapper nil ,*restore-options*)
169     ("remap" ,#'mcvs-remap-wrapper nil ,*remap-options*)
170     ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)))
171 kaz 1.5
172 kaz 1.33 (defconstant *usage*
173     "Meta-CVS command syntax:
174    
175 kaz 1.59 mcvs [ global-options] command [ command-options ] [ command-arguments ]
176 kaz 1.33
177     Global options:
178    
179 kaz 1.35 -H --help Print this help and terminate. If a command is specified,
180     help specific to that command is printed instead.
181     -Q Very quiet, generate output only for serious problems. (*)
182     -q Somewhat quiet, some informational messages suppresed. (*)
183 kaz 1.69 --debug Verbose debug output; -Q and -q are ignored but still
184     passed to CVS.
185 kaz 1.35 -r Make working files read-only. (@)
186     -w Make new working files read-write (default). (@)
187     -l Do not log cvs command in command history, but execute
188     it anyway. (@)
189     -t Trace CVS execution. (@)
190     -v --version Display version information and terminate.
191     -f CVS not to read ~/.cvsrc file. (@)
192 kaz 1.65 -i script-name Load a Lisp file and evaluate its top level forms,
193     allowing Meta-CVS to behave as an interpreter.
194 kaz 1.50 --meta Include metafiles such as MCVS/MAP in the set of files
195     to operate on.
196     --metaonly Operate only on metafiles.
197     --nometa Exclude metafiles from the set of files to operate on.
198 kaz 1.35 --error-continue Instead of interactive error handling, automatically
199     continue all continuable errors.
200     --error-terminate Terminate without cleanup when an error happens instead
201     of interactive error handling (use with care).
202     -T tempdir Place temporary files in tempdir. (@)
203     -e editor Edit messages with editor. (*)
204     -d root Specify CVSROOT. (@)
205     -z gzip-level Specify compression level. (@)
206 kaz 1.33
207     Notes: (*) option processed by Meta-CVS and passed to CVS too.
208     (@) option merely passed to CVS.
209    
210     Commands:
211    
212 kaz 1.59 help Obtain more detailed help for a specific command.
213 kaz 1.45 create Create new project from an existing file tree.
214 kaz 1.46 grab Take a snapshot of an external source tree, such
215     as a third-party release, and incorporate it into
216     the working copy. Tries to discover file moves.
217 kaz 1.35 checkout (co) Retrieve a Meta-CVS project from CVS and build
218     working copy.
219     add Place files (or directories with add -R) under
220     version control.
221     remove (rm) Remove files or directories.
222     move (mv) Rename files and directories.
223     update (up) Incorporate latest changes from repository into
224     working copy.
225     commit (ci) Incorporate outstanding changes in the working copy
226     into the repository.
227     diff Compute differences between files in the working copy
228     and the repository or between revisions in the repository.
229     tag Associate a symbolic name with file revisions to create
230     an identifiable baseline. By default, tags the
231     revisions that were last synchronized with the
232     directory. A branch is created using tag -b.
233     log Display log information for files.
234     status (stat) Show current status of files.
235     annotate Perform a detailed analysis of files, showing the
236     version information about every individual line of text.
237     filt (fi) Act as a text filter, which converts Meta-CVS F- file
238     names to readable paths, according to the current mapping.
239 kaz 1.38 branch Create a managed branch. Meta-CVS managed branches keep
240     track of what has been merged where, so users don't have
241     to track merges with tags at all.
242     merge Merge a managed branch to the current branch or trunk.
243 kaz 1.40 remerge Re-apply the most recent merge without changing any tags.
244     Useful when a merge goes bad so the local changes have
245     to be discarded and the merge done over again.
246 kaz 1.41 list-branches (lb) List Meta-CVS managed branches.
247 kaz 1.43 switch (sw) Switch to a branch. With no arguments, switch to
248 kaz 1.42 main trunk.
249 kaz 1.44 remap Force Meta-CVS to notice and incorporate moves and
250     deletions that were performed directly on the sandbox.
251 kaz 1.48 purge Execute a CVS remove on files that have been unmapped
252     with the remove command.
253 kaz 1.51 restore Restore files that have been deleted with the remove
254     command, but not purged. These appear in the lost+found
255     directory under cryptic names.
256 kaz 1.54 prop Manipulate properties.
257 kaz 1.56 prop --set <bool-prop-name> [ files ... ]
258     prop --clear <bool-prop-name> [ files ... ]
259 kaz 1.62 prop --value <prop-name> <new-value> [ files ... ]
260     prop --remove <prop-name> [ files ... ]
261 kaz 1.56 The ``exec'' property represents the execute permission
262     of a file. More than one --set, --clear, --value
263     or --remove may be specified before the files.
264 kaz 1.35 convert Convert a CVS module to a Meta-CVS project. This requires
265     filesystem-level access to the repository. This is
266     currently an experimental command that is known not
267     to work 100%.")
268 kaz 1.33
269 kaz 1.68 (defvar *options*)
270 kaz 1.67 (defvar *args*)
271 kaz 1.66
272 kaz 1.5 (defun mcvs-execute (args)
273 kaz 1.27 (handler-bind ((error #'mcvs-error-handler))
274 kaz 1.18 (multiple-value-bind (global-options global-args)
275 kaz 1.55 (parse-opt args *cvs-options*)
276 kaz 1.33 (setf global-options (filter-global-options global-options))
277    
278     (find-bind (:test #'string= :key #'first)
279     ((help-long "help") (help "H") (quiet "q")
280 kaz 1.34 (very-quiet "Q") (version "v") (version-long "version")
281 kaz 1.65 (editor "e") (interpret-file "i"))
282 kaz 1.33 global-options
283 kaz 1.68 (setf *args* global-args)
284     (setf *options* global-options)
285 kaz 1.33 (when (or help-long help)
286     (terpri)
287     (write-line *usage*)
288     (terpri)
289     (throw 'mcvs-terminate nil))
290     (when (or version version-long)
291 kaz 1.34 (let* ((vers (split-words "$Name: $" "$:- "))
292 kaz 1.33 (major (third vers))
293     (minor (fourth vers)))
294     (if (and major minor)
295     (format t "Meta-CVS version ~a.~a (c) 2002 Kaz Kylheku~%"
296     major minor)
297     (format t "Meta-CVS unknown version (c) 2002 Kaz Kylheku~%"))
298 kaz 1.34 (throw 'mcvs-terminate nil)))
299     (when editor
300     (setf *editor* (second editor)))
301     (cond
302     (very-quiet (setf *mcvs-chatter-level* *mcvs-silent*))
303 kaz 1.69 (quiet (setf *mcvs-chatter-level* *mcvs-terse*)))
304 kaz 1.65 (when interpret-file
305 kaz 1.66 (load (second interpret-file))
306     (throw 'mcvs-terminate nil)))
307 kaz 1.33
308 kaz 1.18 (when (not (first global-args))
309 kaz 1.35 (write-line "Meta-CVS requires a command argument.")
310 kaz 1.33 (write-line "Use mcvs -H to view help.")
311     (throw 'mcvs-terminate nil))
312    
313 kaz 1.18 (let ((command (find (first global-args) *mcvs-command-table*
314 kaz 1.55 :key #'first
315     :test #'string=)))
316 kaz 1.11 (when (not command)
317 kaz 1.69 (error "~a is not a recognized mcvs command."
318 kaz 1.18 (first global-args)))
319 kaz 1.58 (destructuring-bind (name func help-text opt-spec) command
320     (declare (ignore name help-text))
321 kaz 1.68 (multiple-value-bind (command-options command-args)
322     (parse-opt (rest global-args) opt-spec)
323     (funcall func global-options command-options command-args))))))
324 kaz 1.18 nil)
325 kaz 1.5
326 kaz 1.8 (defun mcvs-debug-shell ()
327 kaz 1.24 (let ((counter 0)
328     (*mcvs-error-treatment* :decline))
329     (loop
330     (format t "~&mcvs[~a]> " (incf counter))
331     (let ((line (string-trim #(#\space #\tab) (read-line))))
332 kaz 1.29 (restart-case
333 kaz 1.24 (cond
334     ((zerop (length line)))
335     ((string-equal line "exit")
336     (return-from mcvs-debug-shell))
337     ((char-equal (char line 0) #\!)
338     (print (eval (read-from-string (subseq line 1)))))
339 kaz 1.29 (t (mcvs-execute (split-words line #(#\space #\tab)))))
340 kaz 1.36 (debug () :report "Return to mcvs debug shell"
341 kaz 1.29 (terpri)))))))
342 kaz 1.10
343 kaz 1.5 #+clisp
344     (defun mcvs ()
345 kaz 1.28 (exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
346     *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5