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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5