/[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.95 by kaz, Fri Nov 24 04:53:49 2006 UTC revision 1.96 by kaz, Fri Nov 24 06:47:12 2006 UTC
# Line 311  Commands: Line 311  Commands:
311         (when ,var (close ,var)))))         (when ,var (close ,var)))))
312    
313  (defun mcvs-execute (args)  (defun mcvs-execute (args)
314      (handler-bind ((error #'mcvs-error-handler))
315        (multiple-value-bind (global-options global-args)
316                             (parse-opt args *global-options*)
317          (setf global-options (filter-global-options global-options))
318    
319          (when *print-usage*
320            (terpri)
321            (write-line *usage*)
322            (terpri)
323            (throw 'mcvs-terminate nil))
324    
325          (when (not (first global-args))
326            (write-line "Meta-CVS requires a command argument." *error-output*)
327            (write-line "Use mcvs -H to view help." *error-output*)
328            (throw 'mcvs-terminate nil))
329    
330          (let ((command (find (first global-args) *mcvs-command-table*
331                               :key #'first
332                               :test #'string=)))
333            (when (not command)
334              (error "~a is not a recognized mcvs command."
335                     (first global-args)))
336            (destructuring-bind (name func help-text opt-spec) command
337              (declare (ignore name help-text))
338              (multiple-value-bind (command-options command-args)
339                                   (parse-opt (rest global-args) opt-spec)
340                (funcall func global-options command-options command-args)))))))
341    
342    (defun main ()
343    (with-open-file-ignore-errors (*interactive-error-io* (parse-posix-namestring    (with-open-file-ignore-errors (*interactive-error-io* (parse-posix-namestring
344                                                            (unix-funcs:ctermid))                                                            (unix-funcs:ctermid))
345                                                          :direction :io                                                          :direction :io
# Line 322  Commands: Line 351  Commands:
351          (chatter-info "unable to open terminal device ~a .~%"          (chatter-info "unable to open terminal device ~a .~%"
352                        (unix-funcs:ctermid))                        (unix-funcs:ctermid))
353          (chatter-info "interactive error handling disabled.~%"))          (chatter-info "interactive error handling disabled.~%"))
354        (handler-bind ((error #'mcvs-error-handler))        (ext:exit (catch 'mcvs-terminate
355          (multiple-value-bind (global-options global-args)                    (mcvs-execute ext:*args*)
356                               (parse-opt args *global-options*)                    *mcvs-errors-occured-p*)))))
357            (setf global-options (filter-global-options global-options))  
358    (defun main-debug ()
359            (when *print-usage*    (let ((*mcvs-error-treatment* :decline)
360              (terpri)          (*interactive-error-io* *terminal-io*))
361              (write-line *usage*)      (ext:exit (catch 'mcvs-terminate
362              (terpri)                  (mcvs-execute ext:*args*)
363              (throw 'mcvs-terminate nil))                  *mcvs-errors-occured-p*))))
   
           (when (not (first global-args))  
             (write-line "Meta-CVS requires a command argument." *error-output*)  
             (write-line "Use mcvs -H to view help." *error-output*)  
             (throw 'mcvs-terminate 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))  
   
 (defun mcvs-debug-shell ()  
   (let ((counter 0)  
         (*mcvs-error-treatment* :decline))  
     (loop  
       (format t "~&mcvs[~a]> " (incf counter))  
       (let ((line (string-trim #(#\space #\tab) (read-line))))  
         (restart-case  
           (cond  
             ((zerop (length line)))  
             ((string-equal line "exit")  
                (return-from mcvs-debug-shell))  
             ((char-equal (char line 0) #\!)  
                (print (eval (read-from-string (subseq line 1)))))  
             (t (mcvs-execute (split-words line #(#\space #\tab)))))  
           (debug () :report "Return to mcvs debug shell"  
             (terpri)))))))  
   
 #+clisp  
 (defun main ()  
   (ext:exit (catch 'mcvs-terminate (or (mcvs-execute ext:*args*)  
                                        *mcvs-errors-occured-p*))))  

Legend:
Removed from v.1.95  
changed lines
  Added in v.1.96

  ViewVC Help
Powered by ViewVC 1.1.5