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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.72 - (hide annotations)
Mon Oct 14 00:00:23 2002 UTC (11 years, 6 months ago) by kaz
Branch: MAIN
Changes since 1.71: +15 -2 lines
Merging from mcvs-1-0-branch.

* code/mcvs-main.lisp (*usage*): Describe export and watch commands.
(*watch-options*): New constant.
(*mcvs-command-table*): New entry for watch command.

* code/watch.lisp: New file.
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.72 (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.71 (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.70 (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.72 (define-option-constant *watch-options*
117     (0 arg "on" "off")
118     (1 arg "add" "remove"))
119    
120 kaz 1.58 (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 kaz 1.69 (error "~a is not a recognized mcvs command."
135 kaz 1.58 command-name))
136 kaz 1.59 (let ((help-text (third command)))
137     (when (null help-text)
138 kaz 1.69 (error "sorry, no help available for ~a command."
139 kaz 1.58 command-name))
140 kaz 1.59 (terpri)
141     (write-line help-text)
142     (terpri))))
143 kaz 1.69 (t (error "try \"mcvs help <name-of-command>\"."))))
144 kaz 1.58
145 kaz 1.5 (defconstant *mcvs-command-table*
146 kaz 1.58 `(("help" ,#'mcvs-help nil ,*help-options*)
147 kaz 1.59 ("create" ,#'mcvs-create-wrapper ,*create-help* ,*create-options*)
148 kaz 1.60 ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
149 kaz 1.61 ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
150     ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
151 kaz 1.71 ("export" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
152     ("ex" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
153 kaz 1.61 ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)
154 kaz 1.63 ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
155 kaz 1.64 ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
156 kaz 1.58 ("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 kaz 1.72 ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)
182     ("watch" ,#'mcvs-watch-wrapper nil ,*watch-options*)))
183 kaz 1.5
184 kaz 1.33 (defconstant *usage*
185     "Meta-CVS command syntax:
186    
187 kaz 1.59 mcvs [ global-options] command [ command-options ] [ command-arguments ]
188 kaz 1.33
189     Global options:
190    
191 kaz 1.35 -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 kaz 1.69 --debug Verbose debug output; -Q and -q are ignored but still
196     passed to CVS.
197 kaz 1.35 -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 kaz 1.65 -i script-name Load a Lisp file and evaluate its top level forms,
205     allowing Meta-CVS to behave as an interpreter.
206 kaz 1.50 --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 kaz 1.35 --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 kaz 1.33
219     Notes: (*) option processed by Meta-CVS and passed to CVS too.
220     (@) option merely passed to CVS.
221    
222     Commands:
223    
224 kaz 1.59 help Obtain more detailed help for a specific command.
225 kaz 1.45 create Create new project from an existing file tree.
226 kaz 1.46 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 kaz 1.72 checkout (co) Retrieve a Meta-CVS project from the repository to
230     create a working copy.
231     export (ex) Retrieve a Meta-CVS project without creating a
232 kaz 1.35 working copy.
233     add Place files (or directories with add -R) under
234     version control.
235     remove (rm) Remove files or directories.
236     move (mv) Rename files and directories.
237     update (up) Incorporate latest changes from repository into
238     working copy.
239     commit (ci) Incorporate outstanding changes in the working copy
240     into the repository.
241     diff Compute differences between files in the working copy
242     and the repository or between revisions in the repository.
243     tag Associate a symbolic name with file revisions to create
244     an identifiable baseline. By default, tags the
245     revisions that were last synchronized with the
246     directory. A branch is created using tag -b.
247     log Display log information for files.
248     status (stat) Show current status of files.
249     annotate Perform a detailed analysis of files, showing the
250     version information about every individual line of text.
251     filt (fi) Act as a text filter, which converts Meta-CVS F- file
252     names to readable paths, according to the current mapping.
253 kaz 1.38 branch Create a managed branch. Meta-CVS managed branches keep
254     track of what has been merged where, so users don't have
255     to track merges with tags at all.
256     merge Merge a managed branch to the current branch or trunk.
257 kaz 1.40 remerge Re-apply the most recent merge without changing any tags.
258     Useful when a merge goes bad so the local changes have
259     to be discarded and the merge done over again.
260 kaz 1.41 list-branches (lb) List Meta-CVS managed branches.
261 kaz 1.43 switch (sw) Switch to a branch. With no arguments, switch to
262 kaz 1.42 main trunk.
263 kaz 1.44 remap Force Meta-CVS to notice and incorporate moves and
264     deletions that were performed directly on the sandbox.
265 kaz 1.48 purge Execute a CVS remove on files that have been unmapped
266     with the remove command.
267 kaz 1.51 restore Restore files that have been deleted with the remove
268     command, but not purged. These appear in the lost+found
269     directory under cryptic names.
270 kaz 1.54 prop Manipulate properties.
271 kaz 1.56 prop --set <bool-prop-name> [ files ... ]
272     prop --clear <bool-prop-name> [ files ... ]
273 kaz 1.62 prop --value <prop-name> <new-value> [ files ... ]
274     prop --remove <prop-name> [ files ... ]
275 kaz 1.56 The ``exec'' property represents the execute permission
276     of a file. More than one --set, --clear, --value
277     or --remove may be specified before the files.
278 kaz 1.72 watch Manipulate per-file CVS watch settings.
279     watch --on [ files ... ]
280     watch --off [ files ... ]
281     watch --add <action> [ files ... ]
282     watch --remove <action> [ files ... ]
283 kaz 1.35 convert Convert a CVS module to a Meta-CVS project. This requires
284     filesystem-level access to the repository. This is
285     currently an experimental command that is known not
286     to work 100%.")
287 kaz 1.33
288 kaz 1.68 (defvar *options*)
289 kaz 1.67 (defvar *args*)
290 kaz 1.66
291 kaz 1.5 (defun mcvs-execute (args)
292 kaz 1.27 (handler-bind ((error #'mcvs-error-handler))
293 kaz 1.18 (multiple-value-bind (global-options global-args)
294 kaz 1.55 (parse-opt args *cvs-options*)
295 kaz 1.33 (setf global-options (filter-global-options global-options))
296    
297     (find-bind (:test #'string= :key #'first)
298     ((help-long "help") (help "H") (quiet "q")
299 kaz 1.34 (very-quiet "Q") (version "v") (version-long "version")
300 kaz 1.65 (editor "e") (interpret-file "i"))
301 kaz 1.33 global-options
302 kaz 1.68 (setf *args* global-args)
303     (setf *options* global-options)
304 kaz 1.33 (when (or help-long help)
305     (terpri)
306     (write-line *usage*)
307     (terpri)
308     (throw 'mcvs-terminate nil))
309     (when (or version version-long)
310 kaz 1.34 (let* ((vers (split-words "$Name: $" "$:- "))
311 kaz 1.33 (major (third vers))
312     (minor (fourth vers)))
313     (if (and major minor)
314     (format t "Meta-CVS version ~a.~a (c) 2002 Kaz Kylheku~%"
315     major minor)
316     (format t "Meta-CVS unknown version (c) 2002 Kaz Kylheku~%"))
317 kaz 1.34 (throw 'mcvs-terminate nil)))
318     (when editor
319     (setf *editor* (second editor)))
320     (cond
321     (very-quiet (setf *mcvs-chatter-level* *mcvs-silent*))
322 kaz 1.69 (quiet (setf *mcvs-chatter-level* *mcvs-terse*)))
323 kaz 1.65 (when interpret-file
324 kaz 1.66 (load (second interpret-file))
325     (throw 'mcvs-terminate nil)))
326 kaz 1.33
327 kaz 1.18 (when (not (first global-args))
328 kaz 1.35 (write-line "Meta-CVS requires a command argument.")
329 kaz 1.33 (write-line "Use mcvs -H to view help.")
330     (throw 'mcvs-terminate nil))
331    
332 kaz 1.18 (let ((command (find (first global-args) *mcvs-command-table*
333 kaz 1.55 :key #'first
334     :test #'string=)))
335 kaz 1.11 (when (not command)
336 kaz 1.69 (error "~a is not a recognized mcvs command."
337 kaz 1.18 (first global-args)))
338 kaz 1.58 (destructuring-bind (name func help-text opt-spec) command
339     (declare (ignore name help-text))
340 kaz 1.68 (multiple-value-bind (command-options command-args)
341     (parse-opt (rest global-args) opt-spec)
342     (funcall func global-options command-options command-args))))))
343 kaz 1.18 nil)
344 kaz 1.5
345 kaz 1.8 (defun mcvs-debug-shell ()
346 kaz 1.24 (let ((counter 0)
347     (*mcvs-error-treatment* :decline))
348     (loop
349     (format t "~&mcvs[~a]> " (incf counter))
350     (let ((line (string-trim #(#\space #\tab) (read-line))))
351 kaz 1.29 (restart-case
352 kaz 1.24 (cond
353     ((zerop (length line)))
354     ((string-equal line "exit")
355     (return-from mcvs-debug-shell))
356     ((char-equal (char line 0) #\!)
357     (print (eval (read-from-string (subseq line 1)))))
358 kaz 1.29 (t (mcvs-execute (split-words line #(#\space #\tab)))))
359 kaz 1.36 (debug () :report "Return to mcvs debug shell"
360 kaz 1.29 (terpri)))))))
361 kaz 1.10
362 kaz 1.5 #+clisp
363     (defun mcvs ()
364 kaz 1.28 (exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
365     *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5