[Linedit-cvs] CVS update: src/complete.lisp src/linedit.asd src/main.lisp src/packages.lisp src/sbcl-repl.lisp src/smart-terminal.lisp src/terminal.lisp src/version.lisp-expr
Nikodemus Siivola
nsiivola at common-lisp.net
Fri Mar 5 18:21:37 UTC 2004
Update of /project/linedit/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv2121
Modified Files:
complete.lisp linedit.asd main.lisp packages.lisp
sbcl-repl.lisp smart-terminal.lisp terminal.lisp
version.lisp-expr
Log Message:
* Fix #\, handling in input.
* Don't intern read symbols before passing them to the system.
* Better directory completion (via Osicat).
* Fixed AGAIN: editor confusion after completion.
Date: Fri Mar 5 13:21:36 2004
Author: nsiivola
Index: src/complete.lisp
diff -u src/complete.lisp:1.2 src/complete.lisp:1.3
--- src/complete.lisp:1.2 Sun Sep 28 07:37:43 2003
+++ src/complete.lisp Fri Mar 5 13:21:36 2004
@@ -21,34 +21,42 @@
(in-package :linedit)
+(defun pathname-directory-pathname (pathname)
+ (make-pathname :name nil :type nil
+ :defaults pathname))
+
+(defun underlying-directory-p (pathname)
+ (case (file-kind pathname)
+ (:directory t)
+ (:symbolic-link (file-kind (merge-pathnames (read-link pathname) pathname)))))
+
;; This version of directory-complete isn't nice to symlinks, and
;; should be replaced by something backed by foreign glue.
(defun directory-complete (string)
(declare (simple-string string))
- (let ((namefun (case (car (pathname-directory string))
- (:absolute #'namestring)
- (t #'enough-namestring)))
- (common nil)
- (max 0)
- (hash (make-hash-table :test 'equal)))
- (dolist (path (directory (concat string "*")))
- (let* ((candidate (funcall namefun path))
- (diff (mismatch string candidate)))
- (unless (or (not diff)
- (< diff (length string)))
- (setf common (if common
- (subseq candidate 0 (mismatch common candidate))
- candidate)
- max (max max (length candidate))
- (gethash candidate hash) candidate))))
+ (let* ((common nil)
+ (all nil)
+ (max 0)
+ (dir (pathname-directory-pathname string)))
+ (unless (underlying-directory-p dir)
+ (return-from directory-complete (values nil 0)))
+ (with-directory-iterator (next dir)
+ (loop for entry = (next)
+ while entry
+ do (let* ((full (namestring (merge-pathnames entry)))
+ (diff (mismatch string full)))
+ (dbg "~& completed: ~A, diff: ~A~%" full diff)
+ (unless (< diff (length string))
+ (dbg "~& common ~A mismatch ~A~&" common (mismatch common full))
+ (setf common (if common
+ (subseq common 0 (mismatch common full))
+ full)
+ max (max max (length full))
+ all (cons full all))))))
+ (dbg "~&common: ~A~%" common)
(if (or (null common)
(<= (length common) (length string)))
- (let (list)
- (maphash (lambda (key val)
- (declare (ignore val))
- (push key list))
- hash)
- (values list max))
+ (values all max)
(values (list common) (length common)))))
(defun lisp-complete (string editor)
Index: src/linedit.asd
diff -u src/linedit.asd:1.25 src/linedit.asd:1.26
--- src/linedit.asd:1.25 Fri Mar 5 04:34:00 2004
+++ src/linedit.asd Fri Mar 5 13:21:36 2004
@@ -48,8 +48,8 @@
(error 'operation-error :component c :operation o)))
(defsystem :linedit
- :version "0.15.7"
- :depends-on (:uffi :terminfo)
+ :version "0.15.8"
+ :depends-on (:uffi :terminfo :osicat)
:components
(;; Common
(:file "packages")
Index: src/main.lisp
diff -u src/main.lisp:1.10 src/main.lisp:1.11
--- src/main.lisp:1.10 Mon Nov 24 17:56:38 2003
+++ src/main.lisp Fri Mar 5 13:21:36 2004
@@ -44,19 +44,24 @@
(table (copy-readtable)))
;; FIXME: It would be nice to provide an interace of some sort that
;; the user could use to alter the crucial reader macros in custom readtables.
+ (set-macro-character #\: #'colon-reader nil table)
+ (set-macro-character #\, (constantly (values)) nil table)
(set-macro-character #\; #'semicolon-reader nil table)
(set-dispatch-macro-character #\# #\. (constantly (values)) table)
(do ((str (apply #'linedit :prompt prompt1 args)
(concat str
(string #\newline)
(apply #'linedit :prompt prompt2 args))))
- ((let ((form (handler-case (let ((*readtable* table))
+ ((let ((form (handler-case (let ((*readtable* table)
+ (*package* (make-package "LINEDIT-SCRATCH")))
;; KLUDGE: This is needed to handle input that starts
;; with an empty line. (At least in the presense of
;; ACLREPL).
- (if (find-if-not 'whitespacep str)
- (read-from-string str)
- (error 'end-of-file)))
+ (unwind-protect
+ (if (find-if-not 'whitespacep str)
+ (read-from-string str)
+ (error 'end-of-file))
+ (delete-package *package*)))
(end-of-file ()
eof-marker))))
(unless (eq eof-marker form)
@@ -67,3 +72,7 @@
(loop for char = (read-char stream)
until (eql char #\newline))
(values))
+
+(defun colon-reader (stream char)
+ (declare (ignore char))
+ (read stream t nil t))
Index: src/packages.lisp
diff -u src/packages.lisp:1.15 src/packages.lisp:1.16
--- src/packages.lisp:1.15 Thu Mar 4 08:52:53 2004
+++ src/packages.lisp Fri Mar 5 13:21:36 2004
@@ -20,7 +20,7 @@
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
(defpackage :linedit
- (:use :cl)
+ (:use :cl :osicat)
(:export
#:linedit
#:formedit
Index: src/sbcl-repl.lisp
diff -u src/sbcl-repl.lisp:1.6 src/sbcl-repl.lisp:1.7
--- src/sbcl-repl.lisp:1.6 Thu Nov 20 12:29:55 2003
+++ src/sbcl-repl.lisp Fri Mar 5 13:21:36 2004
@@ -64,7 +64,7 @@
:initial-element #\Space))
(end-of-file (e)
(if eof-quits
- (and (fresh-line) (sb-ext:quit))
+ (and (fresh-line) (eof-handler))
;; Hackins, I know.
"#.''end-of-file"))))))
(setf sb-int:*repl-prompt-fun* (constantly ""))
@@ -85,4 +85,24 @@
(write-line "#<end-of-file>")
(values)))))))
t)))
-
\ No newline at end of file
+
+(defun eof-handler ()
+ (format *terminal-io* "Really quit SBCL? (y or n) ")
+ (finish-output *terminal-io*)
+ (handler-case
+ (loop
+ (let ((result (linedit)))
+ (cond
+ ((string= result "") nil)
+ ((char-equal (elt result 0) #\y)
+ (fresh-line)
+ (sb-ext:quit))
+ ((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.~%Really quit SBCL? (y or n) ")
+ (finish-output *terminal-io*)))
+ (end-of-file ()
+ (fresh-line)
+ (sb-ext:quit))))
Index: src/smart-terminal.lisp
diff -u src/smart-terminal.lisp:1.16 src/smart-terminal.lisp:1.17
--- src/smart-terminal.lisp:1.16 Thu Mar 4 11:47:09 2004
+++ src/smart-terminal.lisp Fri Mar 5 13:21:36 2004
@@ -22,9 +22,7 @@
(in-package :linedit)
(defclass smart-terminal (terminal)
- ((old-row :initform 1 :accessor old-row)
- (old-col :initform 0 :accessor old-col)
- (old-point :initform 0 :accessor old-point)
+ ((old-point :initform 0 :accessor old-point)
(old-string :initform "" :accessor old-string)
(old-markup :initform 0 :accessor old-markup)))
@@ -78,13 +76,18 @@
(let* ((*terminal-io* *standard-output*)
(columns (backend-columns backend))
(old-markup (old-markup backend))
- (old-col (old-col backend))
- (old-row (old-row backend))
(old-point (old-point backend))
+ (old-col (find-col old-point columns))
+ (old-row (find-row old-point columns))
(old (old-string backend))
(new (concat prompt line))
(end (length new))
(rows (find-row end columns)))
+ (when (dirty-p backend)
+ (setf old-markup 0
+ old-point 0
+ old-col 0
+ old-row 1))
(multiple-value-bind (marked-line markup)
(if markup
(dwim-mark-parens line point
@@ -115,9 +118,8 @@
:vertical (- rows point-row)
:current-col (find-col end columns))
;; Save state
- (setf (old-row backend) point-row
- (old-col backend) point-col
- (old-string backend) new
+ (setf (old-string backend) new
(old-markup backend) markup
- (old-point backend) point)))
+ (old-point backend) point
+ (dirty-p backend) nil)))
(force-output *terminal-io*)))
Index: src/terminal.lisp
diff -u src/terminal.lisp:1.6 src/terminal.lisp:1.7
--- src/terminal.lisp:1.6 Thu Mar 4 08:52:53 2004
+++ src/terminal.lisp Fri Mar 5 13:21:36 2004
@@ -22,7 +22,8 @@
(in-package :linedit)
(defclass terminal (backend)
- ((translations :initform *terminal-translations*)))
+ ((translations :initform *terminal-translations*)
+ (dirty-p :initform t :accessor dirty-p)))
(uffi:def-function ("linedit_terminal_columns" c-terminal-columns)
((default :int))
@@ -144,7 +145,7 @@
(newline backend))
(defmethod newline ((backend terminal))
- (setf (get-start backend) 0)
+ (setf (dirty-p backend) t)
(write-char #\newline)
(write-char #\return)
(force-output))
Index: src/version.lisp-expr
diff -u src/version.lisp-expr:1.10 src/version.lisp-expr:1.11
--- src/version.lisp-expr:1.10 Fri Mar 5 04:34:00 2004
+++ src/version.lisp-expr Fri Mar 5 13:21:36 2004
@@ -1 +1 @@
-0.15.7
+0.15.8
More information about the linedit-cvs
mailing list