New command to display generic methods (C-cC-dg) implemented.

1 files changed, 132 insertions, 0 deletions

diff --git a/elisp/geiser-xref.el b/elisp/geiser-xref.el
new file mode 100644
index 0000000..62375e0
--- /dev/null
+++ b/elisp/geiser-xref.el
@@ -0,0 +1,132 @@
+;; geiser-xref.el -- utilities for cross-referencing
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Thu Mar 05, 2009 23:03
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Comentary:
+
+;; Obtaining cross-reference information (generic's methods, callers, etc.)
+
+;;; Code:
+
+(require' geiser-edit)
+(require 'geiser-eval)
+(require 'geiser-popup)
+(require 'geiser-custom)
+(require 'geiser-base)
+
+(require 'button)
+
+
+;;; Customization:
+(defgroup geiser-xref nil
+  "Options for cross-referencing commands."
+  :group 'geiser)
+
+(geiser-edit--define-custom-visit
+ geiser-xref-follow-link-method geiser-xref
+ "How to visit buffers when following xrefs.")
+
+(geiser-custom--defface xref-link
+  'link geiser-xref "links in cross-reference buffers")
+
+(geiser-custom--defface xref-header
+  'bold geiser-xref "headers in cross-reference buffers")
+
+
+;;; Ref button:
+
+(define-button-type 'geiser-xref--button
+  'action 'geiser-xref--button-action
+  'face 'geiser-font-lock-xref-link
+  'follow-link t)
+
+(defun geiser-xref--button-action (button)
+  (let ((location (button-get button 'location))
+        (name (button-get button 'name)))
+    (when location
+      (geiser-edit--try-edit-location name location geiser-xref-follow-link-method))))
+
+(defun geiser-xref--insert-button (xref)
+  (let ((location (cdr (assoc 'location xref)))
+        (signature (cdr (assoc 'signature xref))))
+    (when signature
+      (insert "\t")
+      (if location
+          (insert-text-button (format "%s" signature)
+                              :type 'geiser-xref--button
+                              'location location
+                              'name (car signature)
+                              'help-echo (format "%s in %s"
+                                                 (car signature)
+                                                 (geiser-edit--location-file location)))
+        (insert (format "%s" signature)))
+      (newline))))
+
+
+;;; Buffer and mode:
+
+(geiser-popup--define xref "*Geiser xref*" geiser-xref-mode)
+
+(defvar geiser-xref-mode-map
+  (let ((map (make-sparse-keymap)))
+    (suppress-keymap map)
+    (set-keymap-parent map button-buffer-map)
+    map))
+
+(defun geiser-xref-mode ()
+  "Major mode for displaying cross-references.
+\\{geiser-xref-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (buffer-disable-undo)
+  (use-local-map geiser-xref-mode-map)
+  (set-syntax-table scheme-mode-syntax-table)
+  (setq mode-name "Geiser Xref")
+  (setq major-mode 'geiser-xref-mode)
+  (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))
+
+(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))))
+
+
+
+(provide 'geiser-xref)
+;;; geiser-xref.el ends here