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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5