April 2005 - climacs-cvs@common-lisp.net - mailman3.common-lisp.net

[climacs-cvs] CVS update: climacs/syntax.lisp
by rstrandh＠common-lisp.net 15 Apr '05

15 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv25598 Modified Files: syntax.lisp Log Message: Removed complete-item class which is no longer used. Date: Fri Apr 15 08:12:27 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.45 climacs/syntax.lisp:1.46 --- climacs/syntax.lisp:1.45 Fri Apr 15 07:48:02 2005 +++ climacs/syntax.lisp Fri Apr 15 08:12:27 2005 @@ -299,12 +299,6 @@ do (format stream " ~a" (aref (symbols (rule item)) i))) (format stream "]")) -(defclass complete-item (rule-item) - ((parse-tree :initarg :parse-tree :reader parse-tree))) - -(defmethod print-object ((item complete-item) stream) - (format stream "[~a]" (parse-tree item))) - (defun derive-and-handle-item (prev-item parse-tree orig-state to-state) (let ((remaining (funcall (suffix prev-item) parse-tree))) (cond ((null remaining)

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by rstrandh＠common-lisp.net 15 Apr '05

15 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv24216 Modified Files: syntax.lisp Log Message: More performance improvements: Renamed handle-item so that it is now called handle-incomplete-item, because it is never called with a complete item. Made handle-incomplete-item an ordinary function to avoid generic function dispatch. Renamed derive-item so that it is now called derive-and-handle-item because it now both derives and handles the item. Date: Fri Apr 15 07:48:02 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.44 climacs/syntax.lisp:1.45 --- climacs/syntax.lisp:1.44 Fri Apr 15 07:22:58 2005 +++ climacs/syntax.lisp Fri Apr 15 07:48:02 2005 @@ -305,18 +305,19 @@ (defmethod print-object ((item complete-item) stream) (format stream "[~a]" (parse-tree item))) -(defun derive-item (prev-item parse-tree) +(defun derive-and-handle-item (prev-item parse-tree orig-state to-state) (let ((remaining (funcall (suffix prev-item) parse-tree))) (cond ((null remaining) nil) ((functionp remaining) - (make-instance 'incomplete-item - :orig-state (orig-state prev-item) - :predicted-from (predicted-from prev-item) - :rule (rule prev-item) - :dot-position (1+ (dot-position prev-item)) - :parse-trees (cons parse-tree (parse-trees prev-item)) - :suffix remaining)) + (handle-incomplete-item (make-instance 'incomplete-item + :orig-state (orig-state prev-item) + :predicted-from (predicted-from prev-item) + :rule (rule prev-item) + :dot-position (1+ (dot-position prev-item)) + :parse-trees (cons parse-tree (parse-trees prev-item)) + :suffix remaining) + orig-state to-state)) (t (let* ((parse-trees (cons parse-tree (parse-trees prev-item))) (start (find-if-not #'null parse-trees @@ -326,9 +327,7 @@ (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))))))) + (potentially-handle-parse-tree remaining orig-state to-state))))))) (defun item-equal (item1 item2) (declare (optimize speed)) @@ -363,16 +362,12 @@ do (funcall fun key incomplete-item))) (incomplete-items state))) -(defgeneric handle-item (item orig-state to-state)) - (defun potentially-handle-parse-tree (parse-tree from-state to-state) (let ((parse-trees (parse-trees to-state))) (flet ((handle-parse-tree () (map-over-incomplete-items from-state (lambda (orig-state incomplete-item) - (let ((new-item (derive-item incomplete-item parse-tree))) - (when new-item - (handle-item new-item orig-state to-state))))))) + (derive-and-handle-item incomplete-item parse-tree orig-state to-state))))) (cond ((find parse-tree (gethash from-state parse-trees) :test #'parse-tree-better) (setf (gethash from-state parse-trees) @@ -386,7 +381,7 @@ (t (push parse-tree (gethash from-state parse-trees)) (handle-parse-tree)))))) -(defmethod handle-item ((item incomplete-item) orig-state to-state) +(defun handle-incomplete-item (item orig-state to-state) (declare (optimize speed)) (cond ((find item (the list (gethash orig-state (incomplete-items to-state))) :test #'item-equal) @@ -396,21 +391,17 @@ (dolist (rule (gethash (aref (symbols (rule item)) (dot-position item)) (hash (parser-grammar (parser to-state))))) (if (functionp (right-hand-side rule)) - (handle-item (make-instance 'incomplete-item - :orig-state to-state - :predicted-from item - :rule rule - :dot-position 0 - :suffix (right-hand-side rule)) - to-state to-state) + (handle-incomplete-item (make-instance 'incomplete-item + :orig-state to-state + :predicted-from item + :rule rule + :dot-position 0 + :suffix (right-hand-side rule)) + to-state to-state) (potentially-handle-parse-tree (right-hand-side rule) to-state to-state))) (loop for parse-tree in (gethash to-state (parse-trees to-state)) - do (let ((new-item (derive-item item parse-tree))) - (when new-item (handle-item new-item to-state to-state))))))) + do (derive-and-handle-item item parse-tree to-state to-state))))) -(defmethod handle-item ((item complete-item) orig-state to-state) - (potentially-handle-parse-tree (parse-tree item) orig-state to-state)) - (defmethod initialize-instance :after ((parser parser) &rest args) (declare (ignore args)) (with-slots (grammar initial-state) parser @@ -421,13 +412,13 @@ (or (subtypep (target parser) sym) (subtypep sym (target parser)))) (if (functionp (right-hand-side rule)) - (handle-item (make-instance 'incomplete-item - :orig-state initial-state - :predicted-from nil - :rule rule - :dot-position 0 - :suffix (right-hand-side rule)) - initial-state initial-state) + (handle-incomplete-item (make-instance 'incomplete-item + :orig-state initial-state + :predicted-from nil + :rule rule + :dot-position 0 + :suffix (right-hand-side rule)) + initial-state initial-state) (potentially-handle-parse-tree (right-hand-side rule) initial-state initial-state))))))

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by rstrandh＠common-lisp.net 15 Apr '05

15 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv22978 Modified Files: syntax.lisp Log Message: Avoid some more generic function dispatch by calling potentially-handle-parse-tree directly when we know that it is a complete item. Also avoid creating the complete item, thus cutting down on consing. Date: Fri Apr 15 07:22:59 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.43 climacs/syntax.lisp:1.44 --- climacs/syntax.lisp:1.43 Fri Apr 15 07:02:53 2005 +++ climacs/syntax.lisp Fri Apr 15 07:22:58 2005 @@ -305,9 +305,7 @@ (defmethod print-object ((item complete-item) stream) (format stream "[~a]" (parse-tree item))) -(defgeneric derive-item (prev-item parse-tree)) - -(defmethod derive-item ((prev-item incomplete-item) parse-tree) +(defun derive-item (prev-item parse-tree) (let ((remaining (funcall (suffix prev-item) parse-tree))) (cond ((null remaining) nil) @@ -397,16 +395,15 @@ (push item (gethash orig-state (incomplete-items to-state))) (dolist (rule (gethash (aref (symbols (rule item)) (dot-position item)) (hash (parser-grammar (parser to-state))))) - (handle-item (if (functionp (right-hand-side rule)) - (make-instance 'incomplete-item - :orig-state to-state - :predicted-from item - :rule rule - :dot-position 0 - :suffix (right-hand-side rule)) - (make-instance 'complete-item - :parse-tree (right-hand-side rule))) - to-state to-state)) + (if (functionp (right-hand-side rule)) + (handle-item (make-instance 'incomplete-item + :orig-state to-state + :predicted-from item + :rule rule + :dot-position 0 + :suffix (right-hand-side rule)) + to-state to-state) + (potentially-handle-parse-tree (right-hand-side rule) to-state to-state))) (loop for parse-tree in (gethash to-state (parse-trees to-state)) do (let ((new-item (derive-item item parse-tree))) (when new-item (handle-item new-item to-state to-state))))))) @@ -423,16 +420,16 @@ do (when (let ((sym (left-hand-side rule))) (or (subtypep (target parser) sym) (subtypep sym (target parser)))) - (handle-item (if (functionp (right-hand-side rule)) - (make-instance 'incomplete-item + (if (functionp (right-hand-side rule)) + (handle-item (make-instance 'incomplete-item :orig-state initial-state :predicted-from nil :rule rule :dot-position 0 :suffix (right-hand-side rule)) - (make-instance 'complete-item - :parse-tree (right-hand-side rule))) - initial-state initial-state))))) + initial-state initial-state) + (potentially-handle-parse-tree + (right-hand-side rule) initial-state initial-state)))))) (defun state-contains-target-p (state) (loop with target = (target (parser state))

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by rstrandh＠common-lisp.net 15 Apr '05

15 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv22111 Modified Files: syntax.lisp Log Message: Performance improvement of the Earley parser. handle-item is no longer called on nil items which represented the vast majority of calls. Date: Fri Apr 15 07:02:53 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.42 climacs/syntax.lisp:1.43 --- climacs/syntax.lisp:1.42 Thu Apr 14 10:13:18 2005 +++ climacs/syntax.lisp Fri Apr 15 07:02:53 2005 @@ -372,8 +372,9 @@ (flet ((handle-parse-tree () (map-over-incomplete-items from-state (lambda (orig-state incomplete-item) - (handle-item (derive-item incomplete-item parse-tree) - orig-state to-state))))) + (let ((new-item (derive-item incomplete-item parse-tree))) + (when new-item + (handle-item new-item orig-state to-state))))))) (cond ((find parse-tree (gethash from-state parse-trees) :test #'parse-tree-better) (setf (gethash from-state parse-trees) @@ -387,9 +388,6 @@ (t (push parse-tree (gethash from-state parse-trees)) (handle-parse-tree)))))) -(defmethod handle-item ((item (eql nil)) orig-state to-state) - nil) - (defmethod handle-item ((item incomplete-item) orig-state to-state) (declare (optimize speed)) (cond ((find item (the list (gethash orig-state (incomplete-items to-state))) @@ -410,8 +408,8 @@ :parse-tree (right-hand-side rule))) to-state to-state)) (loop for parse-tree in (gethash to-state (parse-trees to-state)) - do (handle-item (derive-item item parse-tree) - to-state to-state))))) + do (let ((new-item (derive-item item parse-tree))) + (when new-item (handle-item new-item to-state to-state))))))) (defmethod handle-item ((item complete-item) orig-state to-state) (potentially-handle-parse-tree (parse-tree item) orig-state to-state))

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by crhodes＠common-lisp.net 14 Apr '05

14 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv12616 Modified Files: syntax.lisp Log Message: slight improvement in speed to syntax.lisp (though not enough): Cache in the grammar which rules are applicable to which symbols. Make ITEM-EQUAL a regular function. A couple of folorn (optimize speed)s and type declarations, which don't actually help all that much. Date: Thu Apr 14 10:13:18 2005 Author: crhodes Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.41 climacs/syntax.lisp:1.42 --- climacs/syntax.lisp:1.41 Fri Mar 18 08:49:17 2005 +++ climacs/syntax.lisp Thu Apr 14 10:13:18 2005 @@ -207,7 +207,8 @@ (symbols :initarg :symbols :reader symbols))) (defclass grammar () - ((rules :initarg :rules :accessor rules))) + ((rules :initform nil :accessor rules) + (hash :initform (make-hash-table) :accessor hash))) (defmacro grammar-rule ((left-hand-side arrow arglist &body body)) (declare (ignore arrow)) @@ -245,14 +246,29 @@ (defmacro grammar (&body body) - `(make-instance 'grammar - :rules (list ,@(loop for rule in body - collect `(grammar-rule ,rule))))) + (let ((rule (gensym "RULE")) + (rules (gensym "RULES")) + (result (gensym "RESULT"))) + `(let* ((,rules (list ,@(loop for rule in body + collect `(grammar-rule ,rule)))) + (,result (make-instance 'grammar))) + (dolist (,rule ,rules ,result) + (add-rule ,rule ,result))))) (defgeneric add-rule (rule grammar)) (defmethod add-rule (rule (grammar grammar)) - (push rule (rules grammar))) + (push rule (rules grammar)) + (clrhash (hash grammar)) + (let (rhs-symbols) + (dolist (rule (rules grammar)) + (setf rhs-symbols (union rhs-symbols (coerce (symbols rule) 'list)))) + (dolist (rule (rules grammar)) + (let ((lhs-symbol (left-hand-side rule))) + (dolist (rhs-symbol rhs-symbols) + (when (or (subtypep lhs-symbol rhs-symbol) + (subtypep rhs-symbol lhs-symbol)) + (pushnew rule (gethash rhs-symbol (hash grammar))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -316,19 +332,18 @@ :parse-tree remaining :parse-trees parse-trees))))))) -(defgeneric item-equal (item1 item2)) - -(defgeneric parse-tree-equal (tree1 tree2)) - -(defmethod item-equal ((item1 rule-item) (item2 rule-item)) - nil) - -(defmethod item-equal ((item1 incomplete-item) (item2 incomplete-item)) +(defun item-equal (item1 item2) + (declare (optimize speed)) (and (eq (rule item1) (rule item2)) - (eq (length (parse-trees item1)) (length (parse-trees item2))) - (every #'parse-tree-equal (parse-trees item1) (parse-trees item2)))) + (do ((trees1 (parse-trees item1) (cdr trees1)) + (trees2 (parse-trees item2) (cdr trees2))) + ((and (null trees1) (null trees2)) t) + (when (or (null trees1) (null trees2)) + (return nil)) + (when (not (parse-tree-equal (car trees1) (car trees2))) + (return nil))))) -(defmethod parse-tree-equal (tree1 tree2) +(defun parse-tree-equal (tree1 tree2) (eq (class-of tree1) (class-of tree2))) (defgeneric parse-tree-better (tree1 tree2)) @@ -376,25 +391,24 @@ nil) (defmethod handle-item ((item incomplete-item) orig-state to-state) - (cond ((find item (gethash orig-state (incomplete-items to-state)) + (declare (optimize speed)) + (cond ((find item (the list (gethash orig-state (incomplete-items to-state))) :test #'item-equal) nil) (t (push item (gethash orig-state (incomplete-items to-state))) - (loop for rule in (rules (parser-grammar (parser to-state))) - do (when (let ((sym1 (aref (symbols (rule item)) (dot-position item))) - (sym2 (left-hand-side rule))) - (or (subtypep sym1 sym2) (subtypep sym2 sym1))) - (handle-item (if (functionp (right-hand-side rule)) - (make-instance 'incomplete-item - :orig-state to-state - :predicted-from item - :rule rule - :dot-position 0 - :suffix (right-hand-side rule)) - (make-instance 'complete-item - :parse-tree (right-hand-side rule))) - to-state to-state))) + (dolist (rule (gethash (aref (symbols (rule item)) (dot-position item)) + (hash (parser-grammar (parser to-state))))) + (handle-item (if (functionp (right-hand-side rule)) + (make-instance 'incomplete-item + :orig-state to-state + :predicted-from item + :rule rule + :dot-position 0 + :suffix (right-hand-side rule)) + (make-instance 'complete-item + :parse-tree (right-hand-side rule))) + to-state to-state)) (loop for parse-tree in (gethash to-state (parse-trees to-state)) do (handle-item (derive-item item parse-tree) to-state to-state)))))

1 0

[climacs-cvs] CVS update: climacs/prolog-syntax.lisp
by crhodes＠common-lisp.net 12 Apr '05

12 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv5047 Modified Files: prolog-syntax.lisp Log Message: make variable-terms show up in yellow. Band-aid for functor/canonical-name business with lists, curly lists and char-code-lists. Date: Tue Apr 12 23:48:19 2005 Author: crhodes Index: climacs/prolog-syntax.lisp diff -u climacs/prolog-syntax.lisp:1.15 climacs/prolog-syntax.lisp:1.16 --- climacs/prolog-syntax.lisp:1.15 Wed Apr 6 19:00:20 2005 +++ climacs/prolog-syntax.lisp Tue Apr 12 23:48:19 2005 @@ -400,7 +400,8 @@ (display-parse-tree (value entity) syntax pane)) (defmethod display-parse-tree ((entity variable-term) (syntax prolog-syntax) pane) - (display-parse-tree (name entity) syntax pane)) + (with-drawing-options (pane :ink (make-rgb-color 0.7 0.7 0.0)) + (display-parse-tree (name entity) syntax pane))) (defmethod display-parse-tree ((entity functional-compound-term) (syntax prolog-syntax) pane) (with-drawing-options (pane :ink (make-rgb-color 0.9 0 0.9)) @@ -440,6 +441,10 @@ (defclass atom (prolog-nonterminal) ((value :initarg :value :accessor value))) +(defgeneric canonical-name (thing) + ;; FIXME: is this actually necessary? There is confusion over the + ;; FUNCTOR of lists, curly lists and char-code lists. + (:method ((thing string)) thing)) (defmethod canonical-name ((thing atom)) (canonical-name (value thing))) (defmethod canonical-name ((thing name))

1 0

[climacs-cvs] CVS update: climacs/buffer-en.html climacs/buffer.html climacs/html-syntax.lisp
by rstrandh＠common-lisp.net 11 Apr '05

11 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv24885 Modified Files: buffer-en.html buffer.html html-syntax.lisp Log Message: Modified html lexer to return end-tag-start when it sees `</', and start-tag-start when it sees `<' followed by something other than slash. Slash is no longer a specific lexeme, just a delimiter like the others. Date: Mon Apr 11 08:27:13 2005 Author: rstrandh Index: climacs/buffer-en.html diff -u climacs/buffer-en.html:1.3 climacs/buffer-en.html:1.4 --- climacs/buffer-en.html:1.3 Thu Dec 16 07:29:01 2004 +++ climacs/buffer-en.html Mon Apr 11 08:27:12 2005 @@ -1,8 +1,9 @@ -<HTML><TITLE> Second semester master </TITLE> +<HTML lang=en> +<head><TITLE> Second semester master </TITLE></head> <BODY> -<a "href="buffer.html">Version française</a> +<p><a href="buffer.html">Version française</a></p> <h1> Programming project 2004 - 2005 </h1> -<br><hr><br> +<hr> <ul> <li> <h3> Title: </h3> @@ -33,9 +34,9 @@ ISO-latin-1, while still allowing all Unicode characters to be present, the physical representation consists of a 2-3-tree (which might be supplied) of lines of text, each line being represented by a -flexichain of characters (the implementation of which will be supplied).<p> +flexichain of characters (the implementation of which will be supplied).</p> + -<br> <li><h3> Required hardware and software:</h3> <p>A PC with GNU/Linux. A recent version (at least 0.8.17) of the SBCL system (a free implementation of Common Lisp), GNU Emacs, SLIME @@ -43,7 +44,7 @@ <br> <li> <h3> Bibliographic- and web references: :</h3> -<P> + <ul> <li><a href="climacs-en.html">Description of the Climacs project</a> <li><a href="buffer.text">Description of the "buffer" protocol</a></li> @@ -57,7 +58,7 @@ <li><a href="http://www.finseth.com/craft/">The Craft of Text Editing by Craig A. Finseth</a></li> </ul> -</p> + </ul> </BODY></HTML> Index: climacs/buffer.html diff -u climacs/buffer.html:1.4 climacs/buffer.html:1.5 --- climacs/buffer.html:1.4 Mon Apr 11 08:12:22 2005 +++ climacs/buffer.html Mon Apr 11 08:27:12 2005 @@ -1,4 +1,4 @@ -<HTML><HEAD><TITLE> Master 2ème semestre</TITLE></HEAD> +<HTML lang=fr><HEAD><TITLE> Master 2ème semestre</TITLE></HEAD> <BODY> <p><a href="buffer-en.html">English version</a></p> <h1> Projets de Programmation 2004 - 2005 </h1> @@ -44,7 +44,7 @@ <br> <li> <h3> Références bibliographiques et http: :</h3> -<P> + <ul> <li><a href="climacs.html">Description du projet Climacs</a> <li><a href="buffer.text">Description du protocole "buffer"</a></li> @@ -58,7 +58,7 @@ <li><a href="http://www.finseth.com/craft/">The Craft of Text Editing by Craig A. Finseth</a></li> </ul> -</p> + </ul> </BODY></HTML> Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.28 climacs/html-syntax.lisp:1.29 --- climacs/html-syntax.lisp:1.28 Mon Apr 11 08:12:22 2005 +++ climacs/html-syntax.lisp Mon Apr 11 08:27:13 2005 @@ -48,9 +48,9 @@ ((state :initarg :state))) (defclass start-lexeme (html-lexeme) ()) -(defclass tag-start (html-lexeme) ()) +(defclass start-tag-start (html-lexeme) ()) +(defclass end-tag-start (html-lexeme) ()) (defclass tag-end (html-lexeme) ()) -(defclass slash (html-lexeme) ()) (defclass word (html-lexeme) ()) (defclass delimiter (html-lexeme) ()) @@ -60,9 +60,12 @@ (flet ((fo () (forward-object scan))) (let ((object (object-after scan))) (case object - (#\< (fo) (make-instance 'tag-start)) + (#\< (fo) (cond ((or (end-of-buffer-p scan) + (not (eql (object-after scan) #\/))) + (make-instance 'start-tag-start)) + (t (fo) + (make-instance 'end-tag-start)))) (#\> (fo) (make-instance 'tag-end)) - (#\/ (fo) (make-instance 'slash)) (t (cond ((alphanumericp object) (loop until (end-of-buffer-p scan) while (alphanumericp (object-after scan)) @@ -94,8 +97,8 @@ (defclass ,name (html-tag) ()) (add-html-rule - (,name -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) + (,name -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word ,string))) (tag-end (= (end-offset word) (start-offset tag-end)))))))) @@ -104,9 +107,8 @@ (defclass ,name (html-tag) ()) (add-html-rule - (,name -> (tag-start - (slash (= (end-offset tag-start) (start-offset slash))) - (word (and (= (end-offset slash) (start-offset word)) + (,name -> (end-tag-start + (word (and (= (end-offset end-tag-start) (start-offset word)) (word-is word ,string))) (tag-end (= (end-offset word) (start-offset tag-end)))))))) @@ -383,12 +385,12 @@ (attributes :initarg :attributes) (end :initarg :end))) -(add-html-rule (<a> -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) +(add-html-rule (<a> -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word "a"))) <a>-attributes tag-end) - :start tag-start :name word :attributes <a>-attributes :end tag-end)) + :start start-tag-start :name word :attributes <a>-attributes :end tag-end)) (defmethod display-parse-tree ((entity <a>) (syntax html-syntax) pane) (with-slots (start name attributes end) entity @@ -435,12 +437,12 @@ (attributes :initarg :attributes) (end :initarg :end))) -(add-html-rule (<p> -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) +(add-html-rule (<p> -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word "p"))) common-attributes tag-end) - :start tag-start :name word :attributes common-attributes :end tag-end)) + :start start-tag-start :name word :attributes common-attributes :end tag-end)) (defmethod display-parse-tree ((entity <p>) (syntax html-syntax) pane) (with-slots (start name attributes end) entity @@ -473,12 +475,12 @@ (attributes :initarg :attributes) (end :initarg :end))) -(add-html-rule (<li> -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) +(add-html-rule (<li> -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word "li"))) common-attributes tag-end) - :start tag-start + :start start-tag-start :name word :attributes common-attributes :end tag-end)) @@ -517,12 +519,12 @@ (attributes :initarg :attributes) (end :initarg :end))) -(add-html-rule (<ul> -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) +(add-html-rule (<ul> -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word "ul"))) common-attributes tag-end) - :start tag-start + :start start-tag-start :name word :attributes common-attributes :end tag-end)) @@ -628,12 +630,12 @@ (attributes :initarg :attributes) (end :initarg :end))) -(add-html-rule (<html> -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) +(add-html-rule (<html> -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word "html"))) <html>-attributes tag-end) - :start tag-start :name word :attributes <html>-attributes :end tag-end)) + :start start-tag-start :name word :attributes <html>-attributes :end tag-end)) (defmethod display-parse-tree ((entity <html>) (syntax html-syntax) pane) (with-slots (start name attributes end) entity

1 0

[climacs-cvs] CVS update: climacs/buffer.html climacs/climacs-en.html climacs/html-syntax.lisp
by rstrandh＠common-lisp.net 11 Apr '05

11 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv24038 Modified Files: buffer.html climacs-en.html html-syntax.lisp Log Message: Defined BR and HR elements and modified some html files accordingly. Date: Mon Apr 11 08:12:22 2005 Author: rstrandh Index: climacs/buffer.html diff -u climacs/buffer.html:1.3 climacs/buffer.html:1.4 --- climacs/buffer.html:1.3 Thu Dec 16 07:29:01 2004 +++ climacs/buffer.html Mon Apr 11 08:12:22 2005 @@ -1,8 +1,8 @@ -<HTML><TITLE> Master 2ème semestre </TITLE> +<HTML><HEAD><TITLE> Master 2ème semestre</TITLE></HEAD> <BODY> -<a href="buffer-en.html">English version</a> +<p><a href="buffer-en.html">English version</a></p> <h1> Projets de Programmation 2004 - 2005 </h1> -<br><hr><br> +<hr> <ul> <li> <h3> Titre du Sujet: </h3> Index: climacs/climacs-en.html diff -u climacs/climacs-en.html:1.4 climacs/climacs-en.html:1.5 --- climacs/climacs-en.html:1.4 Fri Apr 8 16:36:59 2005 +++ climacs/climacs-en.html Mon Apr 11 08:12:22 2005 @@ -1,4 +1,5 @@ -<HTML><HEAD><TITLE>Climacs, a modern version of the Emacs editor</TITLE></HEAD> +<HTML lang=en> +<HEAD><TITLE>Climacs, a modern version of the Emacs editor</TITLE></HEAD> <BODY> <p><a href="climacs.html">Version française.</a></p> @@ -11,33 +12,33 @@ problems today. :</p> <ul> -<li><p>Emacs Lisp is a language that was specially designed in order to +<li>Emacs Lisp is a language that was specially designed in order to implement Emacs. Since the design of GNU Emacs and of Emacs Lisp, Common Lisp has been standardized, and gives both better performance than that of Emacs Lisp (because Emacs Lisp is implemented as an interpreter written in C) and more sophisticated functionalities (macros, CLOS, etc). The natural choice for - implementing Emacs today is thus Common Lisp.</p></li> + implementing Emacs today is thus Common Lisp.</li> -<li><p>GNU Emacs was designed before the existence of the Unicode +<li>GNU Emacs was designed before the existence of the Unicode standard. Unfortunately, the internal representation of a buffer does not allow the representation of all Unicode characters in a compact way. An internal representation allowing both all of Unicode and a compact representation for the ISO-latin-1 subset is - desirable.</p></li> + desirable.</li> -<li><p>Twenty years ago, graphic user interfaces practically did not +<li>Twenty years ago, graphic user interfaces practically did not exist. GNU Emacs was designed for a text-only terminal. Today better modes of interaction exist. In particular, with CLIM (Common LIsp Interface Manager) it is both possible and desirable - to have an interface based on the concept of "presentation types".</p></li> + to have an interface based on the concept of "presentation types".</li> -<li><p>Because of the limited power of computers at the time, GNU Emacs +<li>Because of the limited power of computers at the time, GNU Emacs uses a certain number of approximations in order to analyze the contents of a buffer, in particular when that contents is the text of a program. These approximations are no longer necessary, and with current technology, it is possible to maintain a complete - syntactic analysis of the buffer text. </p></li> + syntactic analysis of the buffer text. </li> </ul> Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.27 climacs/html-syntax.lisp:1.28 --- climacs/html-syntax.lisp:1.27 Mon Apr 11 07:28:51 2005 +++ climacs/html-syntax.lisp Mon Apr 11 08:12:22 2005 @@ -414,6 +414,19 @@ (display-parse-tree items syntax pane)) (display-parse-tree </a> syntax pane))) +;;;;;;;;;;;;;;; br element + +(defclass br-element (inline-element) + ((<br> :initarg :<br>))) + +(define-start-tag <br> "br") + +(add-html-rule (br-element -> (<br>) :<br> <br>)) + +(defmethod display-parse-tree ((entity br-element) (syntax html-syntax) pane) + (with-slots (<br>) entity + (display-parse-tree <br> syntax pane))) + ;;;;;;;;;;;;;;; p element (defclass <p> (html-tag) @@ -538,6 +551,19 @@ (display-parse-tree <ul> syntax pane) (display-parse-tree items syntax pane) (display-parse-tree </ul> syntax pane))) + +;;;;;;;;;;;;;;; hr element + +(defclass hr-element (block-level-element) + ((<hr> :initarg :<hr>))) + +(define-start-tag <hr> "hr") + +(add-html-rule (hr-element -> (<hr>) :<hr> <hr>)) + +(defmethod display-parse-tree ((entity hr-element) (syntax html-syntax) pane) + (with-slots (<hr>) entity + (display-parse-tree <hr> syntax pane))) ;;;;;;;;;;;;;;; body element

1 0

[climacs-cvs] CVS update: climacs/climacs.html climacs/html-syntax.lisp
by rstrandh＠common-lisp.net 11 Apr '05

11 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv21479 Modified Files: climacs.html html-syntax.lisp Log Message: Improvements to HTML syntax: * defined a macro for creating nonempty lists * the UL element now contains a nonempty list of LI elements * the LI element can contain ordinary text as is allowed by the spec * the </LI> closing tag is now optional as is allowed by the spec Several things still do not conform to the spec, in particular optional tags for some elements. Modified climacs.html to take advantage of these improvements. Date: Mon Apr 11 07:28:51 2005 Author: rstrandh Index: climacs/climacs.html diff -u climacs/climacs.html:1.5 climacs/climacs.html:1.6 --- climacs/climacs.html:1.5 Fri Apr 8 16:36:59 2005 +++ climacs/climacs.html Mon Apr 11 07:28:51 2005 @@ -1,4 +1,5 @@ -<HTML><HEAD><TITLE>Climacs, une version moderne de l'éditeur Emacs</TITLE></HEAD> +<HTML lang=fr> +<HEAD><TITLE>Climacs, une version moderne de l'éditeur Emacs</TITLE></HEAD> <BODY> @@ -12,36 +13,36 @@ l'époque posent quelques problèmes aujourd'hui :</p> <ul> -<li><p>Emacs Lisp est un langage spécialement conçu pour implémenter +<li>Emacs Lisp est un langage spécialement conçu pour implémenter Emacs. Depuis la conception de GNU Emacs et du langage Emacs LIsp, Common Lisp a été normalisé et propose à la fois une efficacité bien supérieure à celle de Emacs Lisp (car Emacs Lisp est implémenté sous la forme d'un interpréteur écrit en C) et des fonctionnalités plus sophistiqués (macros, CLOS, etc). Le choix naturelle pour implémenter Emacs aujourd'hui est donc Common - Lisp.</p></li> + Lisp.</li> -<li><p>GNU Emacs a été conçu avant l'existence de la norme +<li>GNU Emacs a été conçu avant l'existence de la norme Unicode. Malheureusement, la représentation interne d'un tampon (buffer) permet difficilement de représenter des caractères Unicode de manière compacte et efficace. Une représentation interne permettant à la fois l'ensemble des caractères Unicode et une représentation compacte du sous ensemble - ISO-latin-1 est souhaitable.</p></li> + ISO-latin-1 est souhaitable.</li> -<li><p>Il y a 20 ans, les interfaces graphiques n'existait pratiquement +<li>Il y a 20 ans, les interfaces graphiques n'existait pratiquement pas. GNU Emacs a été conçu pour un terminal texte. D'autres modes d'interaction sont possibles aujourd'hui. En particulier, avec CLIM (Common Lisp Interface Manager) une interface basée sur la notion de "types de présentation" est à la - fois possible et souhaitable. </p></li> + fois possible et souhaitable. </li> -<li><p>Pour des raisons de la performance limitée des ordinateurs de +<li>Pour des raisons de la performance limitée des ordinateurs de l'époque, GNU Emacs se sert d'un certain nombre d'approximations pour analyser le contenu d'un tampon, en particulier lorsque ce contenu est un programme. Ces approximations n'ont plus raison d'être, et avec la technologie d'aujourd'hui, il est possible de - maintenir un analyseur syntaxique incrémental et complet.</p></li> + maintenir un analyseur syntaxique incrémental et complet.</li> </ul> Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.26 climacs/html-syntax.lisp:1.27 --- climacs/html-syntax.lisp:1.26 Fri Apr 8 16:36:59 2005 +++ climacs/html-syntax.lisp Mon Apr 11 07:28:51 2005 @@ -134,7 +134,36 @@ (add-html-rule (,name -> (,name ,item-name) (make-instance ',nonempty-name - :items ,name :item ,item-name))) + :items ,name :item ,item-name))) + + (defmethod display-parse-tree ((entity ,empty-name) (syntax html-syntax) pane) + (declare (ignore pane)) + nil) + + (defmethod display-parse-tree ((entity ,nonempty-name) (syntax html-syntax) pane) + (with-slots (items item) entity + (display-parse-tree items syntax pane) + (display-parse-tree item syntax pane)))))) + +(defmacro define-nonempty-list (name item-name) + (let ((empty-name (gensym)) + (nonempty-name (gensym))) + `(progn + (defclass ,name (html-nonterminal) ()) + (defclass ,empty-name (,name) ()) + + (defclass ,nonempty-name (,name) + ((items :initarg :items) + (item :initarg :item))) + + (add-html-rule (,name -> (,item-name) + (make-instance ',nonempty-name + :items (make-instance ',empty-name) + :item ,item-name))) + + (add-html-rule (,name -> (,name ,item-name) + (make-instance ',nonempty-name + :items ,name :item ,item-name))) (defmethod display-parse-tree ((entity ,empty-name) (syntax html-syntax) pane) (declare (ignore pane)) @@ -274,20 +303,34 @@ (defclass inline-element (html-nonterminal) ()) (defclass block-level-element (html-nonterminal) ()) -;;;;;;;;;;;;;;; inline-element-or-text +;;;;;;;;;;;;;;; %inline -(defclass inline-element-or-text (html-nonterminal) +(defclass $inline (html-nonterminal) ((contents :initarg :contents))) -(add-html-rule (inline-element-or-text -> (inline-element) :contents inline-element)) -(add-html-rule (inline-element-or-text -> (word) :contents word)) -(add-html-rule (inline-element-or-text -> (delimiter) :contents delimiter)) +(add-html-rule ($inline -> (inline-element) :contents inline-element)) +(add-html-rule ($inline -> (word) :contents word)) +(add-html-rule ($inline -> (delimiter) :contents delimiter)) -(defmethod display-parse-tree ((entity inline-element-or-text) (syntax html-syntax) pane) +(defmethod display-parse-tree ((entity $inline) (syntax html-syntax) pane) (with-slots (contents) entity (display-parse-tree contents syntax pane))) -(define-list inline-things inline-element-or-text) +(define-list $inlines $inline) + +;;;;;;;;;;;;;;; %flow + +(defclass $flow (html-nonterminal) + ((contents :initarg :contents))) + +(add-html-rule ($flow -> ($inline) :contents $inline)) +(add-html-rule ($flow -> (block-level-element) :contents block-level-element)) + +(defmethod display-parse-tree ((entity $flow) (syntax html-syntax) pane) + (with-slots (contents) entity + (display-parse-tree contents syntax pane))) + +(define-list $flows $flow) ;;;;;;;;;;;;;;; headings @@ -310,8 +353,8 @@ (defclass ,class-name (heading) ()) (add-html-rule - (,class-name -> (,start-tag-name inline-things ,end-tag-name) - :start ,start-tag-name :contents inline-things :end ,end-tag-name)))) + (,class-name -> (,start-tag-name $inlines ,end-tag-name) + :start ,start-tag-name :contents $inlines :end ,end-tag-name)))) (define-heading h1 "h1" <h1> </h1>) @@ -361,8 +404,8 @@ (items :initarg :items) (</a> :initarg :</a>))) -(add-html-rule (a-element -> (<a> inline-things </a>) - :<a> <a> :items inline-things :</a> </a>)) +(add-html-rule (a-element -> (<a> $inlines </a>) + :<a> <a> :items $inlines :</a> </a>)) (defmethod display-parse-tree ((entity a-element) (syntax html-syntax) pane) (with-slots (<a> items </a>) entity @@ -400,8 +443,8 @@ (contents :initarg :contents) (</p> :initarg :</p>))) -(add-html-rule (p-element -> (<p> inline-things </p>) - :<p> <p> :contents inline-things :</p> </p>)) +(add-html-rule (p-element -> (<p> $inlines </p>) + :<p> <p> :contents $inlines :</p> </p>)) (defmethod display-parse-tree ((entity p-element) (syntax html-syntax) pane) (with-slots (<p> contents </p>) entity @@ -436,32 +479,22 @@ (define-end-tag </li> "li") -(defclass li-item (html-nonterminal) - ((item :initarg :item))) - -(add-html-rule (li-item -> (block-level-element) :item block-level-element)) -(add-html-rule (li-item -> (inline-element) :item inline-element)) - -(defmethod display-parse-tree ((entity li-item) (syntax html-syntax) pane) - (with-slots (item) entity - (display-parse-tree item syntax pane))) - -(define-list li-items li-item) - (defclass li-element (html-nonterminal) ((<li> :initarg :<li>) (items :initarg :items) (</li> :initarg :</li>))) -(add-html-rule (li-element -> (<li> li-items </li>) - :<li> <li> :items li-items :</li> </li>)) +(add-html-rule (li-element -> (<li> $flows </li>) + :<li> <li> :items $flows :</li> </li>)) +(add-html-rule (li-element -> (<li> $flows) + :<li> <li> :items $flows :</li> nil)) (defmethod display-parse-tree ((entity li-element) (syntax html-syntax) pane) (with-slots (<li> items </li>) entity (display-parse-tree <li> syntax pane) (display-parse-tree items syntax pane) - (display-parse-tree </li> syntax pane))) - + (when </li> + (display-parse-tree </li> syntax pane)))) ;;;;;;;;;;;;;;; ul element @@ -490,7 +523,7 @@ (define-end-tag </ul> "ul") -(define-list li-elements li-element) +(define-nonempty-list li-elements li-element) (defclass ul-element (block-level-element) ((<ul> :initarg :<ul>) @@ -511,8 +544,6 @@ (defclass body-item (html-nonterminal) ((item :initarg :item))) -(add-html-rule (body-item -> (word) :item word)) -(add-html-rule (body-item -> (delimiter) :item delimiter)) (add-html-rule (body-item -> ((element block-level-element)) :item element)) (defmethod display-parse-tree ((entity body-item) (syntax html-syntax) pane)

1 0

[climacs-cvs] CVS update: climacs/climacs-en.html climacs/climacs.html climacs/html-syntax.lisp
by rstrandh＠common-lisp.net 08 Apr '05

08 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv31704 Modified Files: climacs-en.html climacs.html html-syntax.lisp Log Message: Added <ul>...</ul> and <li>...</li> elements. Modified some html files to be conform. Date: Fri Apr 8 16:37:00 2005 Author: rstrandh Index: climacs/climacs-en.html diff -u climacs/climacs-en.html:1.3 climacs/climacs-en.html:1.4 --- climacs/climacs-en.html:1.3 Thu Dec 16 07:29:01 2004 +++ climacs/climacs-en.html Fri Apr 8 16:36:59 2005 @@ -1,7 +1,7 @@ <HTML><HEAD><TITLE>Climacs, a modern version of the Emacs editor</TITLE></HEAD> <BODY> -<a href="climacs.html">Version française.</a> +<p><a href="climacs.html">Version française.</a></p> <h1>Climacs, a modern version of the Emacs editor</h1> @@ -11,33 +11,33 @@ problems today. :</p> <ul> -<li>Emacs Lisp is a language that was specially designed in order to +<li><p>Emacs Lisp is a language that was specially designed in order to implement Emacs. Since the design of GNU Emacs and of Emacs Lisp, Common Lisp has been standardized, and gives both better performance than that of Emacs Lisp (because Emacs Lisp is implemented as an interpreter written in C) and more sophisticated functionalities (macros, CLOS, etc). The natural choice for - implementing Emacs today is thus Common Lisp.</li> + implementing Emacs today is thus Common Lisp.</p></li> -<li>GNU Emacs was designed before the existence of the Unicode +<li><p>GNU Emacs was designed before the existence of the Unicode standard. Unfortunately, the internal representation of a buffer does not allow the representation of all Unicode characters in a compact way. An internal representation allowing both all of Unicode and a compact representation for the ISO-latin-1 subset is - desirable.</li> + desirable.</p></li> -<li>Twenty years ago, graphic user interfaces practically did not +<li><p>Twenty years ago, graphic user interfaces practically did not exist. GNU Emacs was designed for a text-only terminal. Today better modes of interaction exist. In particular, with CLIM (Common LIsp Interface Manager) it is both possible and desirable - to have an interface based on the concept of "presentation types".</li> + to have an interface based on the concept of "presentation types".</p></li> -<li>Because of the limited power of computers at the time, GNU Emacs +<li><p>Because of the limited power of computers at the time, GNU Emacs uses a certain number of approximations in order to analyze the contents of a buffer, in particular when that contents is the text of a program. These approximations are no longer necessary, and with current technology, it is possible to maintain a complete - syntactic analysis of the buffer text. + syntactic analysis of the buffer text. </p></li> </ul> @@ -67,5 +67,5 @@ <li><a href="syntax.text">Description of the "syntax" protocol</a></li> <li><a href="climacs.tar.gz">Lisp code</a></li> </ul> - +</body> </HTML> Index: climacs/climacs.html diff -u climacs/climacs.html:1.4 climacs/climacs.html:1.5 --- climacs/climacs.html:1.4 Fri Apr 8 10:30:42 2005 +++ climacs/climacs.html Fri Apr 8 16:36:59 2005 @@ -12,36 +12,36 @@ l'époque posent quelques problèmes aujourd'hui :</p> <ul> -<li>Emacs Lisp est un langage spécialement conçu pour implémenter +<li><p>Emacs Lisp est un langage spécialement conçu pour implémenter Emacs. Depuis la conception de GNU Emacs et du langage Emacs LIsp, Common Lisp a été normalisé et propose à la fois une efficacité bien supérieure à celle de Emacs Lisp (car Emacs Lisp est implémenté sous la forme d'un interpréteur écrit en C) et des fonctionnalités plus sophistiqués (macros, CLOS, etc). Le choix naturelle pour implémenter Emacs aujourd'hui est donc Common - Lisp.</li> + Lisp.</p></li> -<li>GNU Emacs a été conçu avant l'existence de la norme +<li><p>GNU Emacs a été conçu avant l'existence de la norme Unicode. Malheureusement, la représentation interne d'un tampon (buffer) permet difficilement de représenter des caractères Unicode de manière compacte et efficace. Une représentation interne permettant à la fois l'ensemble des caractères Unicode et une représentation compacte du sous ensemble - ISO-latin-1 est souhaitable.</li> + ISO-latin-1 est souhaitable.</p></li> -<li>Il y a 20 ans, les interfaces graphiques n'existait pratiquement +<li><p>Il y a 20 ans, les interfaces graphiques n'existait pratiquement pas. GNU Emacs a été conçu pour un terminal texte. D'autres modes d'interaction sont possibles aujourd'hui. En particulier, avec CLIM (Common Lisp Interface Manager) une interface basée sur la notion de "types de présentation" est à la - fois possible et souhaitable. </li> + fois possible et souhaitable. </p></li> -<li>Pour des raisons de la performance limitée des ordinateurs de +<li><p>Pour des raisons de la performance limitée des ordinateurs de l'époque, GNU Emacs se sert d'un certain nombre d'approximations pour analyser le contenu d'un tampon, en particulier lorsque ce contenu est un programme. Ces approximations n'ont plus raison d'être, et avec la technologie d'aujourd'hui, il est possible de - maintenir un analyseur syntaxique incrémental et complet. + maintenir un analyseur syntaxique incrémental et complet.</p></li> </ul> @@ -71,7 +71,5 @@ <li><a href="syntax.text">Description du protocole "syntax"</a></li> <li><a href="climacs.tar.gz">Code Lisp</a></li> </ul> - - - +</body> </HTML> Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.25 climacs/html-syntax.lisp:1.26 --- climacs/html-syntax.lisp:1.25 Fri Apr 8 10:30:42 2005 +++ climacs/html-syntax.lisp Fri Apr 8 16:36:59 2005 @@ -117,8 +117,6 @@ (define-tag-pair <head> </head> "head") (define-tag-pair <title> </title> "title") (define-tag-pair <body> </body> "body") -(define-tag-pair <ul> </ul> "ul") -(define-tag-pair <li> </li> "li") (defmacro define-list (name item-name) (let ((empty-name (gensym)) @@ -301,7 +299,8 @@ (defmethod display-parse-tree ((entity heading) (syntax html-syntax) pane) (with-slots (start contents end) entity (display-parse-tree start syntax pane) - (display-parse-tree contents syntax pane) + (with-text-face (pane :bold) + (display-parse-tree contents syntax pane)) (display-parse-tree end syntax pane))) (defmacro define-heading (class-name tag-string start-tag-name end-tag-name) @@ -410,6 +409,103 @@ (display-parse-tree contents syntax pane) (display-parse-tree </p> syntax pane))) +;;;;;;;;;;;;;;; li element + +(defclass <li> (html-tag) + ((start :initarg :start) + (name :initarg :name) + (attributes :initarg :attributes) + (end :initarg :end))) + +(add-html-rule (<li> -> (tag-start + (word (and (= (end-offset tag-start) (start-offset word)) + (word-is word "li"))) + common-attributes + tag-end) + :start tag-start + :name word + :attributes common-attributes + :end tag-end)) + +(defmethod display-parse-tree ((entity <li>) (syntax html-syntax) pane) + (with-slots (start name attributes end) entity + (display-parse-tree start syntax pane) + (display-parse-tree name syntax pane) + (display-parse-tree attributes syntax pane) + (display-parse-tree end syntax pane))) + +(define-end-tag </li> "li") + +(defclass li-item (html-nonterminal) + ((item :initarg :item))) + +(add-html-rule (li-item -> (block-level-element) :item block-level-element)) +(add-html-rule (li-item -> (inline-element) :item inline-element)) + +(defmethod display-parse-tree ((entity li-item) (syntax html-syntax) pane) + (with-slots (item) entity + (display-parse-tree item syntax pane))) + +(define-list li-items li-item) + +(defclass li-element (html-nonterminal) + ((<li> :initarg :<li>) + (items :initarg :items) + (</li> :initarg :</li>))) + +(add-html-rule (li-element -> (<li> li-items </li>) + :<li> <li> :items li-items :</li> </li>)) + +(defmethod display-parse-tree ((entity li-element) (syntax html-syntax) pane) + (with-slots (<li> items </li>) entity + (display-parse-tree <li> syntax pane) + (display-parse-tree items syntax pane) + (display-parse-tree </li> syntax pane))) + + +;;;;;;;;;;;;;;; ul element + +(defclass <ul> (html-tag) + ((start :initarg :start) + (name :initarg :name) + (attributes :initarg :attributes) + (end :initarg :end))) + +(add-html-rule (<ul> -> (tag-start + (word (and (= (end-offset tag-start) (start-offset word)) + (word-is word "ul"))) + common-attributes + tag-end) + :start tag-start + :name word + :attributes common-attributes + :end tag-end)) + +(defmethod display-parse-tree ((entity <ul>) (syntax html-syntax) pane) + (with-slots (start name attributes end) entity + (display-parse-tree start syntax pane) + (display-parse-tree name syntax pane) + (display-parse-tree attributes syntax pane) + (display-parse-tree end syntax pane))) + +(define-end-tag </ul> "ul") + +(define-list li-elements li-element) + +(defclass ul-element (block-level-element) + ((<ul> :initarg :<ul>) + (items :initarg :items) + (</ul> :initarg :</ul>))) + +(add-html-rule (ul-element -> (<ul> li-elements </ul>) + :<ul> <ul> :items li-elements :</ul> </ul>)) + +(defmethod display-parse-tree ((entity ul-element) (syntax html-syntax) pane) + (with-slots (<ul> items </ul>) entity + (display-parse-tree <ul> syntax pane) + (display-parse-tree items syntax pane) + (display-parse-tree </ul> syntax pane))) + ;;;;;;;;;;;;;;; body element (defclass body-item (html-nonterminal) @@ -603,7 +699,7 @@ :stream pane))))) (defmethod display-parse-tree :around ((entity html-tag) (syntax html-syntax) pane) - (with-drawing-options (pane :ink +green+) + (with-drawing-options (pane :ink +green4+) (call-next-method))) (defmethod display-parse-tree :before ((entity html-token) (syntax html-syntax) pane)

1 0