/[climacs]/climacs/html-syntax.lisp
ViewVC logotype

Diff of /climacs/html-syntax.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.20 by rstrandh, Sun Mar 20 08:25:21 2005 UTC revision 1.21 by rstrandh, Mon Apr 4 06:20:52 2005 UTC
# Line 82  Line 82 
82    
83  (defparameter *html-grammar* (grammar))  (defparameter *html-grammar* (grammar))
84    
85    (defmacro add-html-rule (rule)
86      `(add-rule (grammar-rule ,rule) *html-grammar*))
87    
88  (defun word-is (word string)  (defun word-is (word string)
89    (string-equal (coerce (buffer-sequence (buffer word) (start-offset word) (end-offset word)) 'string)    (string-equal (coerce (buffer-sequence (buffer word) (start-offset word) (end-offset word)) 'string)
90                  string))                  string))
# Line 90  Line 93 
93    `(progn    `(progn
94       (defclass ,name (html-tag) ())       (defclass ,name (html-tag) ())
95    
96       (add-rule (grammar-rule       (add-html-rule
97                  (,name -> (tag-start        (,name -> (tag-start
98                             (word (and (= (end-offset tag-start) (start-offset word))                   (word (and (= (end-offset tag-start) (start-offset word))
99                                        (word-is word ,string)))                              (word-is word ,string)))
100                             (tag-end (= (end-offset word) (start-offset tag-end))))))                   (tag-end (= (end-offset word) (start-offset tag-end))))))))
                *html-grammar*)))  
101    
102  (defmacro define-end-tag (name string)  (defmacro define-end-tag (name string)
103    `(progn    `(progn
104       (defclass ,name (html-tag) ())       (defclass ,name (html-tag) ())
105    
106       (add-rule (grammar-rule       (add-html-rule
107                  (,name -> (tag-start        (,name -> (tag-start
108                             (slash (= (end-offset tag-start) (start-offset slash)))                   (slash (= (end-offset tag-start) (start-offset slash)))
109                             (word (and (= (end-offset slash) (start-offset word))                   (word (and (= (end-offset slash) (start-offset word))
110                                        (word-is word ,string)))                              (word-is word ,string)))
111                             (tag-end (= (end-offset word) (start-offset tag-end))))))                   (tag-end (= (end-offset word) (start-offset tag-end))))))))
                *html-grammar*)))  
112    
113  (defmacro define-tag-pair (start-name end-name string)  (defmacro define-tag-pair (start-name end-name string)
114    `(progn (define-start-tag ,start-name ,string)    `(progn (define-start-tag ,start-name ,string)
115            (define-end-tag ,end-name ,string)))            (define-end-tag ,end-name ,string)))
116    
 (define-tag-pair <html> </html> "html")  
117  (define-tag-pair <head> </head> "head")  (define-tag-pair <head> </head> "head")
118  (define-tag-pair <title> </title> "title")  (define-tag-pair <title> </title> "title")
119  (define-tag-pair <body> </body> "body")  (define-tag-pair <body> </body> "body")
# Line 133  Line 133 
133            ((items :initarg :items)            ((items :initarg :items)
134             (item :initarg :item)))             (item :initarg :item)))
135    
136       (add-rule (grammar-rule (,name -> ()       (add-html-rule (,name -> ()
137                                      (make-instance ',empty-name)))                             (make-instance ',empty-name)))
138                 *html-grammar*)  
139         (add-html-rule (,name -> (,name ,item-name)
140       (add-rule (grammar-rule (,name -> (,name ,item-name)                             (make-instance ',nonempty-name
141                                      (make-instance ',nonempty-name                                :items ,name :item ,item-name)))
                                        :items ,name :item ,item-name)))  
                *html-grammar*)  
142    
143       (defmethod display-parse-tree ((entity ,empty-name) (syntax html-syntax) pane)       (defmethod display-parse-tree ((entity ,empty-name) (syntax html-syntax) pane)
144         (declare (ignore pane))         (declare (ignore pane))
# Line 151  Line 149 
149            (display-parse-tree items syntax pane)            (display-parse-tree items syntax pane)
150            (display-parse-tree item syntax pane)))))            (display-parse-tree item syntax pane)))))
151    
152    ;;;;;;;;;;;;;;; attributes
153    
154    (defclass html-attribute (html-nonterminal)
155      ((name :initarg :name)
156       (equals :initarg :equals)))
157    
158    (defmethod display-parse-tree :before ((entity html-attribute) (syntax html-syntax) pane)
159      (with-slots (name equals) entity
160         (display-parse-tree name syntax pane)
161         (display-parse-tree equals syntax pane)))
162    
163    ;;;;;;;;;;;;;;; lang attribute
164    
165    (defclass lang-attr (html-attribute)
166      ((lang :initarg :lang)))
167    
168    (add-html-rule (lang-attr -> ((name word (word-is name "lang"))
169                                  (equals delimiter (and (= (end-offset name) (start-offset equals))
170                                                         (word-is equals "=")))
171                                  (lang word (and (= (end-offset equals) (start-offset lang))
172                                                  (= (- (end-offset lang) (start-offset lang))
173                                                     2))))
174                              :name name :equals equals :lang lang))
175    
176    (defmethod display-parse-tree ((entity lang-attr) (syntax html-syntax) pane)
177      (with-slots (lang) entity
178         (display-parse-tree lang syntax pane)))
179    
180    ;;;;;;;;;;;;;;; dir attribute
181    
182    (defclass dir-attr (html-attribute)
183      ((dir :initarg :dir)))
184    
185    (add-html-rule (dir-attr -> ((name word (word-is name "dir"))
186                                 (equals delimiter (and (= (end-offset name) (start-offset equals))
187                                                        (word-is equals "=")))
188                                 (dir word (and (= (end-offset equals) (start-offset dir))
189                                                (or (word-is dir "rtl")
190                                                    (word-is dir "ltr")))))
191                             :name name :equals equals :dir dir))
192    
193    (defmethod display-parse-tree ((entity dir-attr) (syntax html-syntax) pane)
194      (with-slots (dir) entity
195         (display-parse-tree dir syntax pane)))
196    
197    
198    ;;;;;;;;;;;;;;; <html>-tag
199    
200    (defclass <html>-attribute (html-nonterminal)
201      ((attribute :initarg :attribute)))
202    
203    (defmethod display-parse-tree ((entity <html>-attribute) (syntax html-syntax) pane)
204      (with-slots (attribute) entity
205         (display-parse-tree attribute syntax pane)))
206    
207    (add-html-rule (<html>-attribute -> (lang-attr) :attribute lang-attr))
208    (add-html-rule (<html>-attribute -> (dir-attr) :attribute dir-attr))
209    
210    (define-list <html>-attributes empty-<html>-attribute nonempty-<html>-attribute <html>-attribute)
211    
212    (defclass <html> (html-tag)
213      ((start :initarg :start)
214       (name :initarg :name)
215       (attributes :initarg :attributes)
216       (end :initarg :end)))
217    
218    (add-html-rule (<html> -> (tag-start
219                               (word (and (= (end-offset tag-start) (start-offset word))
220                                          (word-is word "html")))
221                               <html>-attributes
222                               tag-end)
223                           :start tag-start :name word :attributes <html>-attributes :end tag-end))
224    
225    (defmethod display-parse-tree ((entity <html>) (syntax html-syntax) pane)
226      (with-slots (start name attributes end) entity
227        (display-parse-tree start syntax pane)
228        (display-parse-tree name syntax pane)
229        (display-parse-tree attributes syntax pane)
230        (display-parse-tree end syntax pane)))
231    
232    (define-end-tag </html> "html")
233    
234  ;;;;;;;;;;;;;;; title-item, title-items  ;;;;;;;;;;;;;;; title-item, title-items
235    
236  (defclass title-item (html-nonterminal)  (defclass title-item (html-nonterminal)
237    ((item :initarg :item)))    ((item :initarg :item)))
238    
239  (add-rule (grammar-rule (title-item -> (word) :item word)) *html-grammar*)  (add-html-rule (title-item -> (word) :item word))
240  (add-rule (grammar-rule (title-item -> (delimiter) :item delimiter)) *html-grammar*)  (add-html-rule (title-item -> (delimiter) :item delimiter))
241    
242  (defmethod display-parse-tree ((entity title-item) (syntax html-syntax) pane)  (defmethod display-parse-tree ((entity title-item) (syntax html-syntax) pane)
243    (with-slots (item) entity    (with-slots (item) entity
# Line 172  Line 252 
252     (items :initarg :items)     (items :initarg :items)
253     (</title> :initarg :</title>)))     (</title> :initarg :</title>)))
254    
255  (add-rule (grammar-rule (title -> (<title> title-items </title>)  (add-html-rule (title -> (<title> title-items </title>)
256                                 :<title> <title> :items title-items :</title> </title>))                        :<title> <title> :items title-items :</title> </title>))
           *html-grammar*)  
257    
258  (defmethod display-parse-tree ((entity title) (syntax html-syntax) pane)  (defmethod display-parse-tree ((entity title) (syntax html-syntax) pane)
259    (with-slots (<title> items </title>) entity    (with-slots (<title> items </title>) entity
# Line 188  Line 267 
267  (defclass body-item (html-nonterminal)  (defclass body-item (html-nonterminal)
268    ((item :initarg :item)))    ((item :initarg :item)))
269    
270  (add-rule (grammar-rule (body-item -> (word) :item word)) *html-grammar*)  (add-html-rule (body-item -> (word) :item word))
271  (add-rule (grammar-rule (body-item -> (delimiter) :item delimiter)) *html-grammar*)  (add-html-rule (body-item -> (delimiter) :item delimiter))
272  (add-rule (grammar-rule (body-item -> (a) :item a)) *html-grammar*)  (add-html-rule (body-item -> (a) :item a))
273    
274  (defmethod display-parse-tree ((entity body-item) (syntax html-syntax) pane)  (defmethod display-parse-tree ((entity body-item) (syntax html-syntax) pane)
275    (with-slots (item) entity    (with-slots (item) entity
# Line 205  Line 284 
284     (items :initarg :items)     (items :initarg :items)
285     (</body> :initarg :</body>)))     (</body> :initarg :</body>)))
286    
287  (add-rule (grammar-rule (body -> (<body> body-items </body>)  (add-html-rule (body -> (<body> body-items </body>)
288                                :<body> <body> :items body-items :</body> </body>))                       :<body> <body> :items body-items :</body> </body>))
           *html-grammar*)  
289    
290  (defmethod display-parse-tree ((entity body) (syntax html-syntax) pane)  (defmethod display-parse-tree ((entity body) (syntax html-syntax) pane)
291    (with-slots (<body> items </body>) entity    (with-slots (<body> items </body>) entity
# Line 220  Line 298 
298  (defclass a-tag-item (html-nonterminal)  (defclass a-tag-item (html-nonterminal)
299    ((item :initarg :item)))    ((item :initarg :item)))
300    
301  (add-rule (grammar-rule (a-tag-item -> (word) :item word)) *html-grammar*)  (add-html-rule (a-tag-item -> (word) :item word))
302  (add-rule (grammar-rule (a-tag-item -> (delimiter) :item delimiter)) *html-grammar*)  (add-html-rule (a-tag-item -> (delimiter) :item delimiter))
303    
304  (defmethod display-parse-tree ((entity a-tag-item) (syntax html-syntax) pane)  (defmethod display-parse-tree ((entity a-tag-item) (syntax html-syntax) pane)
305    (with-slots (item) entity    (with-slots (item) entity
# Line 235  Line 313 
313     (items :initarg :items)     (items :initarg :items)
314     (end :initarg :end)))     (end :initarg :end)))
315    
316  (add-rule (grammar-rule (<a> -> (tag-start  (add-html-rule (<a> -> (tag-start
317                                   (word (and (= (end-offset tag-start) (start-offset word))                                   (word (and (= (end-offset tag-start) (start-offset word))
318                                              (word-is word "a")))                                              (word-is word "a")))
319                                   a-tag-items                                   a-tag-items
320                                   tag-end)                                   tag-end)
321                               :start tag-start :name word :items a-tag-items :end tag-end))                      :start tag-start :name word :items a-tag-items :end tag-end))
           *html-grammar*)  
322    
323  (defmethod display-parse-tree ((entity <a>) (syntax html-syntax) pane)  (defmethod display-parse-tree ((entity <a>) (syntax html-syntax) pane)
324    (with-slots (start name items end) entity    (with-slots (start name items end) entity
# Line 257  Line 334 
334     (items :initarg :items)     (items :initarg :items)
335     (</a> :initarg :</a>)))     (</a> :initarg :</a>)))
336    
337  (add-rule (grammar-rule (a -> (<a> body-items </a>)  (add-html-rule (a -> (<a> body-items </a>)
338                             :<a> <a> :items body-items :</a> </a>))                    :<a> <a> :items body-items :</a> </a>))
           *html-grammar*)  
339    
340  (defmethod display-parse-tree ((entity a) (syntax html-syntax) pane)  (defmethod display-parse-tree ((entity a) (syntax html-syntax) pane)
341    (with-slots (<a> items </a>) entity    (with-slots (<a> items </a>) entity
# Line 274  Line 350 
350     (title :initarg :title)     (title :initarg :title)
351     (</head> :initarg :</head>)))     (</head> :initarg :</head>)))
352    
353  (add-rule (grammar-rule (head -> (<head> title </head>)  (add-html-rule (head -> (<head> title </head>)
354                                :<head> <head> :title title :</head> </head>))                       :<head> <head> :title title :</head> </head>))
           *html-grammar*)  
355    
356  (defmethod display-parse-tree ((entity head) (syntax html-syntax) pane)  (defmethod display-parse-tree ((entity head) (syntax html-syntax) pane)
357    (with-slots (<head> title </head>) entity    (with-slots (<head> title </head>) entity
# Line 292  Line 367 
367     (body :initarg :body)     (body :initarg :body)
368     (</html> :initarg :</html>)))     (</html> :initarg :</html>)))
369    
370  (add-rule (grammar-rule (html -> (<html> head body </html>)  (add-html-rule (html -> (<html> head body </html>)
371                                :<html> <html> :head head :body body :</html> </html>))                       :<html> <html> :head head :body body :</html> </html>))
           *html-grammar*)  
372    
373  (defmethod display-parse-tree ((entity html) (syntax html-syntax) pane)  (defmethod display-parse-tree ((entity html) (syntax html-syntax) pane)
374    (with-slots (<html> head body </html>) entity    (with-slots (<html> head body </html>) entity

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21

  ViewVC Help
Powered by ViewVC 1.1.5