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

Diff of /meta-cvs/F-233AD6EEE14894A7303F09519A2AB734

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.69 by kaz, Sat Oct 5 18:09:48 2002 UTC revision 1.69.2.29 by kaz, Thu Jan 29 04:56:22 2004 UTC
# Line 2  Line 2 
2  ;;; which is distributed under the GNU license.  ;;; which is distributed under the GNU license.
3  ;;; Copyright 2002 Kaz Kylheku  ;;; Copyright 2002 Kaz Kylheku
4    
5    ;; Clear out requires for mcvs-upgrade to work right.
6    (setf *modules* nil)
7    
8  (require "create")  (require "create")
9  (require "checkout")  (require "checkout")
10  (require "grab")  (require "grab")
11  (require "add")  (require "add")
12  (require "remove")  (require "remove")
13  (require "move")  (require "move")
14    (require "link")
15  (require "update")  (require "update")
16  (require "filt")  (require "filt")
17  (require "generic")  (require "generic")
# Line 17  Line 21 
21  (require "purge")  (require "purge")
22  (require "restore")  (require "restore")
23  (require "prop")  (require "prop")
24    (require "watch")
25  (require "split")  (require "split")
26  (require "restart")  (require "restart")
27  (require "error")  (require "error")
# Line 24  Line 29 
29  (require "find-bind")  (require "find-bind")
30  (provide "mcvs-main")  (provide "mcvs-main")
31    
32  (define-option-constant *cvs-options*  (define-option-constant *global-options*
33    (0 arg "H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"    (0 arg "H" "help" "Q" "q" "r" "w" "l" "n" "t" "v" "f" "version"
34           "meta" "metaonly" "nometa" "error-continue" "error-terminate"           "meta" "metaonly" "nometa" "error-continue" "error-terminate" "debug")
35           "debug")    (1 arg "T" "e" "d" "r" "z" "s" "i" "up"))
   (1 arg "T" "e" "d" "r" "z" "s" "i"))  
36    
37  (define-option-constant *help-options*)  (define-option-constant *help-options*)
38    
# Line 44  Line 48 
48    (0 arg "f")    (0 arg "f")
49    (1 arg "r" "D" "d" "k" "j"))    (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*  (define-option-constant *add-options*
56    (0 arg "R")    (0 arg "R")
57    (1 arg "k" "m"))    (1 arg "k" "m"))
# Line 52  Line 60 
60    (0 arg "R"))    (0 arg "R"))
61    
62  (define-option-constant *update-options*  (define-option-constant *update-options*
63    (0 arg "A" "f" "p")    (0 arg "A" "C" "f" "p")
64    (1 arg "k" "r" "D" "j" "I" "W"))    (1 arg "k" "r" "D" "j" "I" "W"))
65    
66  (define-option-constant *switch-options*  (define-option-constant *switch-options*
# Line 94  Line 102 
102  (define-option-constant *filt-options*  (define-option-constant *filt-options*
103    (1 arg "r" "D"))    (1 arg "r" "D"))
104    
105    (define-option-constant *remote-filt-options*
106      (1 arg "r" "D"))
107    
108  (define-option-constant *move-options*)  (define-option-constant *move-options*)
109    (define-option-constant *link-options*)
110  (define-option-constant *convert-options*)  (define-option-constant *convert-options*)
111  (define-option-constant *branch-options*)  (define-option-constant *branch-options*)
112  (define-option-constant *merge-options*)  
113  (define-option-constant *remerge-options*)  (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*)  (define-option-constant *list-branches-options*)
120  (define-option-constant *remap-options*)  (define-option-constant *remap-options*)
121  (define-option-constant *purge-options*)  (define-option-constant *purge-options*)
# Line 108  Line 125 
125    (1 arg "set" "clear" "remove")    (1 arg "set" "clear" "remove")
126    (2 arg "value"))    (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    (declaim (special *usage* *mcvs-command-table*))
140    
141  (defun mcvs-help (global-options command-options args)  (defun mcvs-help (global-options command-options args)
142    (declare (special *usage* *mcvs-command-table*)    (declare (ignore global-options command-options))
            (ignore global-options command-options))  
143    (cond    (cond
144      ((null args)      ((null args)
145        (terpri)        (terpri)
# Line 139  Line 168 
168     ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)     ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
169     ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)     ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
170     ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)     ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
171       ("export" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
172       ("ex" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
173     ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)     ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)
174     ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)     ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
175     ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)     ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
176     ("move" ,#'mcvs-move-wrapper nil ,*move-options*)     ("move" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
177     ("mv" ,#'mcvs-move-wrapper nil ,*move-options*)     ("mv" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
178       ("link" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
179       ("ln" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
180     ("update" ,#'mcvs-update-wrapper nil ,*update-options*)     ("update" ,#'mcvs-update-wrapper nil ,*update-options*)
181     ("up" ,#'mcvs-update-wrapper nil ,*update-options*)     ("up" ,#'mcvs-update-wrapper nil ,*update-options*)
182     ("commit" ,#'mcvs-commit-wrapper nil ,*commit-options*)     ("commit" ,#'mcvs-commit-wrapper nil ,*commit-options*)
# Line 156  Line 189 
189     ("annotate" ,#'mcvs-annotate-wrapper nil ,*annotate-options*)     ("annotate" ,#'mcvs-annotate-wrapper nil ,*annotate-options*)
190     ("filt" ,#'mcvs-filt-wrapper nil ,*filt-options*)     ("filt" ,#'mcvs-filt-wrapper nil ,*filt-options*)
191     ("fi" ,#'mcvs-filt-wrapper nil ,*filt-options*)     ("fi" ,#'mcvs-filt-wrapper nil ,*filt-options*)
192       ("remote-filt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
193       ("rfilt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
194       ("rfi" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
195     ("convert" ,#'mcvs-convert-wrapper nil ,*convert-options*)     ("convert" ,#'mcvs-convert-wrapper nil ,*convert-options*)
196     ("branch" ,#'mcvs-branch-wrapper nil ,*branch-options*)     ("branch" ,#'mcvs-branch-wrapper ,*branch-help* ,*branch-options*)
197     ("switch" ,#'mcvs-switch-wrapper nil ,*switch-options*)     ("switch" ,#'mcvs-switch-wrapper nil ,*switch-options*)
198     ("sw" ,#'mcvs-switch-wrapper nil ,*switch-options*)     ("sw" ,#'mcvs-switch-wrapper nil ,*switch-options*)
199     ("merge" ,#'mcvs-merge-wrapper nil ,*merge-options*)     ("merge" ,#'mcvs-merge-wrapper nil ,*merge-options*)
# Line 167  Line 203 
203     ("purge" ,#'mcvs-purge-wrapper nil ,*purge-options*)     ("purge" ,#'mcvs-purge-wrapper nil ,*purge-options*)
204     ("restore" ,#'mcvs-restore-wrapper nil ,*restore-options*)     ("restore" ,#'mcvs-restore-wrapper nil ,*restore-options*)
205     ("remap" ,#'mcvs-remap-wrapper nil ,*remap-options*)     ("remap" ,#'mcvs-remap-wrapper nil ,*remap-options*)
206     ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)))     ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)
207       ("watch" ,#'mcvs-watch-wrapper nil ,*watch-options*)
208       ("watchers" ,#'mcvs-watchers-wrapper nil ,*watchers-options*)
209       ("edit" ,#'mcvs-edit-wrapper nil ,*edit-options*)
210       ("unedit" ,#'mcvs-unedit-wrapper nil ,*unedit-options*)
211       ("editors" ,#'mcvs-editors-wrapper nil ,*editors-options*)
212       ("sync-from-cvs" ,#'mcvs-sync-from-wrapper nil ,*editors-options*)
213       ("sync-to-cvs" ,#'mcvs-sync-to-wrapper nil ,*editors-options*)))
214    
215  (defconstant *usage*  (defconstant *usage*
216  "Meta-CVS command syntax:  "Meta-CVS command syntax:
217    
218    mcvs [ global-options] command [ command-options ] [ command-arguments ]    mcvs [ global-options ] command [ command-options ] [ command-arguments ]
219    
220  Global options:  Global options:
221    
222    -H --help          Print this help and terminate. If a command is specified,    -H --help          Print this help and terminate. If a command is specified,
223                       help specific to that command is printed instead.                       help specific to that command is printed instead.
224    -Q                 Very quiet, generate output only for serious problems. (*)    -Q                 Very quiet, generate output only for serious problems. (*)
225    -q                 Somewhat quiet, some informational messages suppresed. (*)    -q                 Somewhat quiet, some info messages suppressed. (*)
226      -n                 Dry run; do not modify filesystem. (*)
227    --debug            Verbose debug output; -Q and -q are ignored but still    --debug            Verbose debug output; -Q and -q are ignored but still
228                       passed to CVS.                       passed to CVS.
229    -r                 Make working files read-only. (@)    -r                 Make working files read-only. (@)
# Line 197  Global options: Line 241  Global options:
241    --nometa           Exclude metafiles from the set of files to operate on.    --nometa           Exclude metafiles from the set of files to operate on.
242    --error-continue   Instead of interactive error handling, automatically    --error-continue   Instead of interactive error handling, automatically
243                       continue all continuable errors.                       continue all continuable errors.
244    --error-terminate  Terminate without cleanup when an error happens instead    --error-terminate  Terminate with cleanup when an error happens instead
245                       of interactive error handling (use with care).                       of interactive error handling.
246    -T tempdir         Place temporary files in tempdir. (@)    -T tempdir         Place temporary files in tempdir. (@)
247    -e editor          Edit messages with editor. (*)    -e editor          Edit messages with editor. (*)
248    -d root            Specify CVSROOT. (@)    -d root            Specify CVSROOT. (@)
249    -z gzip-level      Specify compression level. (@)    -z gzip-level      Specify compression level. (@)
250      --up N             Escape out of N levels of sandbox nesting before executing
251                         operation.
252    
253    Notes: (*) option processed by Meta-CVS and passed to CVS too.    Notes: (*) option processed by Meta-CVS and passed to CVS too.
254           (@) option merely passed to CVS.           (@) option merely passed to CVS.
# Line 214  Commands: Line 260  Commands:
260    grab               Take a snapshot of an external source tree, such    grab               Take a snapshot of an external source tree, such
261                       as a third-party release, and incorporate it into                       as a third-party release, and incorporate it into
262                       the working copy. Tries to discover file moves.                       the working copy. Tries to discover file moves.
263    checkout (co)      Retrieve a Meta-CVS project from CVS and build    checkout (co)      Retrieve a Meta-CVS project from the repository to
264                         create a working copy.
265      export (ex)        Retrieve a Meta-CVS project without creating a
266                       working copy.                       working copy.
267    add                Place files (or directories with add -R) under    add                Place files (or directories with add -R) under
268                       version control.                       version control.
269    remove (rm)        Remove files or directories.    remove (rm)        Remove files or directories.
270    move (mv)          Rename files and directories.    move (mv)          Rename files and directories.
271      link (ln)          Create a versioned symbolic link.
272    update (up)        Incorporate latest changes from repository into    update (up)        Incorporate latest changes from repository into
273                       working copy.                       working copy.
274    commit (ci)        Incorporate outstanding changes in the working copy    commit (ci)        Incorporate outstanding changes in the working copy
# Line 229  Commands: Line 278  Commands:
278    tag                Associate a symbolic name with file revisions to create    tag                Associate a symbolic name with file revisions to create
279                       an identifiable baseline.  By default, tags the                       an identifiable baseline.  By default, tags the
280                       revisions that were last synchronized with the                       revisions that were last synchronized with the
281                       directory. A branch is created using tag -b.                       directory. Note: tag -b creates a CVS branch,
282                         it won't be a Meta-CVS branch with managed merges.
283                         Consider the branch command instead!
284    log                Display log information for files.    log                Display log information for files.
285    status (stat)      Show current status of files.    status (stat)      Show current status of files.
286    annotate           Perform a detailed analysis of files, showing the    annotate           Perform a detailed analysis of files, showing the
287                       version information about every individual line of text.                       version information about every individual line of text.
288    filt (fi)          Act as a text filter, which converts Meta-CVS F- file    filt (fi)          Act as a text filter, which converts Meta-CVS F- file
289                       names to readable paths, according to the current mapping.                       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    branch             Create a managed branch. Meta-CVS managed branches keep
292                       track of what has been merged where, so users don't have                       track of what has been merged where, so users don't have
293                       to track merges with tags at all.                       to track merges with tags at all.
# Line 255  Commands: Line 307  Commands:
307                       directory under cryptic names.                       directory under cryptic names.
308    prop               Manipulate properties.    prop               Manipulate properties.
309                         prop --set <bool-prop-name> [ files ... ]                         prop --set <bool-prop-name> [ files ... ]
310                         prop --clear <bool-prop-name> [ files ... ]                         prop --clear <bool-prop-name> [ files ... ]
311                         prop --value <prop-name> <new-value> [ files ... ]                         prop --value <prop-name> <new-value> [ files ... ]
312                         prop --remove <prop-name> [ files ... ]                         prop --remove <prop-name> [ files ... ]
313                       The ``exec'' property represents the execute permission                       The ``exec'' property represents the execute permission
314                       of a file.  More than one --set, --clear, --value                       of a file.  More than one --set, --clear, --value
315                       or --remove may be specified before the files.                       or --remove may be specified before the files.
316    convert            Convert a CVS module to a Meta-CVS project. This requires    watch              Manipulate per-file CVS watch settings.
317                       filesystem-level access to the repository. This is                         watch --on [ files ... ]
318                       currently an experimental command that is known not                         watch --off [ files ... ]
319                       to work 100%.")                         watch --add <action> [ files ... ]
320                           watch --remove <action> [ files ... ]
321  (defvar *options*)    watchers           See who is watching files.
322  (defvar *args*)    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.
329                         This requires direct filesystem access to the repository.
330                         Caveat: this is a very blunt instrument.")
331    
332    (defmacro with-open-file-ignore-errors ((var &rest open-args) &body forms)
333      `(let ((,var (ignore-errors (open ,@open-args))))
334         (unwind-protect
335           (progn ,@forms)
336           (when ,var (close ,var)))))
337    
338  (defun mcvs-execute (args)  (defun mcvs-execute (args)
339    (handler-bind ((error #'mcvs-error-handler))    (with-open-file-ignore-errors (*interactive-error-io* (parse-posix-namestring
340      (multiple-value-bind (global-options global-args)                                                            (unix-funcs:ctermid))
341                           (parse-opt args *cvs-options*)                                                          :direction :io
342        (setf global-options (filter-global-options global-options))                                                          :if-does-not-exist nil)
343        (let ((*mcvs-error-treatment* (if *interactive-error-io*
344        (find-bind (:test #'string= :key #'first)                                      :interactive
345                   ((help-long "help") (help "H") (quiet "q")                                      :terminate)))
346                    (very-quiet "Q") (version "v") (version-long "version")        (unless *interactive-error-io*
347                    (editor "e") (interpret-file "i"))          (chatter-info "unable to open terminal device ~a .~%"
348                   global-options                        (unix-funcs:ctermid))
349          (setf *args* global-args)          (chatter-info "interactive error handling disabled.~%"))
350          (setf *options* global-options)        (handler-bind ((error #'mcvs-error-handler))
351          (when (or help-long help)          (multiple-value-bind (global-options global-args)
352            (terpri)                               (parse-opt args *global-options*)
353            (write-line *usage*)            (setf global-options (filter-global-options global-options))
354            (terpri)  
355            (throw 'mcvs-terminate nil))            (when *print-usage*
356          (when (or version version-long)              (terpri)
357            (let* ((vers (split-words "$Name$" "$:- "))              (write-line *usage*)
358                   (major (third vers))              (terpri)
359                   (minor (fourth vers)))              (throw 'mcvs-terminate nil))
360              (if (and major minor)  
361                (format t "Meta-CVS version ~a.~a (c) 2002 Kaz Kylheku~%"            (when (not (first global-args))
362                        major minor)              (write-line "Meta-CVS requires a command argument." *error-output*)
363                (format t "Meta-CVS unknown version (c) 2002 Kaz Kylheku~%"))              (write-line "Use mcvs -H to view help." *error-output*)
364              (throw 'mcvs-terminate nil)))              (throw 'mcvs-terminate nil))
365          (when editor  
366            (setf *editor* (second editor)))            (let ((command (find (first global-args) *mcvs-command-table*
367          (cond                                 :key #'first
368            (very-quiet (setf *mcvs-chatter-level* *mcvs-silent*))                                 :test #'string=)))
369            (quiet (setf *mcvs-chatter-level* *mcvs-terse*)))              (when (not command)
370          (when interpret-file                (error "~a is not a recognized mcvs command."
371            (load (second interpret-file))                       (first global-args)))
372            (throw 'mcvs-terminate nil)))              (destructuring-bind (name func help-text opt-spec) command
373                  (declare (ignore name help-text))
374        (when (not (first global-args))                (multiple-value-bind (command-options command-args)
375          (write-line "Meta-CVS requires a command argument.")                                     (parse-opt (rest global-args) opt-spec)
376          (write-line "Use mcvs -H to view help.")                  (funcall func global-options command-options command-args)))))))
377          (throw 'mcvs-terminate nil))      nil))
   
       (let ((command (find (first global-args) *mcvs-command-table*  
                            :key #'first  
                            :test #'string=)))  
         (when (not command)  
           (error "~a is not a recognized mcvs command."  
                  (first global-args)))  
         (destructuring-bind (name func help-text opt-spec) command  
           (declare (ignore name help-text))  
           (multiple-value-bind (command-options command-args)  
                                (parse-opt (rest global-args) opt-spec)  
             (funcall func global-options command-options command-args))))))  
   nil)  
378    
379  (defun mcvs-debug-shell ()  (defun mcvs-debug-shell ()
380    (let ((counter 0)    (let ((counter 0)

Legend:
Removed from v.1.69  
changed lines
  Added in v.1.69.2.29

  ViewVC Help
Powered by ViewVC 1.1.5