From nsiivola at common-lisp.net Mon Mar 1 00:08:34 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sun, 29 Feb 2004 19:08:34 -0500 Subject: [Linedit-cvs] CVS update: src/smart-terminal.lisp src/utility-functions.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv30332 Modified Files: smart-terminal.lisp utility-functions.lisp Log Message: * Fixed bug that coused the entire line to be updated when only a single character needed to be added. Date: Sun Feb 29 19:08:33 2004 Author: nsiivola Index: src/smart-terminal.lisp diff -u src/smart-terminal.lisp:1.12 src/smart-terminal.lisp:1.13 --- src/smart-terminal.lisp:1.12 Sat Feb 28 10:13:56 2004 +++ src/smart-terminal.lisp Sun Feb 29 19:08:33 2004 @@ -86,7 +86,8 @@ (old (active-string backend)) (end (+ (length prompt) (length line))) ;; based on unmarked (rows (find-row end columns)) - (start (min0 markup-start old-markup-start (mismatch new old))) + (start (min* markup-start old-markup-start + (mismatch new old) end)) (start-row (find-row start columns)) (start-col (find-col start columns)) (point* (+ point (length prompt))) Index: src/utility-functions.lisp diff -u src/utility-functions.lisp:1.7 src/utility-functions.lisp:1.8 --- src/utility-functions.lisp:1.7 Sat Feb 28 07:11:16 2004 +++ src/utility-functions.lisp Sun Feb 29 19:08:33 2004 @@ -50,6 +50,6 @@ (apply #'format *debug* format-string format-args) (finish-output *debug*))) -(defun min0 (&rest args) - "Like min, except treats NILs as zeroes." - (apply #'min (mapcar (lambda (x) (or x 0)) args))) +(defun min* (&rest args) + "Like min, except ignores NILs." + (apply #'min (remove-if #'null args))) From nsiivola at common-lisp.net Mon Mar 1 13:27:43 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Mon, 01 Mar 2004 08:27:43 -0500 Subject: [Linedit-cvs] CVS update: src/terminfo.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv22305 Modified Files: terminfo.lisp Log Message: * No search-lists on SBCL. Date: Mon Mar 1 08:27:43 2004 Author: nsiivola Index: src/terminfo.lisp diff -u src/terminfo.lisp:1.7 src/terminfo.lisp:1.8 --- src/terminfo.lisp:1.7 Mon Nov 24 17:05:47 2003 +++ src/terminfo.lisp Mon Mar 1 08:27:42 2004 @@ -22,7 +22,7 @@ ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE ;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH ;;; DAMAGE. -#+CMU (ext:file-comment "$Header: /project/linedit/cvsroot/src/terminfo.lisp,v 1.7 2003/11/24 22:05:47 nsiivola Exp $") +#+CMU (ext:file-comment "$Header: /project/linedit/cvsroot/src/terminfo.lisp,v 1.8 2004/03/01 13:27:42 nsiivola Exp $") (in-package "COMMON-LISP-USER") @@ -622,8 +622,10 @@ #+darwin (format nil "~X" (char-code (char name 0))) #-darwin (string (char name 0)))) (let ((name (concatenate 'string (stringify-first-char name) "/" name))) - (dolist (path (list* #+(or CMU SBCL) "home:.terminfo/" + (dolist (path (list* #+CMU "home:.terminfo/" #+Allegro "~/.terminfo/" + #-(or CMU Allegro) + (merge-pathnames ".terminfo/" (user-homedir-pathname)) *terminfo-directories*)) (with-open-file (stream (merge-pathnames name path) :direction :input From nsiivola at common-lisp.net Mon Mar 1 13:28:38 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Mon, 01 Mar 2004 08:28:38 -0500 Subject: [Linedit-cvs] CVS update: src/linedit.asd src/version.lisp-expr Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv27520 Modified Files: linedit.asd version.lisp-expr Log Message: * Oops. Fixed version info. Date: Mon Mar 1 08:28:38 2004 Author: nsiivola Index: src/linedit.asd diff -u src/linedit.asd:1.22 src/linedit.asd:1.23 --- src/linedit.asd:1.22 Sun Nov 9 07:28:03 2003 +++ src/linedit.asd Mon Mar 1 08:28:37 2004 @@ -48,7 +48,7 @@ (error 'operation-error :component c :operation o))) (defsystem :linedit - :version "0.14.4" + :version "0.15.4" :depends-on (:uffi :terminfo) :components (;; Common Index: src/version.lisp-expr diff -u src/version.lisp-expr:1.7 src/version.lisp-expr:1.8 --- src/version.lisp-expr:1.7 Sat Feb 28 10:13:56 2004 +++ src/version.lisp-expr Mon Mar 1 08:28:38 2004 @@ -1 +1 @@ -0.15.3 +0.15.4 From nsiivola at common-lisp.net Thu Mar 4 13:52:54 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Thu, 04 Mar 2004 08:52:54 -0500 Subject: [Linedit-cvs] CVS update: src/backend.lisp src/packages.lisp src/smart-terminal.lisp src/terminal.lisp src/utility-functions.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv29729 Modified Files: backend.lisp packages.lisp smart-terminal.lisp terminal.lisp utility-functions.lisp Log Message: Fix post-completion confusion. Date: Thu Mar 4 08:52:53 2004 Author: nsiivola Index: src/backend.lisp diff -u src/backend.lisp:1.5 src/backend.lisp:1.6 --- src/backend.lisp:1.5 Mon Nov 24 17:56:38 2003 +++ src/backend.lisp Thu Mar 4 08:52:53 2004 @@ -26,7 +26,8 @@ (defclass backend () ((ready-p :accessor backend-ready-p :initform nil) - (translations :reader backend-translations))) + (translations :reader backend-translations) + (start :initform 0 :accessor get-start))) (defmacro with-backend (backend &body forms) (with-unique-names (an-error) Index: src/packages.lisp diff -u src/packages.lisp:1.14 src/packages.lisp:1.15 --- src/packages.lisp:1.14 Mon Nov 24 17:56:38 2003 +++ src/packages.lisp Thu Mar 4 08:52:53 2004 @@ -25,7 +25,7 @@ #:linedit #:formedit #:*default-columns* - #:*default-lines* + #:*default-lines* #+sbcl #:install-repl #+sbcl #:uninstall-repl )) Index: src/smart-terminal.lisp diff -u src/smart-terminal.lisp:1.13 src/smart-terminal.lisp:1.14 --- src/smart-terminal.lisp:1.13 Sun Feb 29 19:08:33 2004 +++ src/smart-terminal.lisp Thu Mar 4 08:52:53 2004 @@ -25,7 +25,7 @@ ((point-row :initform 1 :accessor point-row) (point-col :initform 0 :accessor point-col) (active-string :initform "" :accessor active-string) - (markup-start :initform 0 :accessor get-markup-start))) + (start :initform 0 :accessor get-start))) (defun set-column-address (n current) (if nil @@ -74,7 +74,7 @@ (defmethod display ((backend smart-terminal) &key prompt line point markup) (let* ((*terminal-io* *standard-output*) (columns (backend-columns backend)) - (old-markup-start (get-markup-start backend)) + (old-markup-start (get-start backend)) (old-col (point-col backend))) (multiple-value-bind (marked-line markup-start) (if markup @@ -86,13 +86,13 @@ (old (active-string backend)) (end (+ (length prompt) (length line))) ;; based on unmarked (rows (find-row end columns)) + (point* (+ point (length prompt))) + (point-row (find-row point* columns)) + (point-col (find-col point* columns)) (start (min* markup-start old-markup-start (mismatch new old) end)) (start-row (find-row start columns)) - (start-col (find-col start columns)) - (point* (+ point (length prompt))) - (point-row (find-row point* columns)) - (point-col (find-col point* columns))) + (start-col (find-col start columns))) (move-up-in-column :col start-col :up (- (point-row backend) start-row) @@ -108,5 +108,5 @@ (setf (point-row backend) point-row (point-col backend) point-col (active-string backend) (concat prompt line) - (get-markup-start backend) markup-start) + (get-start backend) markup-start) (force-output *terminal-io*))))) Index: src/terminal.lisp diff -u src/terminal.lisp:1.5 src/terminal.lisp:1.6 --- src/terminal.lisp:1.5 Thu Oct 23 11:07:08 2003 +++ src/terminal.lisp Thu Mar 4 08:52:53 2004 @@ -144,6 +144,7 @@ (newline backend)) (defmethod newline ((backend terminal)) + (setf (get-start backend) 0) (write-char #\newline) (write-char #\return) (force-output)) Index: src/utility-functions.lisp diff -u src/utility-functions.lisp:1.8 src/utility-functions.lisp:1.9 --- src/utility-functions.lisp:1.8 Sun Feb 29 19:08:33 2004 +++ src/utility-functions.lisp Thu Mar 4 08:52:53 2004 @@ -45,6 +45,13 @@ (and (< index (length string)) (word-delimiter-p (char string index)))) +(defun start-debug (pathname &rest open-args) + (setf *debug* (apply #'open pathname :direction :output open-args))) + +(defun end-debug () + (close *debug*) + (setf *debug* nil)) + (defun dbg (format-string &rest format-args) (when *debug* (apply #'format *debug* format-string format-args) @@ -53,3 +60,5 @@ (defun min* (&rest args) "Like min, except ignores NILs." (apply #'min (remove-if #'null args))) + + \ No newline at end of file From nsiivola at common-lisp.net Thu Mar 4 14:37:55 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Thu, 04 Mar 2004 09:37:55 -0500 Subject: [Linedit-cvs] CVS update: src/smart-terminal.lisp src/utility-macros.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv25056 Modified Files: smart-terminal.lisp utility-macros.lisp Log Message: More debugging output, partial fix to long line confusion. Date: Thu Mar 4 09:37:55 2004 Author: nsiivola Index: src/smart-terminal.lisp diff -u src/smart-terminal.lisp:1.14 src/smart-terminal.lisp:1.15 --- src/smart-terminal.lisp:1.14 Thu Mar 4 08:52:53 2004 +++ src/smart-terminal.lisp Thu Mar 4 09:37:55 2004 @@ -89,10 +89,11 @@ (point* (+ point (length prompt))) (point-row (find-row point* columns)) (point-col (find-col point* columns)) - (start (min* markup-start old-markup-start + (start (min* point* markup-start old-markup-start (mismatch new old) end)) (start-row (find-row start columns)) (start-col (find-col start columns))) + (dbg-values point-row point-col start-row start-col (point-row backend)) (move-up-in-column :col start-col :up (- (point-row backend) start-row) Index: src/utility-macros.lisp diff -u src/utility-macros.lisp:1.4 src/utility-macros.lisp:1.5 --- src/utility-macros.lisp:1.4 Sat Feb 28 06:32:05 2004 +++ src/utility-macros.lisp Thu Mar 4 09:37:55 2004 @@ -65,3 +65,14 @@ (defmacro ensure (symbol expr) `(or ,symbol (setf ,symbol ,expr))) + +(defmacro dbg-values (&rest places) + `(progn + (format *debug* ,(apply #'concat (mapcar (lambda (x) + (format nil "~A = ~~A, " x)) + places)) + , at places) + (terpri *debug*) + (force-output *debug*))) + + From nsiivola at common-lisp.net Thu Mar 4 16:47:09 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Thu, 04 Mar 2004 11:47:09 -0500 Subject: [Linedit-cvs] CVS update: src/smart-terminal.lisp src/utility-macros.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv12728 Modified Files: smart-terminal.lisp utility-macros.lisp Log Message: Fixed long line confusion Date: Thu Mar 4 11:47:09 2004 Author: nsiivola Index: src/smart-terminal.lisp diff -u src/smart-terminal.lisp:1.15 src/smart-terminal.lisp:1.16 --- src/smart-terminal.lisp:1.15 Thu Mar 4 09:37:55 2004 +++ src/smart-terminal.lisp Thu Mar 4 11:47:09 2004 @@ -22,10 +22,11 @@ (in-package :linedit) (defclass smart-terminal (terminal) - ((point-row :initform 1 :accessor point-row) - (point-col :initform 0 :accessor point-col) - (active-string :initform "" :accessor active-string) - (start :initform 0 :accessor get-start))) + ((old-row :initform 1 :accessor old-row) + (old-col :initform 0 :accessor old-col) + (old-point :initform 0 :accessor old-point) + (old-string :initform "" :accessor old-string) + (old-markup :initform 0 :accessor old-markup))) (defun set-column-address (n current) (if nil @@ -54,9 +55,11 @@ (defun find-col (n columns) (rem n columns)) -(defun move-up-in-column (&key col up clear-to-eos current-col) +(defun move-in-column (&key col vertical clear-to-eos current-col) (set-column-address col current-col) - (loop repeat up do (ti:tputs ti:cursor-up)) + (if (plusp vertical) + (loop repeat vertical do (ti:tputs ti:cursor-up)) + (loop repeat (abs vertical) do (ti:tputs ti:cursor-down))) (when clear-to-eos (ti:tputs ti:clr-eos))) @@ -74,40 +77,47 @@ (defmethod display ((backend smart-terminal) &key prompt line point markup) (let* ((*terminal-io* *standard-output*) (columns (backend-columns backend)) - (old-markup-start (get-start backend)) - (old-col (point-col backend))) - (multiple-value-bind (marked-line markup-start) + (old-markup (old-markup backend)) + (old-col (old-col backend)) + (old-row (old-row backend)) + (old-point (old-point backend)) + (old (old-string backend)) + (new (concat prompt line)) + (end (length new)) + (rows (find-row end columns))) + (multiple-value-bind (marked-line markup) (if markup (dwim-mark-parens line point :pre-mark ti:enter-bold-mode :post-mark ti:exit-attribute-mode) (values line point)) - (let* ((new (concat prompt marked-line)) - (old (active-string backend)) - (end (+ (length prompt) (length line))) ;; based on unmarked - (rows (find-row end columns)) - (point* (+ point (length prompt))) - (point-row (find-row point* columns)) - (point-col (find-col point* columns)) - (start (min* point* markup-start old-markup-start - (mismatch new old) end)) + (let* ((full (concat prompt marked-line)) + (point (+ point (length prompt))) + (point-row (find-row point columns)) + (point-col (find-col point columns)) + (diff (mismatch new old)) + (start (min* old-point point markup old-markup diff end)) (start-row (find-row start columns)) (start-col (find-col start columns))) - (dbg-values point-row point-col start-row start-col (point-row backend)) - (move-up-in-column + (dbg "---~%") + (dbg-values (subseq new start)) + (dbg-values rows point point-row point-col start start-row start-col + old-point old-row old-col end diff) + (move-in-column :col start-col - :up (- (point-row backend) start-row) + :vertical (- old-row start-row) :clear-to-eos t :current-col old-col) - (write-string (subseq new start)) + (write-string (subseq full start)) (fix-wraparound start end columns) - (move-up-in-column + (move-in-column :col point-col - :up (- rows point-row) + :vertical (- rows point-row) :current-col (find-col end columns)) ;; Save state - (setf (point-row backend) point-row - (point-col backend) point-col - (active-string backend) (concat prompt line) - (get-start backend) markup-start) - (force-output *terminal-io*))))) + (setf (old-row backend) point-row + (old-col backend) point-col + (old-string backend) new + (old-markup backend) markup + (old-point backend) point))) + (force-output *terminal-io*))) Index: src/utility-macros.lisp diff -u src/utility-macros.lisp:1.5 src/utility-macros.lisp:1.6 --- src/utility-macros.lisp:1.5 Thu Mar 4 09:37:55 2004 +++ src/utility-macros.lisp Thu Mar 4 11:47:09 2004 @@ -67,10 +67,11 @@ `(or ,symbol (setf ,symbol ,expr))) (defmacro dbg-values (&rest places) - `(progn - (format *debug* ,(apply #'concat (mapcar (lambda (x) - (format nil "~A = ~~A, " x)) - places)) + `(when *debug* + (format *debug* ,(apply #'concatenate 'string + (mapcar (lambda (x) + (format nil "~A = ~~A, " x)) + places)) , at places) (terpri *debug*) (force-output *debug*))) From nsiivola at common-lisp.net Fri Mar 5 09:21:46 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Fri, 05 Mar 2004 04:21:46 -0500 Subject: [Linedit-cvs] CVS update: src/linedit.asd src/terminal-translations.lisp src/version.lisp-expr Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv31145 Modified Files: linedit.asd terminal-translations.lisp version.lisp-expr Log Message: Version 0.15.6: fixes Home and End on latin keyboards. Date: Fri Mar 5 04:21:46 2004 Author: nsiivola Index: src/linedit.asd diff -u src/linedit.asd:1.23 src/linedit.asd:1.24 --- src/linedit.asd:1.23 Mon Mar 1 08:28:37 2004 +++ src/linedit.asd Fri Mar 5 04:21:45 2004 @@ -48,7 +48,7 @@ (error 'operation-error :component c :operation o))) (defsystem :linedit - :version "0.15.4" + :version "0.15.6" :depends-on (:uffi :terminfo) :components (;; Common Index: src/terminal-translations.lisp diff -u src/terminal-translations.lisp:1.3 src/terminal-translations.lisp:1.4 --- src/terminal-translations.lisp:1.3 Mon Oct 20 14:20:53 2003 +++ src/terminal-translations.lisp Fri Mar 5 04:21:46 2004 @@ -23,11 +23,11 @@ (defvar *terminal-translations* (make-hash-table :test #'equalp)) -(defmacro deftrans (name chord &optional alt) - `(progn - (setf (gethash ,chord *terminal-translations*) ,name) - (when ,alt - (setf (gethash ,alt *terminal-translations*) ,name)))) +(defmacro deftrans (name &rest chords) + `(dolist (chord ',chords) + (when (gethash chord *terminal-translations*) + (warn "Multiple translations for ~A." chord)) + (setf (gethash chord *terminal-translations*) ,name))) (deftrans "C-Space" 0) (deftrans "C-A" 1) @@ -58,51 +58,51 @@ (deftrans "C--" 31) (deftrans "Backspace" 127) -(deftrans "M-A" '(#\Esc #\A) 225) -(deftrans "M-B" '(#\Esc #\B) 226) -(deftrans "M-C" '(#\Esc #\C) 227) -(deftrans "M-D" '(#\Esc #\D) 228) -(deftrans "M-E" '(#\Esc #\E) 229) -(deftrans "M-F" '(#\Esc #\F) 230) -(deftrans "M-G" '(#\Esc #\G) 231) -(deftrans "M-H" '(#\Esc #\H) 232) -(deftrans "M-I" '(#\Esc #\I) 233) -(deftrans "M-J" '(#\Esc #\J) 234) -(deftrans "M-K" '(#\Esc #\K) 235) -(deftrans "M-L" '(#\Esc #\L) 236) -(deftrans "M-M" '(#\Esc #\M) 237) -(deftrans "M-N" '(#\Esc #\N) 238) -(deftrans "M-O" '(#\Esc #\O) 239) -(deftrans "M-P" '(#\Esc #\P) 240) -(deftrans "M-Q" '(#\Esc #\Q) 241) -(deftrans "M-R" '(#\Esc #\R) 242) -(deftrans "M-S" '(#\Esc #\S) 243) -(deftrans "M-T" '(#\Esc #\T) 244) -(deftrans "M-U" '(#\Esc #\U) 245) -(deftrans "M-V" '(#\Esc #\V) 246) -(deftrans "M-W" '(#\Esc #\W) 247) -(deftrans "M-X" '(#\Esc #\X) 248) -(deftrans "M-Y" '(#\Esc #\Y) 249) -(deftrans "M-Z" '(#\Esc #\Z) 250) -(deftrans "M-0" '(#\Esc #\0) 176) -(deftrans "M-1" '(#\Esc #\1) 177) -(deftrans "M-2" '(#\Esc #\2) 178) -(deftrans "M-3" '(#\Esc #\3) 179) -(deftrans "M-4" '(#\Esc #\4) 180) -(deftrans "M-5" '(#\Esc #\5) 181) -(deftrans "M-6" '(#\Esc #\6) 182) -(deftrans "M-7" '(#\Esc #\7) 183) -(deftrans "M-8" '(#\Esc #\8) 184) -(deftrans "M-9" '(#\Esc #\9) 185) +(deftrans "M-A" (#\Esc #\A) 225) +(deftrans "M-B" (#\Esc #\B) 226) +(deftrans "M-C" (#\Esc #\C) 227) +(deftrans "M-D" (#\Esc #\D) 228) +(deftrans "M-E" (#\Esc #\E) 229) +(deftrans "M-F" (#\Esc #\F) 230) +(deftrans "M-G" (#\Esc #\G) 231) +(deftrans "M-H" (#\Esc #\H) 232) +(deftrans "M-I" (#\Esc #\I) 233) +(deftrans "M-J" (#\Esc #\J) 234) +(deftrans "M-K" (#\Esc #\K) 235) +(deftrans "M-L" (#\Esc #\L) 236) +(deftrans "M-M" (#\Esc #\M) 237) +(deftrans "M-N" (#\Esc #\N) 238) +(deftrans "M-O" (#\Esc #\O) 239) +(deftrans "M-P" (#\Esc #\P) 240) +(deftrans "M-Q" (#\Esc #\Q) 241) +(deftrans "M-R" (#\Esc #\R) 242) +(deftrans "M-S" (#\Esc #\S) 243) +(deftrans "M-T" (#\Esc #\T) 244) +(deftrans "M-U" (#\Esc #\U) 245) +(deftrans "M-V" (#\Esc #\V) 246) +(deftrans "M-W" (#\Esc #\W) 247) +(deftrans "M-X" (#\Esc #\X) 248) +(deftrans "M-Y" (#\Esc #\Y) 249) +(deftrans "M-Z" (#\Esc #\Z) 250) +(deftrans "M-0" (#\Esc #\0) 176) +(deftrans "M-1" (#\Esc #\1) 177) +(deftrans "M-2" (#\Esc #\2) 178) +(deftrans "M-3" (#\Esc #\3) 179) +(deftrans "M-4" (#\Esc #\4) 180) +(deftrans "M-5" (#\Esc #\5) 181) +(deftrans "M-6" (#\Esc #\6) 182) +(deftrans "M-7" (#\Esc #\7) 183) +(deftrans "M-8" (#\Esc #\8) 184) +(deftrans "M-9" (#\Esc #\9) 185) -(deftrans "Up-arrow" '(#\Esc #\[ #\A)) -(deftrans "Down-arrow" '(#\Esc #\[ #\B)) -(deftrans "Right-arrow" '(#\Esc #\[ #\C)) -(deftrans "Left-arrow" '(#\Esc #\[ #\D)) -(deftrans "Insert" '(#\Esc #\[ #\2 #\~)) -(deftrans "Delete" '(#\Esc #\[ #\3 #\~)) -(deftrans "C-Delete" '(#\Esc #\[ #\3 #\^)) -(deftrans "Page-up" '(#\Esc #\[ #\5 #\~)) -(deftrans "Page-down" '(#\Esc #\[ #\6 #\~)) -(deftrans "Home" '(#\Esc #\[ #\7 #\~)) -(deftrans "End" '(#\Esc #\[ #\8 #\~)) +(deftrans "Up-arrow" (#\Esc #\[ #\A)) +(deftrans "Down-arrow" (#\Esc #\[ #\B)) +(deftrans "Right-arrow" (#\Esc #\[ #\C)) +(deftrans "Left-arrow" (#\Esc #\[ #\D)) +(deftrans "Insert" (#\Esc #\[ #\2 #\~)) +(deftrans "Delete" (#\Esc #\[ #\3 #\~)) +(deftrans "C-Delete" (#\Esc #\[ #\3 #\^)) +(deftrans "Page-up" (#\Esc #\[ #\5 #\~)) +(deftrans "Page-down" (#\Esc #\[ #\6 #\~)) +(deftrans "Home" (#\Esc #\[ #\7 #\~) (#\Esc #\[ #\1 #\~) (#\Esc #\[ #\H)) +(deftrans "End" (#\Esc #\[ #\8 #\~) (#\Esc #\[ #\4 #\~) (#\Esc #\[ #\F)) Index: src/version.lisp-expr diff -u src/version.lisp-expr:1.8 src/version.lisp-expr:1.9 --- src/version.lisp-expr:1.8 Mon Mar 1 08:28:38 2004 +++ src/version.lisp-expr Fri Mar 5 04:21:46 2004 @@ -1 +1 @@ -0.15.4 +0.15.6 From nsiivola at common-lisp.net Fri Mar 5 09:34:02 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Fri, 05 Mar 2004 04:34:02 -0500 Subject: [Linedit-cvs] CVS update: src/command-functions.lisp src/linedit.asd src/version.lisp-expr Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv24545 Modified Files: command-functions.lisp linedit.asd version.lisp-expr Log Message: Fixed delete-char-forwards behaviour when there is nothing to be deleted. Date: Fri Mar 5 04:34:01 2004 Author: nsiivola Index: src/command-functions.lisp diff -u src/command-functions.lisp:1.8 src/command-functions.lisp:1.9 --- src/command-functions.lisp:1.8 Sat Feb 28 06:32:05 2004 +++ src/command-functions.lisp Fri Mar 5 04:34:00 2004 @@ -49,7 +49,7 @@ (declare (ignore chord)) (with-editor-point-and-string ((point string) editor) (setf (get-string editor) (concat (subseq string 0 point) - (subseq string (1+ point)))))) + (subseq string (min (1+ point) (length string))))))) (defun delete-char-forwards-or-eof (chord editor) (if (equal "" (get-string editor)) Index: src/linedit.asd diff -u src/linedit.asd:1.24 src/linedit.asd:1.25 --- src/linedit.asd:1.24 Fri Mar 5 04:21:45 2004 +++ src/linedit.asd Fri Mar 5 04:34:00 2004 @@ -48,7 +48,7 @@ (error 'operation-error :component c :operation o))) (defsystem :linedit - :version "0.15.6" + :version "0.15.7" :depends-on (:uffi :terminfo) :components (;; Common Index: src/version.lisp-expr diff -u src/version.lisp-expr:1.9 src/version.lisp-expr:1.10 --- src/version.lisp-expr:1.9 Fri Mar 5 04:21:46 2004 +++ src/version.lisp-expr Fri Mar 5 04:34:00 2004 @@ -1 +1 @@ -0.15.6 +0.15.7 From nsiivola at common-lisp.net Fri Mar 5 18:21:37 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Fri, 05 Mar 2004 13:21:37 -0500 Subject: [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 Message-ID: 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 "#") (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 From nsiivola at common-lisp.net Fri Mar 5 18:58:58 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Fri, 05 Mar 2004 13:58:58 -0500 Subject: [Linedit-cvs] CVS update: src/complete.lisp src/editor.lisp src/linedit.asd src/version.lisp-expr Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv31933 Modified Files: complete.lisp editor.lisp linedit.asd version.lisp-expr Log Message: * Fixed an off-by-one error. * Even better filename completion. Date: Fri Mar 5 13:58:58 2004 Author: nsiivola Index: src/complete.lisp diff -u src/complete.lisp:1.3 src/complete.lisp:1.4 --- src/complete.lisp:1.3 Fri Mar 5 13:21:36 2004 +++ src/complete.lisp Fri Mar 5 13:58:58 2004 @@ -30,6 +30,11 @@ (:directory t) (:symbolic-link (file-kind (merge-pathnames (read-link pathname) pathname))))) +(defun relative-pathname-p (pathname) + (let ((dir (pathname-directory pathname))) + (or (null dir) + (eq :relative (car dir))))) + ;; This version of directory-complete isn't nice to symlinks, and ;; should be replaced by something backed by foreign glue. (defun directory-complete (string) @@ -37,13 +42,16 @@ (let* ((common nil) (all nil) (max 0) - (dir (pathname-directory-pathname string))) + (dir (pathname-directory-pathname string)) + (namefun (if (relative-pathname-p string) + #'namestring + (lambda (x) (namestring (merge-pathnames x)))))) (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))) + do (let* ((full (funcall namefun entry)) (diff (mismatch string full))) (dbg "~& completed: ~A, diff: ~A~%" full diff) (unless (< diff (length string)) Index: src/editor.lisp diff -u src/editor.lisp:1.11 src/editor.lisp:1.12 --- src/editor.lisp:1.11 Sat Feb 28 06:32:05 2004 +++ src/editor.lisp Fri Mar 5 13:58:58 2004 @@ -145,7 +145,7 @@ if the point is just after a word, or the point." (with-editor-point-and-string ((point string) editor) (if (or (not (at-delimiter-p string point)) - (not (at-delimiter-p string (1- point)))) + (not (and (plusp point) (at-delimiter-p string (1- point))))) (1+ (or (position-if 'word-delimiter-p string :end point :from-end t) -1)) ; start of string point))) @@ -157,7 +157,7 @@ (let ((tmp (cond ((at-delimiter-p string point) (position-if-not 'word-delimiter-p string :end point :from-end t)) - ((at-delimiter-p string (1- point)) + ((and (plusp point) (at-delimiter-p string (1- point))) (position-if-not 'word-delimiter-p string :end (1- point) :from-end t)) (t point)))) Index: src/linedit.asd diff -u src/linedit.asd:1.26 src/linedit.asd:1.27 --- src/linedit.asd:1.26 Fri Mar 5 13:21:36 2004 +++ src/linedit.asd Fri Mar 5 13:58:58 2004 @@ -48,7 +48,7 @@ (error 'operation-error :component c :operation o))) (defsystem :linedit - :version "0.15.8" + :version "0.15.9" :depends-on (:uffi :terminfo :osicat) :components (;; Common Index: src/version.lisp-expr diff -u src/version.lisp-expr:1.11 src/version.lisp-expr:1.12 --- src/version.lisp-expr:1.11 Fri Mar 5 13:21:36 2004 +++ src/version.lisp-expr Fri Mar 5 13:58:58 2004 @@ -1 +1 @@ -0.15.8 +0.15.9 From nsiivola at common-lisp.net Fri Mar 5 19:52:22 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Fri, 05 Mar 2004 14:52:22 -0500 Subject: [Linedit-cvs] CVS update: src/complete.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv28411 Modified Files: complete.lisp Log Message: Fix (refuse) completion on wild pathnames Date: Fri Mar 5 14:52:22 2004 Author: nsiivola Index: src/complete.lisp diff -u src/complete.lisp:1.4 src/complete.lisp:1.5 --- src/complete.lisp:1.4 Fri Mar 5 13:58:58 2004 +++ src/complete.lisp Fri Mar 5 14:52:22 2004 @@ -46,7 +46,8 @@ (namefun (if (relative-pathname-p string) #'namestring (lambda (x) (namestring (merge-pathnames x)))))) - (unless (underlying-directory-p dir) + (unless (and (underlying-directory-p dir) + (not (wild-pathname-p dir))) (return-from directory-complete (values nil 0))) (with-directory-iterator (next dir) (loop for entry = (next) From nsiivola at common-lisp.net Fri Mar 5 22:10:59 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Fri, 05 Mar 2004 17:10:59 -0500 Subject: [Linedit-cvs] CVS update: src/editor.lisp src/sbcl-repl.lisp src/utility-functions.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv8765 Modified Files: editor.lisp sbcl-repl.lisp utility-functions.lisp Log Message: Escape backslashes Date: Fri Mar 5 17:10:59 2004 Author: nsiivola Index: src/editor.lisp diff -u src/editor.lisp:1.12 src/editor.lisp:1.13 --- src/editor.lisp:1.12 Fri Mar 5 13:58:58 2004 +++ src/editor.lisp Fri Mar 5 17:10:59 2004 @@ -100,7 +100,7 @@ (defun redraw-line (editor &key markup) (display editor :prompt (editor-prompt editor) - :line (get-string editor) + :line (get-string editor) :point (get-point editor) :markup markup)) Index: src/sbcl-repl.lisp diff -u src/sbcl-repl.lisp:1.7 src/sbcl-repl.lisp:1.8 --- src/sbcl-repl.lisp:1.7 Fri Mar 5 13:21:36 2004 +++ src/sbcl-repl.lisp Fri Mar 5 17:10:59 2004 @@ -74,7 +74,7 @@ (declare (type stream out in)) ;; FIXME: Yich. (terpri) - (with-input-from-string (in (repl-reader in out)) + (with-input-from-string (in (meta-escape (repl-reader in out))) (funcall read-form-fun in out))) (lambda (in out) (declare (type stream out in)) Index: src/utility-functions.lisp diff -u src/utility-functions.lisp:1.9 src/utility-functions.lisp:1.10 --- src/utility-functions.lisp:1.9 Thu Mar 4 08:52:53 2004 +++ src/utility-functions.lisp Fri Mar 5 17:10:59 2004 @@ -61,4 +61,12 @@ "Like min, except ignores NILs." (apply #'min (remove-if #'null args))) - \ No newline at end of file +(defun meta-escape (string) + (declare (simple-string string)) + (let (stack) + (loop for i from 1 upto (length string) + for char across string + when (eql #\\ char) + do (push #\\ stack) + do (push char stack)) + (coerce (nreverse stack) 'simple-string))) From nsiivola at common-lisp.net Mon Mar 8 06:45:27 2004 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Mon, 08 Mar 2004 01:45:27 -0500 Subject: [Linedit-cvs] CVS update: src/linedit.asd Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv11456 Modified Files: linedit.asd Log Message: Package for the defsystem Date: Mon Mar 8 01:45:27 2004 Author: nsiivola Index: src/linedit.asd diff -u src/linedit.asd:1.27 src/linedit.asd:1.28 --- src/linedit.asd:1.27 Fri Mar 5 13:58:58 2004 +++ src/linedit.asd Mon Mar 8 01:45:27 2004 @@ -21,7 +21,10 @@ (declaim (optimize (debug 3) (safety 3))) -(in-package :asdf) +(defpackage :linedit-system + (:use :cl :asdf)) + +(in-package :linedit-system) (defvar *gcc* "/usr/bin/gcc") @@ -29,17 +32,20 @@ #+darwin "-bundle" "-fPIC")) -(defmethod output-files ((o compile-op) (c c-source-file)) +;;; Separate class so that we don't mess up other packages +(defclass uffi-c-source-file (c-source-file) ()) + +(defmethod output-files ((o compile-op) (c uffi-c-source-file)) (list (make-pathname :name (component-name c) :type "so" :defaults (component-pathname c)))) -(defmethod perform ((o load-op) (c c-source-file)) +(defmethod perform ((o load-op) (c uffi-c-source-file)) (let ((loader (intern "LOAD-FOREIGN-LIBRARY" :uffi))) - (dolist (f (input-files o c)) + (dolist (f (asdf::input-files o c)) (funcall loader f)))) -(defmethod perform ((o compile-op) (c c-source-file)) +(defmethod perform ((o compile-op) (c uffi-c-source-file)) (unless (zerop (run-shell-command "~A ~A ~{~A ~}-o ~A" *gcc* (namestring (component-pathname c)) @@ -59,7 +65,7 @@ ;; Backend (:file "backend" :depends-on ("utility-macros")) - (:c-source-file "terminal_glue") + (:uffi-c-source-file "terminal_glue") (:file "terminal-translations" :depends-on ("packages")) (:file "terminal" :depends-on ("terminal-translations" "backend" "terminal_glue")) (:file "smart-terminal" :depends-on ("terminal" "matcher")) @@ -70,7 +76,7 @@ (:file "line" :depends-on ("utility-macros")) (:file "buffer" :depends-on ("utility-macros")) (:file "command-keys" :depends-on ("packages")) - (:c-source-file "signals") + (:uffi-c-source-file "signals") (:file "editor" :depends-on ("backend" "rewindable" "signals" "line" "buffer" "command-keys")) (:file "main" :depends-on ("editor"))