X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-aclrepl%2Frepl.lisp;h=9744e68f37853c0736fa11911a1d4d6257c7f31a;hb=8a8a8922802460741d6f8f6c11d71b1f414cf3a7;hp=f5830dbddfabe7069de9e83ff318d893cfb5a9f8;hpb=541c9393cf9d9b61271c5f087020d34547603a34;p=sbcl.git diff --git a/contrib/sb-aclrepl/repl.lisp b/contrib/sb-aclrepl/repl.lisp index f5830db..9744e68 100644 --- a/contrib/sb-aclrepl/repl.lisp +++ b/contrib/sb-aclrepl/repl.lisp @@ -52,11 +52,6 @@ (declaim (type list *history*)) -(eval-when (:compile-toplevel :load-toplevel :execute) - (export '(*prompt* *exit-on-eof* *max-history* - *use-short-package-name* *command-char* - alias))) - (defvar *eof-marker* :eof) (defvar *eof-cmd* (make-user-cmd :func :eof)) (defvar *null-cmd* (make-user-cmd :func :null-cmd)) @@ -64,18 +59,6 @@ (defparameter *cmd-table-hash* (make-hash-table :size 30 :test #'equal)) -;; Set up binding for multithreading - -(let ((*prompt* #.*default-prompt*) - (*use-short-package-name* t) - (*dir-stack* nil) - (*command-char* #\:) - (*max-history* 100) - (*exit-on-eof* t) - (*history* nil) - (*cmd-number* 1) - ) - (defun prompt-package-name () (if *use-short-package-name* (car (sort (append @@ -86,21 +69,24 @@ (defun read-cmd (input-stream) ;; Reads a command from the user and returns a user-cmd object - (let ((next-char (peek-char-non-whitespace input-stream))) - (cond - ((eql *command-char* next-char) - (dispatch-command-line input-stream)) - ((eql #\newline next-char) - (read-char input-stream) - *null-cmd*) - ((eql :eof next-char) - *eof-cmd*) - (t - (let* ((eof (cons nil *eof-marker*)) - (form (read input-stream nil eof))) - (if (eq form eof) - *eof-cmd* - (make-user-cmd :input form :func nil :hnum *cmd-number*))))))) + (let* ((next-char (peek-char-non-whitespace input-stream)) + (cmd (cond + ((eql *command-char* next-char) + (dispatch-command-line input-stream)) + ((eql #\newline next-char) + (read-char input-stream) + *null-cmd*) + ((eql :eof next-char) + *eof-cmd*) + (t + (let* ((eof (cons nil *eof-marker*)) + (form (read input-stream nil eof))) + (if (eq form eof) + *eof-cmd* + (make-user-cmd :input form :func nil :hnum *cmd-number*))))))) + (if (and (eq cmd *eof-cmd*) (typep input-stream 'string-stream)) + (throw 'repl-catcher cmd) + cmd))) (defun dispatch-command-line (input-stream) "Processes an input line that starts with *command-char*" @@ -180,7 +166,7 @@ (defun process-history-search (pattern cmd-args-string) (let ((cmd (find-history-matching-pattern pattern))) (unless cmd - (format *output* "No match on history list with pattern ~S" pattern) + (format *output* "No match on history list with pattern ~S~%" pattern) (return-from process-history-search *null-cmd*)) (maybe-return-history-cmd cmd cmd-args-string))) @@ -411,6 +397,7 @@ (defun apropos-cmd (string) (apropos (string-upcase string)) + (fresh-line *output*) (values)) (let ((last-files-loaded nil)) @@ -424,7 +411,7 @@ (values))) (defun inspect-cmd (arg) - (inspector-fun arg nil *output*) + (inspector-fun (eval arg) nil *output*) (values)) (defun istep-cmd (&optional arg-string) @@ -487,7 +474,7 @@ (defun pushd-cmd (string-arg) (push string-arg *dir-stack*) - (cd-cmd *output* string-arg) + (cd-cmd string-arg) (values)) (defun popd-cmd () @@ -635,8 +622,7 @@ (values)) (defun reset-cmd () - ;; The last restart goes to the toplevel - (invoke-restart-interactively (car (last (compute-restarts))))) + (invoke-restart-interactively (find-restart 'sb-impl::toplevel))) (defun dirs-cmd () (dolist (dir *dir-stack*) @@ -774,29 +760,24 @@ (and (characterp x) (or (char= x #\space) (char= x #\tab) + (char= x #\page) (char= x #\newline) (char= x #\return)))) (defun whitespace-char-not-newline-p (x) (and (whitespace-char-p x) (not (char= x #\newline)))) - ;;;; linking into SBCL hooks - (defun repl-prompt-fun (stream) (let ((break-level (when (plusp *break-level*) *break-level*)) (frame-number (when (and (plusp *break-level*) sb-debug::*current-frame*) (sb-di::frame-number sb-debug::*current-frame*)))) - #+sb-thread - (let ((lock sb-thread::*session-lock*)) - (sb-thread::get-foreground) - (let ((stopped-threads (sb-thread::waitqueue-data lock))) - (when stopped-threads - (format stream "~{~&Thread ~A suspended~}~%" stopped-threads)))) + (sb-thread::get-foreground) + (fresh-line stream) (if (functionp *prompt*) (write-string (funcall *prompt* break-level @@ -830,7 +811,7 @@ ((eq (user-cmd-func user-cmd) :cmd-error) (format *output* "Unknown top-level command: ~s.~%" (user-cmd-input user-cmd)) - (format *output* "Type `:help' for the list of commands.~%") + (format *output* "Type `~Ahelp' for the list of commands.~%" *command-char*) t) ((eq (user-cmd-func user-cmd) :history-error) (format *output* "Input numbered ~d is not on the history list~%" @@ -861,5 +842,23 @@ (setf sb-int:*repl-prompt-fun* #'repl-prompt-fun sb-int:*repl-read-form-fun* #'repl-read-form-fun) -) ;; close special variables bindings - +(defmacro with-new-repl-state ((&rest vars) &body forms) + (let ((gvars (mapcar (lambda (var) (gensym (symbol-name var))) vars))) + `(let (,@(mapcar (lambda (var gvar) `(,gvar ,var)) vars gvars)) + (lambda (noprint) + (let ((*noprint* noprint)) + (let (,@(mapcar (lambda (var gvar) `(,var ,gvar)) vars gvars)) + (unwind-protect + (progn ,@forms) + ,@(mapcar (lambda (var gvar) `(setf ,gvar ,var)) + vars gvars)))))))) + +(defun make-repl-fun () + (with-new-repl-state (*break-level* *inspect-break* *continuable-break* + *dir-stack* *command-char* *prompt* + *use-short-package-name* *max-history* *exit-on-eof* + *history* *cmd-number*) + (repl :noprint noprint :break-level 0))) + +(when (boundp 'sb-impl::*repl-fun-generator*) + (setq sb-impl::*repl-fun-generator* #'make-repl-fun))