Ignore:
Timestamp:
12/19/03 03:24:02 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/top-level.lisp

    r5162 r5192  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: top-level.lisp,v 1.21 2003-12-16 14:38:11 piso Exp $
     4;;; $Id: top-level.lisp,v 1.22 2003-12-19 03:23:38 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    4747  (loop
    4848    (let ((c (read-char stream nil)))
    49       (unless (eql c #\Space)
     49      (unless (eql c #\space)
    5050        (unread-char c stream)
    5151        (return c)))))
    52 
    53 (defun read-cmd (stream)
    54   (let ((c (peek-char-non-whitespace stream)))
    55     (if (eql c *command-char*)
    56         (read-line stream)
    57         (read stream nil))))
    5852
    5953(defun apropos-command (args)
     
    7165  (values))
    7266
    73 (defun continue-command (ignored)
    74   (if (> *debug-level* 0)
    75       (throw 'continue-catcher nil)))
     67(defun continue-command (args)
     68  (when args
     69    (let ((n (read-from-string args)))
     70      (let ((restarts (compute-restarts)))
     71        (when (< -1 n (length restarts))
     72          (invoke-restart (nth n restarts)))))))
    7673
    7774(defun describe-command (args)
    7875  (let ((obj (eval (read-from-string args))))
    7976    (describe obj)))
     77
     78(defun error-command (args)
     79  (when *debug-condition*
     80    (let* ((s (%format nil "~A" *debug-condition*))
     81           (len (length s)))
     82      (when (plusp len)
     83        (setf (schar s 0) (char-upcase (schar s 0)))
     84        (unless (eql (schar s (1- len)) #\.)
     85          (setf s (concatenate 'string s "."))))
     86      (format *debug-io* "~A~%" s))
     87    (show-restarts (compute-restarts) *debug-io*)))
    8088
    8189(defun inspect-command (args)
     
    106114
    107115(defun reset-command (ignored)
    108   (throw 'top-level-catcher nil))
     116  (invoke-restart 'top-level))
    109117
    110118(defun exit-command (ignored)
     
    168176    ("bt" 2 backtrace-command "backtrace n stack frames (default all)")
    169177    ("cd" 2 cd-command "change default directory")
    170     ("continue" 4 continue-command "return from break")
     178    ("continue" 4 continue-command "invoke restart n")
    171179    ("describe" 2 describe-command "describe an object")
     180    ("error" 3 error-command "print the current error message")
    172181    ("exit" 2 exit-command "exit lisp")
    173182    ("help" 2 help-command "print this help")
     
    206215
    207216(defun process-cmd (form)
    208   (when (and (stringp form) (> (length form) 1) (eql (char form 0) *command-char*))
    209     (let* ((pos (position #\Space form))
     217  (when (and (stringp form)
     218             (> (length form) 1)
     219             (eql (char form 0) *command-char*))
     220    (let* ((pos (position #\space form))
    210221           (cmd (subseq form 1 pos))
    211222           (args (if pos (subseq form (1+ pos)) nil)))
     
    221232  nil)
    222233
     234(defun read-cmd (stream)
     235  (let ((c (peek-char-non-whitespace stream)))
     236    (if (eql c *command-char*)
     237        (read-line stream)
     238        (read stream nil))))
     239
    223240(defun repl-read-form-fun (in out)
    224241  (loop
     
    229246             (funcall *repl-prompt-fun* *standard-output*)
    230247             (finish-output *standard-output*))
     248            ((and (> *debug-level* 0)
     249                  (fixnump form))
     250             (let ((n form)
     251                   (restarts (compute-restarts)))
     252               (if (< -1 n (length restarts))
     253                   (invoke-restart (nth n restarts))
     254                   (return form))))
    231255            (t
    232256             (return form))))))
     
    248272(defun top-level-loop ()
    249273  (fresh-line)
    250   (%format t "Type :HELP for a list of top-level commands.~%")
    251   (loop
    252     (catch 'top-level-catcher
    253       (handler-case
    254           (repl)
    255         #+j (stream-error (c) (return-from top-level-loop)) ; FIXME
    256         (error (c)
    257                (invoke-debugger c)
    258                (throw 'top-level-catcher nil))))))
     274  (%format t "Type :HELP for a list of available commands.~%")
     275  (loop
     276      (with-simple-restart (top-level
     277                            "Return to top level.")
     278        #+j
     279        (handler-case
     280            (repl)
     281          (stream-error (c) (return-from top-level-loop)))
     282        #-j
     283        (repl))))
Note: See TracChangeset for help on using the changeset viewer.