climacs-cvs

climacs-cvs@common-lisp.net

847 discussions

[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

[climacs-cvs] CVS update: 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-serv10039 Modified Files: climacs.html html-syntax.lisp Log Message: Added <p>..</p> element to html-syntax Fixed climacs.html to conform to the HTML 4.0 standard. Date: Fri Apr 8 10:30:42 2005 Author: rstrandh Index: climacs/climacs.html diff -u climacs/climacs.html:1.3 climacs/climacs.html:1.4 --- climacs/climacs.html:1.3 Thu Dec 16 07:29:01 2004 +++ climacs/climacs.html Fri Apr 8 10:30:42 2005 @@ -2,7 +2,7 @@ <BODY> -<a href="climacs-en.html">English version.</a> +<p><a href="climacs-en.html">English version.</a></p> <h1>Climacs, une version moderne de l'éditeur Emacs</h1> Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.24 climacs/html-syntax.lisp:1.25 --- climacs/html-syntax.lisp:1.24 Fri Apr 8 07:59:27 2005 +++ climacs/html-syntax.lisp Fri Apr 8 10:30:42 2005 @@ -117,34 +117,35 @@ (define-tag-pair <head> </head> "head") (define-tag-pair <title> </title> "title") (define-tag-pair <body> </body> "body") -(define-tag-pair <p> </p> "p") (define-tag-pair <ul> </ul> "ul") (define-tag-pair <li> </li> "li") -(defmacro define-list (name empty-name nonempty-name item-name) - `(progn - (defclass ,name (html-nonterminal) ()) - (defclass ,empty-name (,name) ()) - - (defclass ,nonempty-name (,name) - ((items :initarg :items) - (item :initarg :item))) - - (add-html-rule (,name -> () - (make-instance ',empty-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)) - 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-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 -> () + (make-instance ',empty-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)) + 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)))))) ;;;;;;;;;;;;;;; string @@ -157,7 +158,7 @@ (lexemes :initarg :lexemes) (end :initarg :end))) -(define-list string-lexemes empty-string-lexeme nonempty-string-lexeme string-lexeme) +(define-list string-lexemes string-lexeme) (add-html-rule (html-string -> ((start delimiter (word-is start "\"")) string-lexemes @@ -182,9 +183,13 @@ (display-parse-tree name syntax pane) (display-parse-tree equals syntax pane))) -(defclass core-attribute (html-attribute) ()) -(defclass i18n-attribute (html-attribute) ()) -(defclass scripting-event (html-attribute) ()) +(defclass common-attribute (html-attribute) ()) + +(defclass core-attribute (common-attribute) ()) +(defclass i18n-attribute (common-attribute) ()) +(defclass scripting-event (common-attribute) ()) + +(define-list common-attributes common-attribute) ;;;;;;;;;;;;;;; lang attribute @@ -237,43 +242,7 @@ (display-parse-tree href syntax pane))) -;;;;;;;;;;;;;;; <html>-tag - -(defclass <html>-attribute (html-nonterminal) - ((attribute :initarg :attribute))) - -(defmethod display-parse-tree ((entity <html>-attribute) (syntax html-syntax) pane) - (with-slots (attribute) entity - (display-parse-tree attribute syntax pane))) - -(add-html-rule (<html>-attribute -> (lang-attr) :attribute lang-attr)) -(add-html-rule (<html>-attribute -> (dir-attr) :attribute dir-attr)) - -(define-list <html>-attributes empty-<html>-attribute nonempty-<html>-attribute <html>-attribute) - -(defclass <html> (html-tag) - ((start :initarg :start) - (name :initarg :name) - (attributes :initarg :attributes) - (end :initarg :end))) - -(add-html-rule (<html> -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) - (word-is word "html"))) - <html>-attributes - tag-end) - :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 - (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 </html> "html") - -;;;;;;;;;;;;;;; title-item, title-items +;;;;;;;;;;;;;;; title (defclass title-item (html-nonterminal) ((item :initarg :item))) @@ -285,9 +254,7 @@ (with-slots (item) entity (display-parse-tree item syntax pane))) -(define-list title-items empty-title-items nonempty-title-items title-item) - -;;;;;;;;;;;;;;; title +(define-list title-items title-item) (defclass title (html-nonterminal) ((<title> :initarg :<title>) @@ -322,7 +289,7 @@ (with-slots (contents) entity (display-parse-tree contents syntax pane))) -(define-list inline-things empty-inline-things nonempty-inline-things inline-element-or-text) +(define-list inline-things inline-element-or-text) ;;;;;;;;;;;;;;; headings @@ -355,7 +322,7 @@ (define-heading h5 "h5" <h5> </h5>) (define-heading h6 "h6" <h6> </h6>) -;;;;;;;;;;;;;;; <a>-tag +;;;;;;;;;;;;;;; a element (defclass <a>-attribute (html-nonterminal) ((attribute :initarg :attribute))) @@ -366,7 +333,7 @@ (with-slots (attribute) entity (display-parse-tree attribute syntax pane))) -(define-list <a>-attributes empty-<a>-attributes nonempty-<a>-attributes <a>-attribute) +(define-list <a>-attributes <a>-attribute) (defclass <a> (html-tag) ((start :initarg :start) @@ -390,22 +357,60 @@ (define-end-tag </a> "a") -(defclass a (inline-element) +(defclass a-element (inline-element) ((<a> :initarg :<a>) (items :initarg :items) (</a> :initarg :</a>))) -(add-html-rule (a -> (<a> body-items </a>) - :<a> <a> :items body-items :</a> </a>)) +(add-html-rule (a-element -> (<a> inline-things </a>) + :<a> <a> :items inline-things :</a> </a>)) -(defmethod display-parse-tree ((entity a) (syntax html-syntax) pane) +(defmethod display-parse-tree ((entity a-element) (syntax html-syntax) pane) (with-slots (<a> items </a>) entity (display-parse-tree <a> syntax pane) (with-text-face (pane :bold) (display-parse-tree items syntax pane)) (display-parse-tree </a> syntax pane))) -;;;;;;;;;;;;;;; body-item body-items +;;;;;;;;;;;;;;; p element + +(defclass <p> (html-tag) + ((start :initarg :start) + (name :initarg :name) + (attributes :initarg :attributes) + (end :initarg :end))) + +(add-html-rule (<p> -> (tag-start + (word (and (= (end-offset tag-start) (start-offset word)) + (word-is word "p"))) + common-attributes + tag-end) + :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 + (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 </p> "p") + +(defclass p-element (block-level-element) + ((<p> :initarg :<p>) + (contents :initarg :contents) + (</p> :initarg :</p>))) + +(add-html-rule (p-element -> (<p> inline-things </p>) + :<p> <p> :contents inline-things :</p> </p>)) + +(defmethod display-parse-tree ((entity p-element) (syntax html-syntax) pane) + (with-slots (<p> contents </p>) entity + (display-parse-tree <p> syntax pane) + (display-parse-tree contents syntax pane) + (display-parse-tree </p> syntax pane))) + +;;;;;;;;;;;;;;; body element (defclass body-item (html-nonterminal) ((item :initarg :item))) @@ -418,9 +423,7 @@ (with-slots (item) entity (display-parse-tree item syntax pane))) -(define-list body-items empty-body-items nonempty-body-items body-item) - -;;;;;;;;;;;;;;; body +(define-list body-items body-item) (defclass body (html-nonterminal) ((<body> :initarg :<body>) @@ -453,6 +456,40 @@ (display-parse-tree </head> syntax pane))) ;;;;;;;;;;;;;;; html + +(defclass <html>-attribute (html-nonterminal) + ((attribute :initarg :attribute))) + +(defmethod display-parse-tree ((entity <html>-attribute) (syntax html-syntax) pane) + (with-slots (attribute) entity + (display-parse-tree attribute syntax pane))) + +(add-html-rule (<html>-attribute -> (lang-attr) :attribute lang-attr)) +(add-html-rule (<html>-attribute -> (dir-attr) :attribute dir-attr)) + +(define-list <html>-attributes <html>-attribute) + +(defclass <html> (html-tag) + ((start :initarg :start) + (name :initarg :name) + (attributes :initarg :attributes) + (end :initarg :end))) + +(add-html-rule (<html> -> (tag-start + (word (and (= (end-offset tag-start) (start-offset word)) + (word-is word "html"))) + <html>-attributes + tag-end) + :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 + (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 </html> "html") (defclass html (html-nonterminal) ((<html> :initarg :<html>)

1 0

[climacs-cvs] CVS update: 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-serv1496 Modified Files: html-syntax.lisp Log Message: headings h1 -- h6 added Date: Fri Apr 8 07:59:27 2005 Author: rstrandh Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.23 climacs/html-syntax.lisp:1.24 --- climacs/html-syntax.lisp:1.23 Thu Apr 7 07:02:33 2005 +++ climacs/html-syntax.lisp Fri Apr 8 07:59:27 2005 @@ -117,9 +117,6 @@ (define-tag-pair <head> </head> "head") (define-tag-pair <title> </title> "title") (define-tag-pair <body> </body> "body") -(define-tag-pair <h1> </h1> "h1") -(define-tag-pair <h2> </h2> "h2") -(define-tag-pair <h3> </h3> "h3") (define-tag-pair <p> </p> "p") (define-tag-pair <ul> </ul> "ul") (define-tag-pair <li> </li> "li") @@ -307,37 +304,6 @@ (display-parse-tree items syntax pane)) (display-parse-tree </title> syntax pane))) -;;;;;;;;;;;;;;; body-item body-items - -(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 -> (a) :item a)) - -(defmethod display-parse-tree ((entity body-item) (syntax html-syntax) pane) - (with-slots (item) entity - (display-parse-tree item syntax pane))) - -(define-list body-items empty-body-items nonempty-body-items body-item) - -;;;;;;;;;;;;;;; body - -(defclass body (html-nonterminal) - ((<body> :initarg :<body>) - (items :initarg :items) - (</body> :initarg :</body>))) - -(add-html-rule (body -> (<body> body-items </body>) - :<body> <body> :items body-items :</body> </body>)) - -(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))) - ;;;;;;;;;;;;;;; inline-element, block-level-element (defclass inline-element (html-nonterminal) ()) @@ -346,7 +312,7 @@ ;;;;;;;;;;;;;;; inline-element-or-text (defclass inline-element-or-text (html-nonterminal) - ((contents :initarg contents))) + ((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)) @@ -356,6 +322,39 @@ (with-slots (contents) entity (display-parse-tree contents syntax pane))) +(define-list inline-things empty-inline-things nonempty-inline-things inline-element-or-text) + +;;;;;;;;;;;;;;; headings + +(defclass heading (block-level-element) + ((start :initarg :start) + (contents :initarg :contents) + (end :initarg :end))) + +(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) + (display-parse-tree end syntax pane))) + +(defmacro define-heading (class-name tag-string start-tag-name end-tag-name) + `(progn + (define-tag-pair ,start-tag-name ,end-tag-name ,tag-string) + + (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)))) + + +(define-heading h1 "h1" <h1> </h1>) +(define-heading h2 "h2" <h2> </h2>) +(define-heading h3 "h3" <h3> </h3>) +(define-heading h4 "h4" <h4> </h4>) +(define-heading h5 "h5" <h5> </h5>) +(define-heading h6 "h6" <h6> </h6>) + ;;;;;;;;;;;;;;; <a>-tag (defclass <a>-attribute (html-nonterminal) @@ -405,6 +404,37 @@ (with-text-face (pane :bold) (display-parse-tree items syntax pane)) (display-parse-tree </a> syntax pane))) + +;;;;;;;;;;;;;;; body-item body-items + +(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) + (with-slots (item) entity + (display-parse-tree item syntax pane))) + +(define-list body-items empty-body-items nonempty-body-items body-item) + +;;;;;;;;;;;;;;; body + +(defclass body (html-nonterminal) + ((<body> :initarg :<body>) + (items :initarg :items) + (</body> :initarg :</body>))) + +(add-html-rule (body -> (<body> body-items </body>) + :<body> <body> :items body-items :</body> </body>)) + +(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))) ;;;;;;;;;;;;;;; head

1 0

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

07 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv11719 Modified Files: html-syntax.lisp Log Message: Introduced the concept of inline element and block-level element. Reorganized the attributes into core attributes, i18n attributes and scripting events according to the HTML standard. Date: Thu Apr 7 07:02:33 2005 Author: rstrandh Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.22 climacs/html-syntax.lisp:1.23 --- climacs/html-syntax.lisp:1.22 Mon Apr 4 13:49:05 2005 +++ climacs/html-syntax.lisp Thu Apr 7 07:02:33 2005 @@ -185,9 +185,13 @@ (display-parse-tree name syntax pane) (display-parse-tree equals syntax pane))) +(defclass core-attribute (html-attribute) ()) +(defclass i18n-attribute (html-attribute) ()) +(defclass scripting-event (html-attribute) ()) + ;;;;;;;;;;;;;;; lang attribute -(defclass lang-attr (html-attribute) +(defclass lang-attr (i18n-attribute) ((lang :initarg :lang))) (add-html-rule (lang-attr -> ((name word (word-is name "lang")) @@ -204,7 +208,7 @@ ;;;;;;;;;;;;;;; dir attribute -(defclass dir-attr (html-attribute) +(defclass dir-attr (i18n-attribute) ((dir :initarg :dir))) (add-html-rule (dir-attr -> ((name word (word-is name "dir")) @@ -334,6 +338,24 @@ (display-parse-tree items syntax pane) (display-parse-tree </body> syntax pane))) +;;;;;;;;;;;;;;; inline-element, block-level-element + +(defclass inline-element (html-nonterminal) ()) +(defclass block-level-element (html-nonterminal) ()) + +;;;;;;;;;;;;;;; inline-element-or-text + +(defclass inline-element-or-text (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)) + +(defmethod display-parse-tree ((entity inline-element-or-text) (syntax html-syntax) pane) + (with-slots (contents) entity + (display-parse-tree contents syntax pane))) + ;;;;;;;;;;;;;;; <a>-tag (defclass <a>-attribute (html-nonterminal) @@ -369,7 +391,7 @@ (define-end-tag </a> "a") -(defclass a (html-nonterminal) +(defclass a (inline-element) ((<a> :initarg :<a>) (items :initarg :items) (</a> :initarg :</a>)))

1 0

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

06 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv365 Modified Files: prolog-syntax.lisp Log Message: Because of multiline tokens, we must redraw on various criteria other than the ink and face changing: specifically, if the substring of the token that we are to draw is different, we cannot simply displace or replay an output record. Date: Wed Apr 6 19:00:20 2005 Author: crhodes Index: climacs/prolog-syntax.lisp diff -u climacs/prolog-syntax.lisp:1.14 climacs/prolog-syntax.lisp:1.15 --- climacs/prolog-syntax.lisp:1.14 Wed Apr 6 18:23:21 2005 +++ climacs/prolog-syntax.lisp Wed Apr 6 19:00:20 2005 @@ -56,7 +56,7 @@ ()) (defclass prolog-token (prolog-parse-tree) - ((ink) (face))) + ((ink) (face) (start) (end))) ;;; lexer @@ -947,40 +947,47 @@ (call-next-method)))) (defmethod display-parse-tree ((entity prolog-token) (syntax prolog-syntax) pane) - (flet ((cache-test (t1 t2) - (and (eq t1 t2) - (eq (slot-value t1 'ink) - (medium-ink (sheet-medium pane))) - (eq (slot-value t1 'face) - (text-style-face (medium-text-style (sheet-medium pane))))))) - (updating-output (pane :unique-id entity - :id-test #'eq - :cache-value entity - :cache-test #'cache-test) - (with-slots (ink face) entity - (setf ink (medium-ink (sheet-medium pane)) - face (text-style-face (medium-text-style (sheet-medium pane)))) - (let ((string (coerce (buffer-sequence (buffer syntax) - (start-offset entity) - (end-offset entity)) - 'string))) - (with-slots (top bot) pane - (let (start end) - (setf start (max 0 (- (offset top) (start-offset entity)))) - (setf end (- (length string) (max 0 (- (end-offset entity) (offset bot))))) - (loop - (when (>= start end) - (return)) - (let ((nl (position #\Newline string - :start start :end end))) - (unless nl - (present (subseq string start end) 'string :stream pane) - (return)) - (present (subseq string start nl) 'string :stream pane) - (handle-whitespace pane (buffer pane) - (+ (start-offset entity) nl) - (+ (start-offset entity) nl 1)) - (setf start (+ nl 1))))))))))) + (with-slots (top bot) pane + (let ((string (coerce (buffer-sequence (buffer syntax) + (start-offset entity) + (end-offset entity)) + 'string))) + (flet ((cache-test (t1 t2) + (and (eq t1 t2) + (eq (slot-value t1 'ink) + (medium-ink (sheet-medium pane))) + (eq (slot-value t1 'face) + (text-style-face (medium-text-style (sheet-medium pane)))) + (eq (slot-value t1 'start) + (max 0 (- (offset top) (start-offset entity)))) + (eq (slot-value t1 'end) + (- (length string) + (max 0 (- (end-offset entity) (offset bot)))))))) + (updating-output (pane :unique-id entity + :id-test #'eq + :cache-value entity + :cache-test #'cache-test) + (with-slots (ink face start end) entity + (setf ink (medium-ink (sheet-medium pane)) + face (text-style-face (medium-text-style (sheet-medium pane))) + start (max 0 (- (offset top) (start-offset entity))) + end (- (length string) + (max 0 (- (end-offset entity) (offset bot))))) + (let ((start start) + (end end)) + (loop + (when (>= start end) + (return)) + (let ((nl (position #\Newline string + :start start :end end))) + (unless nl + (present (subseq string start end) 'string :stream pane) + (return)) + (present (subseq string start nl) 'string :stream pane) + (handle-whitespace pane (buffer pane) + (+ (start-offset entity) nl) + (+ (start-offset entity) nl 1)) + (setf start (+ nl 1))))))))))) (defmethod display-parse-tree :before ((entity prolog-token) (syntax prolog-syntax) pane) (handle-whitespace pane (buffer pane) *white-space-start* (start-offset entity))

1 0

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

06 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv31107 Modified Files: prolog-syntax.lisp Log Message: Use left-recursion rather than right-recursion. (Be careful to adjust the DISPLAY-PARSE-TREE methods when making changes of this kind!) A couple of minor fixes (well, minor except that they were totally broken before) * VALID-LEX, not (undefined) I; * MARK>, not MARK>=, to get Backspace right. Date: Wed Apr 6 18:23:21 2005 Author: crhodes Index: climacs/prolog-syntax.lisp diff -u climacs/prolog-syntax.lisp:1.13 climacs/prolog-syntax.lisp:1.14 --- climacs/prolog-syntax.lisp:1.13 Wed Apr 6 13:54:27 2005 +++ climacs/prolog-syntax.lisp Wed Apr 6 18:23:21 2005 @@ -58,9 +58,6 @@ (defclass prolog-token (prolog-parse-tree) ((ink) (face))) -(defclass prolog-operator (prolog-token) - ()) - ;;; lexer (defclass prolog-lexeme (prolog-token) @@ -78,11 +75,11 @@ (cont :initarg :cont :accessor cont))) (defmethod display-parse-tree ((entity layout-text) (syntax prolog-syntax) pane) + (when (cont entity) + (display-parse-tree (cont entity) syntax pane)) (when (comment entity) (with-drawing-options (pane :ink (make-rgb-color 0.7 0.0 0.0)) - (display-parse-tree (comment entity) syntax pane))) - (when (cont entity) - (display-parse-tree (cont entity) syntax pane))) + (display-parse-tree (comment entity) syntax pane)))) (defgeneric syntactic-lexeme (thing)) (defmethod syntactic-lexeme ((lexeme prolog-lexeme)) @@ -142,7 +139,7 @@ (make-instance 'open-ct :syntactic-lexeme open-ct-lexeme)) ;;; 6.4.1 -(define-prolog-rule (layout-text -> (comment-lexeme layout-text)) +(define-prolog-rule (layout-text -> (layout-text comment-lexeme)) (make-instance 'layout-text :comment comment-lexeme :cont layout-text)) (define-prolog-rule (layout-text -> ()) (make-instance 'layout-text :cont nil)) @@ -301,13 +298,13 @@ nil) (defmethod display-parse-tree ((entity clause-prolog-text) (syntax prolog-syntax) pane) - (display-parse-tree (clause entity) syntax pane) - (display-parse-tree (text-rest entity) syntax pane)) + (display-parse-tree (text-rest entity) syntax pane) + (display-parse-tree (clause entity) syntax pane)) (defmethod display-parse-tree ((entity directive-prolog-text) (syntax prolog-syntax) pane) + (display-parse-tree (text-rest entity) syntax pane) (with-text-face (pane :italic) - (display-parse-tree (directive entity) syntax pane)) - (display-parse-tree (text-rest entity) syntax pane)) + (display-parse-tree (directive entity) syntax pane))) (defclass directive (prolog-nonterminal) ((directive-term :initarg :directive-term :accessor directive-term) @@ -581,10 +578,10 @@ (display-parse-tree (tlist entity) syntax pane)) ;;; 6.2.1 -(define-prolog-rule (prolog-text -> (directive prolog-text)) +(define-prolog-rule (prolog-text -> (prolog-text directive)) (make-instance 'directive-prolog-text :directive directive :text-rest prolog-text)) -(define-prolog-rule (prolog-text -> (clause prolog-text)) +(define-prolog-rule (prolog-text -> (prolog-text clause)) (make-instance 'clause-prolog-text :clause clause :text-rest prolog-text)) (define-prolog-rule (prolog-text -> ()) (make-instance 'empty-prolog-text)) @@ -860,10 +857,10 @@ do (skip-inter-lexeme-objects lexer scan) until (end-of-buffer-p scan) until (mark<= bot (start-offset (lexeme lexer (1- valid-lex)))) - do (when (mark>= scan high-mark) + do (when (mark> scan high-mark) (do () ((= (nb-lexemes lexer) valid-lex)) - (let ((l (lexeme lexer i))) + (let ((l (lexeme lexer valid-lex))) (cond ((mark< scan (start-offset l)) (return nil)) @@ -985,7 +982,7 @@ (+ (start-offset entity) nl 1)) (setf start (+ nl 1))))))))))) -(defmethod display-parse-tree :before ((entity prolog-lexeme) (syntax prolog-syntax) pane) +(defmethod display-parse-tree :before ((entity prolog-token) (syntax prolog-syntax) pane) (handle-whitespace pane (buffer pane) *white-space-start* (start-offset entity)) (setf *white-space-start* (end-offset entity)))

1 0

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

06 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv14737 Modified Files: prolog-syntax.lisp Log Message: Implement incremental lexing. The contract is that * UPDATE-SYNTAX notes the latest possible position that is known to be valid. * UPDATE-SYNTAX-FOR-DISPLAY, within the display bounds, attempts to revalidate the previous lex if possible, or relex if not. After UPDATE-SYNTAX-FOR-DISPLAY has finished, the entirety of the remaining lexemes are known valid (all the rest have been deleted). This may be wrong: it may be that, since lexing takes essentially no time at all, the whole buffer should be relexed each time. Date: Wed Apr 6 13:54:27 2005 Author: crhodes Index: climacs/prolog-syntax.lisp diff -u climacs/prolog-syntax.lisp:1.12 climacs/prolog-syntax.lisp:1.13 --- climacs/prolog-syntax.lisp:1.12 Wed Apr 6 11:30:19 2005 +++ climacs/prolog-syntax.lisp Wed Apr 6 13:54:27 2005 @@ -148,7 +148,7 @@ (make-instance 'layout-text :cont nil)) (defclass prolog-lexer (incremental-lexer) - ((valid-lex :initarg :valid-lex :accessor valid-lex :initform 1))) + ((valid-lex :initarg :valid-lex :initform 1))) (defmethod next-lexeme ((lexer prolog-lexer) scan) (let ((string (make-array 0 :element-type 'character @@ -852,21 +852,26 @@ (defmethod update-syntax-for-display (buffer (syntax prolog-syntax) top bot) (with-slots (parser lexer valid-parse) syntax (with-slots (climacs-syntax::lexemes valid-lex) lexer - (let ((scan (clone-mark (low-mark buffer) :left))) + (let ((scan (clone-mark (low-mark buffer) :left)) + (high-mark (high-mark buffer))) (setf (offset scan) (end-offset (lexeme lexer (1- valid-lex)))) - ;; lex as far as we need. We actually win quite a lot if we - ;; can implement the splicing described in the FIXME note, - ;; below, because there's then a good chance that CLIM's - ;; incremental redisplay will Do The Right Thing (on the EQ - ;; lexemes) - (loop do (skip-inter-lexeme-objects lexer scan) + (loop named relex + do (skip-inter-lexeme-objects lexer scan) until (end-of-buffer-p scan) until (mark<= bot (start-offset (lexeme lexer (1- valid-lex)))) - ;; FIXME: a further criterion is when scan matches the - ;; start-offset of an element in lexemes, at which point - ;; we know that the entirety of the rest of the old lex - ;; is valid without doing any further work. + do (when (mark>= scan high-mark) + (do () + ((= (nb-lexemes lexer) valid-lex)) + (let ((l (lexeme lexer i))) + (cond + ((mark< scan (start-offset l)) + (return nil)) + ((mark= scan (start-offset l)) + (setf valid-lex (nb-lexemes lexer)) + (return-from relex)) + (t + (delete* climacs-syntax::lexemes valid-lex)))))) do (let* ((start-mark (clone-mark scan)) (lexeme (next-lexeme lexer scan)) (size (- (offset scan) (offset start-mark)))) @@ -874,16 +879,18 @@ (slot-value lexeme 'climacs-syntax::size) size) (insert-lexeme lexer valid-lex lexeme) (incf valid-lex))) - ;; remove lexemes which we know to be invalid - (let ((end (end-offset (lexeme lexer (1- valid-lex))))) - (loop until (= (nb-lexemes lexer) valid-lex) - while (< (start-offset (lexeme lexer valid-lex)) end) - do (delete* climacs-syntax::lexemes valid-lex)))) + ;; remove lexemes which we know to be invalid. + ;; + ;; If we wanted some additional complexity, we could maintain + ;; the possibility of not matching a start lexeme in the + ;; visible region, but possibly elsewhere instead; however, + ;; for now, simply assume that the VALID-LEX from above is + ;; definitive. + (loop until (= (nb-lexemes lexer) valid-lex) + do (delete* climacs-syntax::lexemes valid-lex))) ;; parse up to the limit of validity imposed by the lexer, or - ;; the bottom of the visible area + ;; the bottom of the visible area, whichever comes sooner (loop until (= valid-parse valid-lex) - ;; NOTE: this ceases being the same condition as the above - ;; as soon as the FIXME note above is implemented. until (mark<= bot (start-offset (lexeme lexer (1- valid-parse)))) do (let ((current-token (lexeme lexer (1- valid-parse))) (next-lexeme (lexeme lexer valid-parse))) @@ -900,7 +907,8 @@ (let* ((low-mark (low-mark buffer)) (high-mark (high-mark buffer))) (when (mark<= low-mark high-mark) - (with-slots (climacs-syntax::lexemes valid-lex) lexer + (with-slots (climacs-syntax::lexemes valid-lex) + lexer (let ((start 1) (end (nb-elements climacs-syntax::lexemes))) (loop while (< start end)

1 0

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

06 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv5794 Modified Files: prolog-syntax.lisp Log Message: implement CANONICAL-NAME for commas (fixes crash on "1,2") Date: Wed Apr 6 11:30:19 2005 Author: crhodes Index: climacs/prolog-syntax.lisp diff -u climacs/prolog-syntax.lisp:1.11 climacs/prolog-syntax.lisp:1.12 --- climacs/prolog-syntax.lisp:1.11 Tue Apr 5 22:28:29 2005 +++ climacs/prolog-syntax.lisp Wed Apr 6 11:30:19 2005 @@ -448,6 +448,8 @@ (defmethod canonical-name ((thing name)) ;; FIXME: should canonize (lexeme-string (syntactic-lexeme thing))) +(defmethod canonical-name ((thing comma)) + ",") (defclass empty-list (prolog-nonterminal) (([ :initarg :[ :accessor [) (] :initarg :] :accessor ])))

1 0

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

06 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv25110 Modified Files: pane.lisp Log Message: Fixed the redisplay bug reported by Christophe Rhodes. Date: Wed Apr 6 07:31:54 2005 Author: rstrandh Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.23 climacs/pane.lisp:1.24 --- climacs/pane.lisp:1.23 Sat Mar 19 23:08:31 2005 +++ climacs/pane.lisp Wed Apr 6 07:31:53 2005 @@ -361,6 +361,7 @@ (let ((nb-lines-in-pane (nb-lines-in-pane pane))) (with-slots (top bot cache) pane (setf (offset bot) (offset top)) + (end-of-line bot) (loop until (end-of-buffer-p bot) repeat (1- nb-lines-in-pane) do (forward-object bot) @@ -392,8 +393,8 @@ ;;; Make the cache reflect the contents of the buffer starting at top, ;;; trying to preserve contents as much as possible, and inserting a ;;; nil entry where buffer contents is unknonwn. The size of the -;;; cache size at the end may be smaller than, equal to, or greater -;;; than the number of lines in the pane. +;;; cache at the end may be smaller than, equal to, or greater than +;;; the number of lines in the pane. (defun adjust-cache (pane) (let* ((buffer (buffer pane)) (high-mark (high-mark buffer))

1 0

← Newer
1
...
56
57
58
59
60
61
62
...
85
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs