/[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.15 by rstrandh, Tue Mar 15 12:51:39 2005 UTC revision 1.16 by rstrandh, Wed Mar 16 06:12:09 2005 UTC
# Line 1  Line 1 
1  ;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-  ;;; -*- Mode: Lisp; Package: CLIMACS-HTML-SYNTAX -*-
2    
3  ;;;  (c) copyright 2005 by  ;;;  (c) copyright 2005 by
4  ;;;           Robert Strandh (strandh@labri.fr)  ;;;           Robert Strandh (strandh@labri.fr)
# Line 57  Line 57 
57  (defclass html-words (html-balanced)  (defclass html-words (html-balanced)
58    ((words :initarg :words)))    ((words :initarg :words)))
59    
 (defclass title (html-words) ())  
 (defclass body (html-words) ())  
60  (defclass h1 (html-words) ())  (defclass h1 (html-words) ())
61  (defclass h2 (html-words) ())  (defclass h2 (html-words) ())
62  (defclass h3 (html-words) ())  (defclass h3 (html-words) ())
# Line 70  Line 68 
68    
69  (defclass html-tag (html-token) ())  (defclass html-tag (html-token) ())
70    
71  (defclass <html> (html-tag) () (:default-initargs :size 6))  (defclass <html> (html-tag) ())
72  (defclass </html> (html-tag) ()(:default-initargs :size 7))  (defclass </html> (html-tag) ())
73  (defclass <head> (html-tag) () (:default-initargs :size 6))  (defclass <head> (html-tag) ())
74  (defclass </head> (html-tag) () (:default-initargs :size 7))  (defclass </head> (html-tag) ())
75  (defclass <title> (html-tag) () (:default-initargs :size 7))  (defclass <title> (html-tag) ())
76  (defclass </title> (html-tag) () (:default-initargs :size 8))  (defclass </title> (html-tag) ())
77  (defclass <body> (html-tag) () (:default-initargs :size 6))  (defclass <body> (html-tag) ())
78  (defclass </body> (html-tag) () (:default-initargs :size 7))  (defclass </body> (html-tag) ())
79  (defclass <h1> (html-tag) () (:default-initargs :size 4))  (defclass <h1> (html-tag) ())
80  (defclass </h1> (html-tag) () (:default-initargs :size 5))  (defclass </h1> (html-tag) ())
81  (defclass <h2> (html-tag) () (:default-initargs :size 4))  (defclass <h2> (html-tag) ())
82  (defclass </h2> (html-tag) () (:default-initargs :size 5))  (defclass </h2> (html-tag) ())
83  (defclass <h3> (html-tag) () (:default-initargs :size 4))  (defclass <h3> (html-tag) ())
84  (defclass </h3> (html-tag) () (:default-initargs :size 5))  (defclass </h3> (html-tag) ())
85  (defclass <p> (html-tag) () (:default-initargs :size 3))  (defclass <p> (html-tag) ())
86  (defclass </p> (html-tag) () (:default-initargs :size 4))  (defclass </p> (html-tag) ())
87  (defclass <ul> (html-tag) () (:default-initargs :size 4))  (defclass <ul> (html-tag) ())
88  (defclass </ul> (html-tag) () (:default-initargs :size 5))  (defclass </ul> (html-tag) ())
89  (defclass <li> (html-tag) () (:default-initargs :size 4))  (defclass <li> (html-tag) ())
90  (defclass </li> (html-tag) () (:default-initargs :size 5))  (defclass </li> (html-tag) ())
91  (defclass <a> (html-tag)  (defclass <a> (html-tag)
92    ((start :initarg :start)    ((start :initarg :start)
93     (word :initarg :word)     (word :initarg :word)
94     (words :initarg :words)     (words :initarg :words)
95     (end :initarg :end)))     (end :initarg :end)))
96  (defclass </a> (html-tag) () (:default-initargs :size 4))  (defclass </a> (html-tag) ())
97    
98    
99  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 147  Line 145 
145      (<html> -> (tag-start      (<html> -> (tag-start
146                  (word (and (= (end-offset tag-start) (start-offset word))                  (word (and (= (end-offset tag-start) (start-offset word))
147                             (word-is word "html")))                             (word-is word "html")))
148                  (tag-end (= (end-offset word) (start-offset tag-end))))                  (tag-end (= (end-offset word) (start-offset tag-end)))))
             :start-mark (start-mark tag-start))  
149      (</html> -> (tag-start      (</html> -> (tag-start
150                   (slash (= (end-offset tag-start) (start-offset slash)))                   (slash (= (end-offset tag-start) (start-offset slash)))
151                   (word (and (= (end-offset slash) (start-offset word))                   (word (and (= (end-offset slash) (start-offset word))
152                              (word-is word "html")))                              (word-is word "html")))
153                   (tag-end (= (end-offset word) (start-offset tag-end))))                   (tag-end (= (end-offset word) (start-offset tag-end)))))
              :start-mark (start-mark tag-start))  
154      (<head> -> (tag-start      (<head> -> (tag-start
155                  (word (and (= (end-offset tag-start) (start-offset word))                  (word (and (= (end-offset tag-start) (start-offset word))
156                             (word-is word "head")))                             (word-is word "head")))
157                  (tag-end (= (end-offset word) (start-offset tag-end))))                  (tag-end (= (end-offset word) (start-offset tag-end)))))
             :start-mark (start-mark tag-start))  
158      (</head> -> (tag-start      (</head> -> (tag-start
159                   (slash (= (end-offset tag-start) (start-offset slash)))                   (slash (= (end-offset tag-start) (start-offset slash)))
160                   (word (and (= (end-offset slash) (start-offset word))                   (word (and (= (end-offset slash) (start-offset word))
161                              (word-is word "head")))                              (word-is word "head")))
162                   (tag-end (= (end-offset word) (start-offset tag-end))))                   (tag-end (= (end-offset word) (start-offset tag-end)))))
              :start-mark (start-mark tag-start))  
163      (<title> -> (tag-start      (<title> -> (tag-start
164                   (word (and (= (end-offset tag-start) (start-offset word))                   (word (and (= (end-offset tag-start) (start-offset word))
165                              (word-is word "title")))                              (word-is word "title")))
166                   (tag-end (= (end-offset word) (start-offset tag-end))))                   (tag-end (= (end-offset word) (start-offset tag-end)))))
              :start-mark (start-mark tag-start))  
167      (</title> -> (tag-start      (</title> -> (tag-start
168                    (slash (= (end-offset tag-start) (start-offset slash)))                    (slash (= (end-offset tag-start) (start-offset slash)))
169                    (word (and (= (end-offset slash) (start-offset word))                    (word (and (= (end-offset slash) (start-offset word))
170                               (word-is word "title")))                               (word-is word "title")))
171                    (tag-end (= (end-offset word) (start-offset tag-end))))                    (tag-end (= (end-offset word) (start-offset tag-end)))))
               :start-mark (start-mark tag-start))  
172      (<body> -> (tag-start      (<body> -> (tag-start
173                  (word (and (= (end-offset tag-start) (start-offset word))                  (word (and (= (end-offset tag-start) (start-offset word))
174                             (word-is word "body")))                             (word-is word "body")))
175                  (tag-end (= (end-offset word) (start-offset tag-end))))                  (tag-end (= (end-offset word) (start-offset tag-end)))))
             :start-mark (start-mark tag-start))  
176      (</body> -> (tag-start      (</body> -> (tag-start
177                   (slash (= (end-offset tag-start) (start-offset slash)))                   (slash (= (end-offset tag-start) (start-offset slash)))
178                   (word (and (= (end-offset slash) (start-offset word))                   (word (and (= (end-offset slash) (start-offset word))
179                              (word-is word "body")))                              (word-is word "body")))
180                   (tag-end (= (end-offset word) (start-offset tag-end))))                   (tag-end (= (end-offset word) (start-offset tag-end)))))
              :start-mark (start-mark tag-start))  
181      (<a> -> (tag-start      (<a> -> (tag-start
182               (word (and (= (end-offset tag-start) (start-offset word))               (word (and (= (end-offset tag-start) (start-offset word))
183                          (word-is word "a")))                          (word-is word "a")))
184               words               words
185               tag-end)               tag-end)
          :start-mark (start-mark tag-start)  
          :size (- (end-offset tag-end) (start-offset tag-start))  
186           :start tag-start :word word :words words :end tag-end)           :start tag-start :word word :words words :end tag-end)
187      (</a> -> (tag-start      (</a> -> (tag-start
188                (slash (= (end-offset tag-start) (start-offset slash)))                (slash (= (end-offset tag-start) (start-offset slash)))
189                (word (and (= (end-offset slash) (start-offset word))                (word (and (= (end-offset slash) (start-offset word))
190                           (word-is word "a")))                           (word-is word "a")))
191                (tag-end (= (end-offset word) (start-offset tag-end))))                (tag-end (= (end-offset word) (start-offset tag-end)))))
           :start-mark (start-mark tag-start))  
192      (html -> (<html> head body </html>)      (html -> (<html> head body </html>)
           :start-mark (start-mark <html>)  
           :size (- (end-offset </html>) (start-offset <html>))  
193            :start <html> :head head :body body :end </html>)            :start <html> :head head :body body :end </html>)
194      (head -> (<head> title </head>)      (head -> (<head> title </head>)
           :start-mark (start-mark <head>)  
           :size (- (end-offset </head>) (start-offset <head>))  
195            :start <head> :title title :end </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>)  
196      (a -> (<a> words </a>)      (a -> (<a> words </a>)
        :start-mark (start-mark <a>)  
        :size (- (end-offset </a>) (start-offset <a>))  
197         :start <a> :words words :end </a>)         :start <a> :words words :end </a>)
198      (words -> ()      (words -> ()
199             (make-instance 'empty-words :start-mark nil))             (make-instance 'empty-words))
200      (words -> (words word)      (words -> (words word)
201             (make-instance 'nonempty-words             (make-instance 'nonempty-words
202                :start-mark (or (start-mark words) (start-mark word))                :words words :word 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)))))  
203    
204    
205    (defclass title-item (html-nonterminal)
206      ((item :initarg :item)))
207    
208    (add-rule (grammar-rule (title-item -> (word) :item word)) *html-grammar*)
209    (add-rule (grammar-rule (title-item -> (delimiter) :item delimiter)) *html-grammar*)
210    
211    (defmethod display-parse-tree ((entity title-item) (syntax html-syntax) pane)
212      (with-slots (item) entity
213         (display-parse-tree item syntax pane)))
214    
215    ;;;;;;;;;;;;;;; title-items
216    
217    (defclass title-items (html-nonterminal) ())
218    (defclass empty-title-items (title-items) ())
219    
220    (defclass nonempty-title-items (title-items)
221      ((items :initarg :items)
222       (item :initarg :item)))
223    
224    (add-rule (grammar-rule (title-items -> ()
225                                         (make-instance 'empty-title-items)))
226              *html-grammar*)
227    
228    (add-rule (grammar-rule (title-items -> (title-items title-item)
229                                         (make-instance 'nonempty-title-items
230                                            :items title-items :item title-item)))
231              *html-grammar*)
232    
233    (defmethod display-parse-tree ((entity empty-title-items) (syntax html-syntax) pane)
234      (declare (ignore pane))
235      nil)
236    
237    (defmethod display-parse-tree :around ((entity empty-title-items) syntax pane)
238      (declare (ignore syntax pane))
239      nil)
240    
241    (defmethod display-parse-tree ((entity nonempty-title-items) (syntax html-syntax) pane)
242      (with-slots (items item) entity
243         (display-parse-tree items syntax pane)
244         (display-parse-tree item syntax pane)))
245    
246    ;;;;;;;;;;;;;;; title
247    
248    (defclass title (html-nonterminal)
249      ((<title> :initarg :<title>)
250       (items :initarg :items)
251       (</title> :initarg :</title>)))
252    
253    (add-rule (grammar-rule (title -> (<title> title-items </title>)
254                                   :<title> <title> :items title-items :</title> </title>))
255              *html-grammar*)
256    
257    (defmethod display-parse-tree ((entity title) (syntax html-syntax) pane)
258      (with-slots (<title> items </title>) entity
259         (display-parse-tree <title> syntax pane)
260         (with-text-face (pane :bold)
261           (display-parse-tree items syntax pane))
262         (display-parse-tree </title> syntax pane)))
263    
264    ;;;;;;;;;;;;;;; body-item
265    
266    (defclass body-item (html-nonterminal)
267      ((item :initarg :item)))
268    
269    (add-rule (grammar-rule (body-item -> (word) :item word)) *html-grammar*)
270    (add-rule (grammar-rule (body-item -> (delimiter) :item delimiter)) *html-grammar*)
271    (add-rule (grammar-rule (body-item -> (a) :item a)) *html-grammar*)
272    
273    (defmethod display-parse-tree ((entity body-item) (syntax html-syntax) pane)
274      (with-slots (item) entity
275         (display-parse-tree item syntax pane)))
276    
277    ;;;;;;;;;;;;;;; body-items
278    
279    (defclass body-items (html-nonterminal) ())
280    (defclass empty-body-items (body-items) ())
281    
282    (defclass nonempty-body-items (body-items)
283      ((items :initarg :items)
284       (item :initarg :item)))
285    
286    (add-rule (grammar-rule (body-items -> ()
287                                        (make-instance 'empty-body-items)))
288              *html-grammar*)
289    
290    (add-rule (grammar-rule (body-items -> (body-items body-item)
291                                        (make-instance 'nonempty-body-items
292                                           :items body-items :item body-item)))
293              *html-grammar*)
294    
295    (defmethod display-parse-tree ((entity empty-body-items) (syntax html-syntax) pane)
296      (declare (ignore pane))
297      nil)
298    
299    (defmethod display-parse-tree :around ((entity empty-body-items) syntax pane)
300      (declare (ignore syntax pane))
301      nil)
302    
303    (defmethod display-parse-tree ((entity nonempty-body-items) (syntax html-syntax) pane)
304      (with-slots (items item) entity
305         (display-parse-tree items syntax pane)
306         (display-parse-tree item syntax pane)))
307    
308    ;;;;;;;;;;;;;;; body
309    
310    (defclass body (html-nonterminal)
311      ((<body> :initarg :<body>)
312       (items :initarg :items)
313       (</body> :initarg :</body>)))
314    
315    (add-rule (grammar-rule (body -> (<body> body-items </body>)
316                                  :<body> <body> :items body-items :</body> </body>))
317              *html-grammar*)
318    
319    (defmethod display-parse-tree ((entity body) (syntax html-syntax) pane)
320      (with-slots (<body> items </body>) entity
321         (display-parse-tree <body> syntax pane)
322         (display-parse-tree items syntax pane)
323         (display-parse-tree </body> syntax pane)))
324    
325  (defmethod initialize-instance :after ((syntax html-syntax) &rest args)  (defmethod initialize-instance :after ((syntax html-syntax) &rest args)
326    (declare (ignore args))    (declare (ignore args))
327    (with-slots (parser lexer buffer) syntax    (with-slots (parser lexer buffer) syntax
# Line 348  Line 433 
433    (with-slots (end) entity    (with-slots (end) entity
434       (display-parse-tree end syntax pane)))       (display-parse-tree end syntax pane)))
435    
 (defmethod display-parse-tree :around ((entity title) (syntax html-syntax) pane)  
   (with-text-face (pane :bold)  
     (call-next-method)))  
   
436  (defmethod display-parse-tree ((entity html-words) (syntax html-syntax) pane)  (defmethod display-parse-tree ((entity html-words) (syntax html-syntax) pane)
437    (with-slots (words) entity    (with-slots (words) entity
438       (display-parse-tree words syntax pane)))       (display-parse-tree words syntax pane)))

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16

  ViewVC Help
Powered by ViewVC 1.1.5