[Linedit-cvs] CVS update: src/release.txt src/smart-terminal.lisp src/terminfo.lisp src/version.lisp-expr
Nikodemus Siivola
nsiivola at common-lisp.net
Thu Nov 6 14:33:39 UTC 2003
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
More information about the linedit-cvs
mailing list