/[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.23 by kaz, Thu May 1 05:34:31 2003 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  (defun mcvs-help (global-options command-options args)  (defun mcvs-help (global-options command-options args)
140    (declare (special *usage* *mcvs-command-table*)    (declare (special *usage* *mcvs-command-table*)
141             (ignore global-options command-options))             (ignore global-options command-options))
# Line 139  Line 167 
167     ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)     ("grab" ,#'mcvs-grab-wrapper ,*grab-help* ,*grab-options*)
168     ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)     ("checkout" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
169     ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)     ("co" ,#'mcvs-checkout-wrapper ,*checkout-help* ,*checkout-options*)
170       ("export" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
171       ("ex" ,#'mcvs-export-wrapper ,*export-help* ,*export-options*)
172     ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)     ("add" ,#'mcvs-add-wrapper ,*add-help* ,*add-options*)
173     ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)     ("remove" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
174     ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)     ("rm" ,#'mcvs-remove-wrapper ,*remove-help* ,*remove-options*)
175     ("move" ,#'mcvs-move-wrapper nil ,*move-options*)     ("move" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
176     ("mv" ,#'mcvs-move-wrapper nil ,*move-options*)     ("mv" ,#'mcvs-move-wrapper ,*move-help* ,*move-options*)
177       ("link" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
178       ("ln" ,#'mcvs-link-wrapper ,*link-help* ,*link-options*)
179     ("update" ,#'mcvs-update-wrapper nil ,*update-options*)     ("update" ,#'mcvs-update-wrapper nil ,*update-options*)
180     ("up" ,#'mcvs-update-wrapper nil ,*update-options*)     ("up" ,#'mcvs-update-wrapper nil ,*update-options*)
181     ("commit" ,#'mcvs-commit-wrapper nil ,*commit-options*)     ("commit" ,#'mcvs-commit-wrapper nil ,*commit-options*)
# Line 156  Line 188 
188     ("annotate" ,#'mcvs-annotate-wrapper nil ,*annotate-options*)     ("annotate" ,#'mcvs-annotate-wrapper nil ,*annotate-options*)
189     ("filt" ,#'mcvs-filt-wrapper nil ,*filt-options*)     ("filt" ,#'mcvs-filt-wrapper nil ,*filt-options*)
190     ("fi" ,#'mcvs-filt-wrapper nil ,*filt-options*)     ("fi" ,#'mcvs-filt-wrapper nil ,*filt-options*)
191       ("remote-filt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
192       ("rfilt" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
193       ("rfi" ,#'mcvs-remote-filt-wrapper nil ,*remote-filt-options*)
194     ("convert" ,#'mcvs-convert-wrapper nil ,*convert-options*)     ("convert" ,#'mcvs-convert-wrapper nil ,*convert-options*)
195     ("branch" ,#'mcvs-branch-wrapper nil ,*branch-options*)     ("branch" ,#'mcvs-branch-wrapper ,*branch-help* ,*branch-options*)
196     ("switch" ,#'mcvs-switch-wrapper nil ,*switch-options*)     ("switch" ,#'mcvs-switch-wrapper nil ,*switch-options*)
197     ("sw" ,#'mcvs-switch-wrapper nil ,*switch-options*)     ("sw" ,#'mcvs-switch-wrapper nil ,*switch-options*)
198     ("merge" ,#'mcvs-merge-wrapper nil ,*merge-options*)     ("merge" ,#'mcvs-merge-wrapper nil ,*merge-options*)
# Line 167  Line 202 
202     ("purge" ,#'mcvs-purge-wrapper nil ,*purge-options*)     ("purge" ,#'mcvs-purge-wrapper nil ,*purge-options*)
203     ("restore" ,#'mcvs-restore-wrapper nil ,*restore-options*)     ("restore" ,#'mcvs-restore-wrapper nil ,*restore-options*)
204     ("remap" ,#'mcvs-remap-wrapper nil ,*remap-options*)     ("remap" ,#'mcvs-remap-wrapper nil ,*remap-options*)
205     ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)))     ("prop" ,#'mcvs-prop-wrapper nil ,*prop-options*)
206       ("watch" ,#'mcvs-watch-wrapper nil ,*watch-options*)
207       ("watchers" ,#'mcvs-watchers-wrapper nil ,*watchers-options*)
208       ("edit" ,#'mcvs-edit-wrapper nil ,*edit-options*)
209       ("unedit" ,#'mcvs-unedit-wrapper nil ,*unedit-options*)
210       ("editors" ,#'mcvs-editors-wrapper nil ,*editors-options*)
211       ("sync-from-cvs" ,#'mcvs-sync-from-wrapper nil ,*editors-options*)
212       ("sync-to-cvs" ,#'mcvs-sync-to-wrapper nil ,*editors-options*)))
213    
214  (defconstant *usage*  (defconstant *usage*
215  "Meta-CVS command syntax:  "Meta-CVS command syntax:
# Line 180  Global options: Line 222  Global options:
222                       help specific to that command is printed instead.                       help specific to that command is printed instead.
223    -Q                 Very quiet, generate output only for serious problems. (*)    -Q                 Very quiet, generate output only for serious problems. (*)
224    -q                 Somewhat quiet, some informational messages suppresed. (*)    -q                 Somewhat quiet, some informational messages suppresed. (*)
225      -n                 Dry run; do not modify filesystem. (*)
226    --debug            Verbose debug output; -Q and -q are ignored but still    --debug            Verbose debug output; -Q and -q are ignored but still
227                       passed to CVS.                       passed to CVS.
228    -r                 Make working files read-only. (@)    -r                 Make working files read-only. (@)
# Line 197  Global options: Line 240  Global options:
240    --nometa           Exclude metafiles from the set of files to operate on.    --nometa           Exclude metafiles from the set of files to operate on.
241    --error-continue   Instead of interactive error handling, automatically    --error-continue   Instead of interactive error handling, automatically
242                       continue all continuable errors.                       continue all continuable errors.
243    --error-terminate  Terminate without cleanup when an error happens instead    --error-terminate  Terminate with cleanup when an error happens instead
244                       of interactive error handling (use with care).                       of interactive error handling.
245    -T tempdir         Place temporary files in tempdir. (@)    -T tempdir         Place temporary files in tempdir. (@)
246    -e editor          Edit messages with editor. (*)    -e editor          Edit messages with editor. (*)
247    -d root            Specify CVSROOT. (@)    -d root            Specify CVSROOT. (@)
248    -z gzip-level      Specify compression level. (@)    -z gzip-level      Specify compression level. (@)
249      --up N             Escape out of N levels of sandbox nesting before executing
250                         operation.
251    
252    Notes: (*) option processed by Meta-CVS and passed to CVS too.    Notes: (*) option processed by Meta-CVS and passed to CVS too.
253           (@) option merely passed to CVS.           (@) option merely passed to CVS.
# Line 214  Commands: Line 259  Commands:
259    grab               Take a snapshot of an external source tree, such    grab               Take a snapshot of an external source tree, such
260                       as a third-party release, and incorporate it into                       as a third-party release, and incorporate it into
261                       the working copy. Tries to discover file moves.                       the working copy. Tries to discover file moves.
262    checkout (co)      Retrieve a Meta-CVS project from CVS and build    checkout (co)      Retrieve a Meta-CVS project from the repository to
263                         create a working copy.
264      export (ex)        Retrieve a Meta-CVS project without creating a
265                       working copy.                       working copy.
266    add                Place files (or directories with add -R) under    add                Place files (or directories with add -R) under
267                       version control.                       version control.
268    remove (rm)        Remove files or directories.    remove (rm)        Remove files or directories.
269    move (mv)          Rename files and directories.    move (mv)          Rename files and directories.
270      link (ln)          Create a versioned symbolic link.
271    update (up)        Incorporate latest changes from repository into    update (up)        Incorporate latest changes from repository into
272                       working copy.                       working copy.
273    commit (ci)        Incorporate outstanding changes in the working copy    commit (ci)        Incorporate outstanding changes in the working copy
# Line 236  Commands: Line 284  Commands:
284                       version information about every individual line of text.                       version information about every individual line of text.
285    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
286                       names to readable paths, according to the current mapping.                       names to readable paths, according to the current mapping.
287      remote-filt (rfi)  Remote version of filt, requires module name.
288    branch             Create a managed branch. Meta-CVS managed branches keep    branch             Create a managed branch. Meta-CVS managed branches keep
289                       track of what has been merged where, so users don't have                       track of what has been merged where, so users don't have
290                       to track merges with tags at all.                       to track merges with tags at all.
# Line 255  Commands: Line 304  Commands:
304                       directory under cryptic names.                       directory under cryptic names.
305    prop               Manipulate properties.    prop               Manipulate properties.
306                         prop --set <bool-prop-name> [ files ... ]                         prop --set <bool-prop-name> [ files ... ]
307                         prop --clear <bool-prop-name> [ files ... ]                         prop --clear <bool-prop-name> [ files ... ]
308                         prop --value <prop-name> <new-value> [ files ... ]                         prop --value <prop-name> <new-value> [ files ... ]
309                         prop --remove <prop-name> [ files ... ]                         prop --remove <prop-name> [ files ... ]
310                       The ``exec'' property represents the execute permission                       The ``exec'' property represents the execute permission
311                       of a file.  More than one --set, --clear, --value                       of a file.  More than one --set, --clear, --value
312                       or --remove may be specified before the files.                       or --remove may be specified before the files.
313      watch              Manipulate per-file CVS watch settings.
314                           watch --on [ files ... ]
315                           watch --off [ files ... ]
316                           watch --add <action> [ files ... ]
317                           watch --remove <action> [ files ... ]
318      watchers           See who is watching files.
319      edit               Indicate the intent to edit a watched file.
320      unedit             Retract the indication signaled by edit.
321      editors            See who is editing files.
322      sync-to-cvs        Synchronize tree in the direction of the CVS sandbox.
323                         Useful when extending Meta-CVS with external scripts.
324      sync-from-cvs      Synchronize CVS sandbox to the tree.
325    convert            Convert a CVS module to a Meta-CVS project. This requires    convert            Convert a CVS module to a Meta-CVS project. This requires
326                       filesystem-level access to the repository. This is                       filesystem-level access to the repository. This is
327                       currently an experimental command that is known not                       currently an experimental command that is known not
328                       to work 100%.")                       to work 100%.")
329    
 (defvar *options*)  
 (defvar *args*)  
   
330  (defun mcvs-execute (args)  (defun mcvs-execute (args)
331    (handler-bind ((error #'mcvs-error-handler))    (with-open-file (*interactive-error-io* (parse-posix-namestring
332      (multiple-value-bind (global-options global-args)                                              (unix-funcs:ctermid))
333                           (parse-opt args *cvs-options*)                                            :direction :io
334        (setf global-options (filter-global-options global-options))                                            :if-does-not-exist nil)
335        (let ((*mcvs-error-treatment* (if *interactive-error-io*
336        (find-bind (:test #'string= :key #'first)                                      :interactive
337                   ((help-long "help") (help "H") (quiet "q")                                      :terminate)))
338                    (very-quiet "Q") (version "v") (version-long "version")        (unless *interactive-error-io*
339                    (editor "e") (interpret-file "i"))          (chatter-info "unable to open terminal device ~a ."
340                   global-options                        (unix-funcs:ctermid))
341          (setf *args* global-args)          (chatter-info "interactive error handling disabled."))
342          (setf *options* global-options)        (handler-bind ((error #'mcvs-error-handler))
343          (when (or help-long help)          (multiple-value-bind (global-options global-args)
344            (terpri)                               (parse-opt args *global-options*)
345            (write-line *usage*)            (setf global-options (filter-global-options global-options))
346            (terpri)  
347            (throw 'mcvs-terminate nil))            (when *print-usage*
348          (when (or version version-long)              (terpri)
349            (let* ((vers (split-words "$Name$" "$:- "))              (write-line *usage*)
350                   (major (third vers))              (terpri)
351                   (minor (fourth vers)))              (throw 'mcvs-terminate nil))
352              (if (and major minor)  
353                (format t "Meta-CVS version ~a.~a (c) 2002 Kaz Kylheku~%"            (when (not (first global-args))
354                        major minor)              (write-line "Meta-CVS requires a command argument." *error-output*)
355                (format t "Meta-CVS unknown version (c) 2002 Kaz Kylheku~%"))              (write-line "Use mcvs -H to view help." *error-output*)
356              (throw 'mcvs-terminate nil)))              (throw 'mcvs-terminate nil))
357          (when editor  
358            (setf *editor* (second editor)))            (let ((command (find (first global-args) *mcvs-command-table*
359          (cond                                 :key #'first
360            (very-quiet (setf *mcvs-chatter-level* *mcvs-silent*))                                 :test #'string=)))
361            (quiet (setf *mcvs-chatter-level* *mcvs-terse*)))              (when (not command)
362          (when interpret-file                (error "~a is not a recognized mcvs command."
363            (load (second interpret-file))                       (first global-args)))
364            (throw 'mcvs-terminate nil)))              (destructuring-bind (name func help-text opt-spec) command
365                  (declare (ignore name help-text))
366        (when (not (first global-args))                (multiple-value-bind (command-options command-args)
367          (write-line "Meta-CVS requires a command argument.")                                     (parse-opt (rest global-args) opt-spec)
368          (write-line "Use mcvs -H to view help.")                  (funcall func global-options command-options command-args)))))))
369          (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)  
370    
371  (defun mcvs-debug-shell ()  (defun mcvs-debug-shell ()
372    (let ((counter 0)    (let ((counter 0)

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

  ViewVC Help
Powered by ViewVC 1.1.5