Changeset 9725


Ignore:
Timestamp:
Jun 10, 2008, 12:53:33 PM (11 years ago)
Author:
mb
Message:

Make sure printed list of restarts reflects currently available restarts.

If we want to print a list of restarts before the debugger prompt we need to
make sure that compute-restarts is called late enough that no new restarts will
be defined.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-readloop-lds.lisp

    r9602 r9725  
    9696(define-toplevel-command :break q () "return to toplevel" (toplevel))
    9797(define-toplevel-command :break r () "list restarts"
    98   (format t "~&   (:C <n>) can be used to invoke one of the following restarts in this break loop:")
    99   (let* ((r (apply #'vector (compute-restarts *break-condition*))))
    100     (dotimes (i (length r) (terpri))
    101       (format *debug-io* "~&~d. ~a" i (svref r i)))))
    102 
    103 ;;; From Marco Baringer 2003/03/18
     98  (format *debug-io* "~&   (:C <n>) can be used to invoke one of the following restarts in this break loop:")
     99  (display-restarts))
    104100
    105101(define-toplevel-command :break set (n frame value) "Set <n>th item of frame <frame> to <value>"
     
    279275                       (output-stream *standard-output*)
    280276                       (break-level *break-level*)
    281                        (prompt-function #'(lambda (stream) (print-listener-prompt stream t))))
     277                       (prompt-function #'(lambda (stream)
     278                                            (when (and *show-available-restarts* *break-condition*)
     279                                              (display-restarts)
     280                                              (setf *show-available-restarts* nil))
     281                                            (print-listener-prompt stream t))))
    282282  (let* ((*break-level* break-level)
    283283         (*last-break-level* break-level)
     
    285285         *in-read-loop*
    286286         *** ** * +++ ++ + /// // / -
    287          (eof-value (cons nil nil)))
     287         (eof-value (cons nil nil))
     288         (*show-available-restarts* (and *show-restarts-on-break* *break-condition*)))
    288289    (declare (dynamic-extent eof-value))
    289290    (loop
     
    565566(defvar *break-loop-when-uninterruptable* t)
    566567(defvar *show-restarts-on-break* #+ccl-0711 t #-ccl-0711 nil)
     568(defvar *show-available-restarts* nil)
    567569
    568570(defvar *error-reentry-count* 0)
     
    611613           (*backtrace-contexts* (cons context *backtrace-contexts*)))
    612614      (with-toplevel-commands :break
    613         (if *show-restarts-on-break*
    614           (let ((*print-circle* *error-print-circle*)
    615                 (*print-level* *backtrace-print-level*)
    616                 (*print-length* *backtrace-print-length*)
    617                                         ;(*print-pretty* nil)
    618                 (*print-array* nil))
    619             (format t "~&> Type :POP to abort, or :C <n> to invoke one of the following restarts:")
    620             (let* ((r (apply #'vector (compute-restarts *break-condition*))))
    621               (dotimes (i (length r) (terpri))
    622                 (format t "~&~d. ~a" i (svref r i)))))
    623           (if *continuablep*
     615        (if *continuablep*
    624616            (let* ((*print-circle* *error-print-circle*)
    625617                   (*print-level* *backtrace-print-level*)
     
    629621              (format t "~&> Type :GO to continue, :POP to abort, :R for a list of available restarts.")
    630622              (format t "~&> If continued: ~A~%" continue))
    631             (format t "~&> Type :POP to abort, :R for a list of available restarts.~%")))
     623            (format t "~&> Type :POP to abort, :R for a list of available restarts.~%"))
    632624        (format t "~&> Type :? for other options.")
    633625        (terpri)
     
    641633                (application-ui-operation *application*
    642634                                          :enter-backtrace-context context)
    643                   (read-loop :break-level (1+ *break-level*)
    644                              :input-stream *debug-io*
    645                              :output-stream *debug-io*))
     635                (read-loop :break-level (1+ *break-level*)
     636                           :input-stream *debug-io*
     637                           :output-stream *debug-io*))
    646638           (application-ui-operation *application* :exit-backtrace-context
    647639                                     context)))))))
     
    650642
    651643(defun display-restarts (&optional (condition *break-condition*))
    652   (let ((i 0))
    653     (format t "~&[Pretend that these are buttons.]")
    654     (dolist (r (compute-restarts condition) i)
    655       (format t "~&~a : ~A" i r)
    656       (setq i (%i+ i 1)))
    657     (fresh-line nil)))
     644  (loop
     645    for restart in (compute-restarts condition)
     646    for count upfrom 0
     647    do (format *debug-io* "~&~D. ~A" count restart)
     648    finally (fresh-line *debug-io*)))
    658649
    659650(defun select-restart (n &optional (condition *break-condition*))
Note: See TracChangeset for help on using the changeset viewer.