diff --git a/README b/README index 0ad33cc6ea0485002efe011f93aa0258d8bfd6f0..7755c021a8bd02084810268e0c61a3883078f211 100644 --- a/README +++ b/README @@ -52,23 +52,38 @@ LINEDIT INTERFACE --------- - function INSTALL-REPL &key wrap-current eof-quits + function INSTALL-REPL &key wrap-current eof-quits history killring - Installs Linedit REPL input handler. (SBCL and CCL only.) + Installs the Linedit at REPL. (SBCL and CCL only.) + + WRAP-CURRENT keeps current input handlers (eg. toplevel command + processors) in place. + + If EOF-QUITS is true, EOF on *STANDARD-INPUT* causes the system to + exit after verification. + + HISTORY and KILLRING can be pathname designators, in which case + they indicate the file to use for history and killring + persistence, respectively." function UNINSTALL-REPL Removes Linedit REPL input handler. (SBCL and CCL only.) - function LINEDIT &rest keys &key prompt + function LINEDIT &rest keys &key prompt history killring Reads a single line of input with line-editing from standard input of the process and returns it as a string. - Results are unspecified if *STANDARD-INPUT* has been bound or altered. + Results are unspecified if *STANDARD-INPUT* has been bound or + altered. - :PROMPT specifies the string to print to *STANDARD-OUTPUT* before - starting to accept input. + PROMPT specifies the string to print to *STANDARD-OUTPUT* before + starting the accept input. + + HISTORY and KILLRING can be pathname designators, in which case + they indicate the file to use for history and killring + persistence, respectively. Further keyword arguments to LINEDIT are an advanced and undocumented topic, but if you're willing to dive into sources you @@ -76,24 +91,27 @@ LINEDIT invocations of LINEDIT, or change the function responsible for providing input completion. - function FORMEDIT &rest keys &key prompt1 prompt2 + function FORMEDIT &rest keys &key prompt1 prompt2 history killring Reads a single form (s-expession) of input with line-editing from standard input of the process and returns it as a string. Results are unspecified if *STANDARD-INPUT* has been bound or - altered, or if *READTABLE* is not the standard one. + altered, or if *READTABLE* is not the standard readtable. + + PROMPT1 specifies the string to print to *STANDARD-OUTPUT* before + starting the accept input. - :PROMPT1 specifies the string to print to *STANDARD-OUTPUT* before - starting to accept input. + PROMPT2 specifies the string to print to *STANDARD-OUTPUT* when + input spans multiple lines (ie. prefixing every but first line of + input.) - :PROMPT2 specified the string to print to *STANDARD-OUTPUT* when - input spans multiple lines (prefixing every but first line of - input from the user perspective.)q + HISTORY and KILLRING can be pathname designators, in which case + they indicate the file to use for history and killring + persistence, respectively. Further keyword arguments to FORMEDIT are an advanced and undocumented topic, but if you're willing to dive into sources you can eg. use multiple kill-rings not shared between different invocations of FORMEDIT, or change the function responsible for providing input completion. - diff --git a/buffer.lisp b/buffer.lisp index a925b81670d9489616b2580f8d50bdfd81d1bc99..a1856d1badf153bd4c4250c5dd3423db3f677065 100644 --- a/buffer.lisp +++ b/buffer.lisp @@ -27,17 +27,45 @@ (defclass buffer () ((prev :initarg :prev :accessor %buffer-prev :initform nil) (next :initarg :next :accessor %buffer-next :initform nil) - (list :initarg :list :accessor %buffer-list :initform nil))) + (list :initarg :list :accessor %buffer-list :initform nil) + ;; For file-backed buffers. + (pathname :initarg :pathname :initform nil :accessor %buffer-pathname))) (defun copy-buffer (buffer) (make-instance 'buffer :prev (%buffer-prev buffer) :next (%buffer-next buffer) - :list (%buffer-list buffer))) + :list (%buffer-list buffer) + :pathname (%buffer-pathname buffer))) + +(defun ensure-buffer (datum) + ;; DATUM may be a buffer, NIL, or a pathname designator + (if (typep datum 'buffer) + datum + (let ((buffer (make-instance 'buffer :pathname datum))) + (when datum + (with-open-file (f datum + :direction :input + :if-does-not-exist nil + :external-format :utf-8) + (when f + (loop for line = (read-line f nil) + while line + do (push line (%buffer-list buffer))) + (setf (%buffer-prev buffer) (%buffer-list buffer))))) + buffer))) (defun buffer-push (string buffer) (unless (equal string (car (%buffer-list buffer))) (push string (%buffer-list buffer)) + (let ((pathname (%buffer-pathname buffer))) + (when pathname + (with-open-file (f pathname + :direction :output + :if-does-not-exist :create + :if-exists :append + :external-format :utf-8) + (write-line string f)))) (setf (%buffer-next buffer) nil (%buffer-prev buffer) (%buffer-list buffer)))) diff --git a/editor.lisp b/editor.lisp index ce31f2ebbcfd6e318dfbd087573e96861eca336e..ca3fd727347b356fcb8288d3285fa903b056d363 100644 --- a/editor.lisp +++ b/editor.lisp @@ -33,12 +33,8 @@ (completer :reader editor-completer :initform 'lisp-complete :initarg :complete) - (history :accessor editor-history - :initform (ensure *history* (make-instance 'buffer)) - :initarg :history) - (killring :reader editor-killring - :initform (ensure *killring* (make-instance 'buffer)) - :initarg :killring) + (history :accessor editor-history) + (killring :accessor editor-killring) (insert :reader editor-insert-mode :initform t :initarg :insert-mode) @@ -52,7 +48,15 @@ :initform "" :initarg :prompt))) -(defmethod initialize-instance :after ((editor editor) &rest initargs) +(defmethod initialize-instance :after ((editor editor) &rest initargs &key history killring) + (let ((history (ensure-buffer (or history *history*)))) + (unless *history* + (setf *history* history)) + (setf (editor-history editor) history)) + (let ((killring (ensure-buffer (or killring *killring*)))) + (unless *killring* + (setf *killring* killring)) + (setf (editor-killring editor) killring)) (save-state editor)) (defclass smart-editor (editor smart-terminal) ()) diff --git a/main.lisp b/main.lisp index ea5d085a019d7927e729454fc50cc5e884215c36..db464853cbb6fe5772a59788fdea290ba0e2802d 100644 --- a/main.lisp +++ b/main.lisp @@ -23,8 +23,25 @@ (defvar *editor* nil) -(defun linedit (&rest keyword-args) - "Reads a single line of input with line-editing." +(defun linedit (&rest args &key prompt history killring &allow-other-keys) + "Reads a single line of input with line-editing from standard input +of the process and returns it as a string. + +Results are unspecified if *STANDARD-INPUT* has been bound or altered. + +PROMPT specifies the string to print to *STANDARD-OUTPUT* before +starting the accept input. + +HISTORY and KILLRING can be pathname designators, in which case +they indicate the file to use for history and killring persistence, +respectively. + +Further keyword arguments to LINEDIT are an advanced and undocumented +topic, but if you're willing to dive into sources you can eg. use +multiple kill-rings not shared between different invocations of +LINEDIT, or change the function responsible for providing input +completion." + (declare (ignore prompt history killring)) (flet ((edit () (catch 'linedit-done (loop @@ -35,7 +52,7 @@ (if (and *editor* (backend-ready-p *editor*)) ;; FIXME: This is a bit kludgy. It would be nicer to have a new ;; editor object that shares the same backed, kill-ring, etc. - (let* ((new (getf keyword-args :prompt)) + (let* ((new (getf args :prompt)) (old (editor-prompt *editor*)) (history (copy-buffer (editor-history *editor*))) (string (get-string *editor*)) @@ -50,14 +67,34 @@ (setf (get-string *editor*) string (get-point *editor*) point (editor-history *editor*) history))) - (let ((*editor* (apply 'make-editor keyword-args))) + (let ((*editor* (apply 'make-editor args))) (with-backend *editor* (edit)))))) -(defun formedit (&rest args &key (prompt1 "") (prompt2 "") +(defun formedit (&rest args &key (prompt1 "") (prompt2 "") history killring &allow-other-keys) - "Reads a single form of input with line-editing. Returns the form as -a string. Assumes standard readtable." + "Reads a single form (s-expession) of input with line-editing from +standard input of the process and returns it as a string. + +Results are unspecified if *STANDARD-INPUT* has been bound or altered, +or if *READTABLE* is not the standard readtable. + +PROMPT1 specifies the string to print to *STANDARD-OUTPUT* before +starting the accept input. + +PROMPT2 specifies the string to print to *STANDARD-OUTPUT* when input +spans multiple lines (ie. prefixing every but first line of input.) + +HISTORY and KILLRING can be pathname designators, in which case +they indicate the file to use for history and killring persistence, +respectively. + +Further keyword arguments to FORMEDIT are an advanced and undocumented +topic, but if you're willing to dive into sources you can eg. use +multiple kill-rings not shared between different invocations of +FORMEDIT, or change the function responsible for providing input +completion." + (declare (ignore history killring)) (let ((args (copy-list args))) (dolist (key '(:prompt1 :prompt2)) (remf args key)) @@ -92,7 +129,7 @@ a string. Assumes standard readtable." (defun semicolon-reader (stream char) (declare (ignore char)) (loop for char = (read-char stream) - until (eql char #\newline)) + until (eql char #\newline)) (values)) (defun colon-reader (stream char) diff --git a/ports/ccl.lisp b/ports/ccl.lisp index 04f543336975bf0c486bb1a45aaa853c20c034a1..67e54176a0a4a073481a2e00c2ef2b0958624494 100644 --- a/ports/ccl.lisp +++ b/ports/ccl.lisp @@ -52,9 +52,7 @@ original-rtf nil) t)) - (defun install-repl (&key wrap-current eof-quits) - "Installs the Linedit at REPL. Original input handlers can be -preserved with the :WRAP-CURRENT T." + (defun install-repl (&key wrap-current eof-quits history killring) (when original-rtf (warn "INSTALL-REPL failed: Linedit REPL already installed.") (return-from install-repl nil)) @@ -76,7 +74,9 @@ preserved with the :WRAP-CURRENT T." (setf ccl::*quiet-flag* t)))) (handler-case (linedit:formedit :prompt1 prompt :prompt2 (make-string (length prompt) - :initial-element #\Space)) + :initial-element #\Space) + :history history + :killring killring) (end-of-file () (if eof-quits (and (fresh-line) (eof-handler "CCL" #'ccl:quit)) diff --git a/ports/generic.lisp b/ports/generic.lisp index fda873cb03c96c15b84159deb0c09d576b137655..fdd5b27c1771e367bed4c2bd229f0840c1dedb06 100644 --- a/ports/generic.lisp +++ b/ports/generic.lisp @@ -22,19 +22,24 @@ (in-package :linedit) (defun uninstall-repl () - #.(format nil - "Uninstalls the Linedit REPL, restoring original handlers. Unsupported on ~A." - (lisp-implementation-type)) + "Uninstalls the Linedit REPL, restoring original handlers. (SBCL and CCL only.)" (error "~S is unsupported on ~A." 'uninstall-repl (lisp-implementation-type))) -(defun install-repl (&key wrap-current eof-quits) - #.(format nil - "Installs Linedit at REPL. Original input handlers can be -preserved with :WRAP-CURRENT T. Unsupported on ~A." - (lisp-implementation-type)) - (declare (ignore wrap-current eof-quits)) +(defun install-repl (&key wrap-current eof-quits history killring) + "Installs the Linedit at REPL. (SBCL and CCL only.) + +WRAP-CURRENT keeps current input handlers (eg. toplevel command +processors) in place. + +If EOF-QUITS is true, EOF on *STANDARD-INPUT* causes the system to +exit after verification. + +HISTORY and KILLRING can be pathname designators, in which case +they indicate the file to use for history and killring +persistence, respectively." + (declare (ignore wrap-current eof-quits history killring)) (error "~S is unsupported on ~A." 'install-repl (lisp-implementation-type))) diff --git a/ports/sbcl.lisp b/ports/sbcl.lisp index 61057e669bacf8f3bf29fd96f9e250f673f31ba6..80a5092ae53a829dabf89c2d83fe5cef734e03d5 100644 --- a/ports/sbcl.lisp +++ b/ports/sbcl.lisp @@ -32,7 +32,6 @@ (not (or prompt-fun read-form-fun)))))) (defun uninstall-repl () - "Uninstalls the Linedit REPL, restoring original handlers." (enforce-consistent-state) (if prompt-fun (setf sb-int:*repl-prompt-fun* prompt-fun @@ -42,9 +41,7 @@ (warn "UNINSTALL-REPL failed: No Linedit REPL present.")) nil) - (defun install-repl (&key wrap-current eof-quits) - "Installs the Linedit at REPL. Original input handlers can be -preserved with the :WRAP-CURRENT T." + (defun install-repl (&key wrap-current eof-quits history killring) (enforce-consistent-state) (when prompt-fun (warn "INSTALL-REPL failed: Linedit REPL already installed.") @@ -61,7 +58,9 @@ preserved with the :WRAP-CURRENT T." (linedit:formedit :prompt1 prompt :prompt2 (make-string (length prompt) - :initial-element #\Space)) + :initial-element #\Space) + :history history + :killring killring) (end-of-file (e) (if eof-quits (and (fresh-line) (eof-handler "SBCL" #'sb-ext:quit)) diff --git a/utility-functions.lisp b/utility-functions.lisp index d6a1ca84567942a58c1b22a4d705ad8acff81c87..df0f694f8c712b52e43a706a520829c76949b5f2 100644 --- a/utility-functions.lisp +++ b/utility-functions.lisp @@ -69,19 +69,29 @@ open-args passed to `open'." "Like min, except ignores NILs." (apply #'min (remove-if #'null args))) +(defun yes-or-no (control &rest args) + "Like Y-OR-N-P, but using linedit functionality." + ;; Don't save the query response. + (let ((*history* nil) + (*killring* nil)) + (loop + (let ((result (linedit :prompt (format nil "~? (y or n) " control args)))) + (cond + ((zerop (length result))) + ((char-equal (elt result 0) #\y) + (return-from yes-or-no t)) + ((char-equal (elt result 0) #\n) + (return-from yes-or-no nil))) + (format *terminal-io* "Please type \"y\" for yes or \"n\" for no.~%") + (finish-output *terminal-io*))))) + (defun eof-handler (lisp-name quit-fn) (handler-case - (loop - (let ((result (linedit :prompt (format nil "Really quit ~A? (y or n) " lisp-name)))) - (cond - ((string= result "") nil) - ((char-equal (elt result 0) #\y) - (fresh-line) - (funcall quit-fn)) - ((char-equal (elt result 0) #\n) - (return-from eof-handler "#.''end-of-file")) - (t nil)) - (format *terminal-io* "Please type \"y\" for yes or \"n\" for no.~%"))) + (cond ((yes-or-no "Really quit ~A?" lisp-name) + (fresh-line) + (funcall quit-fn)) + (t + (return-from eof-handler "#.''end-of-file"))) (end-of-file () (fresh-line) - (funcall quit-fn)))) \ No newline at end of file + (funcall quit-fn))))