Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv3065

Modified Files: cl-syntax.lisp Log Message: fixed some bugs in balanced comment, fun-expr, vect-expr.line-comment not working as it should be Date: Fri Apr 29 22:10:32 2005 Author: pfong

Index: climacs/cl-syntax.lisp diff -u climacs/cl-syntax.lisp:1.11 climacs/cl-syntax.lisp:1.12 --- climacs/cl-syntax.lisp:1.11 Wed Apr 27 16:02:03 2005 +++ climacs/cl-syntax.lisp Fri Apr 29 22:10:32 2005 @@ -56,7 +56,7 @@ (defclass double-quote (cl-lexeme) ()) (defclass hex (cl-lexeme) ()) (defclass pipe (cl-lexeme) ()) -(defclass semicolon (cl-lexeme) ()) +(defclass line-comment-entry (cl-lexeme) ()) (defclass backquote (cl-lexeme) ()) (defclass at (cl-lexeme) ()) (defclass backslash (cl-lexeme) ()) @@ -88,9 +88,11 @@ (#+ (fo) (make-instance 'plus-symbol)) (#- (fo) (make-instance 'minus-symbol)) (#; (fo) (loop until (end-of-buffer-p scan) - while (eql (object-after scan) #;) + until (eql (object-after scan) #\Newline) do (fo)) - (make-instance 'semicolon)) + (if (end-of-buffer-p scan) + (make-instance 'other-entry) + (make-instance 'line-comment-entry))) (t (cond ((digit-char-p object) (loop until (end-of-buffer-p scan) while (digit-char-p (object-after scan)) @@ -161,7 +163,6 @@

(defclass empty-item (cl-entry) ())

- (defmethod display-parse-tree ((entity empty-item) (syntax cl-syntax) pane) (declare (ignore pane)) nil) @@ -173,11 +174,11 @@

(add-cl-rule (token-char -> (default-item) :item default-item)) (add-cl-rule (token-char -> (comma) :item comma)) -(add-cl-rule (token-char -> (semicolon) :item semicolon)) (add-cl-rule (token-char -> (backquote) :item backquote)) (add-cl-rule (token-char -> (at) :item at)) (add-cl-rule (token-char -> (plus-symbol) :item plus-symbol)) (add-cl-rule (token-char -> (minus-symbol) :item minus-symbol)) +(add-cl-rule (token-char -> (pipe) :item pipe))

(defmethod display-parse-tree ((entity token-char) (syntax cl-syntax) pane) (with-slots (item) entity @@ -219,6 +220,7 @@ (add-cl-rule (string-item -> (backslash) :item backslash)) (add-cl-rule (string-item -> (slash) :item slash)) (add-cl-rule (string-item -> (dot) :item dot)) +(add-cl-rule (string-item -> (line-comment-entry) :item line-comment-entry))

(define-list string-items empty-string-items @@ -274,28 +276,47 @@ (with-slots (item) entity (display-parse-tree item syntax pane)))

+;;;;;;;;;;;;; line-comment + +(defclass line-comment (cl-item) ()) + +(add-cl-rule (line-comment -> ((item line-comment-entry)) :item item)) + +(defmethod display-parse-tree ((entity line-comment) (syntax cl-syntax) pane) + (with-slots (item) entity + (with-drawing-options (pane :ink (make-rgb-color 0.6 0.16 0.3)) + (display-parse-tree item syntax pane))))

;;;;;;;;;;;;; balanced-comment

(defclass balanced-comment (cl-entry) ((start-hex :initarg :start-hex) + (start-pipe :initarg :start-pipe) (item :initarg :item) + (end-pipe :initarg :end-pipe) (end-hex :initarg :end-hex)))

(add-cl-rule (balanced-comment -> ((start-hex hex) - (item identifier-compound (= (end-offset start-hex) - (start-offset item))) - (end-hex hex (= (end-offset item) + (start-pipe pipe (= (end-offset + start-hex) + (start-offset start-pipe))) + (item identifier-items) + (end-pipe pipe) + (end-hex hex (= (end-offset end-pipe) (start-offset end-hex)))) :start-hex start-hex + :start-pipe start-pipe :item item + :end-pipe end-pipe :end-hex end-hex))

(defmethod display-parse-tree ((entity balanced-comment) (syntax cl-syntax) pane) - (with-slots (start-hex item end-hex) entity + (with-slots (start-hex start-pipe item end-pipe end-hex) entity (with-drawing-options (pane :ink (make-rgb-color 0.6 0.16 0.3)) (display-parse-tree start-hex syntax pane) + (display-parse-tree start-pipe syntax pane) (display-parse-tree item syntax pane) + (display-parse-tree end-pipe syntax pane) (display-parse-tree end-hex syntax pane))))

;;;;;;;;;;;;; string @@ -697,7 +718,8 @@ (quoted-expr :initarg :quoted-expr)))

(add-cl-rule (fun-expr -> ((start hex) - (quoted-expr quoted-expr)) + (quoted-expr quoted-expr (= (end-offset start) + (start-offset quoted-expr)))) :start start :quoted-expr quoted-expr))

(defmethod display-parse-tree ((entity fun-expr) (syntax cl-syntax) pane) @@ -714,7 +736,8 @@ (list-expr :initarg :list-expr)))

(add-cl-rule (vect-expr -> ((start hex) - (list-expr list-expr)) + (list-expr list-expr (= (end-offset start) + (start-offset list-expr)))) :start start :list-expr list-expr))

(defmethod display-parse-tree ((entity vect-expr) (syntax cl-syntax) pane) @@ -838,6 +861,7 @@ (add-cl-rule (cl-terminal -> (read-time-conditional-plus) :item read-time-conditional-plus)) (add-cl-rule (cl-terminal -> (read-time-conditional-minus) :item read-time-conditional-minus)) (add-cl-rule (cl-terminal -> (read-time-evaluation) :item read-time-evaluation)) +(add-cl-rule (cl-terminal -> (line-comment) :item line-comment))

(define-list cl-terminals empty-cl-terminals nonempty-cl-terminals cl-terminal)