[clim-desktop-cvs] CVS clim-desktop

[thenriksen]

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

Modified Files:
	swine.lisp swine-cmds.lisp 
Log Message:
Changed the name of the command Arglist Lookup to Lookup Arglist and
cleaned it a bit. Factored the lookup-arglist-at-point functionality
into a command imaginatively named com-lookup-arglist-for-this-symbol.


--- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp	2006/05/28 16:28:42	1.12
+++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp	2006/05/28 16:48:46	1.13
@@ -761,9 +761,10 @@
                                  arglist emphasized-symbols
                                  highlighted-symbols))))
 
-(defun show-arglist (symbol name)
-  (unless (show-arglist-silent symbol)
-    (esa:display-message "Function ~a not found." name)))
+(defun show-arglist (symbol)
+  (unless (and (fboundp symbol)
+               (show-arglist-silent symbol))
+    (esa:display-message "Function ~a not found." symbol)))
 
 (defun find-argument-indices-for-operand (syntax operand-form operator-form)
   "Return a list of argument indices for `argument-form' relative
--- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp	2006/05/28 12:26:08	1.16
+++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp	2006/05/28 16:48:46	1.17
@@ -187,22 +187,25 @@
               'lisp-table
               '((#\c :control) (#\d :control) (#\h)))
 
-(define-command (com-arglist-lookup :name t :command-table lisp-table)
+(define-command (com-lookup-arglist-for-this-symbol :command-table lisp-table)
+    ()
+  "Show argument list for symbol at point."
+  (let* ((pane (current-window))
+         (buffer (buffer pane))
+         (syntax (syntax buffer))
+         (mark (point pane))
+         (token (or (form-before syntax (offset mark))
+                    (form-around syntax (offset mark)))))
+    (if (and token (typep token 'complete-token-lexeme))
+        (com-lookup-arglist (token-to-object syntax token))
+        (esa:display-message "Could not find symbol at point."))))
+
+(define-command (com-lookup-arglist :name t :command-table lisp-table)
     ((symbol 'symbol :prompt "Symbol"))
-  "Show argument list for given symbol. If the provided argument
-is nil, this command will attempt to find a token at point."
-  (let* ((name (string-upcase (or symbol
-                                  (symbol-name-at-mark (point (current-window))
-						       (syntax (buffer (current-window))))
-                                  (accept 'symbol :prompt "Symbol")))))
-    (with-slots (package) (syntax (buffer (current-window)))
-      (let ((function-symbol (let* ((pos2 (position #\: name :from-end t))
-				    (pos1 (if (and pos2 (char= (elt name (1- pos2)) #\:)) (1- pos2) pos2) ))
-			       (if pos2 (find-symbol (subseq name (1+ pos2)) (subseq name 0 pos1))
-				   (find-symbol name (or package *package*))))))
-	(show-arglist function-symbol (string-upcase name))))))
+  "Show argument list for a given symbol."
+  (show-arglist symbol))
 
-(esa:set-key '(com-arglist-lookup nil)
+(esa:set-key `(com-lookup-arglist-for-this-symbol)
              'lisp-table
              '((#\c :control) (#\d :control) (#\a)))
 
@@ -307,7 +310,7 @@
     (list object))
 
 (define-presentation-to-command-translator lookup-symbol-arglist
-    (symbol com-arglist-lookup lisp-table
+    (symbol com-lookup-arglist lisp-table
             :gesture :describe
             :tester ((object presentation)
                      (declare (ignore object))