[climacs-cvs] CVS update: climacs/prolog-syntax.lisp

[Christophe Rhodes]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv365

Modified Files:
	prolog-syntax.lisp 
Log Message:
Because of multiline tokens, we must redraw on various criteria other than
the ink and face changing: specifically, if the substring of the token
that we are to draw is different, we cannot simply displace or replay an 
output record.

Date: Wed Apr  6 19:00:20 2005
Author: crhodes

Index: climacs/prolog-syntax.lisp
diff -u climacs/prolog-syntax.lisp:1.14 climacs/prolog-syntax.lisp:1.15
--- climacs/prolog-syntax.lisp:1.14	Wed Apr  6 18:23:21 2005
+++ climacs/prolog-syntax.lisp	Wed Apr  6 19:00:20 2005
@@ -56,7 +56,7 @@
   ())
 
 (defclass prolog-token (prolog-parse-tree)
-  ((ink) (face)))
+  ((ink) (face) (start) (end)))
 
 ;;; lexer
 
@@ -947,40 +947,47 @@
        (call-next-method))))
 
 (defmethod display-parse-tree ((entity prolog-token) (syntax prolog-syntax) pane)
-  (flet ((cache-test (t1 t2)
-	   (and (eq t1 t2)
-		(eq (slot-value t1 'ink)
-		    (medium-ink (sheet-medium pane)))
-		(eq (slot-value t1 'face)
-		    (text-style-face (medium-text-style (sheet-medium pane)))))))
-    (updating-output (pane :unique-id entity
-			   :id-test #'eq
-			   :cache-value entity
-			   :cache-test #'cache-test)
-      (with-slots (ink face) entity
-	 (setf ink (medium-ink (sheet-medium pane))
-	       face (text-style-face (medium-text-style (sheet-medium pane))))
-	 (let ((string (coerce (buffer-sequence (buffer syntax)
-						(start-offset entity)
-						(end-offset entity))
-			       'string)))
-	   (with-slots (top bot) pane
-	     (let (start end)
-	       (setf start (max 0 (- (offset top) (start-offset entity))))
-	       (setf end (- (length string) (max 0 (- (end-offset entity) (offset bot)))))
-	       (loop
-		(when (>= start end)
-		  (return))
-		(let ((nl (position #\Newline string
-				    :start start :end end)))
-		  (unless nl
-		    (present (subseq string start end) 'string :stream pane)
-		    (return))
-		  (present (subseq string start nl) 'string :stream pane)
-		  (handle-whitespace pane (buffer pane)
-				     (+ (start-offset entity) nl)
-				     (+ (start-offset entity) nl 1))
-		  (setf start (+ nl 1)))))))))))
+  (with-slots (top bot) pane
+    (let ((string (coerce (buffer-sequence (buffer syntax)
+					   (start-offset entity)
+					   (end-offset entity))
+			  'string)))
+      (flet ((cache-test (t1 t2)
+	       (and (eq t1 t2)
+		    (eq (slot-value t1 'ink)
+			(medium-ink (sheet-medium pane)))
+		    (eq (slot-value t1 'face)
+			(text-style-face (medium-text-style (sheet-medium pane))))
+		    (eq (slot-value t1 'start)
+			(max 0 (- (offset top) (start-offset entity))))
+		    (eq (slot-value t1 'end)
+			(- (length string)
+			   (max 0 (- (end-offset entity) (offset bot))))))))
+	(updating-output (pane :unique-id entity
+			       :id-test #'eq
+			       :cache-value entity
+			       :cache-test #'cache-test)
+          (with-slots (ink face start end) entity
+	    (setf ink (medium-ink (sheet-medium pane))
+		  face (text-style-face (medium-text-style (sheet-medium pane)))
+		  start (max 0 (- (offset top) (start-offset entity)))
+		  end (- (length string)
+			 (max 0 (- (end-offset entity) (offset bot)))))
+	    (let ((start start)
+		  (end end))
+	      (loop
+	       (when (>= start end)
+		 (return))
+	       (let ((nl (position #\Newline string
+				   :start start :end end)))
+		 (unless nl
+		   (present (subseq string start end) 'string :stream pane)
+		   (return))
+		 (present (subseq string start nl) 'string :stream pane)
+		 (handle-whitespace pane (buffer pane)
+				    (+ (start-offset entity) nl)
+				    (+ (start-offset entity) nl 1))
+		 (setf start (+ nl 1)))))))))))
 
 (defmethod display-parse-tree :before ((entity prolog-token) (syntax prolog-syntax) pane)
   (handle-whitespace pane (buffer pane) *white-space-start* (start-offset entity))