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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.103 - (hide annotations)
Sat Mar 8 02:43:16 2008 UTC (6 years, 1 month ago) by kaz
Branch: MAIN
CVS Tags: mcvs-1-1-98, HEAD
Changes since 1.102: +31 -23 lines
Implement -x option.
Allow repetitions of -i.

* code/main.lisp (*global-options*): Add "x" as a 1 arg option.
(*usage*): Describe -x in help text.
(execute): Execute all forms in the newly introduced *exec-list*
before invoking the command (if there is one). Only complain about a
missing command if the *exec-list* is empty.

* code/options.lisp (*exec-list*): New dynamic variable.
(filter-mcvs-options): Look for -x and -i options in the options,
remove them, and turn them into items in the *exec-list*.
The arguments of -x are parsed as Lisp using read-from-string.
The -i arguments are turned into (LOAD ...) forms.
(process-cvs-options): The -i option is no longer handled here.
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.95 (in-package :meta-cvs)
6 kaz 1.79
7 kaz 1.82 (define-option-constant *global-options*
8 kaz 1.55 (0 arg "H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"
9 kaz 1.97 "meta" "metaonly" "nometa" "error-continue" "error-terminate" "debug"
10     "nofilt")
11 kaz 1.103 (1 arg "T" "e" "d" "r" "z" "s" "i" "x" "up"))
12 kaz 1.55
13 kaz 1.58 (define-option-constant *help-options*)
14    
15 kaz 1.55 (define-option-constant *create-options*
16     (0 arg "d")
17     (1 arg "k" "I" "b" "m" "W"))
18    
19     (define-option-constant *grab-options*
20     (0 arg "A")
21     (1 arg "r"))
22    
23     (define-option-constant *checkout-options*
24 kaz 1.61 (0 arg "f")
25 kaz 1.55 (1 arg "r" "D" "d" "k" "j"))
26    
27 kaz 1.71 (define-option-constant *export-options*
28     (0 arg "f")
29     (1 arg "r" "D" "d" "k"))
30    
31 kaz 1.55 (define-option-constant *add-options*
32     (0 arg "R")
33     (1 arg "k" "m"))
34    
35     (define-option-constant *remove-options*
36     (0 arg "R"))
37    
38     (define-option-constant *update-options*
39 kaz 1.70 (0 arg "A" "C" "f" "p")
40 kaz 1.55 (1 arg "k" "r" "D" "j" "I" "W"))
41    
42     (define-option-constant *switch-options*
43     (1 arg "k" "I" "W"))
44    
45     (define-option-constant *commit-options*
46     (0 arg "f")
47     (1 arg "F" "m" "r"))
48    
49     (define-option-constant *diff-options*
50     (0 arg "a" "b" "B" "brief" "c" "d" "e" "ed" "expand-tabs" "f" "forward-ed"
51     "H" "i" "ignore-all-space" "ignore-blank-lines" "ignore-case"
52     "ignore-space-change" "initial-tab" "l" "left-column" "minimal" "n"
53     "N" "new-file" "p" "P" "--paginate" "q" "rcs" "report-identical-files"
54     "s" "show-c-function" "side-by-side" "speed-large-files"
55     "suppress-common-lines" "t" "T" "text" "u" "unidirectional-new-file"
56     "w" "y")
57     (1 arg "C" "context" "D" "F" "horizon-lines" "ifdef" "ignore-matching-lines"
58     "L" "label" "line-format" "new-group-format" "new-line-format"
59     "old-group-format" "old-line-format" "r" "show-function-line"
60     "unchanged-group-format" "unchanged-line-format" "U" "unified" "W"
61     "width"))
62    
63     (define-option-constant *tag-options*
64     (0 arg "l" "d" "f" "b" "F" "c")
65     (1 arg "r" "D"))
66    
67     (define-option-constant *log-options*
68     (0 arg "R" "h" "t" "N" "b")
69     (1 arg "r" "d" "s" "w"))
70    
71     (define-option-constant *status-options*
72     (0 arg "v"))
73    
74     (define-option-constant *annotate-options*
75     (0 arg "f")
76     (1 arg "r" "D"))
77    
78     (define-option-constant *filt-options*
79     (1 arg "r" "D"))
80    
81 kaz 1.84 (define-option-constant *remote-filt-options*
82     (1 arg "r" "D"))
83    
84 kaz 1.57 (define-option-constant *move-options*)
85 kaz 1.78 (define-option-constant *link-options*)
86 kaz 1.55 (define-option-constant *convert-options*)
87     (define-option-constant *branch-options*)
88 kaz 1.81
89     (define-option-constant *merge-options*
90     (1 arg "k"))
91    
92     (define-option-constant *remerge-options*
93     (1 arg "k"))
94    
95 kaz 1.55 (define-option-constant *list-branches-options*)
96     (define-option-constant *remap-options*)
97     (define-option-constant *purge-options*)
98     (define-option-constant *restore-options*)
99    
100     (define-option-constant *prop-options*
101     (1 arg "set" "clear" "remove")
102     (2 arg "value"))
103 kaz 1.18
104 kaz 1.72 (define-option-constant *watch-options*
105     (0 arg "on" "off")
106     (1 arg "add" "remove"))
107    
108 kaz 1.73 (define-option-constant *watchers-options*)
109     (define-option-constant *edit-options*)
110     (define-option-constant *unedit-options*)
111     (define-option-constant *editors-options*)
112 kaz 1.87 (define-option-constant *sync-to-cvs-options*)
113     (define-option-constant *sync-from-cvs-options*)
114 kaz 1.73
115 kaz 1.99 (defconstant *command-table*
116 kaz 1.101 `(("help" ,'help nil ,*help-options*)
117 kaz 1.99 ("create" ,#'create-wrapper ,*create-help* ,*create-options* nil)
118     ("grab" ,#'grab-wrapper ,*grab-help* ,*grab-options* nil)
119     ("checkout" ,#'checkout-wrapper ,*checkout-help* ,*checkout-options* t)
120     ("co" ,#'checkout-wrapper ,*checkout-help* ,*checkout-options* nil)
121     ("export" ,#'export-wrapper ,*export-help* ,*export-options* nil)
122     ("ex" ,#'export-wrapper ,*export-help* ,*export-options* nil)
123 kaz 1.102 ("add" ,#'add-wrapper ,*add-help* ,*add-options* nil)
124     ("remove" ,#'remove-wrapper ,*remove-help* ,*remove-options* nil)
125     ("rm" ,#'remove-wrapper ,*remove-help* ,*remove-options* nil)
126     ("move" ,#'move-wrapper ,*move-help* ,*move-options* nil)
127     ("mv" ,#'move-wrapper ,*move-help* ,*move-options* nil)
128     ("link" ,#'link-wrapper ,*link-help* ,*link-options* nil)
129     ("ln" ,#'link-wrapper ,*link-help* ,*link-options* nil)
130 kaz 1.99 ("update" ,#'update-wrapper nil ,*update-options* t)
131     ("up" ,#'update-wrapper nil ,*update-options* t)
132     ("commit" ,#'commit-wrapper nil ,*commit-options* nil)
133     ("ci" ,#'commit-wrapper nil ,*commit-options* nil)
134     ("diff" ,#'diff-wrapper nil ,*diff-options* t)
135     ("tag" ,#'tag-wrapper nil ,*tag-options* t)
136     ("log" ,#'log-wrapper nil ,*log-options* t)
137     ("status" ,#'status-wrapper nil ,*status-options* t)
138     ("stat" ,#'status-wrapper nil ,*status-options* t)
139     ("annotate" ,#'annotate-wrapper nil ,*annotate-options* t)
140     ("filt" ,#'filt-wrapper nil ,*filt-options* nil)
141     ("fi" ,#'filt-wrapper nil ,*filt-options* nil)
142     ("remote-filt" ,#'remote-filt-wrapper nil ,*remote-filt-options* nil)
143     ("rfilt" ,#'remote-filt-wrapper nil ,*remote-filt-options* nil)
144     ("rfi" ,#'remote-filt-wrapper nil ,*remote-filt-options* nil)
145     ("convert" ,#'convert-wrapper ,*convert-help* ,*convert-options* nil)
146     ("branch" ,#'branch-wrapper ,*branch-help* ,*branch-options* t)
147     ("switch" ,#'switch-wrapper nil ,*switch-options* t)
148     ("sw" ,#'switch-wrapper nil ,*switch-options* t)
149 kaz 1.102 ("merge" ,#'merge-wrapper nil ,*merge-options* nil)
150     ("remerge" ,#'remerge-wrapper nil ,*remerge-options* nil)
151 kaz 1.99 ("list-branches" ,#'list-branches-wrapper nil ,*list-branches-options* nil)
152     ("lb" ,#'list-branches-wrapper nil ,*list-branches-options* nil)
153     ("purge" ,#'purge-wrapper nil ,*purge-options* nil)
154     ("restore" ,#'restore-wrapper nil ,*restore-options* nil)
155     ("remap" ,#'remap-wrapper nil ,*remap-options* nil)
156 kaz 1.102 ("prop" ,#'prop-wrapper nil ,*prop-options* nil)
157 kaz 1.99 ("watch" ,#'watch-wrapper nil ,*watch-options* nil)
158     ("watchers" ,#'watchers-wrapper nil ,*watchers-options* nil)
159     ("edit" ,#'edit-wrapper nil ,*edit-options* nil)
160     ("unedit" ,#'unedit-wrapper nil ,*unedit-options* nil)
161     ("editors" ,#'editors-wrapper nil ,*editors-options* nil)
162 kaz 1.102 ("sync-from-cvs" ,#'sync-from-wrapper nil ,*editors-options* nil)
163     ("sync-to-cvs" ,#'sync-to-wrapper nil ,*editors-options* nil)))
164 kaz 1.5
165 kaz 1.33 (defconstant *usage*
166     "Meta-CVS command syntax:
167    
168 kaz 1.91 mcvs [ global-options ] command [ command-options ] [ command-arguments ]
169 kaz 1.33
170     Global options:
171    
172 kaz 1.35 -H --help Print this help and terminate. If a command is specified,
173     help specific to that command is printed instead.
174     -Q Very quiet, generate output only for serious problems. (*)
175 kaz 1.91 -q Somewhat quiet, some info messages suppressed. (*)
176 kaz 1.80 -n Dry run; do not modify filesystem. (*)
177 kaz 1.97 --nofilt Do not filter the output of CVS commands. Normally,
178     many Meta-CVS commands that invoke CVS call it with
179     with its standard output redirected to a filtering
180     process equivalent to ``mcvs filt''.
181 kaz 1.69 --debug Verbose debug output; -Q and -q are ignored but still
182     passed to CVS.
183 kaz 1.35 -r Make working files read-only. (@)
184     -w Make new working files read-write (default). (@)
185     -l Do not log cvs command in command history, but execute
186     it anyway. (@)
187     -t Trace CVS execution. (@)
188     -v --version Display version information and terminate.
189     -f CVS not to read ~/.cvsrc file. (@)
190 kaz 1.65 -i script-name Load a Lisp file and evaluate its top level forms,
191     allowing Meta-CVS to behave as an interpreter.
192 kaz 1.103 Can be specified more than once.
193     -x expression Parse the argument as a Lisp expression and evaluate.
194     Can be specified more than once.
195 kaz 1.50 --meta Include metafiles such as MCVS/MAP in the set of files
196     to operate on.
197     --metaonly Operate only on metafiles.
198     --nometa Exclude metafiles from the set of files to operate on.
199 kaz 1.35 --error-continue Instead of interactive error handling, automatically
200     continue all continuable errors.
201 kaz 1.86 --error-terminate Terminate with cleanup when an error happens instead
202 kaz 1.85 of interactive error handling.
203 kaz 1.35 -T tempdir Place temporary files in tempdir. (@)
204     -e editor Edit messages with editor. (*)
205     -d root Specify CVSROOT. (@)
206     -z gzip-level Specify compression level. (@)
207 kaz 1.83 --up N Escape out of N levels of sandbox nesting before executing
208     operation.
209 kaz 1.33
210     Notes: (*) option processed by Meta-CVS and passed to CVS too.
211     (@) option merely passed to CVS.
212    
213     Commands:
214    
215 kaz 1.59 help Obtain more detailed help for a specific command.
216 kaz 1.45 create Create new project from an existing file tree.
217 kaz 1.46 grab Take a snapshot of an external source tree, such
218     as a third-party release, and incorporate it into
219     the working copy. Tries to discover file moves.
220 kaz 1.72 checkout (co) Retrieve a Meta-CVS project from the repository to
221     create a working copy.
222     export (ex) Retrieve a Meta-CVS project without creating a
223 kaz 1.35 working copy.
224     add Place files (or directories with add -R) under
225     version control.
226     remove (rm) Remove files or directories.
227     move (mv) Rename files and directories.
228 kaz 1.78 link (ln) Create a versioned symbolic link.
229 kaz 1.35 update (up) Incorporate latest changes from repository into
230     working copy.
231     commit (ci) Incorporate outstanding changes in the working copy
232     into the repository.
233     diff Compute differences between files in the working copy
234     and the repository or between revisions in the repository.
235     tag Associate a symbolic name with file revisions to create
236     an identifiable baseline. By default, tags the
237     revisions that were last synchronized with the
238 kaz 1.90 directory. Note: tag -b creates a CVS branch,
239     it won't be a Meta-CVS branch with managed merges.
240     Consider the branch command instead!
241 kaz 1.35 log Display log information for files.
242     status (stat) Show current status of files.
243     annotate Perform a detailed analysis of files, showing the
244     version information about every individual line of text.
245     filt (fi) Act as a text filter, which converts Meta-CVS F- file
246     names to readable paths, according to the current mapping.
247 kaz 1.97 This is not required in most situations, since Meta-CVS
248     arranges a filter automatically (see --nofilt option).
249 kaz 1.84 remote-filt (rfi) Remote version of filt, requires module name.
250 kaz 1.38 branch Create a managed branch. Meta-CVS managed branches keep
251     track of what has been merged where, so users don't have
252     to track merges with tags at all.
253     merge Merge a managed branch to the current branch or trunk.
254 kaz 1.40 remerge Re-apply the most recent merge without changing any tags.
255     Useful when a merge goes bad so the local changes have
256     to be discarded and the merge done over again.
257 kaz 1.41 list-branches (lb) List Meta-CVS managed branches.
258 kaz 1.43 switch (sw) Switch to a branch. With no arguments, switch to
259 kaz 1.42 main trunk.
260 kaz 1.44 remap Force Meta-CVS to notice and incorporate moves and
261     deletions that were performed directly on the sandbox.
262 kaz 1.48 purge Execute a CVS remove on files that have been unmapped
263     with the remove command.
264 kaz 1.51 restore Restore files that have been deleted with the remove
265     command, but not purged. These appear in the lost+found
266     directory under cryptic names.
267 kaz 1.54 prop Manipulate properties.
268 kaz 1.56 prop --set <bool-prop-name> [ files ... ]
269 kaz 1.77 prop --clear <bool-prop-name> [ files ... ]
270     prop --value <prop-name> <new-value> [ files ... ]
271     prop --remove <prop-name> [ files ... ]
272     The ``exec'' property represents the execute permission
273     of a file. More than one --set, --clear, --value
274     or --remove may be specified before the files.
275 kaz 1.72 watch Manipulate per-file CVS watch settings.
276     watch --on [ files ... ]
277     watch --off [ files ... ]
278     watch --add <action> [ files ... ]
279     watch --remove <action> [ files ... ]
280 kaz 1.73 watchers See who is watching files.
281     edit Indicate the intent to edit a watched file.
282     unedit Retract the indication signaled by edit.
283     editors See who is editing files.
284 kaz 1.87 sync-to-cvs Synchronize tree in the direction of the CVS sandbox.
285     Useful when extending Meta-CVS with external scripts.
286     sync-from-cvs Synchronize CVS sandbox to the tree.
287 kaz 1.92 convert Convert a CVS module to a Meta-CVS project.
288     This requires direct filesystem access to the repository.
289     Caveat: this is a very blunt instrument.")
290 kaz 1.33
291 kaz 1.99 (defun help (global-options command-options args)
292     (declare (ignore global-options command-options))
293     (cond
294     ((null args)
295     (terpri)
296     (write-line *usage*)
297     (terpri))
298     ((= (length args) 1)
299     (let* ((command-name (first args))
300     (command (find command-name *command-table*
301     :key #'first
302     :test #'string=)))
303     (when (null command)
304     (error "~a is not a recognized mcvs command."
305     command-name))
306     (let ((help-text (third command)))
307     (when (null help-text)
308     (error "sorry, no help available for ~a command."
309     command-name))
310     (terpri)
311     (write-line help-text)
312     (terpri))))
313     (t (error "try \"mcvs help <name-of-command>\"."))))
314    
315    
316 kaz 1.90 (defmacro with-open-file-ignore-errors ((var &rest open-args) &body forms)
317     `(let ((,var (ignore-errors (open ,@open-args))))
318     (unwind-protect
319     (progn ,@forms)
320     (when ,var (close ,var)))))
321    
322 kaz 1.99 (defun execute (args)
323     (handler-bind ((error #'error-handler))
324 kaz 1.96 (multiple-value-bind (global-options global-args)
325     (parse-opt args *global-options*)
326     (setf global-options (filter-global-options global-options))
327    
328     (when *print-usage*
329     (terpri)
330     (write-line *usage*)
331     (terpri)
332 kaz 1.99 (throw 'terminate nil))
333 kaz 1.96
334 kaz 1.103 (if *exec-list*
335     (let ((*package* (find-package :mcvs)))
336     (dolist (expr *exec-list*)
337     (eval expr)))
338     (unless global-args
339     (write-line "Meta-CVS requires a command argument." *error-output*)
340     (write-line "Use mcvs -H to view help." *error-output*)
341     (throw 'terminate nil)))
342    
343     (if global-args
344     (let ((command (find (first global-args) *command-table*
345     :key #'first
346     :test #'string=)))
347     (when (not command)
348     (error "~a is not a recognized mcvs command."
349     (first global-args)))
350     (destructuring-bind (name func help-text opt-spec
351     &optional filtered) command
352     (declare (ignore name help-text))
353     (multiple-value-bind (command-options command-args)
354     (parse-opt (rest global-args) opt-spec)
355     (with-filtered-execute-program ((and filtered
356     (not *nofilt-option*))
357     (lambda ()
358     (filt nil))
359     :output)
360     (funcall func global-options command-options command-args)))))))))
361 kaz 1.96
362 kaz 1.100 (defun init ()
363     #+clisp
364     (let ((encoding (ext:make-encoding :charset 'charset:iso-8859-1)))
365     (setf custom:*foreign-encoding* encoding
366     custom:*default-file-encoding* encoding
367     custom:*misc-encoding* encoding)))
368    
369 kaz 1.96 (defun main ()
370 kaz 1.100 (init)
371 kaz 1.90 (with-open-file-ignore-errors (*interactive-error-io* (parse-posix-namestring
372     (unix-funcs:ctermid))
373     :direction :io
374     :if-does-not-exist nil)
375 kaz 1.99 (let ((*error-treatment* (if *interactive-error-io*
376     :interactive
377     :terminate)))
378 kaz 1.89 (unless *interactive-error-io*
379 kaz 1.90 (chatter-info "unable to open terminal device ~a .~%"
380 kaz 1.89 (unix-funcs:ctermid))
381 kaz 1.90 (chatter-info "interactive error handling disabled.~%"))
382 kaz 1.99 (ext:exit (catch 'terminate
383     (execute #+clisp ext:*args*)
384     *errors-occured-p*)))))
385 kaz 1.85
386 kaz 1.96 (defun main-debug ()
387 kaz 1.100 (init)
388 kaz 1.99 (let ((*error-treatment* :decline)
389 kaz 1.96 (*interactive-error-io* *terminal-io*))
390 kaz 1.99 (ext:exit (catch 'terminate
391     (execute #+clisp ext:*args*)
392     *errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5