diff options
| -rw-r--r-- | README | 2 | ||||
| -rw-r--r-- | elisp/geiser-eval.el | 2 | ||||
| -rw-r--r-- | elisp/geiser-mode.el | 2 | ||||
| -rw-r--r-- | elisp/geiser-xref.el | 57 |
4 files changed, 43 insertions, 20 deletions
@@ -45,6 +45,8 @@ | C-cC-dm | See list of module symbols | | C-cC-da | Toggle autodoc mode | |------------------+-------------------------------------------------| + | C-c< | Show callers of procedure at point | + | C-c> | Show callees of procedure at point | | C-cC-xf | See a generic's methods signatures | |------------------+-------------------------------------------------| | M-TAB | Complete symbol at point | diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index a22428a..b8f971b 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -76,7 +76,7 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (defsubst geiser-eval--comp (code) (geiser-eval--scheme-str - `(,(geiser-eval--form 'compile (quote ,(nth 0 code)) (:module ,(nth 1 code)))))) + `(,(geiser-eval--form 'compile) (quote ,(nth 0 code)) (:module ,(nth 1 code))))) (defsubst geiser-eval--load-file (file) (geiser-eval--scheme-str `(,(geiser-eval--form 'load-file) ,file))) diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el index 3a57ec7..0bfe25d 100644 --- a/elisp/geiser-mode.el +++ b/elisp/geiser-mode.el @@ -199,6 +199,8 @@ interacting with the Geiser REPL is at your disposal. (define-key geiser-mode-map (kbd "C-.") 'geiser-completion--complete-module) (define-key geiser-mode-map "\M-." 'geiser-edit-symbol-at-point) (define-key geiser-mode-map "\M-," 'geiser-edit-pop-edit-symbol-stack) +(define-key geiser-mode-map (kbd "C-c <") 'geiser-xref-callers) +(define-key geiser-mode-map (kbd "C-c >") 'geiser-xref-callees) (define-key geiser-mode-map "\M-\C-x" 'geiser-eval-definition) (define-key geiser-mode-map "\C-x\C-e" 'geiser-eval-last-sexp) diff --git a/elisp/geiser-xref.el b/elisp/geiser-xref.el index f0920d8..40f2a5d 100644 --- a/elisp/geiser-xref.el +++ b/elisp/geiser-xref.el @@ -65,7 +65,8 @@ (defun geiser-xref--insert-button (xref) (let* ((location (cdr (assoc 'location xref))) (file (geiser-edit--location-file location)) - (signature (cdr (assoc 'signature xref)))) + (signature (cdr (assoc 'signature xref))) + (module (cdr (assoc 'module xref)))) (when signature (insert "\t") (if (stringp file) @@ -75,8 +76,31 @@ 'name (car signature) 'help-echo (format "%s in %s" (car signature) file)) (insert (format "%s" signature))) + (when (and (not (null module)) (not (eq '\#f module))) + (insert (format " in module %s" module))) (newline)))) +(defun geiser-xref--display-xrefs (header xrefs) + (geiser-xref--with-buffer + (erase-buffer) + (geiser--insert-with-face header 'geiser-font-lock-xref-header) + (newline 2) + (mapc 'geiser-xref--insert-button xrefs)) + (geiser-xref--pop-to-buffer)) + +(defun geiser-xref--read-name (ask prompt) + (let ((name (or (and (not prompt) (symbol-at-point)) + (read-string prompt nil nil (symbol-at-point))))) + (and name (format "%s" name)))) + +(defun geiser-xref--fetch-xrefs (ask kind rkind proc) + (let* ((name (geiser-xref--read-name (format "%s: " (capitalize kind)) ask)) + (res (and name (geiser-eval--send/result + `(:eval ((:ge ,proc) (quote (:scm ,name)))))))) + (if (or (not res) (not (listp res))) + (message "No %ss found for '%s'" rkind name) + (geiser-xref--display-xrefs (format "%ss for %s" rkind name) res)))) + ;;; Buffer and mode: @@ -101,30 +125,25 @@ (setq buffer-read-only t)) -;;; Generic's methods: - -(defun geiser-xref--display-generic-methods (generic res) - (geiser-xref--with-buffer - (erase-buffer) - (geiser--insert-with-face (format "Methods for generic '%s'" generic) - 'geiser-font-lock-xref-header) - (newline 2) - (mapc 'geiser-xref--insert-button res)) - (geiser-xref--pop-to-buffer)) +;;; Commands: (defun geiser-xref-generic-methods (&optional arg) "Display information about known methods of a given generic. With prefix, ask for the name of the generic." (interactive "P") - (let* ((name (or (and (not arg) (symbol-at-point)) - (read-string "Generic: " nil nil (symbol-at-point)))) - (name (and name (format "%s" name))) - (res (geiser-eval--send/result - `(:eval ((:ge generic-methods) (quote (:scm ,name))))))) - (if (or (not res) (not (listp res))) - (message "No methods found for '%s'" name) - (geiser-xref--display-generic-methods name res)))) + (geiser-xref--fetch-xrefs arg "generic" "method" 'generic-methods)) + +(defun geiser-xref-callers (&optional arg) + "Display list of callers for procedure at point. +With prefix, ask for the procedure." + (interactive "P") + (geiser-xref--fetch-xrefs arg "procedure" "caller" 'callers)) +(defun geiser-xref-callees (&optional arg) + "Display list of callees for procedure at point. +With prefix, ask for the procedure." + (interactive "P") + (geiser-xref--fetch-xrefs arg "procedure" "callee" 'callees)) (provide 'geiser-xref) |