[climacs-cvs] CVS update: climacs/gui.lisp climacs/lisp-syntax.lisp climacs/packages.lisp
Robert Strandh
rstrandh at common-lisp.net
Tue Jul 26 05:28:41 UTC 2005
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
More information about the Climacs-cvs
mailing list