X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-aclrepl%2Ftoplevel.lisp;h=36c36dabfc9a88bbc9b8fe42ad7382e05cda3c6d;hb=fb8533122551bbb7aea669f40bc91c1211809b58;hp=41d871ce74822a8c9e298ab14371bed7866edf5a;hpb=b79fc0e07dc40c8c0f7b59e0fa6006042986758a;p=sbcl.git diff --git a/contrib/sb-aclrepl/toplevel.lisp b/contrib/sb-aclrepl/toplevel.lisp index 41d871c..36c36da 100644 --- a/contrib/sb-aclrepl/toplevel.lisp +++ b/contrib/sb-aclrepl/toplevel.lisp @@ -1,17 +1,28 @@ (cl:defpackage :sb-aclrepl - (:use :cl :sb-ext)) + (:use "COMMON-LISP" "SB-EXT") + (:shadowing-import-from "SB-IMPL" "SCRUB-CONTROL-STACK") + (:shadowing-import-from "SB-INT" "*REPL-PROMPT-FUN*" "*REPL-READ-FORM-FUN*") + (:export + ;; user-level customization of UI + "*PROMPT*" "*EXIT-ON-EOF*" "*MAX-HISTORY*" + "*USE-SHORT-PACKAGE-NAME*" "*COMMAND-CHAR*" + ;; user-level customization of functionality + "ALIAS" + ;; internalsish, but the documented way to make a new repl "object" + ;; such that it inherits the current state of the repl but has its + ;; own independent state subsequently. + "MAKE-REPL-FUN")) (cl:in-package :sb-aclrepl) -(defvar *noprint* nil "boolean: T if don't print prompt and output") -(defvar *break-level* 0 "current break level") -(defvar *inspect-break* nil "boolean: T if break caused by inspect") -(defvar *continuable-break* nil "boolean: T if break caused by continuable error") - -(shadowing-import '(sb-impl::scrub-control-stack - sb-int:*repl-prompt-fun* sb-int:*repl-read-form-fun*) - :sb-aclrepl) - +(defvar *noprint* nil + "boolean: T if don't print prompt and output") +(defvar *break-level* 0 + "current break level") +(defvar *inspect-break* nil + "boolean: T if break caused by inspect") +(defvar *continuable-break* nil + "boolean: T if break caused by continuable error") (defun repl (&key (break-level (1+ *break-level*)) @@ -28,6 +39,7 @@ (catch 'repl-catcher (loop (rep-one))) + (declare (ignore reason-param)) (cond ((and (eq reason :inspect) (plusp *break-level*)) @@ -55,11 +67,10 @@ (results (multiple-value-list (sb-impl::interactive-eval form)))) (unless *noprint* (dolist (result results) - (fresh-line) - (prin1 result))))) - -(defun repl-fun (noprint) - (repl :noprint noprint :break-level 0)) - -(when (boundp 'sb-impl::*repl-fun*) - (setq sb-impl::*repl-fun* #'repl-fun)) + ;; FIXME: Calling fresh-line before a result ensures the result starts + ;; on a newline, but it usually generates an empty line. + ;; One solution would be to have the newline's entered on the + ;; input stream inform the output stream that the column should be + ;; reset to the beginning of the line. + (fresh-line *standard-output*) + (prin1 result *standard-output*)))))