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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.67 - (show annotations)
Sat Sep 21 20:30:37 2002 UTC (11 years, 6 months ago) by kaz
Branch: MAIN
Changes since 1.66: +2 -2 lines
* code/mcvs-main.lisp (*args*): New global variable. Gives
scripts access to command line.
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 (require "create")
6 (require "checkout")
7 (require "grab")
8 (require "add")
9 (require "remove")
10 (require "move")
11 (require "update")
12 (require "filt")
13 (require "generic")
14 (require "convert")
15 (require "branch")
16 (require "remap")
17 (require "purge")
18 (require "restore")
19 (require "prop")
20 (require "split")
21 (require "restart")
22 (require "error")
23 (require "options")
24 (require "find-bind")
25 (provide "mcvs-main")
26
27 (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 (1 arg "T" "e" "d" "r" "z" "s" "i"))
31
32 (define-option-constant *help-options*)
33
34 (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 (0 arg "f")
44 (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 (define-option-constant *move-options*)
97 (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
110 (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 (let ((help-text (third command)))
127 (when (null help-text)
128 (error "mcvs: sorry, no help available for ~a command."
129 command-name))
130 (terpri)
131 (write-line help-text)
132 (terpri))))
133 (t (error "mcvs-help: try \"mcvs help <name-of-command>\"."))))
134
135 (defconstant *mcvs-command-table*
136 `(("help" ,#'mcvs-help nil ,*help-options*)
137 ("create" ,#'mcvs-create-wrapper ,*create-help* ,*create-options*)
138 ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
139 ("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 ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
143 ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
144 ("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
171 (defconstant *usage*
172 "Meta-CVS command syntax:
173
174 mcvs [ global-options] command [ command-options ] [ command-arguments ]
175
176 Global options:
177
178 -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 -i script-name Load a Lisp file and evaluate its top level forms,
190 allowing Meta-CVS to behave as an interpreter.
191 --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 --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
204 Notes: (*) option processed by Meta-CVS and passed to CVS too.
205 (@) option merely passed to CVS.
206
207 Commands:
208
209 help Obtain more detailed help for a specific command.
210 create Create new project from an existing file tree.
211 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 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 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 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 list-branches (lb) List Meta-CVS managed branches.
244 switch (sw) Switch to a branch. With no arguments, switch to
245 main trunk.
246 remap Force Meta-CVS to notice and incorporate moves and
247 deletions that were performed directly on the sandbox.
248 purge Execute a CVS remove on files that have been unmapped
249 with the remove command.
250 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 prop Manipulate properties.
254 prop --set <bool-prop-name> [ files ... ]
255 prop --clear <bool-prop-name> [ files ... ]
256 prop --value <prop-name> <new-value> [ files ... ]
257 prop --remove <prop-name> [ files ... ]
258 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 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
266 (defvar *args*)
267
268 (defun mcvs-execute (args)
269 (setf *args* args)
270 (handler-bind ((error #'mcvs-error-handler))
271 (multiple-value-bind (global-options global-args)
272 (parse-opt args *cvs-options*)
273 (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 (very-quiet "Q") (version "v") (version-long "version")
278 (editor "e") (interpret-file "i"))
279 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 (let* ((vers (split-words "$Name: $" "$:- "))
287 (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 (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 (t (setf *mcvs-chatter-level* *mcvs-info*)))
300 (when interpret-file
301 (load (second interpret-file))
302 (throw 'mcvs-terminate nil)))
303
304 (when (not (first global-args))
305 (write-line "Meta-CVS requires a command argument.")
306 (write-line "Use mcvs -H to view help.")
307 (throw 'mcvs-terminate nil))
308
309 (let ((command (find (first global-args) *mcvs-command-table*
310 :key #'first
311 :test #'string=)))
312 (when (not command)
313 (error "mcvs: ~a is not a recognized mcvs command."
314 (first global-args)))
315 (destructuring-bind (name func help-text opt-spec) command
316 (declare (ignore name help-text))
317 (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 (parse-opt (rest global-args) opt-spec)
326 (funcall func global-options command-options command-args)))))))
327 nil)
328
329 (defun mcvs-debug-shell ()
330 (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 (restart-case
336 (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 (t (mcvs-execute (split-words line #(#\space #\tab)))))
343 (debug () :report "Return to mcvs debug shell"
344 (terpri)))))))
345
346 #+clisp
347 (defun mcvs ()
348 (exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
349 *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5