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

[Robert Strandh]

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

Modified Files:
	syntax.lisp 
Log Message:
Prepared the syntax module for incremental output.  I didn't put it in
though, because I have problems getting it to work.  I'll check with Tim 
Moore before making another attempt.

Date: Sun Dec 26 16:20:00 2004
Author: rstrandh

Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.5 climacs/syntax.lisp:1.6
--- climacs/syntax.lisp:1.5	Sun Dec 26 08:18:01 2004
+++ climacs/syntax.lisp	Sun Dec 26 16:19:59 2004
@@ -59,48 +59,52 @@
 (define-presentation-type url ()
   :inherit-from 'string)
 
-(defmethod present-contents (pane (syntax basic-syntax))
-  (with-slots (saved-offset scan) syntax
-     (unless (null saved-offset)
-       (let ((word (coerce (region-to-sequence saved-offset scan) 'string)))
-	 (present word
-		  (if (and (>= (length word) 7) (string= (subseq word 0 7) "http://"))
-		      'url
-		      'string)
-		:stream pane))
-       (setf saved-offset nil))))
+(defmethod present-contents (contents pane (syntax basic-syntax))
+  (unless (null contents)
+    (present contents
+	     (if (and (>= (length contents) 7) (string= (subseq contents 0 7) "http://"))
+		 'url
+		 'string)
+	     :stream pane)))
 
 (defmethod display-line (pane (syntax basic-syntax))
   (with-slots (saved-offset bot scan cursor-x cursor-y space-width tab-width) syntax
-     (loop when (mark= scan (point pane))
-	     do (multiple-value-bind (x y) (stream-cursor-position pane)
-		  (setf cursor-x (+ x (if (null saved-offset)
-					  0
-					  (* space-width (- (offset scan) saved-offset))))
-			cursor-y y))
-	   when (mark= scan bot)
-	     do (present-contents pane syntax)
-		(return)
-	   until (eql (object-after scan) #\Newline)
-	   do (let ((obj (object-after scan)))
-		(cond ((eql obj #\Space)
-		       (present-contents pane syntax)
-		       (princ obj pane))
-		      ((eql obj #\Tab)
-		       (present-contents pane syntax)
-		       (let ((x (stream-cursor-position pane)))
-			 (stream-increment-cursor-position
-			  pane (- tab-width (mod x tab-width)) 0)))
-		      ((constituentp obj)
-		       (when (null saved-offset)
-			 (setf saved-offset (offset scan))))
-		      (t
-		       (present-contents pane syntax)
-		       (princ obj pane))))
-	      (incf (offset scan))
-	   finally (present-contents pane syntax)
-		   (incf (offset scan))
-		   (terpri pane))))
+     (flet ((compute-contents ()
+	      (unless (null saved-offset)
+		(prog1 (coerce (region-to-sequence saved-offset scan) 'string)
+		       (setf saved-offset nil)))))
+       (macrolet ((output-word (&body body)
+		    `(let ((contents (compute-contents)))
+		       (present-contents contents pane syntax)
+		       , at body)))
+	 (loop with id = 0
+	       when (mark= scan (point pane))
+		 do (multiple-value-bind (x y) (stream-cursor-position pane)
+		      (setf cursor-x (+ x (if (null saved-offset)
+					      0
+					      (* space-width (- (offset scan) saved-offset))))
+			    cursor-y y))
+	       when (mark= scan bot)
+		 do (output-word)
+		    (return)
+	       until (eql (object-after scan) #\Newline)
+	       do (let ((obj (object-after scan)))
+		    (cond ((eql obj #\Space)
+			   (output-word (princ obj pane)))
+			  ((eql obj #\Tab)
+			   (output-word)
+			   (let ((x (stream-cursor-position pane)))
+			     (stream-increment-cursor-position
+			      pane (- tab-width (mod x tab-width)) 0)))
+			  ((constituentp obj)
+			   (when (null saved-offset)
+			     (setf saved-offset (offset scan))))
+			  (t
+			   (output-word (princ obj pane)))))
+		  (incf (offset scan))
+	       finally (output-word)
+		       (incf (offset scan))
+		       (terpri pane))))))
 
 (defmethod redisplay-with-syntax (pane (syntax basic-syntax))
   (let* ((medium (sheet-medium pane))
@@ -156,13 +160,10 @@
 (define-presentation-type texinfo-command ()
   :inherit-from 'string)
 
-(defmethod present-contents (pane (syntax texinfo-syntax))
-  (with-slots (saved-offset scan) syntax
-     (unless (null saved-offset)
-       (let ((word (coerce (region-to-sequence saved-offset scan) 'string)))
-	 (if (char= (aref word 0) #\@)
-	     (with-drawing-options (pane :ink +red+)
-	       (present word 'texinfo-command :stream pane))
-	     (present word 'string :stream pane)))
-       (setf saved-offset nil))))
+(defmethod present-contents (contents pane (syntax texinfo-syntax))
+  (unless (null contents)
+    (if (char= (aref contents 0) #\@)
+	(with-drawing-options (pane :ink +red+)
+	  (present contents 'texinfo-command :stream pane))
+	(present contents 'string :stream pane))))