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

[Christophe Rhodes]

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

Modified Files:
	prolog-syntax.lisp 
Log Message:
Support multiline lexemes.  Only tested on comment lexemes, but it does seem
to work.

Date: Mon Apr  4 17:46:35 2005
Author: crhodes

Index: climacs/prolog-syntax.lisp
diff -u climacs/prolog-syntax.lisp:1.7 climacs/prolog-syntax.lisp:1.8
--- climacs/prolog-syntax.lisp:1.7	Mon Apr  4 15:39:40 2005
+++ climacs/prolog-syntax.lisp	Mon Apr  4 17:46:31 2005
@@ -854,7 +854,7 @@
 	      ;; FIXME: are we allowed to mix DO and UNTIL like this?
 	      ;; I doubt it.
               until (end-of-buffer-p scan)
-	      until (mark< bot (start-offset (lexeme lexer (1- valid-lex))))
+	      until (mark<= bot (start-offset (lexeme lexer (1- valid-lex))))
 	      ;; FIXME: a further criterion is when scan matches the
 	      ;; start-offset of an element in lexemes, at which point
 	      ;; we know that the entirety of the rest of the old lex
@@ -874,7 +874,9 @@
       ;; parse up to the limit of validity imposed by the lexer, or
       ;; the bottom of the visible area
       (loop until (= valid-parse valid-lex)
-	    while (mark<= (end-offset (lexeme lexer valid-parse)) bot)
+	    ;; NOTE: this ceases being the same condition as the above
+	    ;; as soon as the FIXME note above is implemented.
+	    until (mark<= bot (start-offset (lexeme lexer (1- valid-parse))))
 	    do (let ((current-token (lexeme lexer (1- valid-parse)))
 		     (next-lexeme (lexeme lexer valid-parse)))
 		 (setf (slot-value next-lexeme 'state)
@@ -948,12 +950,27 @@
 	 #+nil
 	 (setf ink (medium-ink (sheet-medium pane))
 	       face (text-style-face (medium-text-style (sheet-medium pane))))
-	 (present (coerce (buffer-sequence (buffer syntax)
-					   (start-offset entity)
-					   (end-offset entity))
-			  'string)
-		  'string
-		  :stream 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))))))))))
 
 (defmethod display-parse-tree :before ((entity prolog-lexeme) (syntax prolog-syntax) pane)
   (handle-whitespace pane (buffer pane) *white-space-start* (start-offset entity))