climacs-cvs November 2006

climacs-cvs@common-lisp.net

1 participants
11 discussions

[climacs-cvs] CVS climacs
by thenriksen 24 Nov '06

24 Nov '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv17818 Modified Files: INSTALL Log Message: Updated installation instructions. --- /project/climacs/cvsroot/climacs/INSTALL 2006/03/25 22:29:12 1.8 +++ /project/climacs/cvsroot/climacs/INSTALL 2006/11/24 22:52:27 1.9 @@ -8,14 +8,16 @@ this far, it means that you have either extracted a tar file with everything in it, or checked out the files from some CVS repository. -0. You need to check out the flexichain and esa projects from +0. You need to check out the flexichain project from common-lisp.net. If you are not a member of those projects, here is how you do it: cvs -z3 -d :pserver:anonymous:anonymous@common-lisp.net:/project/flexichain/cvsroot co flexichain cvs -z3 -d :pserver:anonymous:anonymous@common-lisp.net:/project/climacs/cvsroot co esa - Ensure that asdf can find the .asd files for these projects. + Ensure that asdf can find the .asd files for these projects. Recent + versions of McCLIM depend on Flexichain, and thus, you might + already have it installed. 1. Start Lisp either from the shell or from Emacs @@ -29,9 +31,10 @@ This command will compile and load the source files in the right order. -4. (climacs-gui::climacs) +4. (climacs:climacs) - Start the Climacs editor. + Start the Climacs editor. Alternatively, try (climacs:climacs + :new-process t), to start Climacs in a new thread. Finally, please notice that as we develop Climacs, we occasionally find bugs in McCLIM, or ask for functionality of McCLIM that can be

1 0

[climacs-cvs] CVS climacs
by thenriksen 22 Nov '06

22 Nov '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv1683 Modified Files: gui.lisp Log Message: This definition is not actually necessary. --- /project/climacs/cvsroot/climacs/gui.lisp 2006/11/12 16:06:06 1.232 +++ /project/climacs/cvsroot/climacs/gui.lisp 2006/11/22 18:27:03 1.233 @@ -295,9 +295,6 @@ "") pane)))) -(defmethod execute-drei-command ((drei-instance climacs-pane) command) - (execute-frame-command (pane-frame drei-instance) command)) - (defmethod execute-frame-command :around ((frame climacs) command) (handling-drei-conditions (with-undo ((buffers frame))

1 0

[climacs-cvs] CVS climacs
by thenriksen 16 Nov '06

16 Nov '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv2794 Modified Files: prolog-syntax.lisp Log Message: Fix Prolog-syntax (well, one can hope). Should now work with the crazy Drei cursor-positioning code, and not defer redisplay to the method for Fundamental syntax. --- /project/climacs/cvsroot/climacs/prolog-syntax.lisp 2006/11/12 16:06:06 1.30 +++ /project/climacs/cvsroot/climacs/prolog-syntax.lisp 2006/11/16 15:05:23 1.31 @@ -1218,31 +1218,32 @@ (defvar *white-space-start* nil) -(defvar *cursor-positions* nil) (defvar *current-line* 0) (defun handle-whitespace (pane buffer start end) (let ((space-width (space-width pane)) - (tab-width (tab-width pane))) - (loop while (< start end) - do (case (buffer-object buffer start) - (#\Newline (terpri pane) - (stream-increment-cursor-position - pane (first (aref *cursor-positions* *current-line*)) 0) - (setf (aref *cursor-positions* (incf *current-line*)) - (multiple-value-list (stream-cursor-position pane)))) - ((#\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)))) + (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 :around ((entity prolog-parse-tree) (syntax prolog-syntax) (stream extended-output-stream) (drei drei)) (with-slots (top bot) drei - (when (and (end-offset entity) (mark> (end-offset entity) top)) - (call-next-method)))) + (when (and (end-offset entity) + (mark> (end-offset entity) top)) + (call-next-method)))) (defmethod display-parse-tree ((entity prolog-token) (syntax prolog-syntax) (stream extended-output-stream) (drei drei)) @@ -1313,12 +1314,15 @@ (defun nb-valid-lexemes (lexer) (slot-value lexer 'valid-lex)) -(defmethod display-drei-contents ((stream extended-output-stream) (drei drei) (syntax prolog-syntax)) +(defmethod display-drei-contents ((stream clim-stream-pane) (drei drei) (syntax prolog-syntax)) (with-slots (top bot) drei (with-accessors ((cursor-positions cursor-positions)) syntax - (setf cursor-positions (make-array (1+ (number-of-lines-in-region top bot))) + (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 stream)))) + (aref cursor-positions 0) (multiple-value-list + (stream-cursor-position stream)))) + (setf *white-space-start* (offset top)) (with-slots (lexer) syntax (let ((average-token-size (max (float (/ (size (buffer drei)) (nb-valid-lexemes lexer))) 1.0))) @@ -1338,17 +1342,16 @@ (not (parse-state-empty-p (slot-value (lexeme lexer (1- start-token-index)) 'state)))) 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 stream drei)) - ;; display the lexemes - (with-drawing-options (stream :ink +red+) - (loop while (< start-token-index end-token-index) - do (let ((token (lexeme lexer start-token-index))) - (display-parse-tree token syntax stream drei)) - (incf start-token-index)))))))))) + ;; 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 stream drei)) + ;; display the lexemes + (with-drawing-options (stream :ink +red+) + (loop while (< start-token-index end-token-index) + do (let ((token (lexeme lexer start-token-index))) + (display-parse-tree token syntax stream drei)) + (incf start-token-index))))))))) #| (climacs-gui::define-named-command com-inspect-lex ()

1 0

[climacs-cvs] CVS climacs
by thenriksen 14 Nov '06

14 Nov '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv31984 Modified Files: climacs-lisp-syntax-commands.lisp climacs-lisp-syntax.lisp Log Message: The Compile Definition command is not going to work properly in standalone Drei. Move to Climacs. --- /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp 2006/11/12 16:06:06 1.1 +++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp 2006/11/14 12:42:06 1.2 @@ -127,6 +127,12 @@ Definition command was issued." (pop-find-definition-stack)) +(define-command (com-compile-definition :name t :command-table pane-lisp-table) + () + "Compile and load definition at point." + (evaluating-interactively + (compile-definition-interactively *current-point* *current-syntax*))) + (esa:set-key 'com-eval-defun 'climacs-lisp-table '((#\x :control :meta))) @@ -154,3 +160,7 @@ (esa:set-key 'com-return-from-definition 'climacs-lisp-table '((#\, :meta))) + +(set-key 'com-compile-definition + 'pane-lisp-table + '((#\c :control) (#\c :control))) --- /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2006/11/12 16:06:06 1.1 +++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp 2006/11/14 12:42:06 1.2 @@ -273,6 +273,27 @@ (insert-sequence point expansion-string) (insert-object point #\Newline))))) +(defun compile-definition-interactively (mark syntax) + (let* ((token (definition-at-mark mark syntax)) + (string (token-string syntax token)) + (m (clone-mark mark)) + (buffer-name (name (buffer syntax))) + (*read-base* (base syntax))) + (with-syntax-package (syntax mark) + (forward-definition m syntax) + (backward-definition m syntax) + (multiple-value-bind (result notes) + (compile-form-for-drei (get-usable-image syntax) + (token-to-object syntax token + :read t + :package (package-at-mark syntax mark)) + (buffer syntax) + m) + (show-note-counts notes (second result)) + (when (not (null notes)) + (show-notes notes buffer-name + (one-line-ify (subseq string 0 (min (length string) 20))))))))) + (defun compile-file-interactively (buffer &optional load-p) (cond ((null (filepath buffer)) (esa:display-message "Buffer ~A is not associated with a file" (name buffer)))

1 0

[climacs-cvs] CVS climacs
by thenriksen 13 Nov '06

13 Nov '06

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 -> ( ) : )) -(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 ( ) entity - (display-parse-tree syntax pane))) + (display-parse-tree pane drei syntax))) ;;;;;;;;;;;;;;; p element @@ -475,11 +496,12 @@ (add-html-rule (p-element -> ( $inlines ) : :contents $inlines : )) -(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 ( contents ) entity - (display-parse-tree syntax pane) - (display-parse-tree contents syntax pane) - (display-parse-tree syntax pane))) + (display-parse-tree pane drei syntax) + (display-parse-tree contents pane drei syntax) + (display-parse-tree 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))))))))))

1 0

[climacs-cvs] CVS climacs
by thenriksen 12 Nov '06

12 Nov '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv26276 Modified Files: packages.lisp Log Message: Oops. Remove mention of :flexi-streams package. --- /project/climacs/cvsroot/climacs/packages.lisp 2006/11/12 16:06:06 1.121 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/11/12 21:07:59 1.122 @@ -77,7 +77,7 @@ (:use :clim-lisp :drei-base :drei-buffer :drei-fundamental-syntax :drei-syntax :drei-motion :drei :drei-kill-ring :drei-editing :climacs-gui :clim :drei-abbrev :esa :esa-buffer :esa-io - :esa-utils :drei-core :flexi-streams) + :esa-utils :drei-core) (:export #:display-string #:object-equal #:object=

1 0

[climacs-cvs] CVS climacs/cl-automaton
by thenriksen 12 Nov '06

12 Nov '06

Update of /project/climacs/cvsroot/climacs/cl-automaton In directory clnet:/tmp/cvs-serv19175/cl-automaton Removed Files: automaton-package.lisp automaton-test-package.lisp automaton-test.asd automaton-test.lisp automaton.asd automaton.lisp eqv-hash-test.lisp eqv-hash.lisp eqv-hash.txt regexp-test.lisp regexp.lisp state-and-transition-test.lisp state-and-transition.lisp Log Message: Remove unneeded directories

1 0

[climacs-cvs] CVS climacs/testing
by thenriksen 12 Nov '06

12 Nov '06

Update of /project/climacs/cvsroot/climacs/testing In directory clnet:/tmp/cvs-serv19175/testing Removed Files: rt-doc.txt rt-original.lisp rt-test.lisp rt.lisp Log Message: Remove unneeded directories

1 0

[climacs-cvs] CVS climacs/Persistent
by thenriksen 12 Nov '06

12 Nov '06

Update of /project/climacs/cvsroot/climacs/Persistent In directory clnet:/tmp/cvs-serv19175/Persistent Removed Files: README binseq-package.lisp binseq.lisp binseq2.lisp obinseq.lisp persistent-buffer.lisp persistent-undo.lisp Log Message: Remove unneeded directories

1 0

[climacs-cvs] CVS climacs
by thenriksen 12 Nov '06

12 Nov '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv18943 Removed Files: abbrev.lisp base-test.lisp base.lisp buffer-test.lisp buffer.lisp delegating-buffer.lisp editing-commands.lisp editing.lisp fundamental-syntax.lisp kill-ring-test.lisp kill-ring.lisp lisp-syntax-commands.lisp lisp-syntax-swank.lisp lisp-syntax-swine.lisp lisp-syntax.lisp motion-commands.lisp motion.lisp pane.lisp rectangle.lisp syntax.lisp undo.lisp unicode-commands.lisp utils.lisp Log Message: Remove unneeded files.

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 November 2006