/[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.3 - (show annotations)
Sun Oct 13 23:53:14 2002 UTC (11 years, 6 months ago) by kaz
Branch: mcvs-1-0-branch
Changes since 1.69.2.2: +7 -1 lines
* code/mcvs-main.lisp (*watch-options*): New constant.
(*mcvs-command-table*): New entry for watch command.

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

  ViewVC Help
Powered by ViewVC 1.1.5