[climacs-cvs] CVS climacs
thenriksen
thenriksen at common-lisp.net
Mon Nov 13 09:01:52 UTC 2006
Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv8855
Modified Files:
html-syntax.lisp ttcn3-syntax.lisp
Log Message:
TTCN3 syntax and HTML syntax should work now, but they have not been
fully tested.
--- /project/climacs/cvsroot/climacs/html-syntax.lisp 2006/11/12 16:06:06 1.36
+++ /project/climacs/cvsroot/climacs/html-syntax.lisp 2006/11/13 09:01:52 1.37
@@ -53,24 +53,28 @@
(attributes :initform nil :initarg :attributes)
(end :initarg :end)))
-(defmethod display-parse-tree ((entity html-start-tag) (syntax html-syntax) pane)
+(defgeneric display-parse-tree (parse-symbol pane drei syntax))
+
+(defmethod display-parse-tree ((entity html-start-tag) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (start name attributes end) entity
- (display-parse-tree start syntax pane)
- (display-parse-tree name syntax pane)
+ (display-parse-tree start pane drei syntax)
+ (display-parse-tree name pane drei syntax)
(unless (null attributes)
- (display-parse-tree attributes syntax pane))
- (display-parse-tree end syntax pane)))
+ (display-parse-tree attributes pane drei syntax))
+ (display-parse-tree end pane drei syntax)))
(defclass html-end-tag (html-tag)
((start :initarg :start)
(name :initarg :name)
(end :initarg :end)))
-(defmethod display-parse-tree ((entity html-end-tag) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity html-end-tag) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (start name attributes end) entity
- (display-parse-tree start syntax pane)
- (display-parse-tree name syntax pane)
- (display-parse-tree end syntax pane)))
+ (display-parse-tree start pane drei syntax)
+ (display-parse-tree name pane drei syntax)
+ (display-parse-tree end pane drei syntax)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -170,14 +174,16 @@
(make-instance ',nonempty-name
:items ,name :item ,item-name)))
- (defmethod display-parse-tree ((entity ,empty-name) (syntax html-syntax) pane)
+ (defmethod display-parse-tree ((entity ,empty-name) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(declare (ignore pane))
nil)
- (defmethod display-parse-tree ((entity ,nonempty-name) (syntax html-syntax) pane)
+ (defmethod display-parse-tree ((entity ,nonempty-name) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (items item) entity
- (display-parse-tree items syntax pane)
- (display-parse-tree item syntax pane))))))
+ (display-parse-tree items pane drei syntax)
+ (display-parse-tree item pane drei syntax))))))
(defmacro define-nonempty-list (name item-name)
(let ((empty-name (gensym))
@@ -199,14 +205,16 @@
(make-instance ',nonempty-name
:items ,name :item ,item-name)))
- (defmethod display-parse-tree ((entity ,empty-name) (syntax html-syntax) pane)
+ (defmethod display-parse-tree ((entity ,empty-name) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(declare (ignore pane))
nil)
- (defmethod display-parse-tree ((entity ,nonempty-name) (syntax html-syntax) pane)
+ (defmethod display-parse-tree ((entity ,nonempty-name) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (items item) entity
- (display-parse-tree items syntax pane)
- (display-parse-tree item syntax pane))))))
+ (display-parse-tree items pane drei syntax)
+ (display-parse-tree item pane drei syntax))))))
;;;;;;;;;;;;;;; string
@@ -226,12 +234,13 @@
(end delimiter (word-is end "\"")))
:start start :lexemes string-lexemes :end end))
-(defmethod display-parse-tree ((entity html-string) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity html-string) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (start lexemes end) entity
- (display-parse-tree start syntax pane)
+ (display-parse-tree start pane drei syntax)
(with-text-face (pane :italic)
- (display-parse-tree lexemes syntax pane))
- (display-parse-tree end syntax pane)))
+ (display-parse-tree lexemes pane drei syntax))
+ (display-parse-tree end pane drei syntax)))
;;;;;;;;;;;;;;; attributes
@@ -239,10 +248,11 @@
((name :initarg :name)
(equals :initarg :equals)))
-(defmethod display-parse-tree :before ((entity html-attribute) (syntax html-syntax) pane)
+(defmethod display-parse-tree :before ((entity html-attribute) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (name equals) entity
- (display-parse-tree name syntax pane)
- (display-parse-tree equals syntax pane)))
+ (display-parse-tree name pane drei syntax)
+ (display-parse-tree equals pane drei syntax)))
(defclass common-attribute (html-attribute) ())
@@ -265,9 +275,10 @@
2))))
:name name :equals equals :lang lang))
-(defmethod display-parse-tree ((entity lang-attr) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity lang-attr) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (lang) entity
- (display-parse-tree lang syntax pane)))
+ (display-parse-tree lang pane drei syntax)))
;;;;;;;;;;;;;;; dir attribute
@@ -282,9 +293,10 @@
(word-is dir "ltr")))))
:name name :equals equals :dir dir))
-(defmethod display-parse-tree ((entity dir-attr) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity dir-attr) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (dir) entity
- (display-parse-tree dir syntax pane)))
+ (display-parse-tree dir pane drei syntax)))
;;;;;;;;;;;;;;; href attribute
@@ -298,9 +310,10 @@
(href html-string))
:name name :equals equals :href href))
-(defmethod display-parse-tree ((entity href-attr) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity href-attr) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (href) entity
- (display-parse-tree href syntax pane)))
+ (display-parse-tree href pane drei syntax)))
;;;;;;;;;;;;;;; title
@@ -311,9 +324,10 @@
(add-html-rule (title-item -> (word) :item word))
(add-html-rule (title-item -> (delimiter) :item delimiter))
-(defmethod display-parse-tree ((entity title-item) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity title-item) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (item) entity
- (display-parse-tree item syntax pane)))
+ (display-parse-tree item pane drei syntax)))
(define-list title-items title-item)
@@ -325,12 +339,13 @@
(add-html-rule (title -> (<title> title-items </title>)
:<title> <title> :items title-items :</title> </title>))
-(defmethod display-parse-tree ((entity title) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity title) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (<title> items </title>) entity
- (display-parse-tree <title> syntax pane)
+ (display-parse-tree <title> pane drei syntax)
(with-text-face (pane :bold)
- (display-parse-tree items syntax pane))
- (display-parse-tree </title> syntax pane)))
+ (display-parse-tree items pane drei syntax))
+ (display-parse-tree </title> pane drei syntax)))
;;;;;;;;;;;;;;; inline-element, block-level-element
@@ -348,9 +363,10 @@
(add-html-rule ($inline -> (word) :contents word))
(add-html-rule ($inline -> (delimiter) :contents delimiter))
-(defmethod display-parse-tree ((entity $inline) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity $inline) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (contents) entity
- (display-parse-tree contents syntax pane)))
+ (display-parse-tree contents pane drei syntax)))
(define-list $inlines $inline)
@@ -364,9 +380,10 @@
:predict-test (lambda (token)
(typep token 'start-tag-start)))
-(defmethod display-parse-tree ((entity $flow) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity $flow) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (contents) entity
- (display-parse-tree contents syntax pane)))
+ (display-parse-tree contents pane drei syntax)))
(define-list $flows $flow)
@@ -377,12 +394,13 @@
(contents :initarg :contents)
(end :initarg :end)))
-(defmethod display-parse-tree ((entity heading) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity heading) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (start contents end) entity
- (display-parse-tree start syntax pane)
+ (display-parse-tree start pane drei syntax)
(with-text-face (pane :bold)
- (display-parse-tree contents syntax pane))
- (display-parse-tree end syntax pane)))
+ (display-parse-tree contents pane drei syntax))
+ (display-parse-tree end pane drei syntax)))
(defmacro define-heading (class-name tag-string start-tag-name end-tag-name)
`(progn
@@ -409,9 +427,10 @@
(add-html-rule (<a>-attribute -> (href-attr) :attribute href-attr))
-(defmethod display-parse-tree ((entity <a>-attribute) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity <a>-attribute) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (attribute) entity
- (display-parse-tree attribute syntax pane)))
+ (display-parse-tree attribute pane drei syntax)))
(define-list <a>-attributes <a>-attribute)
@@ -434,12 +453,13 @@
(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)
+(defmethod display-parse-tree ((entity a-element) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (<a> items </a>) entity
- (display-parse-tree <a> syntax pane)
+ (display-parse-tree <a> pane drei syntax)
(with-text-face (pane :bold)
- (display-parse-tree items syntax pane))
- (display-parse-tree </a> syntax pane)))
+ (display-parse-tree items pane drei syntax))
+ (display-parse-tree </a> pane drei syntax)))
;;;;;;;;;;;;;;; br element
@@ -450,9 +470,10 @@
(add-html-rule (br-element -> (<br>) :<br> <br>))
-(defmethod display-parse-tree ((entity br-element) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity br-element) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (<br>) entity
- (display-parse-tree <br> syntax pane)))
+ (display-parse-tree <br> pane drei syntax)))
;;;;;;;;;;;;;;; p element
@@ -475,11 +496,12 @@
(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)
+(defmethod display-parse-tree ((entity p-element) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (<p> contents </p>) entity
- (display-parse-tree <p> syntax pane)
- (display-parse-tree contents syntax pane)
- (display-parse-tree </p> syntax pane)))
+ (display-parse-tree <p> pane drei syntax)
+ (display-parse-tree contents pane drei syntax)
+ (display-parse-tree </p> pane drei syntax)))
;;;;;;;;;;;;;;; li element
@@ -507,12 +529,13 @@
(add-html-rule (li-element -> (<li> $flows)
:<li> <li> :items $flows :</li> nil))
-(defmethod display-parse-tree ((entity li-element) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity li-element) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (<li> items </li>) entity
- (display-parse-tree <li> syntax pane)
- (display-parse-tree items syntax pane)
+ (display-parse-tree <li> pane drei syntax)
+ (display-parse-tree items pane drei syntax)
(when </li>
- (display-parse-tree </li> syntax pane))))
+ (display-parse-tree </li> pane drei syntax))))
;;;;;;;;;;;;;;; ul element
@@ -540,11 +563,12 @@
(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)
+(defmethod display-parse-tree ((entity ul-element) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (<ul> items </ul>) entity
- (display-parse-tree <ul> syntax pane)
- (display-parse-tree items syntax pane)
- (display-parse-tree </ul> syntax pane)))
+ (display-parse-tree <ul> pane drei syntax)
+ (display-parse-tree items pane drei syntax)
+ (display-parse-tree </ul> pane drei syntax)))
;;;;;;;;;;;;;;; hr element
@@ -555,9 +579,10 @@
(add-html-rule (hr-element -> (<hr>) :<hr> <hr>))
-(defmethod display-parse-tree ((entity hr-element) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity hr-element) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (<hr>) entity
- (display-parse-tree <hr> syntax pane)))
+ (display-parse-tree <hr> pane drei syntax)))
;;;;;;;;;;;;;;; body element
@@ -566,9 +591,10 @@
(add-html-rule (body-item -> ((element block-level-element)) :item element))
-(defmethod display-parse-tree ((entity body-item) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity body-item) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (item) entity
- (display-parse-tree item syntax pane)))
+ (display-parse-tree item pane drei syntax)))
(define-list body-items body-item)
@@ -580,11 +606,12 @@
(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)
+(defmethod display-parse-tree ((entity body) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (<body> items </body>) entity
- (display-parse-tree <body> syntax pane)
- (display-parse-tree items syntax pane)
- (display-parse-tree </body> syntax pane)))
+ (display-parse-tree <body> pane drei syntax)
+ (display-parse-tree items pane drei syntax)
+ (display-parse-tree </body> pane drei syntax)))
;;;;;;;;;;;;;;; head
@@ -596,20 +623,22 @@
(add-html-rule (head -> (<head> title </head>)
:<head> <head> :title title :</head> </head>))
-(defmethod display-parse-tree ((entity head) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity head) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (<head> title </head>) entity
- (display-parse-tree <head> syntax pane)
- (display-parse-tree title syntax pane)
- (display-parse-tree </head> syntax pane)))
+ (display-parse-tree <head> pane drei syntax)
+ (display-parse-tree title pane drei syntax)
+ (display-parse-tree </head> pane drei syntax)))
;;;;;;;;;;;;;;; html
(defclass <html>-attribute (html-nonterminal)
((attribute :initarg :attribute)))
-(defmethod display-parse-tree ((entity <html>-attribute) (syntax html-syntax) pane)
+(defmethod display-parse-tree ((entity <html>-attribute) (pane clim-stream-pane)
+ (drei drei) (syntax html-syntax))
(with-slots (attribute) entity
- (display-parse-tree attribute syntax pane)))
+ (display-parse-tree attribute pane drei syntax)))
(add-html-rule (<html>-attribute -> (lang-attr) :attribute lang-attr))
(add-html-rule (<html>-attribute -> (dir-attr) :attribute dir-attr))
@@ -636,12 +665,13 @@
(add-html-rule (html -> (<html> head body </html>)
:<html> <html> :head head :body body :</html> </html>))
[103 lines skipped]
--- /project/climacs/cvsroot/climacs/ttcn3-syntax.lisp 2006/11/12 16:06:06 1.8
+++ /project/climacs/cvsroot/climacs/ttcn3-syntax.lisp 2006/11/13 09:01:52 1.9
@@ -26,7 +26,7 @@
(:export))
(in-package :climacs-ttcn3-syntax)
-(defgeneric display-parse-tree (entity syntax pane))
+(defgeneric display-parse-tree (parse-symbol pane drei syntax))
(defclass ttcn3-parse-tree (parse-tree) ())
@@ -158,14 +158,16 @@
(make-instance ',nonempty-name
:items ,name :item ,item-name))) *ttcn3-grammar*)
- (defmethod display-parse-tree ((entity ,empty-name) (syntax ttcn3-syntax) pane)
+ (defmethod display-parse-tree ((entity ,empty-name) (pane clim-stream-pane)
+ (drei drei) (syntax ttcn3-syntax))
(declare (ignore pane))
nil)
- (defmethod display-parse-tree ((entity ,nonempty-name) (syntax ttcn3-syntax) pane)
+ (defmethod display-parse-tree ((entity ,nonempty-name) (pane clim-stream-pane)
+ (drei drei) (syntax ttcn3-syntax))
(with-slots (items item) entity
- (display-parse-tree items syntax pane)
- (display-parse-tree item syntax pane)))))
+ (display-parse-tree items drei pane syntax)
+ (display-parse-tree item drei pane syntax)))))
(defmacro define-simple-list (name item-name)
(let ((empty-name (gensym))
@@ -213,7 +215,8 @@
(add-rule (grammar-rule (,name -> ((word identifier (word-is word ,(first rule-body)))) :word word))
,grammar)
,@(if start-p `((add-rule (grammar-rule (,terminal -> (,name) :item ,name)) ,grammar)))
- (defmethod display-parse-tree :around ((entity ,name) (syntax ,syntax) pane)
+ (defmethod display-parse-tree :around ((entity ,name) (pane clim-stream-pane)
+ (drei drei) (syntax ,syntax))
(with-drawing-options (pane :ink +blue-violet+)
(call-next-method)))))
((and (eql (length rule-body) 1)
@@ -223,8 +226,9 @@
,@(loop for alt in (cdr (first rule-body))
collect `(add-rule (grammar-rule (,name -> ((item ,alt)) :item item)) ,grammar))
,@(if start-p `((add-rule (grammar-rule (,terminal -> (,name) :item ,name)) ,grammar)))
- (defmethod display-parse-tree ((entity ,name) (syntax ,syntax) pane)
- (display-parse-tree (slot-value entity 'item) syntax pane))))
+ (defmethod display-parse-tree ((entity ,name) (pane clim-stream-pane)
+ (drei drei) (syntax ,syntax))
+ (display-parse-tree (slot-value entity 'item) pane drei syntax))))
((and (eql (length rule-body) 1)
(typep (first rule-body) 'cons)
(eq (first (first rule-body)) 'nonempty-list-of))
@@ -247,11 +251,12 @@
appending `(,(intern (symbol-name component) :keyword)
,component)))) ,grammar)
,@(if start-p `((add-rule (grammar-rule (,terminal -> (,name) :item ,name)) ,grammar)))
- (defmethod display-parse-tree ((entity ,name) (syntax ,syntax) pane)
+ (defmethod display-parse-tree ((entity ,name) (pane clim-stream-pane)
+ (drei drei) (syntax ,syntax))
(with-slots ,rule-body
entity
,@(loop for component in rule-body collect
- `(display-parse-tree ,component syntax pane))))))
+ `(display-parse-tree ,component pane drei syntax))))))
(t (error "Unrecognized rule body ~S for rule ~S~%" rule-body
name)))))
`(progn
@@ -321,11 +326,13 @@
(or identifier number-form)))
-(defmethod display-parse-tree ((entity ttcn3-terminal) (syntax ttcn3-syntax) pane)
+(defmethod display-parse-tree ((entity ttcn3-terminal) (pane clim-stream-pane)
+ (drei drei) (syntax ttcn3-syntax))
(with-slots (item) entity
- (display-parse-tree item syntax pane)))
+ (display-parse-tree item pane drei syntax)))
-(defmethod display-parse-tree ((entity ttcn3-entry) (syntax ttcn3-syntax) pane)
+(defmethod display-parse-tree ((entity ttcn3-entry) (pane clim-stream-pane)
+ (drei drei) (syntax ttcn3-syntax))
(flet ((cache-test (t1 t2)
(and (eq t1 t2)
(eq (slot-value t1 'ink)
@@ -346,20 +353,21 @@
'string
:stream pane)))))
-(defgeneric display-parse-stack (symbol stack syntax pane))
+(defgeneric display-parse-stack (symbol stack pane drei syntax))
-(defmethod display-parse-stack (symbol stack (syntax ttcn3-syntax) pane)
+(defmethod display-parse-stack (symbol stack (pane clim-stream-pane)
+ (drei drei) (syntax ttcn3-syntax))
(let ((next (parse-stack-next stack)))
(unless (null next)
- (display-parse-stack (parse-stack-symbol next) next syntax pane))
+ (display-parse-stack (parse-stack-symbol next) next pane drei syntax))
(loop for parse-tree in (reverse (parse-stack-parse-trees stack))
- do (display-parse-tree parse-tree syntax pane))))
+ do (display-parse-tree parse-tree pane drei syntax))))
-(defun display-parse-state (state syntax pane)
+(defun display-parse-state (state pane drei syntax)
(let ((top (parse-stack-top state)))
(if (not (null top))
- (display-parse-stack (parse-stack-symbol top) top syntax pane)
- (display-parse-tree (target-parse-tree state) syntax pane))))
+ (display-parse-stack (parse-stack-symbol top) top pane drei syntax)
+ (display-parse-tree (target-parse-tree state) pane drei syntax))))
(defmethod update-syntax-for-display (buffer (syntax ttcn3-syntax) top bot)
(with-slots (parser lexer valid-parse) syntax
@@ -390,38 +398,40 @@
(defun handle-whitespace (pane buffer start end)
(let ((space-width (space-width pane))
- (tab-width (tab-width pane)))
- (loop while (and (< start end)
- (whitespacep (syntax buffer)
- (buffer-object buffer start)))
- do (ecase (buffer-object buffer start)
- (#\Newline (terpri pane)
- (setf (aref *cursor-positions* (incf *current-line*))
- (multiple-value-bind (x y) (stream-cursor-position pane)
- (declare (ignore x))
- y)))
- (#\Space (stream-increment-cursor-position
- pane space-width 0))
- (#\Tab (let ((x (stream-cursor-position pane)))
- (stream-increment-cursor-position
- pane (- tab-width (mod x tab-width)) 0)))
- (#\Page nil))
- (incf start))))
+ (tab-width (tab-width pane)))
+ (with-sheet-medium (medium pane)
+ (with-accessors ((cursor-positions cursor-positions)) (syntax buffer)
+ (loop while (< start end)
+ do (case (buffer-object buffer start)
+ (#\Newline (record-line-vertical-offset pane (syntax buffer) (incf *current-line*))
+ (terpri pane)
+ (stream-increment-cursor-position
+ pane (first (aref cursor-positions 0)) 0))
+ ((#\Page #\Return #\Space) (stream-increment-cursor-position
+ pane space-width 0))
+ (#\Tab (let ((x (stream-cursor-position pane)))
+ (stream-increment-cursor-position
+ pane (- tab-width (mod x tab-width)) 0))))
+ (incf start))))))
-(defmethod display-parse-tree :before ((entity ttcn3-entry) (syntax ttcn3-syntax) pane)
+(defmethod display-parse-tree :before ((entity ttcn3-entry) (pane clim-stream-pane)
+ (drei drei) (syntax ttcn3-syntax))
(handle-whitespace pane (buffer pane) *white-space-start* (start-offset entity))
(setf *white-space-start* (end-offset entity)))
-(defmethod display-parse-tree :around ((entity ttcn3-parse-tree) syntax pane)
+(defmethod display-parse-tree :around ((entity ttcn3-parse-tree) pane drei syntax)
(with-slots (top bot) pane
(when (and (end-offset entity) (mark> (end-offset entity) top))
(call-next-method))))
-(defmethod redisplay-pane-with-syntax ((pane drei-pane) (syntax ttcn3-syntax) current-p)
+(defmethod display-drei-contents ((pane clim-stream-pane) (drei drei) (syntax ttcn3-syntax))
(with-slots (top bot) pane
- (setf *cursor-positions* (make-array (1+ (number-of-lines-in-region top bot)))
- *current-line* 0
- (aref *cursor-positions* 0) (stream-cursor-position pane))
+ (with-accessors ((cursor-positions cursor-positions)) syntax
+ (setf cursor-positions (make-array (1+ (number-of-lines-in-region top bot))
+ :initial-element nil)
+ *current-line* 0
+ (aref cursor-positions 0) (multiple-value-list
+ (stream-cursor-position pane))))
(with-slots (lexer) syntax
(let ((average-token-size (max (float (/ (size (buffer pane)) (nb-lexemes lexer)))
1.0)))
@@ -440,19 +450,15 @@
(loop until (or (mark<= (end-offset (lexeme lexer (1- start-token-index))) top)
(not (parse-state-empty-p
(slot-value (lexeme lexer (1- start-token-index)) 'state))))
- do (decf start-token-index))
+ do (decf start-token-index))
(let ((*white-space-start* (offset top)))
;; display the parse tree if any
(unless (parse-state-empty-p (slot-value (lexeme lexer (1- start-token-index)) 'state))
(display-parse-state (slot-value (lexeme lexer (1- start-token-index)) 'state)
- syntax
- pane))
+ pane drei syntax))
;; display the lexemes
(with-drawing-options (pane :ink (make-rgb-color 0.7 0.7 0.7))
(loop while (< start-token-index end-token-index)
do (let ((token (lexeme lexer start-token-index)))
- (display-parse-tree token syntax pane))
- (incf start-token-index))))))))
- (when (region-visible-p pane) (display-region pane syntax))
- (display-cursor pane syntax current-p)))
-
+ (display-parse-tree token pane drei syntax))
+ (incf start-token-index))))))))))
More information about the Climacs-cvs
mailing list