/[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.6 - (hide annotations)
Thu Oct 17 15:28:17 2002 UTC (11 years, 6 months ago) by kaz
Branch: mcvs-1-0-branch
Changes since 1.69.2.5: +1 -1 lines
Detect failure to start text editor.

* code/posix.lisp (*editor*): Change name to *mcvs-editor*, due
to name-clash with a CLISP extension!

* code/mcvs-main.lisp: Likewise.

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

  ViewVC Help
Powered by ViewVC 1.1.5