/[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 - (show 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 ;;; 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 (in-package :meta-cvs)
6
7 (define-option-constant *global-options*
8 (0 arg "H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"
9 "meta" "metaonly" "nometa" "error-continue" "error-terminate" "debug"
10 "nofilt")
11 (1 arg "T" "e" "d" "r" "z" "s" "i" "x" "up"))
12
13 (define-option-constant *help-options*)
14
15 (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 (0 arg "f")
25 (1 arg "r" "D" "d" "k" "j"))
26
27 (define-option-constant *export-options*
28 (0 arg "f")
29 (1 arg "r" "D" "d" "k"))
30
31 (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 (0 arg "A" "C" "f" "p")
40 (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 (define-option-constant *remote-filt-options*
82 (1 arg "r" "D"))
83
84 (define-option-constant *move-options*)
85 (define-option-constant *link-options*)
86 (define-option-constant *convert-options*)
87 (define-option-constant *branch-options*)
88
89 (define-option-constant *merge-options*
90 (1 arg "k"))
91
92 (define-option-constant *remerge-options*
93 (1 arg "k"))
94
95 (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
104 (define-option-constant *watch-options*
105 (0 arg "on" "off")
106 (1 arg "add" "remove"))
107
108 (define-option-constant *watchers-options*)
109 (define-option-constant *edit-options*)
110 (define-option-constant *unedit-options*)
111 (define-option-constant *editors-options*)
112 (define-option-constant *sync-to-cvs-options*)
113 (define-option-constant *sync-from-cvs-options*)
114
115 (defconstant *command-table*
116 `(("help" ,'help nil ,*help-options*)
117 ("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 ("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 ("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 ("merge" ,#'merge-wrapper nil ,*merge-options* nil)
150 ("remerge" ,#'remerge-wrapper nil ,*remerge-options* nil)
151 ("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 ("prop" ,#'prop-wrapper nil ,*prop-options* nil)
157 ("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 ("sync-from-cvs" ,#'sync-from-wrapper nil ,*editors-options* nil)
163 ("sync-to-cvs" ,#'sync-to-wrapper nil ,*editors-options* nil)))
164
165 (defconstant *usage*
166 "Meta-CVS command syntax:
167
168 mcvs [ global-options ] command [ command-options ] [ command-arguments ]
169
170 Global options:
171
172 -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 -q Somewhat quiet, some info messages suppressed. (*)
176 -n Dry run; do not modify filesystem. (*)
177 --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 --debug Verbose debug output; -Q and -q are ignored but still
182 passed to CVS.
183 -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 -i script-name Load a Lisp file and evaluate its top level forms,
191 allowing Meta-CVS to behave as an interpreter.
192 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 --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 --error-continue Instead of interactive error handling, automatically
200 continue all continuable errors.
201 --error-terminate Terminate with cleanup when an error happens instead
202 of interactive error handling.
203 -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 --up N Escape out of N levels of sandbox nesting before executing
208 operation.
209
210 Notes: (*) option processed by Meta-CVS and passed to CVS too.
211 (@) option merely passed to CVS.
212
213 Commands:
214
215 help Obtain more detailed help for a specific command.
216 create Create new project from an existing file tree.
217 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 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 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 link (ln) Create a versioned symbolic link.
229 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 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 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 This is not required in most situations, since Meta-CVS
248 arranges a filter automatically (see --nofilt option).
249 remote-filt (rfi) Remote version of filt, requires module name.
250 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 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 list-branches (lb) List Meta-CVS managed branches.
258 switch (sw) Switch to a branch. With no arguments, switch to
259 main trunk.
260 remap Force Meta-CVS to notice and incorporate moves and
261 deletions that were performed directly on the sandbox.
262 purge Execute a CVS remove on files that have been unmapped
263 with the remove command.
264 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 prop Manipulate properties.
268 prop --set <bool-prop-name> [ files ... ]
269 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 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 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 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 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
291 (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 (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 (defun execute (args)
323 (handler-bind ((error #'error-handler))
324 (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 (throw 'terminate nil))
333
334 (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
362 (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 (defun main ()
370 (init)
371 (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 (let ((*error-treatment* (if *interactive-error-io*
376 :interactive
377 :terminate)))
378 (unless *interactive-error-io*
379 (chatter-info "unable to open terminal device ~a .~%"
380 (unix-funcs:ctermid))
381 (chatter-info "interactive error handling disabled.~%"))
382 (ext:exit (catch 'terminate
383 (execute #+clisp ext:*args*)
384 *errors-occured-p*)))))
385
386 (defun main-debug ()
387 (init)
388 (let ((*error-treatment* :decline)
389 (*interactive-error-io* *terminal-io*))
390 (ext:exit (catch 'terminate
391 (execute #+clisp ext:*args*)
392 *errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5