/[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.23 - (show annotations)
Thu May 1 05:34:31 2003 UTC (10 years, 11 months ago) by kaz
Branch: mcvs-1-0-branch
CVS Tags: mcvs-1-0-8
Changes since 1.69.2.22: +4 -0 lines
* code/mcvs-main.lisp (mcvs-execute): If not able to open controlling
tty, emit some warning messages that interactive error handling is
disabled. This alerts users to problems, like missing /dev directory
on Cygwin.
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 ;; Clear out requires for mcvs-upgrade to work right.
6 (setf *modules* nil)
7
8 (require "create")
9 (require "checkout")
10 (require "grab")
11 (require "add")
12 (require "remove")
13 (require "move")
14 (require "link")
15 (require "update")
16 (require "filt")
17 (require "generic")
18 (require "convert")
19 (require "branch")
20 (require "remap")
21 (require "purge")
22 (require "restore")
23 (require "prop")
24 (require "watch")
25 (require "split")
26 (require "restart")
27 (require "error")
28 (require "options")
29 (require "find-bind")
30 (provide "mcvs-main")
31
32 (define-option-constant *global-options*
33 (0 arg "H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"
34 "meta" "metaonly" "nometa" "error-continue" "error-terminate" "debug")
35 (1 arg "T" "e" "d" "r" "z" "s" "i" "up"))
36
37 (define-option-constant *help-options*)
38
39 (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 (0 arg "f")
49 (1 arg "r" "D" "d" "k" "j"))
50
51 (define-option-constant *export-options*
52 (0 arg "f")
53 (1 arg "r" "D" "d" "k"))
54
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 (0 arg "A" "C" "f" "p")
64 (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 (define-option-constant *remote-filt-options*
106 (1 arg "r" "D"))
107
108 (define-option-constant *move-options*)
109 (define-option-constant *link-options*)
110 (define-option-constant *convert-options*)
111 (define-option-constant *branch-options*)
112
113 (define-option-constant *merge-options*
114 (1 arg "k"))
115
116 (define-option-constant *remerge-options*
117 (1 arg "k"))
118
119 (define-option-constant *list-branches-options*)
120 (define-option-constant *remap-options*)
121 (define-option-constant *purge-options*)
122 (define-option-constant *restore-options*)
123
124 (define-option-constant *prop-options*
125 (1 arg "set" "clear" "remove")
126 (2 arg "value"))
127
128 (define-option-constant *watch-options*
129 (0 arg "on" "off")
130 (1 arg "add" "remove"))
131
132 (define-option-constant *watchers-options*)
133 (define-option-constant *edit-options*)
134 (define-option-constant *unedit-options*)
135 (define-option-constant *editors-options*)
136 (define-option-constant *sync-to-cvs-options*)
137 (define-option-constant *sync-from-cvs-options*)
138
139 (defun mcvs-help (global-options command-options args)
140 (declare (special *usage* *mcvs-command-table*)
141 (ignore global-options command-options))
142 (cond
143 ((null args)
144 (terpri)
145 (write-line *usage*)
146 (terpri))
147 ((= (length args) 1)
148 (let* ((command-name (first args))
149 (command (find command-name *mcvs-command-table*
150 :key #'first
151 :test #'string=)))
152 (when (null command)
153 (error "~a is not a recognized mcvs command."
154 command-name))
155 (let ((help-text (third command)))
156 (when (null help-text)
157 (error "sorry, no help available for ~a command."
158 command-name))
159 (terpri)
160 (write-line help-text)
161 (terpri))))
162 (t (error "try \"mcvs help <name-of-command>\"."))))
163
164 (defconstant *mcvs-command-table*
165 `(("help" ,#'mcvs-help nil ,*help-options*)
166 ("create" ,#'mcvs-create-wrapper ,*create-help* ,*create-options*)
167 ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
168 ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
169 ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
170 ("export" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
171 ("ex" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
172 ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)
173 ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
174 ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
175 ("move" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
176 ("mv" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
177 ("link" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
178 ("ln" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
179 ("update" ,#'mcvs-update-wrapper nil ,*update-options*)
180 ("up" ,#'mcvs-update-wrapper nil ,*update-options*)
181 ("commit" ,#'mcvs-commit-wrapper nil ,*commit-options*)
182 ("ci" ,#'mcvs-commit-wrapper nil ,*commit-options*)
183 ("diff" ,#'mcvs-diff-wrapper nil ,*diff-options*)
184 ("tag" ,#'mcvs-tag-wrapper nil ,*tag-options*)
185 ("log" ,#'mcvs-log-wrapper nil ,*log-options*)
186 ("status" ,#'mcvs-status-wrapper nil ,*status-options*)
187 ("stat" ,#'mcvs-status-wrapper nil ,*status-options*)
188 ("annotate" ,#'mcvs-annotate-wrapper nil ,*annotate-options*)
189 ("filt" ,#'mcvs-filt-wrapper nil ,*filt-options*)
190 ("fi" ,#'mcvs-filt-wrapper nil ,*filt-options*)
191 ("remote-filt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
192 ("rfilt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
193 ("rfi" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
194 ("convert" ,#'mcvs-convert-wrapper nil ,*convert-options*)
195 ("branch" ,#'mcvs-branch-wrapper ,*branch-help* ,*branch-options*)
196 ("switch" ,#'mcvs-switch-wrapper nil ,*switch-options*)
197 ("sw" ,#'mcvs-switch-wrapper nil ,*switch-options*)
198 ("merge" ,#'mcvs-merge-wrapper nil ,*merge-options*)
199 ("remerge" ,#'mcvs-remerge-wrapper nil ,*remerge-options*)
200 ("list-branches" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
201 ("lb" ,#'mcvs-list-branches-wrapper nil ,*list-branches-options*)
202 ("purge" ,#'mcvs-purge-wrapper nil ,*purge-options*)
203 ("restore" ,#'mcvs-restore-wrapper nil ,*restore-options*)
204 ("remap" ,#'mcvs-remap-wrapper nil ,*remap-options*)
205 ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)
206 ("watch" ,#'mcvs-watch-wrapper nil ,*watch-options*)
207 ("watchers" ,#'mcvs-watchers-wrapper nil ,*watchers-options*)
208 ("edit" ,#'mcvs-edit-wrapper nil ,*edit-options*)
209 ("unedit" ,#'mcvs-unedit-wrapper nil ,*unedit-options*)
210 ("editors" ,#'mcvs-editors-wrapper nil ,*editors-options*)
211 ("sync-from-cvs" ,#'mcvs-sync-from-wrapper nil ,*editors-options*)
212 ("sync-to-cvs" ,#'mcvs-sync-to-wrapper nil ,*editors-options*)))
213
214 (defconstant *usage*
215 "Meta-CVS command syntax:
216
217 mcvs [ global-options] command [ command-options ] [ command-arguments ]
218
219 Global options:
220
221 -H --help Print this help and terminate. If a command is specified,
222 help specific to that command is printed instead.
223 -Q Very quiet, generate output only for serious problems. (*)
224 -q Somewhat quiet, some informational messages suppresed. (*)
225 -n Dry run; do not modify filesystem. (*)
226 --debug Verbose debug output; -Q and -q are ignored but still
227 passed to CVS.
228 -r Make working files read-only. (@)
229 -w Make new working files read-write (default). (@)
230 -l Do not log cvs command in command history, but execute
231 it anyway. (@)
232 -t Trace CVS execution. (@)
233 -v --version Display version information and terminate.
234 -f CVS not to read ~/.cvsrc file. (@)
235 -i script-name Load a Lisp file and evaluate its top level forms,
236 allowing Meta-CVS to behave as an interpreter.
237 --meta Include metafiles such as MCVS/MAP in the set of files
238 to operate on.
239 --metaonly Operate only on metafiles.
240 --nometa Exclude metafiles from the set of files to operate on.
241 --error-continue Instead of interactive error handling, automatically
242 continue all continuable errors.
243 --error-terminate Terminate with cleanup when an error happens instead
244 of interactive error handling.
245 -T tempdir Place temporary files in tempdir. (@)
246 -e editor Edit messages with editor. (*)
247 -d root Specify CVSROOT. (@)
248 -z gzip-level Specify compression level. (@)
249 --up N Escape out of N levels of sandbox nesting before executing
250 operation.
251
252 Notes: (*) option processed by Meta-CVS and passed to CVS too.
253 (@) option merely passed to CVS.
254
255 Commands:
256
257 help Obtain more detailed help for a specific command.
258 create Create new project from an existing file tree.
259 grab Take a snapshot of an external source tree, such
260 as a third-party release, and incorporate it into
261 the working copy. Tries to discover file moves.
262 checkout (co) Retrieve a Meta-CVS project from the repository to
263 create a working copy.
264 export (ex) Retrieve a Meta-CVS project without creating a
265 working copy.
266 add Place files (or directories with add -R) under
267 version control.
268 remove (rm) Remove files or directories.
269 move (mv) Rename files and directories.
270 link (ln) Create a versioned symbolic link.
271 update (up) Incorporate latest changes from repository into
272 working copy.
273 commit (ci) Incorporate outstanding changes in the working copy
274 into the repository.
275 diff Compute differences between files in the working copy
276 and the repository or between revisions in the repository.
277 tag Associate a symbolic name with file revisions to create
278 an identifiable baseline. By default, tags the
279 revisions that were last synchronized with the
280 directory. A branch is created using tag -b.
281 log Display log information for files.
282 status (stat) Show current status of files.
283 annotate Perform a detailed analysis of files, showing the
284 version information about every individual line of text.
285 filt (fi) Act as a text filter, which converts Meta-CVS F- file
286 names to readable paths, according to the current mapping.
287 remote-filt (rfi) Remote version of filt, requires module name.
288 branch Create a managed branch. Meta-CVS managed branches keep
289 track of what has been merged where, so users don't have
290 to track merges with tags at all.
291 merge Merge a managed branch to the current branch or trunk.
292 remerge Re-apply the most recent merge without changing any tags.
293 Useful when a merge goes bad so the local changes have
294 to be discarded and the merge done over again.
295 list-branches (lb) List Meta-CVS managed branches.
296 switch (sw) Switch to a branch. With no arguments, switch to
297 main trunk.
298 remap Force Meta-CVS to notice and incorporate moves and
299 deletions that were performed directly on the sandbox.
300 purge Execute a CVS remove on files that have been unmapped
301 with the remove command.
302 restore Restore files that have been deleted with the remove
303 command, but not purged. These appear in the lost+found
304 directory under cryptic names.
305 prop Manipulate properties.
306 prop --set <bool-prop-name> [ files ... ]
307 prop --clear <bool-prop-name> [ files ... ]
308 prop --value <prop-name> <new-value> [ files ... ]
309 prop --remove <prop-name> [ files ... ]
310 The ``exec'' property represents the execute permission
311 of a file. More than one --set, --clear, --value
312 or --remove may be specified before the files.
313 watch Manipulate per-file CVS watch settings.
314 watch --on [ files ... ]
315 watch --off [ files ... ]
316 watch --add <action> [ files ... ]
317 watch --remove <action> [ files ... ]
318 watchers See who is watching files.
319 edit Indicate the intent to edit a watched file.
320 unedit Retract the indication signaled by edit.
321 editors See who is editing files.
322 sync-to-cvs Synchronize tree in the direction of the CVS sandbox.
323 Useful when extending Meta-CVS with external scripts.
324 sync-from-cvs Synchronize CVS sandbox to the tree.
325 convert Convert a CVS module to a Meta-CVS project. This requires
326 filesystem-level access to the repository. This is
327 currently an experimental command that is known not
328 to work 100%.")
329
330 (defun mcvs-execute (args)
331 (with-open-file (*interactive-error-io* (parse-posix-namestring
332 (unix-funcs:ctermid))
333 :direction :io
334 :if-does-not-exist nil)
335 (let ((*mcvs-error-treatment* (if *interactive-error-io*
336 :interactive
337 :terminate)))
338 (unless *interactive-error-io*
339 (chatter-info "unable to open terminal device ~a ."
340 (unix-funcs:ctermid))
341 (chatter-info "interactive error handling disabled."))
342 (handler-bind ((error #'mcvs-error-handler))
343 (multiple-value-bind (global-options global-args)
344 (parse-opt args *global-options*)
345 (setf global-options (filter-global-options global-options))
346
347 (when *print-usage*
348 (terpri)
349 (write-line *usage*)
350 (terpri)
351 (throw 'mcvs-terminate nil))
352
353 (when (not (first global-args))
354 (write-line "Meta-CVS requires a command argument." *error-output*)
355 (write-line "Use mcvs -H to view help." *error-output*)
356 (throw 'mcvs-terminate nil))
357
358 (let ((command (find (first global-args) *mcvs-command-table*
359 :key #'first
360 :test #'string=)))
361 (when (not command)
362 (error "~a is not a recognized mcvs command."
363 (first global-args)))
364 (destructuring-bind (name func help-text opt-spec) command
365 (declare (ignore name help-text))
366 (multiple-value-bind (command-options command-args)
367 (parse-opt (rest global-args) opt-spec)
368 (funcall func global-options command-options command-args)))))))
369 nil))
370
371 (defun mcvs-debug-shell ()
372 (let ((counter 0)
373 (*mcvs-error-treatment* :decline))
374 (loop
375 (format t "~&mcvs[~a]> " (incf counter))
376 (let ((line (string-trim #(#\space #\tab) (read-line))))
377 (restart-case
378 (cond
379 ((zerop (length line)))
380 ((string-equal line "exit")
381 (return-from mcvs-debug-shell))
382 ((char-equal (char line 0) #\!)
383 (print (eval (read-from-string (subseq line 1)))))
384 (t (mcvs-execute (split-words line #(#\space #\tab)))))
385 (debug () :report "Return to mcvs debug shell"
386 (terpri)))))))
387
388 #+clisp
389 (defun mcvs ()
390 (exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
391 *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5