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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.89 - (show annotations)
Thu May 1 05:40:54 2003 UTC (10 years, 11 months ago) by kaz
Branch: MAIN
Changes since 1.88: +4 -0 lines
Merging from mcvs-1-0-branch.

* code/generic.lisp (mcvs-generic): The after-synchronization
was going in both directions rather than just MCVS -> tree.

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

  ViewVC Help
Powered by ViewVC 1.1.5