[clim-desktop-cvs] CVS clim-desktop

thenriksen thenriksen at common-lisp.net
Fri Mar 17 23:54:04 UTC 2006


Update of /project/clim-desktop/cvsroot/clim-desktop
In directory clnet:/tmp/cvs-serv30113

Modified Files:
	swine-cmds.lisp 
Log Message:
Updated Edit Definition command to be more presentation translator-friendly.


--- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp	2006/03/15 15:32:26	1.5
+++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp	2006/03/17 23:54:04	1.6
@@ -101,13 +101,26 @@
     (presentation)
     (list (presentation-object presentation)))
 
-(define-command (com-edit-definition :name t :command-table lisp-table) ()
-  (let ((name (or (symbol-name-at-mark (point (current-window))
-				       (syntax (buffer (current-window))))
-		  (accept 'symbol :prompt "Edit symbol"))))
-    (edit-definition name (syntax (buffer (current-window))))))
+;; This command is a bit convoluted because we want to invoke it as a
+;; normal command, by a keystroke (where it automatically picks up a
+;; symbol name from the buffer) and by presentation translators. If
+;; NIL is passed as the symbol, the command will try looking up a
+;; symbol at the current point in the buffer.
+(define-command (com-edit-definition :name t :command-table lisp-table)
+    ((symbol 'symbol :prompt "Edit symbol"))
+  (flet ((fully-qualified-symbol-name (symbol)
+           (let ((*package* (find-package :keyword)))
+             (format nil "~S" symbol))))
+   (let ((name (or (when symbol
+                     (if (symbolp symbol)
+                         (fully-qualified-symbol-name symbol)
+                         symbol))
+                   (symbol-name-at-mark (point (current-window))
+                                        (syntax (buffer (current-window))))
+                   (fully-qualified-symbol-name (accept 'symbol :prompt "Edit symbol")))))
+     (edit-definition name (syntax (buffer (current-window)))))))
 
-(esa:set-key  'com-edit-definition
+(esa:set-key  '(com-edit-definition nil)
 	      'lisp-table
 	      '((#\. :meta)))
 




More information about the Clim-desktop-cvs mailing list