Dan Pierson wrote:
I've made a couple of fixes to slime-browse-xrefs:
- Add support for the common 'q' keystroke to quit out of the xref.
Oops, this was slightly buggy. I've attached a revised patch.
Index: swank.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank.lisp,v retrieving revision 1.295 diff -u -r1.295 swank.lisp --- swank.lisp 21 Apr 2005 07:39:12 -0000 1.295 +++ swank.lisp 28 Apr 2005 17:40:45 -0000 @@ -3038,18 +3038,29 @@ errors))))))))
(defslimefun xref (type symbol-name) - (let ((symbol (parse-symbol-or-lose symbol-name *buffer-package*))) - (group-xrefs - (ecase type - (:calls (who-calls symbol)) - (:calls-who (calls-who symbol)) - (:references (who-references symbol)) - (:binds (who-binds symbol)) - (:sets (who-sets symbol)) - (:macroexpands (who-macroexpands symbol)) - (:specializes (who-specializes symbol)) - (:callers (list-callers symbol)) - (:callees (list-callees symbol)))))) + ;; Minimal attempts to retrieve something when passed "(METHOD FOO ...)". + ;; Return nil when passed something incomprehensible like "(FLET FOO ...)". + ;;---*** This is way too CMUCL-specific for the front end, but I have to + ;;---*** do something before parse-symbol-or-lose looses. + (let* ((spec (from-string symbol-name)) + (symbol-string nil)) + (cond ((and (listp spec) (string-equal (string (first spec)) "METHOD")) + (setq symbol-string (string (second spec)))) + ((not (listp spec)) + (setq symbol-string symbol-name))) + (when symbol-string + (let ((symbol (parse-symbol-or-lose symbol-string *buffer-package*))) + (group-xrefs + (ecase type + (:calls (who-calls symbol)) + (:calls-who (calls-who symbol)) + (:references (who-references symbol)) + (:binds (who-binds symbol)) + (:sets (who-sets symbol)) + (:macroexpands (who-macroexpands symbol)) + (:specializes (who-specializes symbol)) + (:callers (list-callers symbol)) + (:callees (list-callees symbol))))))))
;;;; Inspecting Index: slime.el =================================================================== RCS file: /project/slime/cvsroot/slime/slime.el,v retrieving revision 1.484 diff -u -r1.484 slime.el --- slime.el 18 Apr 2005 19:23:40 -0000 1.484 +++ slime.el 28 Apr 2005 17:40:49 -0000 @@ -5587,7 +5587,7 @@ (backward-up-list 1) (slime-parse-context `(setf ,name))) ((slime-in-expression-p '(defmethod *)) - (unless (looking-at "\>\|\s ") + (unless (looking-at "\s ") (forward-sexp 1)) ; skip over the methodname (let (qualifiers arglist) (loop for e = (read (current-buffer)) @@ -7485,8 +7485,16 @@ :dynargs 'slime-expand-class-node :has-echildren t))))
+(defvar slime-browser-map nil + "Keymap for tree widget browsers") + +(require 'tree-widget) +(unless slime-browser-map + (setq slime-browser-map (make-sparse-keymap)) + (set-keymap-parent slime-browser-map widget-keymap) + (define-key slime-browser-map "q" 'bury-buffer)) + (defun slime-call-with-browser-setup (buffer package title fn) - (require 'tree-widget) (switch-to-buffer buffer) (kill-all-local-variables) (setq slime-buffer-package package) @@ -7495,9 +7503,9 @@ (funcall fn) (lisp-mode) (slime-mode t) - (use-local-map widget-keymap) + (use-local-map slime-browser-map) (widget-setup)) - + ;;;; Xref browser
@@ -7510,6 +7518,9 @@ append specs)))
(loop for (dspec . _) in specs + ;; We can't expand FLET references so they're useless + unless (string= "(FLET" (substring dspec 0 5)) + ;;---*** Need to find and remove duplicates collect `(tree-widget :tag ,dspec :xref-type ,type :dynargs slime-expand-xrefs