[climacs-cvs] CVS update: climacs/html-syntax.lisp climacs/syntax.lisp
Robert Strandh
rstrandh at common-lisp.net
Wed Mar 16 06:12:11 UTC 2005
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv26142
Modified Files:
html-syntax.lisp syntax.lisp
Log Message:
The start-mark and size of parse trees are now automatically updated
in syntax.lisp, so there is no need for individual syntax modules to
be concerned with updating them.
Started restructuring the grammar in html-syntax so that for some
grammatical entity, grammar rules, display function, class definition,
etc are grouped together. This will probably be the preferable way of
structuring most grammars for other syntax modules as well.
Date: Wed Mar 16 07:12:10 2005
Author: rstrandh
Index: climacs/html-syntax.lisp
diff -u climacs/html-syntax.lisp:1.15 climacs/html-syntax.lisp:1.16
--- climacs/html-syntax.lisp:1.15 Tue Mar 15 13:51:39 2005
+++ climacs/html-syntax.lisp Wed Mar 16 07:12:09 2005
@@ -1,4 +1,4 @@
-;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-
+;;; -*- Mode: Lisp; Package: CLIMACS-HTML-SYNTAX -*-
;;; (c) copyright 2005 by
;;; Robert Strandh (strandh at labri.fr)
@@ -57,8 +57,6 @@
(defclass html-words (html-balanced)
((words :initarg :words)))
-(defclass title (html-words) ())
-(defclass body (html-words) ())
(defclass h1 (html-words) ())
(defclass h2 (html-words) ())
(defclass h3 (html-words) ())
@@ -70,32 +68,32 @@
(defclass html-tag (html-token) ())
-(defclass <html> (html-tag) () (:default-initargs :size 6))
-(defclass </html> (html-tag) ()(:default-initargs :size 7))
-(defclass <head> (html-tag) () (:default-initargs :size 6))
-(defclass </head> (html-tag) () (:default-initargs :size 7))
-(defclass <title> (html-tag) () (:default-initargs :size 7))
-(defclass </title> (html-tag) () (:default-initargs :size 8))
-(defclass <body> (html-tag) () (:default-initargs :size 6))
-(defclass </body> (html-tag) () (:default-initargs :size 7))
-(defclass <h1> (html-tag) () (:default-initargs :size 4))
-(defclass </h1> (html-tag) () (:default-initargs :size 5))
-(defclass <h2> (html-tag) () (:default-initargs :size 4))
-(defclass </h2> (html-tag) () (:default-initargs :size 5))
-(defclass <h3> (html-tag) () (:default-initargs :size 4))
-(defclass </h3> (html-tag) () (:default-initargs :size 5))
-(defclass <p> (html-tag) () (:default-initargs :size 3))
-(defclass </p> (html-tag) () (:default-initargs :size 4))
-(defclass <ul> (html-tag) () (:default-initargs :size 4))
-(defclass </ul> (html-tag) () (:default-initargs :size 5))
-(defclass <li> (html-tag) () (:default-initargs :size 4))
-(defclass </li> (html-tag) () (:default-initargs :size 5))
+(defclass <html> (html-tag) ())
+(defclass </html> (html-tag) ())
+(defclass <head> (html-tag) ())
+(defclass </head> (html-tag) ())
+(defclass <title> (html-tag) ())
+(defclass </title> (html-tag) ())
+(defclass <body> (html-tag) ())
+(defclass </body> (html-tag) ())
+(defclass <h1> (html-tag) ())
+(defclass </h1> (html-tag) ())
+(defclass <h2> (html-tag) ())
+(defclass </h2> (html-tag) ())
+(defclass <h3> (html-tag) ())
+(defclass </h3> (html-tag) ())
+(defclass <p> (html-tag) ())
+(defclass </p> (html-tag) ())
+(defclass <ul> (html-tag) ())
+(defclass </ul> (html-tag) ())
+(defclass <li> (html-tag) ())
+(defclass </li> (html-tag) ())
(defclass <a> (html-tag)
((start :initarg :start)
(word :initarg :word)
(words :initarg :words)
(end :initarg :end)))
-(defclass </a> (html-tag) () (:default-initargs :size 4))
+(defclass </a> (html-tag) ())
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -147,96 +145,183 @@
(<html> -> (tag-start
(word (and (= (end-offset tag-start) (start-offset word))
(word-is word "html")))
- (tag-end (= (end-offset word) (start-offset tag-end))))
- :start-mark (start-mark tag-start))
+ (tag-end (= (end-offset word) (start-offset tag-end)))))
(</html> -> (tag-start
(slash (= (end-offset tag-start) (start-offset slash)))
(word (and (= (end-offset slash) (start-offset word))
(word-is word "html")))
- (tag-end (= (end-offset word) (start-offset tag-end))))
- :start-mark (start-mark tag-start))
+ (tag-end (= (end-offset word) (start-offset tag-end)))))
(<head> -> (tag-start
(word (and (= (end-offset tag-start) (start-offset word))
(word-is word "head")))
- (tag-end (= (end-offset word) (start-offset tag-end))))
- :start-mark (start-mark tag-start))
+ (tag-end (= (end-offset word) (start-offset tag-end)))))
(</head> -> (tag-start
(slash (= (end-offset tag-start) (start-offset slash)))
(word (and (= (end-offset slash) (start-offset word))
(word-is word "head")))
- (tag-end (= (end-offset word) (start-offset tag-end))))
- :start-mark (start-mark tag-start))
+ (tag-end (= (end-offset word) (start-offset tag-end)))))
(<title> -> (tag-start
(word (and (= (end-offset tag-start) (start-offset word))
(word-is word "title")))
- (tag-end (= (end-offset word) (start-offset tag-end))))
- :start-mark (start-mark tag-start))
+ (tag-end (= (end-offset word) (start-offset tag-end)))))
(</title> -> (tag-start
(slash (= (end-offset tag-start) (start-offset slash)))
(word (and (= (end-offset slash) (start-offset word))
(word-is word "title")))
- (tag-end (= (end-offset word) (start-offset tag-end))))
- :start-mark (start-mark tag-start))
+ (tag-end (= (end-offset word) (start-offset tag-end)))))
(<body> -> (tag-start
(word (and (= (end-offset tag-start) (start-offset word))
(word-is word "body")))
- (tag-end (= (end-offset word) (start-offset tag-end))))
- :start-mark (start-mark tag-start))
+ (tag-end (= (end-offset word) (start-offset tag-end)))))
(</body> -> (tag-start
(slash (= (end-offset tag-start) (start-offset slash)))
(word (and (= (end-offset slash) (start-offset word))
(word-is word "body")))
- (tag-end (= (end-offset word) (start-offset tag-end))))
- :start-mark (start-mark tag-start))
+ (tag-end (= (end-offset word) (start-offset tag-end)))))
(<a> -> (tag-start
(word (and (= (end-offset tag-start) (start-offset word))
(word-is word "a")))
words
tag-end)
- :start-mark (start-mark tag-start)
- :size (- (end-offset tag-end) (start-offset tag-start))
:start tag-start :word word :words words :end tag-end)
(</a> -> (tag-start
(slash (= (end-offset tag-start) (start-offset slash)))
(word (and (= (end-offset slash) (start-offset word))
(word-is word "a")))
- (tag-end (= (end-offset word) (start-offset tag-end))))
- :start-mark (start-mark tag-start))
+ (tag-end (= (end-offset word) (start-offset tag-end)))))
(html -> (<html> head body </html>)
- :start-mark (start-mark <html>)
- :size (- (end-offset </html>) (start-offset <html>))
:start <html> :head head :body body :end </html>)
(head -> (<head> title </head>)
- :start-mark (start-mark <head>)
- :size (- (end-offset </head>) (start-offset <head>))
:start <head> :title title :end </head>)
- (title -> (<title> words </title>)
- :start-mark (start-mark <title>)
- :size (- (end-offset </title>) (start-offset <title>))
- :start <title> :words words :end </title>)
- (body -> (<body> words </body>)
- :start-mark (start-mark <body>)
- :size (- (end-offset </body>) (start-offset <body>))
- :start <body> :words words :end </body>)
(a -> (<a> words </a>)
- :start-mark (start-mark <a>)
- :size (- (end-offset </a>) (start-offset <a>))
:start <a> :words words :end </a>)
(words -> ()
- (make-instance 'empty-words :start-mark nil))
+ (make-instance 'empty-words))
(words -> (words word)
(make-instance 'nonempty-words
- :start-mark (or (start-mark words) (start-mark word))
- :size (- (end-offset word) (offset (or (start-mark words) (start-mark word))))
- :words words :word word))
- (word -> (a)
- :start-mark (start-mark a)
- :size (- (end-offset a) (start-offset a)))
- (word -> (delimiter)
- :start-mark (start-mark delimiter)
- :size (- (end-offset delimiter) (start-offset delimiter)))))
+ :words words :word word))))
+(defclass title-item (html-nonterminal)
+ ((item :initarg :item)))
+
+(add-rule (grammar-rule (title-item -> (word) :item word)) *html-grammar*)
+(add-rule (grammar-rule (title-item -> (delimiter) :item delimiter)) *html-grammar*)
+
+(defmethod display-parse-tree ((entity title-item) (syntax html-syntax) pane)
+ (with-slots (item) entity
+ (display-parse-tree item syntax pane)))
+
+;;;;;;;;;;;;;;; title-items
+
+(defclass title-items (html-nonterminal) ())
+(defclass empty-title-items (title-items) ())
+
+(defclass nonempty-title-items (title-items)
+ ((items :initarg :items)
+ (item :initarg :item)))
+
+(add-rule (grammar-rule (title-items -> ()
+ (make-instance 'empty-title-items)))
+ *html-grammar*)
+
+(add-rule (grammar-rule (title-items -> (title-items title-item)
+ (make-instance 'nonempty-title-items
+ :items title-items :item title-item)))
+ *html-grammar*)
+
+(defmethod display-parse-tree ((entity empty-title-items) (syntax html-syntax) pane)
+ (declare (ignore pane))
+ nil)
+
+(defmethod display-parse-tree :around ((entity empty-title-items) syntax pane)
+ (declare (ignore syntax pane))
+ nil)
+
+(defmethod display-parse-tree ((entity nonempty-title-items) (syntax html-syntax) pane)
+ (with-slots (items item) entity
+ (display-parse-tree items syntax pane)
+ (display-parse-tree item syntax pane)))
+
+;;;;;;;;;;;;;;; title
+
+(defclass title (html-nonterminal)
+ ((<title> :initarg :<title>)
+ (items :initarg :items)
+ (</title> :initarg :</title>)))
+
+(add-rule (grammar-rule (title -> (<title> title-items </title>)
+ :<title> <title> :items title-items :</title> </title>))
+ *html-grammar*)
+
+(defmethod display-parse-tree ((entity title) (syntax html-syntax) pane)
+ (with-slots (<title> items </title>) entity
+ (display-parse-tree <title> syntax pane)
+ (with-text-face (pane :bold)
+ (display-parse-tree items syntax pane))
+ (display-parse-tree </title> syntax pane)))
+
+;;;;;;;;;;;;;;; body-item
+
+(defclass body-item (html-nonterminal)
+ ((item :initarg :item)))
+
+(add-rule (grammar-rule (body-item -> (word) :item word)) *html-grammar*)
+(add-rule (grammar-rule (body-item -> (delimiter) :item delimiter)) *html-grammar*)
+(add-rule (grammar-rule (body-item -> (a) :item a)) *html-grammar*)
+
+(defmethod display-parse-tree ((entity body-item) (syntax html-syntax) pane)
+ (with-slots (item) entity
+ (display-parse-tree item syntax pane)))
+
+;;;;;;;;;;;;;;; body-items
+
+(defclass body-items (html-nonterminal) ())
+(defclass empty-body-items (body-items) ())
+
+(defclass nonempty-body-items (body-items)
+ ((items :initarg :items)
+ (item :initarg :item)))
+
+(add-rule (grammar-rule (body-items -> ()
+ (make-instance 'empty-body-items)))
+ *html-grammar*)
+
+(add-rule (grammar-rule (body-items -> (body-items body-item)
+ (make-instance 'nonempty-body-items
+ :items body-items :item body-item)))
+ *html-grammar*)
+
+(defmethod display-parse-tree ((entity empty-body-items) (syntax html-syntax) pane)
+ (declare (ignore pane))
+ nil)
+
+(defmethod display-parse-tree :around ((entity empty-body-items) syntax pane)
+ (declare (ignore syntax pane))
+ nil)
+
+(defmethod display-parse-tree ((entity nonempty-body-items) (syntax html-syntax) pane)
+ (with-slots (items item) entity
+ (display-parse-tree items syntax pane)
+ (display-parse-tree item syntax pane)))
+
+;;;;;;;;;;;;;;; body
+
+(defclass body (html-nonterminal)
+ ((<body> :initarg :<body>)
+ (items :initarg :items)
+ (</body> :initarg :</body>)))
+
+(add-rule (grammar-rule (body -> (<body> body-items </body>)
+ :<body> <body> :items body-items :</body> </body>))
+ *html-grammar*)
+
+(defmethod display-parse-tree ((entity body) (syntax html-syntax) pane)
+ (with-slots (<body> items </body>) entity
+ (display-parse-tree <body> syntax pane)
+ (display-parse-tree items syntax pane)
+ (display-parse-tree </body> syntax pane)))
+
(defmethod initialize-instance :after ((syntax html-syntax) &rest args)
(declare (ignore args))
(with-slots (parser lexer buffer) syntax
@@ -347,10 +432,6 @@
(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 :around ((entity title) (syntax html-syntax) pane)
- (with-text-face (pane :bold)
- (call-next-method)))
(defmethod display-parse-tree ((entity html-words) (syntax html-syntax) pane)
(with-slots (words) entity
Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.39 climacs/syntax.lisp:1.40
--- climacs/syntax.lisp:1.39 Tue Mar 15 13:51:39 2005
+++ climacs/syntax.lisp Wed Mar 16 07:12:10 2005
@@ -87,19 +87,22 @@
;;; parse tree
(defclass parse-tree ()
- ((start-mark :initarg :start-mark :reader start-mark)
- (size :initarg :size)))
+ ((start-mark :initform nil :initarg :start-mark :reader start-mark)
+ (size :initform nil :initarg :size)))
(defgeneric start-offset (parse-tree))
(defmethod start-offset ((tree parse-tree))
- (offset (start-mark tree)))
+ (let ((mark (start-mark tree)))
+ (when mark
+ (offset mark))))
(defgeneric end-offset (parse-tree))
(defmethod end-offset ((tree parse-tree))
(with-slots (start-mark size) tree
- (+ (offset start-mark) size)))
+ (when start-mark
+ (+ (offset start-mark) size))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -275,9 +278,17 @@
:parse-trees (cons parse-tree (parse-trees prev-item))
:suffix remaining))
(t
- (make-instance 'complete-item
- :parse-tree remaining
- :parse-trees (cons parse-tree (parse-trees prev-item)))))))
+ (let* ((parse-trees (cons parse-tree (parse-trees prev-item)))
+ (start (find-if-not #'null parse-trees
+ :from-end t :key #'start-offset))
+ (end (find-if-not #'null parse-trees :key #'end-offset)))
+ (with-slots (start-mark size) remaining
+ (when start
+ (setf start-mark (start-mark start)
+ size (- (end-offset end) (start-offset start))))
+ (make-instance 'complete-item
+ :parse-tree remaining
+ :parse-trees parse-trees)))))))
(defgeneric item-equal (item1 item2))
More information about the Climacs-cvs
mailing list