Changeset 12209 for trunk/source/level-1


Ignore:
Timestamp:
Jun 6, 2009, 5:41:20 PM (10 years ago)
Author:
gz
Message:

Merge r11804 and r12081 into trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-readloop-lds.lisp

    r12119 r12209  
    244244(%use-toplevel-commands :global)
    245245
    246 (defparameter *toplevel-commands-dwim* t "If true, tries to interpret otherwise-erroneous toplevel
    247 expressions as commands")
     246(defparameter *toplevel-commands-dwim* t
     247 "If true, tries to interpret otherwise-erroneous toplevel expressions as commands.
     248In addition, will suppress standard error handling for expressions that look like
     249commands but aren't")
    248250
    249251(defvar *default-integer-command* nil
     
    265267                   (setq cmd (find-symbol (symbol-name cmd) :keyword))))
    266268      (when (eq cmd :help) (setq cmd :?))
    267       (dolist (g *active-toplevel-commands*)
    268         (let* ((pair (assoc cmd (cdr g))))
    269           (when pair
    270             (apply (cadr pair) args)
    271             (return t)))))))
     269      (flet ((run (cmd form)
     270               (or (dolist (g *active-toplevel-commands*)
     271                     (let* ((pair (assoc cmd (cdr g))))
     272                       (when pair
     273                         (apply (cadr pair) args)
     274                         (return t))))
     275                   ;; Try to detect user mistyping a command
     276                   (when (and *toplevel-commands-dwim*
     277                              (if (consp form)
     278                                (and (keywordp (%car form)) (not (fboundp (%car form))))
     279                                (keywordp form)))
     280                     (error "Unknown command ~s" cmd)))))
     281        (declare (dynamic-extent #'run))
     282        (if *toplevel-commands-dwim*
     283          (block nil
     284            (handler-bind ((error (lambda (c)
     285                                    (format t "~&~a" c)
     286                                    (return t))))
     287              (run cmd form)))
     288          (run cmd form))))))
    272289
    273290(defparameter *quit-on-eof* nil)
     
    481498   of condition handling occurring."
    482499  (if *batch-flag*
    483     (apply #'error string args)
     500    (apply #'error (or string "BREAK invoked in batch mode") args)
    484501    (apply #'%break-in-frame (%get-frame-ptr) string args)))
    485502
     
    606623          ((eql count 1) (error "Error reporting error"))
    607624          (t (bug "Error reporting error")))))
    608 
    609625
    610626
     
    645661         (*backtrace-contexts* (cons context *backtrace-contexts*)))
    646662    (with-terminal-input
    647         (with-toplevel-commands :break
    648           (if *continuablep*
    649             (let* ((*print-circle* *error-print-circle*)
    650                    (*print-level* *error-print-level*)
    651                    (*print-length* *error-print-length*)
     663      (with-toplevel-commands :break
     664        (if *continuablep*
     665          (let* ((*print-circle* *error-print-circle*)
     666                 (*print-level* *error-print-level*)
     667                 (*print-length* *error-print-length*)
    652668                                        ;(*print-pretty* nil)
    653                    (*print-array* nil))
    654               (format t (or (application-ui-operation *application* :break-options-string t)
    655                             "~&> Type :GO to continue, :POP to abort, :R for a list of available restarts."))
    656               (format t "~&> If continued: ~A~%" continue))
    657             (format t (or (application-ui-operation *application* :break-options-string nil)
    658                           "~&> Type :POP to abort, :R for a list of available restarts.~%")))
    659           (format t "~&> Type :? for other options.")
    660           (terpri)
    661           (force-output)
    662 
    663           (clear-input *debug-io*)
    664           (setq *error-reentry-count* 0) ; succesfully reported error
    665           (ignoring-without-interrupts
    666            (unwind-protect
    667                 (progn
    668                   (application-ui-operation *application*
    669                                             :enter-backtrace-context context)
    670                   (read-loop :break-level (1+ *break-level*)
    671                              :input-stream *debug-io*
    672                              :output-stream *debug-io*))
    673              (application-ui-operation *application* :exit-backtrace-context
    674                                        context)))))))
     669                 (*print-array* nil))
     670            (format t (or (application-ui-operation *application* :break-options-string t)
     671                          "~&> Type :GO to continue, :POP to abort, :R for a list of available restarts."))
     672            (format t "~&> If continued: ~A~%" continue))
     673          (format t (or (application-ui-operation *application* :break-options-string nil)
     674                        "~&> Type :POP to abort, :R for a list of available restarts.~%")))
     675        (format t "~&> Type :? for other options.")
     676        (terpri)
     677        (force-output)
     678
     679        (clear-input *debug-io*)
     680        (setq *error-reentry-count* 0) ; succesfully reported error
     681        (ignoring-without-interrupts
     682          (unwind-protect
     683               (progn
     684                 (application-ui-operation *application*
     685                                           :enter-backtrace-context context)
     686                 (read-loop :break-level (1+ *break-level*)
     687                            :input-stream *debug-io*
     688                            :output-stream *debug-io*))
     689            (application-ui-operation *application* :exit-backtrace-context
     690                                      context)))))))
    675691
    676692
Note: See TracChangeset for help on using the changeset viewer.