summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README2
-rw-r--r--elisp/geiser-eval.el2
-rw-r--r--elisp/geiser-mode.el2
-rw-r--r--elisp/geiser-xref.el57
-rw-r--r--scheme/guile/geiser/emacs.scm4
-rw-r--r--scheme/guile/geiser/xref.scm34
6 files changed, 72 insertions, 29 deletions
diff --git a/README b/README
index 6d95050..9c6baa4 100644
--- a/README
+++ b/README
@@ -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