climacs-cvs April 2005

climacs-cvs@common-lisp.net

3 participants
36 discussions

[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

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

05 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv24772 Modified Files: prolog-syntax.lisp Log Message: Enable incremental-redisplay / updating-output This isn't as big a win as it could be, because of the invalidation of lexemes without attempting to splice in the results of a previous lex. (see FIXME comments in update-syntax-for-redisplay) Date: Tue Apr 5 22:28:30 2005 Author: crhodes Index: climacs/prolog-syntax.lisp diff -u climacs/prolog-syntax.lisp:1.10 climacs/prolog-syntax.lisp:1.11 --- climacs/prolog-syntax.lisp:1.10 Mon Apr 4 23:00:42 2005 +++ climacs/prolog-syntax.lisp Tue Apr 5 22:28:29 2005 @@ -56,7 +56,7 @@ ()) (defclass prolog-token (prolog-parse-tree) - ()) + ((ink) (face))) (defclass prolog-operator (prolog-token) ()) @@ -942,18 +942,15 @@ (defmethod display-parse-tree ((entity prolog-token) (syntax prolog-syntax) pane) (flet ((cache-test (t1 t2) (and (eq t1 t2) - #+nil (eq (slot-value t1 'ink) (medium-ink (sheet-medium pane))) - #+nil (eq (slot-value t1 'face) (text-style-face (medium-text-style (sheet-medium pane))))))) -#| (updating-output (pane :unique-id entity + (updating-output (pane :unique-id entity :id-test #'eq :cache-value entity - :cache-test #'cache-test)|# - (with-slots (#|ink face|#) entity - #+nil + :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) @@ -976,7 +973,7 @@ (handle-whitespace pane (buffer pane) (+ (start-offset entity) nl) (+ (start-offset entity) nl 1)) - (setf start (+ nl 1)))))))))) + (setf start (+ nl 1))))))))))) (defmethod display-parse-tree :before ((entity prolog-lexeme) (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 04 Apr '05

04 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv6433 Modified Files: prolog-syntax.lisp Log Message: Just comment fixups Date: Mon Apr 4 23:00:45 2005 Author: crhodes Index: climacs/prolog-syntax.lisp diff -u climacs/prolog-syntax.lisp:1.9 climacs/prolog-syntax.lisp:1.10 --- climacs/prolog-syntax.lisp:1.9 Mon Apr 4 21:09:49 2005 +++ climacs/prolog-syntax.lisp Mon Apr 4 23:00:42 2005 @@ -452,11 +452,13 @@ (([ :initarg :[ :accessor [) (] :initarg :] :accessor ]))) (defmethod canonical-name ((thing empty-list)) + ;; FIXME: this clashes with the canonical name for the atom '[]' "[]") (defclass curly-brackets (prolog-nonterminal) (({ :initarg :{ :accessor {) (} :initarg :} :accessor }))) (defmethod canonical-name ((thing curly-brackets)) + ;; FIXME: see comment in CANONICAL-NAME (EMPTY-LIST) "{}") (defmethod display-parse-tree ((entity atom) (syntax prolog-syntax) pane) (display-parse-tree (value entity) syntax pane)) @@ -857,8 +859,6 @@ ;; incremental redisplay will Do The Right Thing (on the EQ ;; lexemes) (loop do (skip-inter-lexeme-objects lexer scan) - ;; FIXME: are we allowed to mix DO and UNTIL like this? - ;; I doubt it. 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

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs April 2005