persistent history and killring
authorNikodemus Siivola <nikodemus@random-state.net>
Fri, 20 Jan 2012 13:30:34 +0000 (15:30 +0200)
committerNikodemus Siivola <nikodemus@random-state.net>
Fri, 20 Jan 2012 13:30:34 +0000 (15:30 +0200)
  :HISTORY and :KILLRING to LINEDIT &co can now be pathname
  designators.

README
buffer.lisp
editor.lisp
main.lisp
ports/ccl.lisp
ports/generic.lisp
ports/sbcl.lisp
utility-functions.lisp

diff --git a/README b/README
index 0ad33cc..7755c02 100644 (file)
--- 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.
-
index a925b81..a1856d1 100644 (file)
 (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))))
 
index ce31f2e..ca3fd72 100644 (file)
    (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) ())
index ea5d085..db46485 100644 (file)
--- a/main.lisp
+++ b/main.lisp
 
 (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*))
             (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)
index 04f5433..67e5417 100644 (file)
@@ -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))
index fda873c..fdd5b27 100644 (file)
 (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)))
index 61057e6..80a5092 100644 (file)
@@ -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))
index d6a1ca8..df0f694 100644 (file)
@@ -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))))