Ignore:
Timestamp:
02/27/05 03:06:10 (17 years ago)
Author:
piso
Message:

FRAME-COMMAND

File:
1 edited

Legend:

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

    r8644 r8646  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: top-level.lisp,v 1.41 2005-02-26 17:49:57 piso Exp $
     4;;; $Id: top-level.lisp,v 1.42 2005-02-27 03:06:10 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    6565(defun apropos-command (args)
    6666  (when args (apropos args)))
     67
     68(defun continue-command (args)
     69  (when args
     70    (let ((n (read-from-string args)))
     71      (let ((restarts (compute-restarts)))
     72        (when (< -1 n (length restarts))
     73          (invoke-restart-interactively (nth n restarts)))))))
     74
     75(defun describe-command (args)
     76  (let ((obj (eval (read-from-string args))))
     77    (describe obj)))
     78
     79(defun error-command (args)
     80  (when *debug-condition*
     81    (let* ((s (%format nil "~A" *debug-condition*))
     82           (len (length s)))
     83      (when (plusp len)
     84        (setf (schar s 0) (char-upcase (schar s 0)))
     85        (unless (eql (schar s (1- len)) #\.)
     86          (setf s (concatenate 'string s "."))))
     87      (%format *debug-io* "~A~%" s))
     88    (show-restarts (compute-restarts) *debug-io*)))
    6789
    6890(defun backtrace-command (args)
     
    88110  (values))
    89111
    90 (defun continue-command (args)
    91   (when args
    92     (let ((n (read-from-string args)))
    93       (let ((restarts (compute-restarts)))
    94         (when (< -1 n (length restarts))
    95           (invoke-restart-interactively (nth n restarts)))))))
    96 
    97 (defun describe-command (args)
    98   (let ((obj (eval (read-from-string args))))
    99     (describe obj)))
    100 
    101 (defun error-command (args)
    102   (when *debug-condition*
    103     (let* ((s (%format nil "~A" *debug-condition*))
    104            (len (length s)))
    105       (when (plusp len)
    106         (setf (schar s 0) (char-upcase (schar s 0)))
    107         (unless (eql (schar s (1- len)) #\.)
    108           (setf s (concatenate 'string s "."))))
    109       (%format *debug-io* "~A~%" s))
    110     (show-restarts (compute-restarts) *debug-io*)))
     112(defun frame-command (args)
     113  (let* ((n (or (and args (ignore-errors (parse-integer args)))
     114                0))
     115         (frame (nth n *saved-backtrace*)))
     116    (when frame
     117      (with-standard-io-syntax
     118        (let ((*print-pretty* t)
     119              (*print-readably* nil)
     120              (*print-structure* nil))
     121          (fresh-line *debug-io*)
     122          (pprint-logical-block (*debug-io* nil :prefix "(" :suffix ")")
     123            (prin1 (car frame) *debug-io*)
     124            (let ((args (cdr frame)))
     125              (if (listp args)
     126                  (format *debug-io* "~{ ~_~S~}" args)
     127                  (format *debug-io* " ~S" args))))))
     128      (setf *** **
     129            ** *
     130            * frame)))
     131  (values))
    111132
    112133(defun inspect-command (args)
     
    269290    ("error" "err" error-command "print the current error message")
    270291    ("exit" "ex" exit-command "exit lisp")
     292    ("frame" "fr" frame-command "set the value of cl:* to be frame n (default 0)")
    271293    ("help" "he" help-command "print this help")
    272294    ("inspect" "in" inspect-command "inspect an object")
Note: See TracChangeset for help on using the changeset viewer.