Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv16497
Modified Files: html-syntax.lisp Log Message: recognize the <a> and </a> tags
Date: Fri Mar 11 11:25:58 2005 Author: rstrandh
Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.9 climacs/html-syntax.lisp:1.10 --- climacs/html-syntax.lisp:1.9 Fri Mar 11 08:03:31 2005 +++ climacs/html-syntax.lisp Fri Mar 11 11:25:58 2005 @@ -82,6 +82,7 @@ (defclass h1 (html-words) ()) (defclass h2 (html-words) ()) (defclass h3 (html-words) ()) +(defclass a (html-words) ()) (defclass para (html-words) ())
(defclass html-token (html-sym) @@ -109,6 +110,13 @@ (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 <a> (html-tag) + ((start :initarg :start) + (word :initarg :word) + (words :initarg :words) + (end :initarg :end))) +(defclass </a> (html-tag) () (:default-initargs :size 4)) +
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -205,6 +213,20 @@ (word-is word "body"))) (tag-end (= (end-offset word) (start-offset tag-end)))) :start-mark (start-mark tag-start)) + (<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)) (html -> (<html> head body </html>) :start-mark (start-mark <html>) :size (- (end-offset </html>) (start-offset <html>)) @@ -221,13 +243,24 @@ :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)) (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)))) + :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))))) +
(defmethod initialize-instance :after ((syntax html-syntax) &rest args) (declare (ignore args)) @@ -311,6 +344,7 @@ (#\Newline (terpri pane) (setf (aref *cursor-positions* (incf *current-line*)) (multiple-value-bind (x y) (stream-cursor-position pane) + (declare (ignore x)) y))) (#\Space (stream-increment-cursor-position pane space-width 0)) @@ -390,6 +424,13 @@ (with-slots (title) entity (display-parse-tree title syntax pane)))
+(defmethod display-parse-tree ((entity <a>) (syntax html-syntax) pane) + (with-slots (start word words end) entity + (display-parse-tree start syntax pane) + (display-parse-tree word syntax pane) + (display-parse-tree words syntax pane) + (display-parse-tree end syntax pane))) + (defgeneric display-parse-stack (symbol stack syntax pane))
(defmethod display-parse-stack (symbol stack (syntax html-syntax) pane) @@ -452,4 +493,3 @@ (+ cursor-x 2) (+ cursor-y (* 0.8 height)) :ink (if current-p +red+ +blue+)))))) - \ No newline at end of file