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

Contents of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.87 - (hide annotations)
Thu Apr 24 04:33:15 2003 UTC (11 years ago) by kaz
Branch: MAIN
Changes since 1.86: +8 -1 lines
Merging from mcvs-1-0-branch.

New commands, sync-from-cvs and sync-to-cvs.

* code/mcvs-main.lisp (*sync-to-cvs-options*, *sync-from-cvs-options*):
New option constants.
(*mcvs-command-table*): New entries.
(*usage*): New help text.

* code/generic.lisp (mcvs-generic): New keyword parameter
no-invoke-cvs.
(mcvs-sync-to-wrapper, mcvs-sync-from-wrapper): New functions.
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.75 ;; Clear out requires for mcvs-upgrade to work right.
6     (setf *modules* nil)
7    
8 kaz 1.45 (require "create")
9 kaz 1.1 (require "checkout")
10 kaz 1.46 (require "grab")
11 kaz 1.1 (require "add")
12 kaz 1.3 (require "remove")
13 kaz 1.4 (require "move")
14 kaz 1.78 (require "link")
15 kaz 1.1 (require "update")
16 kaz 1.12 (require "filt")
17 kaz 1.21 (require "generic")
18 kaz 1.25 (require "convert")
19 kaz 1.38 (require "branch")
20 kaz 1.44 (require "remap")
21 kaz 1.48 (require "purge")
22 kaz 1.49 (require "restore")
23 kaz 1.54 (require "prop")
24 kaz 1.72 (require "watch")
25 kaz 1.8 (require "split")
26     (require "restart")
27 kaz 1.27 (require "error")
28 kaz 1.10 (require "options")
29 kaz 1.33 (require "find-bind")
30 kaz 1.79 (require "mcvs-package")
31 kaz 1.6 (provide "mcvs-main")
32 kaz 1.5
33 kaz 1.79 (in-package "META-CVS")
34    
35 kaz 1.82 (define-option-constant *global-options*
36 kaz 1.55 (0 arg "H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"
37 kaz 1.86 "meta" "metaonly" "nometa" "error-continue" "error-terminate" "debug")
38 kaz 1.82 (1 arg "T" "e" "d" "r" "z" "s" "i" "up"))
39 kaz 1.55
40 kaz 1.58 (define-option-constant *help-options*)
41    
42 kaz 1.55 (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 kaz 1.61 (0 arg "f")
52 kaz 1.55 (1 arg "r" "D" "d" "k" "j"))
53    
54 kaz 1.71 (define-option-constant *export-options*
55     (0 arg "f")
56     (1 arg "r" "D" "d" "k"))
57    
58 kaz 1.55 (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 kaz 1.70 (0 arg "A" "C" "f" "p")
67 kaz 1.55 (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 kaz 1.84 (define-option-constant *remote-filt-options*
109     (1 arg "r" "D"))
110    
111 kaz 1.57 (define-option-constant *move-options*)
112 kaz 1.78 (define-option-constant *link-options*)
113 kaz 1.55 (define-option-constant *convert-options*)
114     (define-option-constant *branch-options*)
115 kaz 1.81
116     (define-option-constant *merge-options*
117     (1 arg "k"))
118    
119     (define-option-constant *remerge-options*
120     (1 arg "k"))
121    
122 kaz 1.55 (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 kaz 1.18
131 kaz 1.72 (define-option-constant *watch-options*
132     (0 arg "on" "off")
133     (1 arg "add" "remove"))
134    
135 kaz 1.73 (define-option-constant *watchers-options*)
136     (define-option-constant *edit-options*)
137     (define-option-constant *unedit-options*)
138     (define-option-constant *editors-options*)
139 kaz 1.87 (define-option-constant *sync-to-cvs-options*)
140     (define-option-constant *sync-from-cvs-options*)
141 kaz 1.73
142 kaz 1.58 (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 kaz 1.69 (error "~a is not a recognized mcvs command."
157 kaz 1.58 command-name))
158 kaz 1.59 (let ((help-text (third command)))
159     (when (null help-text)
160 kaz 1.69 (error "sorry, no help available for ~a command."
161 kaz 1.58 command-name))
162 kaz 1.59 (terpri)
163     (write-line help-text)
164     (terpri))))
165 kaz 1.69 (t (error "try \"mcvs help <name-of-command>\"."))))
166 kaz 1.58
167 kaz 1.5 (defconstant *mcvs-command-table*
168 kaz 1.58 `(("help" ,#'mcvs-help nil ,*help-options*)
169 kaz 1.59 ("create" ,#'mcvs-create-wrapper ,*create-help* ,*create-options*)
170 kaz 1.60 ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
171 kaz 1.61 ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
172     ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
173 kaz 1.71 ("export" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
174     ("ex" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
175 kaz 1.61 ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)
176 kaz 1.63 ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
177 kaz 1.64 ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
178 kaz 1.76 ("move" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
179     ("mv" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
180 kaz 1.78 ("link" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
181     ("ln" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
182 kaz 1.58 ("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 kaz 1.84 ("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 kaz 1.58 ("convert" ,#'mcvs-convert-wrapper nil ,*convert-options*)
198 kaz 1.80 ("branch" ,#'mcvs-branch-wrapper ,*branch-help* ,*branch-options*)
199 kaz 1.58 ("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 kaz 1.72 ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)
209 kaz 1.73 ("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 kaz 1.87 ("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 kaz 1.5
217 kaz 1.33 (defconstant *usage*
218     "Meta-CVS command syntax:
219    
220 kaz 1.59 mcvs [ global-options] command [ command-options ] [ command-arguments ]
221 kaz 1.33
222     Global options:
223    
224 kaz 1.35 -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 kaz 1.80 -n Dry run; do not modify filesystem. (*)
229 kaz 1.69 --debug Verbose debug output; -Q and -q are ignored but still
230     passed to CVS.
231 kaz 1.35 -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 kaz 1.65 -i script-name Load a Lisp file and evaluate its top level forms,
239     allowing Meta-CVS to behave as an interpreter.
240 kaz 1.50 --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 kaz 1.35 --error-continue Instead of interactive error handling, automatically
245     continue all continuable errors.
246 kaz 1.86 --error-terminate Terminate with cleanup when an error happens instead
247 kaz 1.85 of interactive error handling.
248 kaz 1.35 -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 kaz 1.83 --up N Escape out of N levels of sandbox nesting before executing
253     operation.
254 kaz 1.33
255     Notes: (*) option processed by Meta-CVS and passed to CVS too.
256     (@) option merely passed to CVS.
257    
258     Commands:
259    
260 kaz 1.59 help Obtain more detailed help for a specific command.
261 kaz 1.45 create Create new project from an existing file tree.
262 kaz 1.46 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 kaz 1.72 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 kaz 1.35 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 kaz 1.78 link (ln) Create a versioned symbolic link.
274 kaz 1.35 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 kaz 1.84 remote-filt (rfi) Remote version of filt, requires module name.
291 kaz 1.38 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 kaz 1.40 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 kaz 1.41 list-branches (lb) List Meta-CVS managed branches.
299 kaz 1.43 switch (sw) Switch to a branch. With no arguments, switch to
300 kaz 1.42 main trunk.
301 kaz 1.44 remap Force Meta-CVS to notice and incorporate moves and
302     deletions that were performed directly on the sandbox.
303 kaz 1.48 purge Execute a CVS remove on files that have been unmapped
304     with the remove command.
305 kaz 1.51 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 kaz 1.54 prop Manipulate properties.
309 kaz 1.56 prop --set <bool-prop-name> [ files ... ]
310 kaz 1.77 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 kaz 1.72 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 kaz 1.73 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 kaz 1.87 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 kaz 1.35 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 kaz 1.33
333 kaz 1.5 (defun mcvs-execute (args)
334 kaz 1.85 (let* ((*interactive-error-io* (open (unix-funcs:ctermid) :direction :io))
335     (*mcvs-error-treatment* (if *interactive-error-io*
336     :interactive
337 kaz 1.86 :terminate)))
338 kaz 1.85 (handler-bind ((error #'mcvs-error-handler))
339     (multiple-value-bind (global-options global-args)
340     (parse-opt args *global-options*)
341     (setf global-options (filter-global-options global-options))
342    
343     (when *print-usage*
344     (terpri)
345     (write-line *usage*)
346     (terpri)
347     (throw 'mcvs-terminate nil))
348    
349     (when (not (first global-args))
350     (write-line "Meta-CVS requires a command argument." *error-output*)
351     (write-line "Use mcvs -H to view help." *error-output*)
352     (throw 'mcvs-terminate nil))
353    
354     (let ((command (find (first global-args) *mcvs-command-table*
355     :key #'first
356     :test #'string=)))
357     (when (not command)
358     (error "~a is not a recognized mcvs command."
359     (first global-args)))
360     (destructuring-bind (name func help-text opt-spec) command
361     (declare (ignore name help-text))
362     (multiple-value-bind (command-options command-args)
363     (parse-opt (rest global-args) opt-spec)
364     (funcall func global-options command-options command-args))))))
365     nil))
366 kaz 1.5
367 kaz 1.8 (defun mcvs-debug-shell ()
368 kaz 1.24 (let ((counter 0)
369     (*mcvs-error-treatment* :decline))
370     (loop
371     (format t "~&mcvs[~a]> " (incf counter))
372     (let ((line (string-trim #(#\space #\tab) (read-line))))
373 kaz 1.29 (restart-case
374 kaz 1.24 (cond
375     ((zerop (length line)))
376     ((string-equal line "exit")
377     (return-from mcvs-debug-shell))
378     ((char-equal (char line 0) #\!)
379     (print (eval (read-from-string (subseq line 1)))))
380 kaz 1.29 (t (mcvs-execute (split-words line #(#\space #\tab)))))
381 kaz 1.36 (debug () :report "Return to mcvs debug shell"
382 kaz 1.29 (terpri)))))))
383 kaz 1.10
384 kaz 1.5 #+clisp
385 kaz 1.79 (defun main ()
386     (ext:exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)
387     *mcvs-errors-occured-p*))))

  ViewVC Help
Powered by ViewVC 1.1.5