From nsiivola at common-lisp.net Sat Nov 1 20:01:19 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sat, 01 Nov 2003 15:01:19 -0500 Subject: [Linedit-cvs] CVS update: src/version.txt Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv858 Removed Files: version.txt Log Message: Renamed to version.lisp-expr Date: Sat Nov 1 15:01:19 2003 Author: nsiivola From nsiivola at common-lisp.net Sat Nov 1 20:08:39 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sat, 01 Nov 2003 15:08:39 -0500 Subject: [Linedit-cvs] CVS update: src/version.lisp-expr Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv3385 Added Files: version.lisp-expr Log Message: Renamed Date: Sat Nov 1 15:08:38 2003 Author: nsiivola From nsiivola at common-lisp.net Sat Nov 1 20:35:43 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sat, 01 Nov 2003 15:35:43 -0500 Subject: [Linedit-cvs] CVS update: src/Makefile src/editor.lisp src/packages.lisp src/sbcl-repl.lisp src/smart-terminal.lisp src/terminfo.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv13912 Modified Files: Makefile editor.lisp packages.lisp sbcl-repl.lisp smart-terminal.lisp terminfo.lisp Log Message: What can I say? Stuff. * New Terminfo license. (Yay!) * Other stuff. Date: Sat Nov 1 15:35:42 2003 Author: nsiivola Index: src/Makefile diff -u src/Makefile:1.16 src/Makefile:1.17 --- src/Makefile:1.16 Mon Oct 20 03:49:24 2003 +++ src/Makefile Sat Nov 1 15:35:42 2003 @@ -77,7 +77,7 @@ public_html: $(RSYNC_HTML) && $(HTML_PERMS) -TI_VERSION=1.0 +TI_VERSION=1.0.1 TI=terminfo_$(TI_VERSION) TI_LINK=terminfo_latest.tar.gz Index: src/editor.lisp diff -u src/editor.lisp:1.7 src/editor.lisp:1.8 --- src/editor.lisp:1.7 Thu Oct 23 11:07:08 2003 +++ src/editor.lisp Sat Nov 1 15:35:42 2003 @@ -21,7 +21,11 @@ (in-package :linedit) -(defvar *version* "0.14.4") +(defvar *version* #.(symbol-name + (with-open-file (f (merge-pathnames "version.lisp-expr" + *compile-file-truename*)) + (read f)))) + (defvar *history* nil) (defvar *killring* nil) Index: src/packages.lisp diff -u src/packages.lisp:1.11 src/packages.lisp:1.12 --- src/packages.lisp:1.11 Sun Oct 19 18:49:58 2003 +++ src/packages.lisp Sat Nov 1 15:35:42 2003 @@ -27,4 +27,5 @@ #:*default-columns* #:*default-lines* #+sbcl #:install-repl + #+sbcl #:uninstall-repl )) Index: src/sbcl-repl.lisp diff -u src/sbcl-repl.lisp:1.3 src/sbcl-repl.lisp:1.4 --- src/sbcl-repl.lisp:1.3 Mon Oct 20 11:34:03 2003 +++ src/sbcl-repl.lisp Sat Nov 1 15:35:42 2003 @@ -24,33 +24,54 @@ #-sbcl (error "Attempt to load an SBCL specific file in anothr implementation.") -(defun install-repl (&key wrap-current) - (let ((prompt-fun sb-int:*repl-prompt-fun*) - (read-form-fun sb-int:*repl-read-form-fun*)) - (declare (type function prompt-fun read-form-fun)) - (flet ((repl-reader (in out) - (declare (type stream out) - (ignore in)) - (fresh-line out) - (let ((prompt (with-output-to-string (s) - (funcall prompt-fun s)))) - (handler-case - (linedit:formedit - :prompt1 prompt - :prompt2 (make-string (length prompt) - :initial-element #\Space)) - (end-of-file () (sb-ext:quit)))))) - (setf sb-int:*repl-prompt-fun* (constantly "")) - (setf sb-int:*repl-read-form-fun* - (if wrap-current - (lambda (in out) - (declare (type stream out in)) - (with-input-from-string (in (repl-reader in out)) - ;; FIXME: Youch. - (write-char #\newline) - (write-char #\return) - (funcall read-form-fun in out))) - (lambda (in out) - (declare (type stream out in)) - (read-from-string (repl-reader in out))))))) - t) +(let (prompt-fun read-form-fun) + (declare (type (or null function) prompt-fun read-form-fun)) + + (macrolet ((enforce-consistent-state () + `(invariant (or (and prompt-fun read-form-fun) + (not (or prompt-fun read-form-fun)))))) + + (defun uninstall-repl () + (enforce-consistent-state) + (if prompt-fun + (setf sb-int:*repl-prompt-fun* prompt-fun + sb-int:*repl-read-form-fun* read-form-fun + prompt-fun nil + read-form-fun nil) + (warn "UNINSTALL-REPL failed: No Linedit REPL present.")) + nil) + + (defun install-repl (&key wrap-current) + (enforce-consistent-state) + (when prompt-fun + (warn "INSTALL-REPL failed: Linedit REPL already installed.") + (return-from install-repl nil)) + (setf prompt-fun sb-int:*repl-prompt-fun* + read-form-fun sb-int:*repl-read-form-fun*) + (flet ((repl-reader (in out) + (declare (type stream out) + (ignore in)) + (fresh-line out) + (let ((prompt (with-output-to-string (s) + (funcall prompt-fun s)))) + (handler-case + (linedit:formedit + :prompt1 prompt + :prompt2 (make-string (length prompt) + :initial-element #\Space)) + (end-of-file () (sb-ext:quit)))))) + (setf sb-int:*repl-prompt-fun* (constantly "")) + (setf sb-int:*repl-read-form-fun* + (if wrap-current + (lambda (in out) + (declare (type stream out in)) + (with-input-from-string (in (repl-reader in out)) + ;; FIXME: Youch. + (write-char #\newline) + (write-char #\return) + (funcall read-form-fun in out))) + (lambda (in out) + (declare (type stream out in)) + (read-from-string (repl-reader in out)))))) + t))) + \ No newline at end of file Index: src/smart-terminal.lisp diff -u src/smart-terminal.lisp:1.5 src/smart-terminal.lisp:1.6 --- src/smart-terminal.lisp:1.5 Fri Oct 24 09:13:00 2003 +++ src/smart-terminal.lisp Sat Nov 1 15:35:42 2003 @@ -26,9 +26,11 @@ (active-string :initform "" :accessor active-string))) (defun smart-terminal-p () - (every (lambda (key) - (ti:capability key)) '(:cursor-up :cursor-down :clr-eos - :column-address :auto-right-margin))) + (every 'identity + '(ti:cursor-up ti:cursor-down + ti:clr-eos ti:column-address + ti:auto-right-margin ti:enter-am-mode))) + (defmethod backend-init ((backend smart-terminal)) (call-next-method) (ti:tputs ti:enter-am-mode)) Index: src/terminfo.lisp diff -u src/terminfo.lisp:1.4 src/terminfo.lisp:1.5 --- src/terminfo.lisp:1.4 Mon Oct 20 03:49:24 2003 +++ src/terminfo.lisp Sat Nov 1 15:35:42 2003 @@ -1,8 +1,14 @@ ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: TERMINFO -*- -;;; $Revision: 1.4 $ ;;; Copyright ? 2001 Paul Foley (mycroft at actrix.gen.nz) -;;; All rights reserved. Use and verbatim redistribution permitted. +;;; +;;; Permission is hereby granted, free of charge, to any person obtaining +;;; a copy of this Software to deal in the Software without restriction, +;;; including without limitation the rights to use, copy, modify, merge, +;;; publish, distribute, sublicense, and/or sell copies of the Software, +;;; and to permit persons to whom the Software is furnished to do so, +;;; provided that the above copyright notice and this permission notice +;;; are included in all copies or substantial portions of the Software. ;;; ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED @@ -16,26 +22,27 @@ ;;; (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.4 2003/10/20 07:49:24 nsiivola Exp $") +#+CMU (ext:file-comment "$Header: /project/linedit/cvsroot/src/terminfo.lisp,v 1.5 2003/11/01 20:35:42 nsiivola Exp $") -(in-package "CL-USER") +(in-package "COMMON-LISP-USER") -;; DEFPACKAGE would warn here, since we export things outside the -;; definition. +;; DEFPACKAGE would warn here, since we export things outside the definition (eval-when (:compile-toplevel :load-toplevel) (unless (find-package "TERMINFO") (make-package "TERMINFO" :nicknames '("TI") :use '("CL")))) (in-package "TERMINFO") -(export '(*terminfo-directory* *terminfo* capability tparm - tputs set-terminal)) +(export '(*terminfo-directories* *terminfo* capability tparm tputs + set-terminal)) -(defvar *terminfo-directory* "/usr/share/terminfo/") +(defvar *terminfo-directories* '("/usr/share/terminfo/" + "/usr/share/misc/terminfo/")) (defvar *terminfo* nil) -(defvar *capabilities* (make-hash-table :size 494)) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defvar *capabilities* (make-hash-table :size 494))) (flet ((required-argument () (error "A required argument was not supplied."))) @@ -50,8 +57,13 @@ (numbers (required-argument) :type (simple-array (signed-byte 16) (*))) (strings (required-argument) :type (simple-array t (*))))) -(defun capability (name &optional (terminfo *terminfo*)) +#+CMU +(declaim (ext:start-block capability %capability)) + +(defun %capability (name terminfo) (let ((whatsit (gethash name *capabilities*))) + (when (null whatsit) + (error "Terminfo capability ~S doesn't exist." name)) (if (or (null terminfo) (>= (cdr whatsit) (length (funcall (car whatsit) terminfo)))) nil #| default |# @@ -60,16 +72,45 @@ nil value))))) +(declaim (inline capability)) +(defun capability (name &optional (terminfo *terminfo*)) + (%capability name terminfo)) + +#+CMU +(declaim (ext:end-block)) + +(define-compiler-macro capability (&whole form + name &optional (terminfo '*terminfo*)) + (if (not (keywordp name)) + form + (let ((value (gensym)) + (tmp (gensym))) + (unless (gethash name *capabilities*) + (warn "Terminfo capability ~S doesn't exist." name)) + `(let ((,value (load-time-value (cons nil nil))) + (,tmp ,terminfo)) + (if (eq (car ,value) ,tmp) + (cdr ,value) + (setf (car ,value) ,tmp + (cdr ,value) (%capability ,name ,tmp))))))) + + (defmacro defcap (name type index) (let ((thing (ecase type (boolean 'terminfo-booleans) (integer 'terminfo-numbers) - (string 'terminfo-strings)))) + (string 'terminfo-strings))) + (symbol (intern (string name) "KEYWORD"))) `(progn - (setf (gethash ,(intern (string name) "KEYWORD") *capabilities*) - (cons #',thing ,index)) - (define-symbol-macro ,name - (capability ,(intern (string name) "KEYWORD") *terminfo*)) + (eval-when (:compile-toplevel) + ;; Mark capability as valid for the compiler-macro; needed when + ;; compiling TPUTS. If there's already a value present, leave + ;; it alone, else just put any non-NIL value there; it'll get + ;; fixed up when the file is loaded. + (setf (gethash ,symbol *capabilities*) + (gethash ,symbol *capabilities* t))) + (setf (gethash ,symbol *capabilities*) (cons #',thing ,index)) + (define-symbol-macro ,name (capability ,symbol *terminfo*)) (export ',name "TERMINFO")))) (defcap auto-left-margin boolean 0) @@ -578,9 +619,9 @@ (defun load-terminfo (name) (let ((name (concatenate 'string (list (char name 0) #\/) name))) - (dolist (path (list #+CMU "home:.terminfo/" - #+Allegro "~/.terminfo/" - *terminfo-directory*)) + (dolist (path (list* #+(or CMU SBCL) "home:.terminfo/" + #+Allegro "~/.terminfo/" + *terminfo-directories*)) (with-open-file (stream (merge-pathnames name path) :direction :input :element-type '(unsigned-byte 8) @@ -628,9 +669,6 @@ (dotimes (i szstrings) (unless (minusp (setf (aref strings i) (read-short stream))) (incf count))) - #+CMU - (read-sequence stringtable stream) - #-CMU (dotimes (i szstringtable) (setf (char stringtable i) (code-char (read-byte stream)))) (let ((xtrings (make-array szstrings :initial-element nil))) @@ -840,13 +878,91 @@ (error "Invalid integer constant") state14 (error "Conditional expression parser not yet written.") + terminal #| that's all, folks |#)) (t (princ c out))))))) +(defun stream-fileno (stream) + (typecase stream + #+CMU + (sys:fd-stream + (sys:fd-stream-fd stream)) + (two-way-stream + (stream-fileno (two-way-stream-output-stream stream))) + (synonym-stream + (stream-fileno (symbol-value (synonym-stream-symbol stream)))) + (echo-stream + (stream-fileno (echo-stream-output-stream stream))) + (broadcast-stream + (stream-fileno (first (broadcast-stream-streams stream)))) + (otherwise nil))) + +(defun stream-baud-rate (stream) + #+CMU + (alien:with-alien ((termios (alien:struct unix:termios))) + (declare (optimize (ext:inhibit-warnings 3))) + (when (unix:unix-tcgetattr (stream-fileno stream) termios) + (let ((baud (logand unix:tty-cbaud + (alien:slot termios 'unix:c-cflag)))) + (if (< baud unix::tty-cbaudex) + (aref #(0 50 75 110 134 150 200 300 600 1200 + 1800 2400 4800 9600 19200 38400) + baud) + (aref #(57600 115200 230400 460800 500000 576000 + 921600 1000000 1152000 1500000 2000000 + 2500000 3000000 3500000 4000000) + (logxor baud unix::tty-cbaudex))))))) + (defun tputs (string &rest args) (when string - (princ (apply #'tparm string args) *terminal-io*) + (let* ((stream (if (streamp (first args)) (pop args) *terminal-io*)) + (terminfo (if (terminfo-p (first args)) (pop args) *terminfo*))) + (with-input-from-string (string (apply #'tparm string args)) + (do ((c (read-char string nil) (read-char string nil))) + ((null c)) + (cond ((and (char= c #\$) + (eql (peek-char nil string nil) #\<)) + (let ((time 0) (force nil) (rate nil) (pad #\Null)) + + ;; Find out how long to pad for: + (read-char string) ; eat the #\< + (loop + (setq c (read-char string)) + (let ((n (digit-char-p c))) + (if n + (setq time (+ (* time 10) n)) + (return)))) + (if (char= c #\.) + (setq time (+ (* time 10) + (digit-char-p (read-char string))) + c (read-char string)) + (setq time (* time 10))) + (when (char= c #\*) + ;; multiply time by "number of lines affected" + ;; but how do I know that?? + (setq c (read-char string))) + (when (char= c #\/) + (setq force t c (read-char string))) + (unless (char= c #\>) + (error "Invalid padding specification.")) + + ;; Decide whether to apply padding: + (when (or force (not (capability :xon-xoff terminfo))) + (setq rate (stream-baud-rate stream)) + (when (let ((pb (capability :padding-baud-rate terminfo))) + (and rate (or (null pb) (> rate pb)))) + (cond ((capability :no-pad-char terminfo) + (finish-output stream) + (sleep (/ time 10000.0))) + (t + (let ((tmp (capability :pad-char terminfo))) + (when tmp (setf pad (schar tmp 0)))) + (dotimes (i (ceiling (* rate time) 100000)) + (princ pad stream)))))))) + + (t + (princ c stream)))))) t)) (defun set-terminal (&optional name) @@ -861,7 +977,7 @@ #| if all else fails |# "dumb")))) -(if (null *terminfo*) - (set-terminal)) +;;(if (null *terminfo*) +;; (set-terminal)) (provide :terminfo) From nsiivola at common-lisp.net Sat Nov 1 20:41:04 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sat, 01 Nov 2003 15:41:04 -0500 Subject: [Linedit-cvs] CVS update: src/Makefile Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv16274 Modified Files: Makefile Log Message: Date: Sat Nov 1 15:41:04 2003 Author: nsiivola Index: src/Makefile diff -u src/Makefile:1.17 src/Makefile:1.18 --- src/Makefile:1.17 Sat Nov 1 15:35:42 2003 +++ src/Makefile Sat Nov 1 15:41:04 2003 @@ -1,7 +1,7 @@ # Boilerplate project makefile for Common-lisp.net # May all your snapshots be orderly. ;) # -# Per-project files needed: version.txt, release.txt +# Per-project files needed: version.lisp-expr, release.txt # Per-developer files needed: username.txt # # Following directory structure is assumed, relative to @@ -16,7 +16,7 @@ PROJECT=linedit # Release version number -VERSION=`cat version.txt` +VERSION=`cat version.lisp-expr` # Username USERNAME=`cat username.txt` # List of files included in release @@ -77,7 +77,7 @@ public_html: $(RSYNC_HTML) && $(HTML_PERMS) -TI_VERSION=1.0.1 +TI_VERSION=1.1 TI=terminfo_$(TI_VERSION) TI_LINK=terminfo_latest.tar.gz From nsiivola at common-lisp.net Sat Nov 1 20:43:38 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sat, 01 Nov 2003 15:43:38 -0500 Subject: [Linedit-cvs] CVS update: src/sbcl-repl.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv16818 Modified Files: sbcl-repl.lisp Log Message: Date: Sat Nov 1 15:43:38 2003 Author: nsiivola Index: src/sbcl-repl.lisp diff -u src/sbcl-repl.lisp:1.4 src/sbcl-repl.lisp:1.5 --- src/sbcl-repl.lisp:1.4 Sat Nov 1 15:35:42 2003 +++ src/sbcl-repl.lisp Sat Nov 1 15:43:37 2003 @@ -32,6 +32,7 @@ (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,6 +43,8 @@ nil) (defun install-repl (&key wrap-current) + "Installs the Linedit at REPL. Original input handlers can be +preserved with the :WRAP-CURRENT T." (enforce-consistent-state) (when prompt-fun (warn "INSTALL-REPL failed: Linedit REPL already installed.") From nsiivola at common-lisp.net Sat Nov 1 22:27:14 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sat, 01 Nov 2003 17:27:14 -0500 Subject: [Linedit-cvs] CVS update: src/editor.lisp src/version.lisp-expr Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv22554 Modified Files: editor.lisp version.lisp-expr Log Message: oops. Date: Sat Nov 1 17:27:13 2003 Author: nsiivola Index: src/editor.lisp diff -u src/editor.lisp:1.8 src/editor.lisp:1.9 --- src/editor.lisp:1.8 Sat Nov 1 15:35:42 2003 +++ src/editor.lisp Sat Nov 1 17:27:13 2003 @@ -63,6 +63,7 @@ (let ((ann nil)) (defun make-editor (&rest args) + (ti:set-terminal) (let ((type (if (smart-terminal-p) 'smart-editor 'dumb-editor))) Index: src/version.lisp-expr diff -u src/version.lisp-expr:1.1 src/version.lisp-expr:1.2 --- src/version.lisp-expr:1.1 Sat Nov 1 15:08:38 2003 +++ src/version.lisp-expr Sat Nov 1 17:27:13 2003 @@ -1 +1 @@ -0.14.6 +0.14.7 From nsiivola at common-lisp.net Thu Nov 6 14:33:39 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Thu, 06 Nov 2003 09:33:39 -0500 Subject: [Linedit-cvs] CVS update: src/release.txt src/smart-terminal.lisp src/terminfo.lisp src/version.lisp-expr Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv26911 Modified Files: release.txt smart-terminal.lisp terminfo.lisp version.lisp-expr Log Message: Preliminary darwin stuff. Minor fixes. Date: Thu Nov 6 09:33:39 2003 Author: nsiivola Index: src/release.txt diff -u src/release.txt:1.4 src/release.txt:1.5 --- src/release.txt:1.4 Mon Oct 20 12:25:42 2003 +++ src/release.txt Thu Nov 6 09:33:39 2003 @@ -19,3 +19,4 @@ utility-macros.lisp signals.c terminal_glue.c +version.lisp-expr Index: src/smart-terminal.lisp diff -u src/smart-terminal.lisp:1.6 src/smart-terminal.lisp:1.7 --- src/smart-terminal.lisp:1.6 Sat Nov 1 15:35:42 2003 +++ src/smart-terminal.lisp Thu Nov 6 09:33:39 2003 @@ -26,14 +26,16 @@ (active-string :initform "" :accessor active-string))) (defun smart-terminal-p () - (every 'identity - '(ti:cursor-up ti:cursor-down - ti:clr-eos ti:column-address - ti:auto-right-margin ti:enter-am-mode))) + (and (every 'identity + (list ti:cursor-up ti:cursor-down + ti:clr-eos ti:column-address )) + (some 'identity + (list ti:auto-right-margin ti:enter-am-mode)))) (defmethod backend-init ((backend smart-terminal)) (call-next-method) - (ti:tputs ti:enter-am-mode)) + (when ti:enter-am-mode + (ti:tputs ti:enter-am-mode))) (defmethod display ((backend smart-terminal) prompt line point) (let ((*terminal-io* *standard-output*) Index: src/terminfo.lisp diff -u src/terminfo.lisp:1.5 src/terminfo.lisp:1.6 --- src/terminfo.lisp:1.5 Sat Nov 1 15:35:42 2003 +++ src/terminfo.lisp Thu Nov 6 09:33:39 2003 @@ -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.5 2003/11/01 20:35:42 nsiivola Exp $") +#+CMU (ext:file-comment "$Header: /project/linedit/cvsroot/src/terminfo.lisp,v 1.6 2003/11/06 14:33:39 nsiivola Exp $") (in-package "COMMON-LISP-USER") @@ -616,71 +616,73 @@ (defcap memory-unlock string 412) (defcap box-chars-1 string 413)) - (defun load-terminfo (name) - (let ((name (concatenate 'string (list (char name 0) #\/) name))) - (dolist (path (list* #+(or CMU SBCL) "home:.terminfo/" - #+Allegro "~/.terminfo/" - *terminfo-directories*)) - (with-open-file (stream (merge-pathnames name path) - :direction :input - :element-type '(unsigned-byte 8) - :if-does-not-exist nil) - (when stream - (flet ((read-short (stream) - (let ((n (+ (read-byte stream) (* 256 (read-byte stream))))) - (if (> n 32767) - (- n 65536) - n))) - (read-string (stream) - (do ((c (read-byte stream) (read-byte stream)) - (s '())) - ((zerop c) (coerce (nreverse s) 'string)) - (push (code-char c) s)))) - (let* ((magic (read-short stream)) - (sznames (read-short stream)) - (szbooleans (read-short stream)) - (sznumbers (read-short stream)) - (szstrings (read-short stream)) - (szstringtable (read-short stream)) - (names (let ((string (read-string stream))) - (loop for i = 0 then (1+ j) + (flet ((stringify-first-char (name) + #+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/" + #+Allegro "~/.terminfo/" + *terminfo-directories*)) + (with-open-file (stream (merge-pathnames name path) + :direction :input + :element-type '(unsigned-byte 8) + :if-does-not-exist nil) + (when stream + (flet ((read-short (stream) + (let ((n (+ (read-byte stream) (* 256 (read-byte stream))))) + (if (> n 32767) + (- n 65536) + n))) + (read-string (stream) + (do ((c (read-byte stream) (read-byte stream)) + (s '())) + ((zerop c) (coerce (nreverse s) 'string)) + (push (code-char c) s)))) + (let* ((magic (read-short stream)) + (sznames (read-short stream)) + (szbooleans (read-short stream)) + (sznumbers (read-short stream)) + (szstrings (read-short stream)) + (szstringtable (read-short stream)) + (names (let ((string (read-string stream))) + (loop for i = 0 then (1+ j) as j = (position #\| string :start i) - collect (subseq string i j) while j))) - (booleans (make-array szbooleans - :element-type '(or t nil) - :initial-element nil)) - (numbers (make-array sznumbers - :element-type '(signed-byte 16) - :initial-element -1)) - (strings (make-array szstrings - :element-type '(signed-byte 16) - :initial-element -1)) - (stringtable (make-string szstringtable)) - (count 0)) - (unless (= magic #o432) - (error "Invalid file format")) - (dotimes (i szbooleans) - (setf (aref booleans i) (not (zerop (read-byte stream))))) - (when (oddp (+ sznames szbooleans)) - (read-byte stream)) - (dotimes (i sznumbers) - (setf (aref numbers i) (read-short stream))) - (dotimes (i szstrings) - (unless (minusp (setf (aref strings i) (read-short stream))) - (incf count))) - (dotimes (i szstringtable) - (setf (char stringtable i) (code-char (read-byte stream)))) - (let ((xtrings (make-array szstrings :initial-element nil))) + collect (subseq string i j) while j))) + (booleans (make-array szbooleans + :element-type '(or t nil) + :initial-element nil)) + (numbers (make-array sznumbers + :element-type '(signed-byte 16) + :initial-element -1)) + (strings (make-array szstrings + :element-type '(signed-byte 16) + :initial-element -1)) + (stringtable (make-string szstringtable)) + (count 0)) + (unless (= magic #o432) + (error "Invalid file format")) + (dotimes (i szbooleans) + (setf (aref booleans i) (not (zerop (read-byte stream))))) + (when (oddp (+ sznames szbooleans)) + (read-byte stream)) + (dotimes (i sznumbers) + (setf (aref numbers i) (read-short stream))) (dotimes (i szstrings) - (unless (minusp (aref strings i)) - (setf (aref xtrings i) - (subseq stringtable (aref strings i) - (position #\Null stringtable - :start (aref strings i)))))) - (setq strings xtrings)) - (return (make-terminfo :names names :booleans booleans - :numbers numbers :strings strings))))))))) + (unless (minusp (setf (aref strings i) (read-short stream))) + (incf count))) + (dotimes (i szstringtable) + (setf (char stringtable i) (code-char (read-byte stream)))) + (let ((xtrings (make-array szstrings :initial-element nil))) + (dotimes (i szstrings) + (unless (minusp (aref strings i)) + (setf (aref xtrings i) + (subseq stringtable (aref strings i) + (position #\Null stringtable + :start (aref strings i)))))) + (setq strings xtrings)) + (return (make-terminfo :names names :booleans booleans + :numbers numbers :strings strings)))))))))) (defun tparm (string &rest args) (when (null string) (return-from tparm "")) Index: src/version.lisp-expr diff -u src/version.lisp-expr:1.2 src/version.lisp-expr:1.3 --- src/version.lisp-expr:1.2 Sat Nov 1 17:27:13 2003 +++ src/version.lisp-expr Thu Nov 6 09:33:39 2003 @@ -1 +1 @@ -0.14.7 +0.14.8 From nsiivola at common-lisp.net Sun Nov 9 12:27:54 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sun, 09 Nov 2003 07:27:54 -0500 Subject: [Linedit-cvs] CVS update: src/Makefile Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv29765 Modified Files: Makefile Log Message: Date: Sun Nov 9 07:27:54 2003 Author: nsiivola Index: src/Makefile diff -u src/Makefile:1.18 src/Makefile:1.19 --- src/Makefile:1.18 Sat Nov 1 15:41:04 2003 +++ src/Makefile Sun Nov 9 07:27:54 2003 @@ -77,7 +77,7 @@ public_html: $(RSYNC_HTML) && $(HTML_PERMS) -TI_VERSION=1.1 +TI_VERSION=1.2 TI=terminfo_$(TI_VERSION) TI_LINK=terminfo_latest.tar.gz From nsiivola at common-lisp.net Sun Nov 9 12:28:03 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sun, 09 Nov 2003 07:28:03 -0500 Subject: [Linedit-cvs] CVS update: src/matcher.lisp src/linedit.asd src/smart-terminal.lisp src/utility-functions.lisp src/version.lisp-expr Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv29810 Modified Files: linedit.asd smart-terminal.lisp utility-functions.lisp version.lisp-expr Added Files: matcher.lisp Log Message: Preliminary support for paren-matching. Date: Sun Nov 9 07:28:03 2003 Author: nsiivola Index: src/linedit.asd diff -u src/linedit.asd:1.21 src/linedit.asd:1.22 --- src/linedit.asd:1.21 Thu Oct 23 11:07:08 2003 +++ src/linedit.asd Sun Nov 9 07:28:03 2003 @@ -55,13 +55,14 @@ (:file "packages") (:file "utility-macros" :depends-on ("packages")) (:file "utility-functions" :depends-on ("packages")) + (:file "matcher" :depends-on ("packages")) ;; Backend (:file "backend" :depends-on ("utility-macros")) (: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")) + (:file "smart-terminal" :depends-on ("terminal" "matcher")) (:file "dumb-terminal" :depends-on ("terminal")) ;; Editor Index: src/smart-terminal.lisp diff -u src/smart-terminal.lisp:1.7 src/smart-terminal.lisp:1.8 --- src/smart-terminal.lisp:1.7 Thu Nov 6 09:33:39 2003 +++ src/smart-terminal.lisp Sun Nov 9 07:28:03 2003 @@ -39,7 +39,10 @@ (defmethod display ((backend smart-terminal) prompt line point) (let ((*terminal-io* *standard-output*) - (columns (backend-columns backend))) + (columns (backend-columns backend)) + (line (dwim-mark-parens line point + :pre-mark ti:enter-bold-mode + :post-mark ti:exit-attribute-mode))) (flet ((find-row (n) ;; 1+ includes point in row calculations (ceiling (1+ n) columns)) Index: src/utility-functions.lisp diff -u src/utility-functions.lisp:1.3 src/utility-functions.lisp:1.4 --- src/utility-functions.lisp:1.3 Thu Oct 23 11:07:08 2003 +++ src/utility-functions.lisp Sun Nov 9 07:28:03 2003 @@ -37,4 +37,3 @@ (defun make-whitespace (n) (make-string n :initial-element #\space)) - Index: src/version.lisp-expr diff -u src/version.lisp-expr:1.3 src/version.lisp-expr:1.4 --- src/version.lisp-expr:1.3 Thu Nov 6 09:33:39 2003 +++ src/version.lisp-expr Sun Nov 9 07:28:03 2003 @@ -1 +1 @@ -0.14.8 +0.15.0 From nsiivola at common-lisp.net Sun Nov 9 13:20:39 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Sun, 09 Nov 2003 08:20:39 -0500 Subject: [Linedit-cvs] CVS update: src/backend.lisp src/dumb-terminal.lisp src/editor.lisp src/main.lisp src/matcher.lisp src/smart-terminal.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv22284 Modified Files: backend.lisp dumb-terminal.lisp editor.lisp main.lisp matcher.lisp smart-terminal.lisp Log Message: Slightly less broken paren matching. Date: Sun Nov 9 08:20:39 2003 Author: nsiivola Index: src/backend.lisp diff -u src/backend.lisp:1.3 src/backend.lisp:1.4 --- src/backend.lisp:1.3 Tue Oct 28 09:39:08 2003 +++ src/backend.lisp Sun Nov 9 08:20:39 2003 @@ -48,4 +48,4 @@ , at forms) (backend-init ,backend))) - (defgeneric display (backend prompt line point)) +(defgeneric display (backend &key prompt line point &allow-other-keys)) Index: src/dumb-terminal.lisp diff -u src/dumb-terminal.lisp:1.7 src/dumb-terminal.lisp:1.8 --- src/dumb-terminal.lisp:1.7 Thu Oct 23 11:07:08 2003 +++ src/dumb-terminal.lisp Sun Nov 9 08:20:39 2003 @@ -26,7 +26,7 @@ (defclass dumb-terminal (terminal) ()) -(defmethod display ((backend dumb-terminal) prompt line point) +(defmethod display ((backend dumb-terminal) &key prompt line point &allow-other-keys) (let* ((string (concat prompt line)) (length (length string)) (point (+ point (length prompt))) Index: src/editor.lisp diff -u src/editor.lisp:1.9 src/editor.lisp:1.10 --- src/editor.lisp:1.9 Sat Nov 1 17:27:13 2003 +++ src/editor.lisp Sun Nov 9 08:20:39 2003 @@ -92,8 +92,15 @@ (defvar *debug-info* nil) +(defun redraw-line (editor &key markup) + (display editor + :prompt (editor-prompt editor) + :line (get-string editor) + :point (get-point editor) + :markup markup)) + (defun next-chord (editor) - (display editor (editor-prompt editor) (get-string editor) (get-point editor)) + (redraw-line editor :markup t) (forget-yank editor) (let* ((chord (read-chord editor)) (command (gethash chord (editor-commands editor) Index: src/main.lisp diff -u src/main.lisp:1.7 src/main.lisp:1.8 --- src/main.lisp:1.7 Mon Oct 20 13:49:05 2003 +++ src/main.lisp Sun Nov 9 08:20:39 2003 @@ -29,6 +29,7 @@ (loop (catch 'linedit-loop (next-chord editor)))) + (redraw-line editor) (get-finished-string editor)))) (defun formedit (&rest args &key (prompt1 "") (prompt2 "") Index: src/matcher.lisp diff -u src/matcher.lisp:1.1 src/matcher.lisp:1.2 --- src/matcher.lisp:1.1 Sun Nov 9 07:28:03 2003 +++ src/matcher.lisp Sun Nov 9 08:20:39 2003 @@ -43,7 +43,7 @@ (defun find-close-paren (string index) (loop with count = -1 - for n from (1+ index) upto (length string) + for n from (1+ index) below (length string) do (incf count (paren-count-delta (schar string n))) when (zerop count) return n)) Index: src/smart-terminal.lisp diff -u src/smart-terminal.lisp:1.8 src/smart-terminal.lisp:1.9 --- src/smart-terminal.lisp:1.8 Sun Nov 9 07:28:03 2003 +++ src/smart-terminal.lisp Sun Nov 9 08:20:39 2003 @@ -37,23 +37,25 @@ (when ti:enter-am-mode (ti:tputs ti:enter-am-mode))) -(defmethod display ((backend smart-terminal) prompt line point) - (let ((*terminal-io* *standard-output*) - (columns (backend-columns backend)) - (line (dwim-mark-parens line point - :pre-mark ti:enter-bold-mode - :post-mark ti:exit-attribute-mode))) +(defmethod display ((backend smart-terminal) &key prompt line point markup) + (let* ((*terminal-io* *standard-output*) + (columns (backend-columns backend)) + (marked-line (if markup + (dwim-mark-parens line point + :pre-mark ti:enter-bold-mode + :post-mark ti:exit-attribute-mode) + line))) (flet ((find-row (n) ;; 1+ includes point in row calculations (ceiling (1+ n) columns)) (find-col (n) (rem n columns))) - (let* ((new (concat prompt line)) + (let* ((new (concat prompt marked-line)) (old (active-string backend)) - (end (length new)) + (end (+ (length prompt) (length line))) ;; based on unmarked (rows (find-row end)) (start (or (mismatch new old) 0)) - (start-row (find-row start)) + (start-row (find-row start)) ;; markup? (start-col (find-col start))) ;; Move to start of update and clear to eos (ti:tputs ti:column-address start-col) From nsiivola at common-lisp.net Thu Nov 20 17:29:55 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Thu, 20 Nov 2003 12:29:55 -0500 Subject: [Linedit-cvs] CVS update: src/main.lisp src/packages.lisp src/sbcl-repl.lisp src/utility-functions.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv11544 Modified Files: main.lisp packages.lisp sbcl-repl.lisp utility-functions.lisp Log Message: - Added :eof-quits keyword to install-repl. - Various formedit and repl fixes. Date: Thu Nov 20 12:29:55 2003 Author: nsiivola Index: src/main.lisp diff -u src/main.lisp:1.8 src/main.lisp:1.9 --- src/main.lisp:1.8 Sun Nov 9 08:20:39 2003 +++ src/main.lisp Thu Nov 20 12:29:55 2003 @@ -35,21 +35,31 @@ (defun formedit (&rest args &key (prompt1 "") (prompt2 "") &allow-other-keys) "Reads a single form of input with line-editing. Returns the form as -a string. Not realiable in the presense of customized readtable -functinality." +a string. Assumes standard readtable." (let ((args (copy-list args))) (dolist (key '(:prompt1 :prompt2)) (remf args key)) (catch 'form-done - (let ((eof-marker (list nil)) - (table (copy-readtable *readtable*))) + (let ((eof-marker (gensym "EOF")) + (table (copy-readtable))) + (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)) - (read-from-string str)) - (end-of-file () eof-marker)))) + ;; Eugh. Argh. + (if (find-if-not 'whitespacep str) + (read-from-string str) + (error 'end-of-file))) + (end-of-file () + eof-marker)))) (unless (eq eof-marker form) (throw 'form-done str))))))))) + +(defun semicolon-reader (stream char) + (declare (ignore char)) + (loop for char = (read-char stream) + until (eql char #\newline)) + (values)) Index: src/packages.lisp diff -u src/packages.lisp:1.12 src/packages.lisp:1.13 --- src/packages.lisp:1.12 Sat Nov 1 15:35:42 2003 +++ src/packages.lisp Thu Nov 20 12:29:55 2003 @@ -29,3 +29,7 @@ #+sbcl #:install-repl #+sbcl #:uninstall-repl )) + + + + Index: src/sbcl-repl.lisp diff -u src/sbcl-repl.lisp:1.5 src/sbcl-repl.lisp:1.6 --- src/sbcl-repl.lisp:1.5 Sat Nov 1 15:43:37 2003 +++ src/sbcl-repl.lisp Thu Nov 20 12:29:55 2003 @@ -42,7 +42,7 @@ (warn "UNINSTALL-REPL failed: No Linedit REPL present.")) nil) - (defun install-repl (&key wrap-current) + (defun install-repl (&key wrap-current eof-quits) "Installs the Linedit at REPL. Original input handlers can be preserved with the :WRAP-CURRENT T." (enforce-consistent-state) @@ -62,19 +62,27 @@ :prompt1 prompt :prompt2 (make-string (length prompt) :initial-element #\Space)) - (end-of-file () (sb-ext:quit)))))) + (end-of-file (e) + (if eof-quits + (and (fresh-line) (sb-ext:quit)) + ;; Hackins, I know. + "#.''end-of-file")))))) (setf sb-int:*repl-prompt-fun* (constantly "")) (setf sb-int:*repl-read-form-fun* (if wrap-current (lambda (in out) (declare (type stream out in)) + ;; FIXME: Yich. + (terpri) (with-input-from-string (in (repl-reader in out)) - ;; FIXME: Youch. - (write-char #\newline) - (write-char #\return) (funcall read-form-fun in out))) (lambda (in out) (declare (type stream out in)) - (read-from-string (repl-reader in out)))))) + (handler-case (read-from-string (repl-reader in out)) + (end-of-file () + ;; We never get here if eof-quits is true, so... + (fresh-line) + (write-line "#") + (values))))))) t))) Index: src/utility-functions.lisp diff -u src/utility-functions.lisp:1.4 src/utility-functions.lisp:1.5 --- src/utility-functions.lisp:1.4 Sun Nov 9 07:28:03 2003 +++ src/utility-functions.lisp Thu Nov 20 12:29:55 2003 @@ -28,12 +28,15 @@ (error "Required argument missing.")) (defun concat (&rest strings) - (apply #'concatenate 'string strings)) + (apply #'concatenate 'simple-string strings)) (defun word-delimiter-p (char) - (declare (string *word-delimiters*) + (declare (simple-string *word-delimiters*) (character char)) (find char *word-delimiters*)) (defun make-whitespace (n) (make-string n :initial-element #\space)) + +(defun whitespacep (char) + (member char '(#\space #\newline #\tab #\return #\page))) From nsiivola at common-lisp.net Mon Nov 24 22:05:47 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Mon, 24 Nov 2003 17:05:47 -0500 Subject: [Linedit-cvs] CVS update: src/terminfo.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv5689 Modified Files: terminfo.lisp Log Message: Added /etc/terminfo to *terminfo-directories*. Date: Mon Nov 24 17:05:47 2003 Author: nsiivola Index: src/terminfo.lisp diff -u src/terminfo.lisp:1.6 src/terminfo.lisp:1.7 --- src/terminfo.lisp:1.6 Thu Nov 6 09:33:39 2003 +++ src/terminfo.lisp Mon Nov 24 17:05:47 2003 @@ -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.6 2003/11/06 14:33:39 nsiivola Exp $") +#+CMU (ext:file-comment "$Header: /project/linedit/cvsroot/src/terminfo.lisp,v 1.7 2003/11/24 22:05:47 nsiivola Exp $") (in-package "COMMON-LISP-USER") @@ -36,7 +36,8 @@ (export '(*terminfo-directories* *terminfo* capability tparm tputs set-terminal)) -(defvar *terminfo-directories* '("/usr/share/terminfo/" +(defvar *terminfo-directories* '("/etc/terminfo/" + "/usr/share/terminfo/" "/usr/share/misc/terminfo/")) (defvar *terminfo* nil) From nsiivola at common-lisp.net Mon Nov 24 22:56:39 2003 From: nsiivola at common-lisp.net (Nikodemus Siivola) Date: Mon, 24 Nov 2003 17:56:39 -0500 Subject: [Linedit-cvs] CVS update: src/Makefile src/backend.lisp src/main.lisp src/matcher.lisp src/packages.lisp src/smart-terminal.lisp Message-ID: Update of /project/linedit/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv15087 Modified Files: Makefile backend.lisp main.lisp matcher.lisp packages.lisp smart-terminal.lisp Log Message: slightly less broken, but still not ready for release Date: Mon Nov 24 17:56:38 2003 Author: nsiivola Index: src/Makefile diff -u src/Makefile:1.19 src/Makefile:1.20 --- src/Makefile:1.19 Sun Nov 9 07:27:54 2003 +++ src/Makefile Mon Nov 24 17:56:38 2003 @@ -77,7 +77,7 @@ public_html: $(RSYNC_HTML) && $(HTML_PERMS) -TI_VERSION=1.2 +TI_VERSION=1.3 TI=terminfo_$(TI_VERSION) TI_LINK=terminfo_latest.tar.gz Index: src/backend.lisp diff -u src/backend.lisp:1.4 src/backend.lisp:1.5 --- src/backend.lisp:1.4 Sun Nov 9 08:20:39 2003 +++ src/backend.lisp Mon Nov 24 17:56:38 2003 @@ -49,3 +49,4 @@ (backend-init ,backend))) (defgeneric display (backend &key prompt line point &allow-other-keys)) + Index: src/main.lisp diff -u src/main.lisp:1.9 src/main.lisp:1.10 --- src/main.lisp:1.9 Thu Nov 20 12:29:55 2003 +++ src/main.lisp Mon Nov 24 17:56:38 2003 @@ -42,6 +42,8 @@ (catch 'form-done (let ((eof-marker (gensym "EOF")) (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 #\; #'semicolon-reader nil table) (set-dispatch-macro-character #\# #\. (constantly (values)) table) (do ((str (apply #'linedit :prompt prompt1 args) @@ -49,7 +51,9 @@ (string #\newline) (apply #'linedit :prompt prompt2 args)))) ((let ((form (handler-case (let ((*readtable* table)) - ;; Eugh. Argh. + ;; 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))) Index: src/matcher.lisp diff -u src/matcher.lisp:1.2 src/matcher.lisp:1.3 --- src/matcher.lisp:1.2 Sun Nov 9 08:20:39 2003 +++ src/matcher.lisp Mon Nov 24 17:56:38 2003 @@ -21,6 +21,10 @@ (in-package :linedit) +;; FIXME: This is not the Right Way to do paren matching. +;; * use stack, not counting +;; * don't count #\( #\) &co + (defun after-close-p (string index) (and (array-in-bounds-p string (1- index)) (find (schar string (1- index)) ")]}"))) Index: src/packages.lisp diff -u src/packages.lisp:1.13 src/packages.lisp:1.14 --- src/packages.lisp:1.13 Thu Nov 20 12:29:55 2003 +++ src/packages.lisp Mon Nov 24 17:56:38 2003 @@ -29,7 +29,3 @@ #+sbcl #:install-repl #+sbcl #:uninstall-repl )) - - - - Index: src/smart-terminal.lisp diff -u src/smart-terminal.lisp:1.9 src/smart-terminal.lisp:1.10 --- src/smart-terminal.lisp:1.9 Sun Nov 9 08:20:39 2003 +++ src/smart-terminal.lisp Mon Nov 24 17:56:38 2003 @@ -70,11 +70,11 @@ (let* ((point (+ (length prompt) point)) (point-row (find-row point)) (point-col (find-col point))) - (loop repeat (- rows point-row) - do (ti:tputs ti:cursor-up)) - (ti:tputs ti:column-address point-col) - ;; Save state - (setf (point-row backend) point-row - (active-string backend) new)))) + (loop repeat (- rows point-row) + do (ti:tputs ti:cursor-up)) + (ti:tputs ti:column-address point-col) + ;; Save state + (setf (point-row backend) point-row + (active-string backend) (concat prompt line))))) (force-output *terminal-io*)))