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

[Robert Strandh]

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

Modified Files:
	html-syntax.lisp packages.lisp syntax.lisp 
Log Message:
More progress on html-syntax, which may eventually become a model
for many different language syntax modules.  

The display function now traverses the parse tree up as long as a
valid parse tree exists.  The rest of the display is done from the
token sequence.  It is likely that all of this can be abstracted out
and put into syntax.lisp so that html-syntax would just become a
client among others for this traversal.

Not only is the cursor still not displayed, whitespace is not handled
during the traversal of the parse tree.  This will likely be fixed in
the next few day.



Date: Thu Mar 10 07:37:41 2005
Author: rstrandh

Index: climacs/html-syntax.lisp
diff -u climacs/html-syntax.lisp:1.7 climacs/html-syntax.lisp:1.8
--- climacs/html-syntax.lisp:1.7	Mon Mar  7 07:51:02 2005
+++ climacs/html-syntax.lisp	Thu Mar 10 07:37:40 2005
@@ -300,6 +300,71 @@
 			 pane (- tab-width (mod x tab-width)) 0))))
 	     (incf start))))		    
 
+(defmethod display-parse-tree :around ((entity html-sym) syntax pane)
+  (with-slots (top bot) pane
+     (when (mark> (end-offset entity) top)
+       (call-next-method))))
+
+(defmethod display-parse-tree :around ((entity empty-words) syntax pane)
+  (declare (ignore syntax pane))
+  nil)
+
+(defmethod display-parse-tree ((entity html-token) (syntax html-syntax) pane)
+  (updating-output (pane :unique-id entity
+			 :id-test #'eq
+			 :cache-value entity
+			 :cache-test #'eq)
+    (present (coerce (region-to-sequence (start-mark entity)
+					 (end-offset entity))
+		     'string)
+	     'string
+	     :stream pane)))
+
+(defmethod display-parse-tree :before ((entity html-balanced) (syntax html-syntax) pane)
+  (with-slots (start) entity
+     (display-parse-tree start syntax pane)))
+
+(defmethod display-parse-tree :after ((entity html-balanced) (syntax html-syntax) pane)
+  (with-slots (end) entity
+     (display-parse-tree end syntax pane)))
+
+(defmethod display-parse-tree ((entity html-words) (syntax html-syntax) pane)
+  (with-slots (words) entity
+     (display-parse-tree words syntax pane)))
+
+(defmethod display-parse-tree ((entity empty-words) (syntax html-syntax) pane)
+  (declare (ignore pane))
+  nil)
+
+(defmethod display-parse-tree ((entity nonempty-words) (syntax html-syntax) pane)
+  (with-slots (words word) entity
+     (display-parse-tree words syntax pane)
+     (display-parse-tree word syntax pane)))
+
+(defmethod display-parse-tree ((entity html) (syntax html-syntax) pane)
+  (with-slots (head body) entity
+     (display-parse-tree head syntax pane)
+     (display-parse-tree body syntax pane)))
+
+(defmethod display-parse-tree ((entity head) (syntax html-syntax) pane)
+  (with-slots (title) entity
+     (display-parse-tree title syntax pane)))
+
+(defgeneric display-parse-stack (symbol stack syntax pane))
+
+(defmethod display-parse-stack (symbol stack (syntax html-syntax) pane)
+  (let ((next (parse-stack-next stack)))
+    (unless (null next)
+      (display-parse-stack (parse-stack-symbol next) next syntax pane))
+    (loop for parse-tree in (reverse (parse-stack-parse-trees stack))
+	  do (display-parse-tree parse-tree syntax pane))))  
+
+(defun display-parse-state (state syntax pane)
+  (let ((top (parse-stack-top state)))
+    (if (not (null top))
+	(display-parse-stack (parse-stack-symbol top) top syntax pane)
+	(display-parse-tree (target-parse-tree state) syntax pane))))
+
 (defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax html-syntax) current-p)
   (with-slots (top bot) pane
      (with-slots (tokens) syntax
@@ -310,16 +375,24 @@
 	    ;; go back to a token before bot
 	    (loop until (mark<= (end-offset (element* tokens (1- end-token-index))) bot)
 		  do (decf end-token-index))
-	    ;; for forward to the last token before bot
+	    ;; go forward to the last token before bot
 	    (loop until (or (= end-token-index (nb-elements tokens))
 			    (mark> (start-offset (element* tokens end-token-index)) bot))
 		  do (incf end-token-index))
 	    (let ((start-token-index end-token-index))
-	      ;; go back to the first token after top
-	      (loop until (mark<= (end-offset (element* tokens (1- start-token-index))) top)
+	      ;; go back to the first token after top, or until the previous token
+	      ;; contains a valid parser state
+	      (loop until (or (mark<= (end-offset (element* tokens (1- start-token-index))) top)
+			      (not (null (parse-stack-top
+					  (slot-value (element* tokens (1- start-token-index)) 'state)))))
 		    do (decf start-token-index))
+	      ;; display the parse tree if any
+	      (unless (parse-state-empty-p (slot-value (element* tokens (1- start-token-index)) 'state))
+		(display-parse-state (slot-value (element* tokens (1- start-token-index)) 'state)
+				     syntax
+				     pane))
 	      ;; display the tokens
-	      (loop with prev-offset = (offset top)
+	      (loop with prev-offset = (end-offset (element* tokens (1- start-token-index)))
 		    while (< start-token-index end-token-index)
 		    do (let ((token (element* tokens start-token-index)))
 			 (handle-whitespace pane (buffer pane) prev-offset (start-offset token))


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.54 climacs/packages.lisp:1.55
--- climacs/packages.lisp:1.54	Mon Mar  7 07:51:03 2005
+++ climacs/packages.lisp	Thu Mar 10 07:37:40 2005
@@ -92,7 +92,7 @@
 	   #:update-syntax #:update-syntax-for-display
 	   #:grammar #:parser #:initial-state
 	   #:advance-parse
-	   #:parse-stack-top #:target-parse-tree
+	   #:parse-stack-top #:target-parse-tree #:parse-state-empty-p
 	   #:parse-stack-next #:parse-stack-symbol
 	   #:parse-stack-parse-trees #:map-over-parse-trees
            #:syntax-line-indentation


Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.34 climacs/syntax.lisp:1.35
--- climacs/syntax.lisp:1.34	Sat Mar  5 08:03:53 2005
+++ climacs/syntax.lisp	Thu Mar 10 07:37:40 2005
@@ -326,6 +326,10 @@
 represent a complete parse of the target."
   (state-contains-target-p state))
 
+(defun parse-state-empty-p (state)
+  (and (null (parse-stack-top state))
+       (null (target-parse-tree state))))
+
 (defun parse-stack-next (parse-stack)
   "given a parse stack frame, return the next frame in the stack."
   (assert (not (null parse-stack)))