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))