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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5