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 | ||||
| -rw-r--r-- | scheme/guile/geiser/emacs.scm | 4 | ||||
| -rw-r--r-- | scheme/guile/geiser/xref.scm | 34 |
6 files changed, 72 insertions, 29 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) diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm index 0c99216..13bd8db 100644 --- a/scheme/guile/geiser/emacs.scm +++ b/scheme/guile/geiser/emacs.scm @@ -37,7 +37,9 @@ ge:symbol-documentation ge:all-modules ge:module-children - ge:module-location) + ge:module-location + ge:callers + ge:callees) #:use-module (geiser evaluation) #:use-module ((geiser modules) :renamer (symbol-prefix-proc 'ge:)) #:use-module ((geiser completion) :renamer (symbol-prefix-proc 'ge:)) diff --git a/scheme/guile/geiser/xref.scm b/scheme/guile/geiser/xref.scm index cb39c5d..ec86d7c 100644 --- a/scheme/guile/geiser/xref.scm +++ b/scheme/guile/geiser/xref.scm @@ -26,11 +26,14 @@ (define-module (geiser xref) #:export (symbol-location - generic-methods) + generic-methods + callers + callees) #:use-module (geiser utils) #:use-module (geiser modules) #:use-module (geiser doc) #:use-module (oop goops) + #:use-module (system xref) #:use-module (system vm program)) (define (symbol-location sym) @@ -41,14 +44,15 @@ (let* ((gen (symbol->object sym)) (methods (if (is-a? gen <generic>) (generic-function-methods gen) '()))) (filter (lambda (x) (not (null? x))) - (map (lambda (m) (describe-method sym m)) methods)))) + (map (lambda (m) + (make-xref (method-procedure m) sym (symbol-module sym))) + methods)))) -(define (describe-method name m) - (let ((proc (method-procedure m))) - (if proc - `((location . ,(or (program-location proc) (symbol-location name))) - (signature . ,(object-signature name proc))) - '()))) +(define (make-xref proc name module) + (and proc + `((location . ,(or (program-location proc) (symbol-location name))) + (signature . ,(object-signature name proc)) + (module . ,module)))) (define (program-location p) (cond ((not (program? p)) #f) @@ -63,4 +67,18 @@ (name (and mod (module-name mod)))) (and name (module-filename name)))) +(define (procedure-xref proc) + (let ((name (procedure-name proc))) + (make-xref proc name (symbol-module name)))) + +(define (callers sym) + (let ((mod (symbol-module sym))) + (and mod + (map procedure-xref (procedure-callers (cons mod sym)))))) + +(define (callees sym) + (let ((obj (symbol->object sym))) + (and obj + (map procedure-xref (procedure-callees obj))))) + ;;; xref.scm ends here |