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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.64 - (hide annotations)
Sat Sep 21 18:30:40 2002 UTC (11 years, 6 months ago) by kaz
Branch: MAIN
Changes since 1.63: +1 -1 lines
Make remove help available through rm alias too.
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     (1 arg "T" "e" "d" "r" "z" "s"))
31    
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.50 --meta Include metafiles such as MCVS/MAP in the set of files
190     to operate on.
191     --metaonly Operate only on metafiles.
192     --nometa Exclude metafiles from the set of files to operate on.
193 kaz 1.35 --error-continue Instead of interactive error handling, automatically
194     continue all continuable errors.
195     --error-terminate Terminate without cleanup when an error happens instead
196     of interactive error handling (use with care).
197     -T tempdir Place temporary files in tempdir. (@)
198     -e editor Edit messages with editor. (*)
199     -d root Specify CVSROOT. (@)
200     -z gzip-level Specify compression level. (@)
201 kaz 1.33
202     Notes: (*) option processed by Meta-CVS and passed to CVS too.
203     (@) option merely passed to CVS.
204    
205     Commands:
206    
207 kaz 1.59 help Obtain more detailed help for a specific command.
208 kaz 1.45 create Create new project from an existing file tree.
209 kaz 1.46 grab Take a snapshot of an external source tree, such
210     as a third-party release, and incorporate it into
211     the working copy. Tries to discover file moves.
212 kaz 1.35 checkout (co) Retrieve a Meta-CVS project from CVS and build
213     working copy.
214     add Place files (or directories with add -R) under
215     version control.
216     remove (rm) Remove files or directories.
217     move (mv) Rename files and directories.
218     update (up) Incorporate latest changes from repository into
219     working copy.
220     commit (ci) Incorporate outstanding changes in the working copy
221     into the repository.
222     diff Compute differences between files in the working copy
223     and the repository or between revisions in the repository.
224     tag Associate a symbolic name with file revisions to create
225     an identifiable baseline. By default, tags the
226     revisions that were last synchronized with the
227     directory. A branch is created using tag -b.
228     log Display log information for files.
229     status (stat) Show current status of files.
230     annotate Perform a detailed analysis of files, showing the
231     version information about every individual line of text.
232     filt (fi) Act as a text filter, which converts Meta-CVS F- file
233     names to readable paths, according to the current mapping.
234 kaz 1.38 branch Create a managed branch. Meta-CVS managed branches keep
235     track of what has been merged where, so users don't have
236     to track merges with tags at all.
237     merge Merge a managed branch to the current branch or trunk.
238 kaz 1.40 remerge Re-apply the most recent merge without changing any tags.
239     Useful when a merge goes bad so the local changes have
240     to be discarded and the merge done over again.
241 kaz 1.41 list-branches (lb) List Meta-CVS managed branches.
242 kaz 1.43 switch (sw) Switch to a branch. With no arguments, switch to
243 kaz 1.42 main trunk.
244 kaz 1.44 remap Force Meta-CVS to notice and incorporate moves and
245     deletions that were performed directly on the sandbox.
246 kaz 1.48 purge Execute a CVS remove on files that have been unmapped
247     with the remove command.
248 kaz 1.51 restore Restore files that have been deleted with the remove
249     command, but not purged. These appear in the lost+found
250     directory under cryptic names.
251 kaz 1.54 prop Manipulate properties.
252 kaz 1.56 prop --set <bool-prop-name> [ files ... ]
253     prop --clear <bool-prop-name> [ files ... ]
254 kaz 1.62 prop --value <prop-name> <new-value> [ files ... ]
255     prop --remove <prop-name> [ files ... ]
256 kaz 1.56 The ``exec'' property represents the execute permission
257     of a file. More than one --set, --clear, --value
258     or --remove may be specified before the files.
259 kaz 1.35 convert Convert a CVS module to a Meta-CVS project. This requires
260     filesystem-level access to the repository. This is
261     currently an experimental command that is known not
262     to work 100%.")
263 kaz 1.33
264 kaz 1.5 (defun mcvs-execute (args)
265 kaz 1.27 (handler-bind ((error #'mcvs-error-handler))
266 kaz 1.18 (multiple-value-bind (global-options global-args)
267 kaz 1.55 (parse-opt args *cvs-options*)
268 kaz 1.33 (setf global-options (filter-global-options global-options))
269    
270     (find-bind (:test #'string= :key #'first)
271     ((help-long "help") (help "H") (quiet "q")
272 kaz 1.34 (very-quiet "Q") (version "v") (version-long "version")
273     (editor "e"))
274 kaz 1.33 global-options
275     (when (or help-long help)
276     (terpri)
277     (write-line *usage*)
278     (terpri)
279     (throw 'mcvs-terminate nil))
280     (when (or version version-long)
281 kaz 1.34 (let* ((vers (split-words "$Name: $" "$:- "))
282 kaz 1.33 (major (third vers))
283     (minor (fourth vers)))
284     (if (and major minor)
285     (format t "Meta-CVS version ~a.~a (c) 2002 Kaz Kylheku~%"
286     major minor)
287     (format t "Meta-CVS unknown version (c) 2002 Kaz Kylheku~%"))
288 kaz 1.34 (throw 'mcvs-terminate nil)))
289     (when editor
290     (setf *editor* (second editor)))
291     (cond
292     (very-quiet (setf *mcvs-chatter-level* *mcvs-silent*))
293     (quiet (setf *mcvs-chatter-level* *mcvs-terse*))
294     (t (setf *mcvs-chatter-level* *mcvs-info*))))
295 kaz 1.33
296 kaz 1.18 (when (not (first global-args))
297 kaz 1.35 (write-line "Meta-CVS requires a command argument.")
298 kaz 1.33 (write-line "Use mcvs -H to view help.")
299     (throw 'mcvs-terminate nil))
300    
301 kaz 1.18 (let ((command (find (first global-args) *mcvs-command-table*
302 kaz 1.55 :key #'first
303     :test #'string=)))
304 kaz 1.11 (when (not command)
305 kaz 1.18 (error "mcvs: ~a is not a recognized mcvs command."
306     (first global-args)))
307 kaz 1.58 (destructuring-bind (name func help-text opt-spec) command
308     (declare (ignore name help-text))
309 kaz 1.35 (find-bind (:test #'string= :key #'first)
310     (global-options (ec "error-continue") (et "error-terminate"))
311     global-options
312     (cond
313     (et (setf *mcvs-error-treatment* :terminate))
314     (ec (setf *mcvs-error-treatment* :continue)))
315    
316     (multiple-value-bind (command-options command-args)
317 kaz 1.55 (parse-opt (rest global-args) opt-spec)
318 kaz 1.35 (funcall func global-options command-options command-args)))))))
319 kaz 1.18 nil)
320 kaz 1.5
321 kaz 1.8 (defun mcvs-debug-shell ()
322 kaz 1.24 (let ((counter 0)
323     (*mcvs-error-treatment* :decline))
324     (loop
325     (format t "~&mcvs[~a]> " (incf counter))
326     (let ((line (string-trim #(#\space #\tab) (read-line))))
327 kaz 1.29 (restart-case
328 kaz 1.24 (cond
329     ((zerop (length line)))
330     ((string-equal line "exit")
331     (return-from mcvs-debug-shell))
332     ((char-equal (char line 0) #\!)
333     (print (eval (read-from-string (subseq line 1)))))
334 kaz 1.29 (t (mcvs-execute (split-words line #(#\space #\tab)))))
335 kaz 1.36 (debug () :report "Return to mcvs debug shell"
336 kaz 1.29 (terpri)))))))
337 kaz 1.10
338 kaz 1.5 #+clisp
339     (defun mcvs ()
340 kaz 1.28 (exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
341     *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5