[Linedit-cvs] CVS update: src/matcher.lisp src/smart-terminal.lisp src/utility-functions.lisp

[Nikodemus Siivola]

Update of /project/linedit/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv12417

Modified Files:
	matcher.lisp smart-terminal.lisp utility-functions.lisp 
Log Message:
Fixed paren-higlighting fsvo fix. Eg. ()() now works corretlcy.
Date: Sat Feb 28 07:11:16 2004
Author: nsiivola

Index: src/matcher.lisp
diff -u src/matcher.lisp:1.3 src/matcher.lisp:1.4
--- src/matcher.lisp:1.3	Mon Nov 24 17:56:38 2003
+++ src/matcher.lisp	Sat Feb 28 07:11:16 2004
@@ -61,18 +61,19 @@
 
 (defun dwim-mark-parens (string index &key pre-mark post-mark)
   (multiple-value-bind (open close) (dwim-match-parens string index)
-    (if (and open close)
-	(concat (subseq string 0 open)
-		pre-mark
-		(string (schar string open))
-		post-mark
-		(subseq string (1+ open) close)
-		pre-mark
-		(string (schar string close))
-		post-mark
-		(if (> (length string) (1+ close))
-		    (subseq string (1+ close))
-		    ""))
-	string)))
-		
+    (values 
+     (if (and open close)
+	 (concat (subseq string 0 open)
+		 pre-mark
+		 (string (schar string open))
+		 post-mark
+		 (subseq string (1+ open) close)
+		 pre-mark
+		 (string (schar string close))
+		 post-mark
+		 (if (> (length string) (1+ close))
+		     (subseq string (1+ close))
+		     ""))
+	 string)
+     open)))
 


Index: src/smart-terminal.lisp
diff -u src/smart-terminal.lisp:1.10 src/smart-terminal.lisp:1.11
--- src/smart-terminal.lisp:1.10	Mon Nov 24 17:56:38 2003
+++ src/smart-terminal.lisp	Sat Feb 28 07:11:16 2004
@@ -23,7 +23,8 @@
 
 (defclass smart-terminal (terminal)
   ((point-row :initform 1 :accessor point-row)
-   (active-string :initform "" :accessor active-string)))
+   (active-string :initform "" :accessor active-string)
+   (markup-start :initform 0 :accessor get-markup-start)))
 
 (defun smart-terminal-p ()
   (and (every 'identity
@@ -37,44 +38,61 @@
   (when ti:enter-am-mode
     (ti:tputs ti:enter-am-mode)))
 
+(defun find-row (n columns)
+  ;; 1+ includes point in row calculations
+  (ceiling (1+ n) columns))
+
+(defun find-col (n columns)
+  (rem n columns))
+
+(defun move-up-in-column (&key col up clear-to-eos)
+  (ti:tputs ti:column-address col)
+  (loop repeat up do (ti:tputs ti:cursor-up))
+  (when clear-to-eos
+    (ti:tputs ti:clr-eos)))
+
+(defun fix-wraparound (start end columns)
+  ;; If final character ended in the last column the point
+  ;; will wrap around to the first column on the same line:
+  ;; hence move down if so.
+  (when (and (< start end) (zerop (find-col end columns)))
+    (ti:tputs ti:cursor-down)))
+
+(defun place-point (&key up col)
+  (loop repeat up do (ti:tputs ti:cursor-up))
+  (ti:tputs ti:column-address col))
+
 (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 marked-line))
-	     (old (active-string backend))
-	     (end (+ (length prompt) (length line))) ;; based on unmarked
-	     (rows (find-row end))
-	     (start (or (mismatch new old) 0))
-	     (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)
-	(loop repeat (- (point-row backend) start-row)
-	    do (ti:tputs ti:cursor-up))
-      (ti:tputs ti:clr-eos)
-      ;; Write updated segment
-      (write-string (subseq new start))
-      (when (and (< start end) (zerop (find-col end)))
-	(ti:tputs ti:cursor-down))
-      ;; Place point
-      (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) (concat prompt line)))))
-    (force-output *terminal-io*)))
-
+	 (old-markup-start (get-markup-start backend)))
+    (multiple-value-bind (marked-line markup-start)
+	(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))
+	       (start (min0 markup-start old-markup-start (mismatch new old)))
+	       (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)))
+	  (move-up-in-column
+	   :col start-col 
+	   :up (- (point-row backend) start-row)
+	   :clear-to-eos t)
+	  (write-string (subseq new start))
+	  (fix-wraparound start end columns)
+	  (move-up-in-column 
+	   :col point-col 
+	   :up (- rows point-row))
+	  ;; Save state
+	  (setf (point-row backend) point-row
+		(active-string backend) (concat prompt line)
+		(get-markup-start backend) markup-start)
+	  (force-output *terminal-io*)))))


Index: src/utility-functions.lisp
diff -u src/utility-functions.lisp:1.6 src/utility-functions.lisp:1.7
--- src/utility-functions.lisp:1.6	Sat Feb 28 06:32:05 2004
+++ src/utility-functions.lisp	Sat Feb 28 07:11:16 2004
@@ -49,3 +49,7 @@
   (when *debug*
     (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)))