Changeset 4079


Ignore:
Timestamp:
09/26/03 19:19:14 (19 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r4056 r4079  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: top-level.lisp,v 1.1 2003-09-25 18:19:04 piso Exp $
     4;;; $Id: top-level.lisp,v 1.2 2003-09-26 19:19:14 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    1919
    2020;;; Adapted from SB-ACLREPL (originally written by Kevin Rosenberg).
     21
     22(in-package "EXTENSIONS")
     23
     24(export '(*saved-backtrace* bt))
     25
     26(defvar *saved-backtrace* nil)
     27
     28(defun bt (&optional count)
     29  (let ((count (if (fixnump count) count 7))
     30        (n 0))
     31    (dolist (frame *saved-backtrace*)
     32      (format t "  ~D: ~A~%" n frame)
     33      (incf n)
     34      (when (>= n count)
     35        (return))))
     36  (values))
    2137
    2238(in-package "TOP-LEVEL")
     
    102118                     (format *standard-output* "~A" (namestring *default-pathname-defaults*)))
    103119                   (format *standard-output* "Error: no such directory (~S).~%" args))))
     120            ((string= cmd "bt")
     121             (let ((count (or (and args (ignore-errors (parse-integer args))) 7)))
     122               (bt count)))
     123            ((string= cmd "pa")
     124             (cond ((null args)
     125                    (format *standard-output* "The ~A package is current.~%"
     126                            (package-name *package*)))
     127                   (t
     128                    (when (and (plusp (length args)) (eql (char args 0) #\:))
     129                      (setf args (subseq args 1)))
     130                    (setf args (nstring-upcase args))
     131                    (let ((pkg (find-package args)))
     132                      (if pkg
     133                          (setf *package* pkg)
     134                          (format *standard-output* "Unknown package ~A.~%" args))))))
    104135            ((string= cmd "ex")
    105136             (format t "Bye!~%")
     
    126157(defun interactive-eval (form)
    127158  (setf - form)
    128   (let ((results
    129    (multiple-value-list (eval form))))
     159  (let ((results (multiple-value-list (eval form))))
    130160    (setf /// //
    131161    // /
     
    159189      (handler-case
    160190          (repl-fun)
    161         (error (c) (format t "Error: ~S.~%" c) (throw 'top-level nil))))))
     191        (error (c) (format t "Error: ~S.~%" c) (break) (throw 'top-level nil))))))
Note: See TracChangeset for help on using the changeset viewer.