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
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.
-
(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))))
(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)
: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) ())
(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
(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*))
(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))
(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)
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))
(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))
(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)))
(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
(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.")
(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))
"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))))
common-lisp.net / projects/linedit/linedit.git / commitdiff
