/[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.87 by kaz, Thu Apr 24 04:33:15 2003 UTC revision 1.88 by kaz, Mon Apr 28 06:20:45 2003 UTC
# Line 331  Commands: Line 331  Commands:
331                       to work 100%.")                       to work 100%.")
332    
333  (defun mcvs-execute (args)  (defun mcvs-execute (args)
334    (let* ((*interactive-error-io* (open (unix-funcs:ctermid) :direction :io))    (with-open-file (*interactive-error-io* (parse-posix-namestring
335           (*mcvs-error-treatment* (if *interactive-error-io*                                              (unix-funcs:ctermid))
336                                     :interactive                                            :direction :io
337                                     :terminate)))                                            :if-does-not-exist nil)
338      (handler-bind ((error #'mcvs-error-handler))      (let ((*mcvs-error-treatment* (if *interactive-error-io*
339        (multiple-value-bind (global-options global-args)                                      :interactive
340                             (parse-opt args *global-options*)                                      :terminate)))
341          (setf global-options (filter-global-options global-options))        (handler-bind ((error #'mcvs-error-handler))
342            (multiple-value-bind (global-options global-args)
343                                 (parse-opt args *global-options*)
344              (setf global-options (filter-global-options global-options))
345    
346          (when *print-usage*            (when *print-usage*
347            (terpri)              (terpri)
348            (write-line *usage*)              (write-line *usage*)
349            (terpri)              (terpri)
350            (throw 'mcvs-terminate nil))              (throw 'mcvs-terminate nil))
351    
352          (when (not (first global-args))            (when (not (first global-args))
353            (write-line "Meta-CVS requires a command argument." *error-output*)              (write-line "Meta-CVS requires a command argument." *error-output*)
354            (write-line "Use mcvs -H to view help." *error-output*)              (write-line "Use mcvs -H to view help." *error-output*)
355            (throw 'mcvs-terminate nil))              (throw 'mcvs-terminate nil))
356    
357          (let ((command (find (first global-args) *mcvs-command-table*            (let ((command (find (first global-args) *mcvs-command-table*
358                               :key #'first                                 :key #'first
359                               :test #'string=)))                                 :test #'string=)))
360            (when (not command)              (when (not command)
361              (error "~a is not a recognized mcvs command."                (error "~a is not a recognized mcvs command."
362                     (first global-args)))                       (first global-args)))
363            (destructuring-bind (name func help-text opt-spec) command              (destructuring-bind (name func help-text opt-spec) command
364              (declare (ignore name help-text))                (declare (ignore name help-text))
365              (multiple-value-bind (command-options command-args)                (multiple-value-bind (command-options command-args)
366                                   (parse-opt (rest global-args) opt-spec)                                     (parse-opt (rest global-args) opt-spec)
367                (funcall func global-options command-options command-args))))))                  (funcall func global-options command-options command-args)))))))
368      nil))      nil))
369    
370  (defun mcvs-debug-shell ()  (defun mcvs-debug-shell ()

Legend:
Removed from v.1.87  
changed lines
  Added in v.1.88

  ViewVC Help
Powered by ViewVC 1.1.5