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

Sat Feb 5 06:25:31 UTC 2005

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

Modified Files:
	html-syntax.lisp 
Log Message:
Improvements to HTML syntax.

Date: Sat Feb  5 07:25:30 2005
Author: rstrandh

Index: climacs/html-syntax.lisp
diff -u climacs/html-syntax.lisp:1.1 climacs/html-syntax.lisp:1.2

--- climacs/html-syntax.lisp:1.1	Wed Feb  2 09:01:30 2005
+++ climacs/html-syntax.lisp	Sat Feb  5 07:25:29 2005
@@ -128,25 +128,9 @@
 (defparameter *html-grammar*
   (grammar
    (html -> (<html> head body </html>))
-   (<html> -> (html-sym) :badness 5 :message "substituted <html>")
-   (</html> -> (html-sym) :badness 5 :message "substituted </html>")
-   (<html> -> () :badness 10 :message "missing <html> inserted")
-   (</html> -> () :badness 10 :message "missing </html> inserted")
    (head -> (<head> title </head>))
-   (<head> -> (html-sym) :badness 5 :message "substituted <head>")
-   (</head> -> (html-sym) :badness 5 :message "substituted </head>")
-   (<head> -> () :badness 10 :message "missing <head> inserted")
-   (</head> -> () :badness 10 :message "missing </head> inserted")
    (title -> (<title> texts </title>))
-   (<title> -> (html-sym) :badness 5 :message "substituted <title>")
-   (</title> -> (html-sym) :badness 5 :message "substituted </title>")
-   (<title> -> () :badness 10 :message "missing <title> inserted")
-   (</title> -> () :badness 10 :message "missing </title> inserted")
    (body -> (<body> texts </body>))
-   (<body> -> (html-sym) :badness 5 :message "substituted <body>")
-   (</body> -> (html-sym) :badness 5 :message "substituted </body>")
-   (<body> -> () :badness 10 :message "missing <body> inserted")
-   (</body> -> () :badness 10 :message "missing </body> inserted")
    (texts -> ())
    (texts -> (texts text))))
 
@@ -178,7 +162,11 @@
 		   do (let ((token (lex lexer)))
 			(push (cons (clone-mark mark)
 				    (advance-parse parser (list token) (cdar states)))
-			      states))))))))
+			      states)))))
+       (print (find 'html (gethash (initial-state parser) (parse-trees (cdar states)))
+		    :key #'type-of)
+	      *query-io*)
+       (finish-output *query-io*))))
 
 (defgeneric forward-to-error (point syntax))
 (defgeneric backward-to-error (point syntax))
@@ -193,11 +181,31 @@
 		 (return-from find-bad-parse-tree parse-tree))))
 	   (parse-trees state)))
 
+(defmethod empty-state-p (state)
+  (maphash (lambda (key val)
+	     (declare (ignore key))
+	     (loop for parse-tree in val
+		   do (return-from empty-state-p nil)))
+	   (parse-trees state))
+  (maphash (lambda (key val)
+	     (declare (ignore key))
+	     (loop for parse-tree in val
+		   do (return-from empty-state-p nil)))
+	   (incomplete-items state)))
+
 (defmethod backward-to-error (point (syntax html-syntax))
   (let ((states (slot-value syntax 'states)))
+    ;; find the last state before point
     (loop until (or (null states)
 		    (mark< (caar states) point))
 	  do (pop states))
+    (when (null states)
+      (return-from backward-to-error "no more errors"))
+    (when (empty-state-p (cdar states))
+      (loop for ((m1 . s1) (m2 . s2)) on states
+	    until (not (empty-state-p s2))
+	    finally (setf (offset point) (offset m1)))
+      (return-from backward-to-error "no valid parse from this point"))
     (loop for (mark . state) in states
 	  for tree = (find-bad-parse-tree state)
 	  when tree


