Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv29912
Modified Files: gui.lisp lisp-syntax.lisp packages.lisp Log Message: Improvements to Lisp syntax. (thanks to John Q Splittist)
Here is his own description of these improvements:
This patch:
* fixes presentations of multi-token symbols and strings * introduces a new presentation type, the 'unknown-symbol, for symbol tokens that haven't got a package in the image (because, eg. the file hasn't been loaded) * introduces a new presentation type, the 'lisp-string, for strings in the file surrounded by #"s * presents every token as a 'string.
Also included is a presentation translator from 'lisp-string to 'string that doesn't work. It ought to, and I seem to have got back into the gesture/pointer-event code with things still making (to me) sense, so I'd be grateful if someone could check whether it works for them.
Things to play with:
* M-x Accept String (most things mouseable) * M-x Accept Symbol (see what the system can find, and where - 'symbols are returned as the actual symbol; 'unknown-symbols are returned as strings * M-x Accept Lisp String (source code strings are mouseable) * M-% [being Query Replace], then mouse and click to choose the strings!
Things to think about:
* Should 'string be for actual lisp strings, and (say) ESA-string (or editor-string) be for sequences of objects in the buffer? This makes sense to me, as some commands that accept a sequence of objects from the buffer might be usable in non-text-editor contexts. (Simply changing commands like com-query-replace from (accept 'string ...) to (accept 'esa-string ...), and changing a couple of things in lisp-syntax, would work.) * What other things might it be useful to mouse around with? * Is there a natural meaning for simply clicking on something in the buffer?
Things to do:
* (still!) Numbers * work out why the presentation translator isn't working...
Date: Tue Jul 26 07:28:40 2005 Author: rstrandh
Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.165 climacs/gui.lisp:1.166 --- climacs/gui.lisp:1.165 Mon Jul 25 05:41:13 2005 +++ climacs/gui.lisp Tue Jul 26 07:28:39 2005 @@ -1225,11 +1225,25 @@ (package (climacs-lisp-syntax::package-of syntax))) (display-message (format nil "~s" package))))
+(define-gesture-name :select-other :pointer-button-press (:left :meta) :unique nil) + +(define-presentation-translator lisp-string-to-string + (climacs-lisp-syntax::lisp-string string global-climacs-table + :gesture :select-other + :tester-definitive t + :menu nil + :priority 11) + (object) + object) + (define-named-command com-accept-string () (display-message (format nil "~s" (accept 'string)))) (define-named-command com-accept-symbol () (display-message (format nil "~s" (accept 'symbol)))) + +(define-named-command com-accept-lisp-string () + (display-message (format nil "~s" (accept 'climacs-lisp-syntax::lisp-string))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;
Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.16 climacs/lisp-syntax.lisp:1.17 --- climacs/lisp-syntax.lisp:1.16 Mon Jul 25 13:04:30 2005 +++ climacs/lisp-syntax.lisp Tue Jul 26 07:28:39 2005 @@ -1088,15 +1088,31 @@ (with-drawing-options (pane :ink +red+) (call-next-method)))
+(define-presentation-type unknown-symbol () :inherit-from 'symbol + :description "unknown symbol") + +(define-presentation-method presentation-typep (object (type unknown-symbol)) + (or (symbolp object) (stringp object))) + (defmethod display-parse-tree ((parse-symbol token-mixin) (syntax lisp-syntax) pane) (if (> (end-offset parse-symbol) (start-offset parse-symbol)) - (cond ((eql (buffer-object (buffer syntax) (start-offset parse-symbol)) #:) - (with-drawing-options (pane :ink +dark-violet+) - (call-next-method))) - ((eql (buffer-object (buffer syntax) (start-offset parse-symbol)) #&) - (with-drawing-options (pane :ink +dark-green+) - (call-next-method))) - (t (call-next-method))) + (let ((string (coerce (buffer-sequence (buffer syntax) + (start-offset parse-symbol) + (end-offset parse-symbol)) + 'string))) + (multiple-value-bind (symbol status) + (token-to-symbol syntax parse-symbol) + (with-output-as-presentation + (pane (if status symbol string) (if status 'symbol 'unknown-symbol) + :single-box :highlighting) + (cond ((eql (buffer-object (buffer syntax) (start-offset parse-symbol)) #:) + (with-drawing-options (pane :ink +dark-violet+) + (call-next-method))) + ((eql (buffer-object (buffer syntax) (start-offset parse-symbol)) #&) + (with-drawing-options (pane :ink +dark-green+) + (call-next-method))) + (t (call-next-method))) + ))) (call-next-method)))
(defmethod display-parse-tree ((parser-symbol lisp-lexeme) (syntax lisp-syntax) pane) @@ -1118,31 +1134,49 @@ (start-offset parser-symbol) (end-offset parser-symbol)) 'string))) - (multiple-value-bind (symbol status) - (token-to-symbol syntax parser-symbol) - (declare (ignore symbol)) - (if (and status (typep parser-symbol 'form)) - (present string 'symbol :stream pane) - (present string 'string :stream pane)))))))) - + (present string 'string :stream pane)))))) + (defmethod display-parse-tree :before ((parse-symbol lisp-lexeme) (syntax lisp-syntax) pane) (handle-whitespace pane (buffer pane) *white-space-start* (start-offset parse-symbol)) (setf *white-space-start* (end-offset parse-symbol)))
+(define-presentation-type lisp-string () + :description "lisp string") + +;(define-presentation-method presentation-typep (object (type lisp-string)) +; (stringp object)) + (defmethod display-parse-tree ((parse-symbol complete-string-form) (syntax lisp-syntax) pane) (let ((children (children parse-symbol))) - (display-parse-tree (pop children) syntax pane) - (with-text-face (pane :italic) - (loop until (null (cdr children)) - do (display-parse-tree (pop children) syntax pane))) - (display-parse-tree (pop children) syntax pane))) + (if (third children) + (let ((string (coerce (buffer-sequence (buffer syntax) + (start-offset (second children)) + (end-offset (car (last children 2)))) + 'string))) + (with-output-as-presentation (pane string 'lisp-string + :single-box :highlighting) + (display-parse-tree (pop children) syntax pane) + (with-text-face (pane :italic) + (loop until (null (cdr children)) + do (display-parse-tree (pop children) syntax pane))) + (display-parse-tree (pop children) syntax pane))) + (progn (display-parse-tree (pop children) syntax pane) + (display-parse-tree (pop children) syntax pane)))))
(defmethod display-parse-tree ((parse-symbol incomplete-string-form) (syntax lisp-syntax) pane) (let ((children (children parse-symbol))) - (display-parse-tree (pop children) syntax pane) - (with-text-face (pane :italic) - (loop until (null children) - do (display-parse-tree (pop children) syntax pane))))) + (if (second children) + (let ((string (coerce (buffer-sequence (buffer syntax) + (start-offset (second children)) + (end-offset (car (last children)))) + 'string))) + (with-output-as-presentation (pane string 'lisp-string + :single-box :highlighting) + (display-parse-tree (pop children) syntax pane) + (with-text-face (pane :italic) + (loop until (null children) + do (display-parse-tree (pop children) syntax pane))))) + (display-parse-tree (pop children) syntax pane))))
(defmethod display-parse-tree ((parse-symbol line-comment-form) (syntax lisp-syntax) pane) (with-drawing-options (pane :ink +maroon+)
Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.69 climacs/packages.lisp:1.70 --- climacs/packages.lisp:1.69 Mon Jul 25 05:41:13 2005 +++ climacs/packages.lisp Tue Jul 26 07:28:39 2005 @@ -174,7 +174,8 @@ #:esa-frame-mixin #:windows #:recordingp #:executingp #:*numeric-argument-p* #:*current-gesture* #:esa-top-level #:simple-command-loop - #:global-esa-table #:keyboard-macro-table)) + #:global-esa-table #:keyboard-macro-table + #:set-key))
(defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax