From 038ed78d546d9d0112e9cdd568cc1a7bf11c7c81 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Fri, 6 Mar 2009 00:47:05 +0100 Subject: New command to display generic methods (C-cC-dg) implemented. --- README | 3 +- elisp/geiser-base.el | 6 +++ elisp/geiser-edit.el | 14 +++--- elisp/geiser-mode.el | 1 + elisp/geiser-xref.el | 132 +++++++++++++++++++++++++++++++++++++++++++++++++++ elisp/geiser.el | 1 + 6 files changed, 150 insertions(+), 7 deletions(-) create mode 100644 elisp/geiser-xref.el diff --git a/README b/README index 98ddf77..b7e8776 100644 --- a/README +++ b/README @@ -41,7 +41,8 @@ | C-cC-l | Load current file | |------------------+-------------------------------------------------| | C-cC-dd | See documentation for symbol at point | - | C-cC-dm | See module documentation | + | C-cC-dm | See module symbols documentation | + | C-cC-dg | See generic methods | | C-cC-da | Toggle autodoc mode | |------------------+-------------------------------------------------| | M-TAB | Complete symbol at point | diff --git a/elisp/geiser-base.el b/elisp/geiser-base.el index 2a8d5a9..362930d 100644 --- a/elisp/geiser-base.el +++ b/elisp/geiser-base.el @@ -91,6 +91,12 @@ (let* ((str (buffer-substring-no-properties begin end)) (pieces (split-string str nil t))) (mapconcat 'identity pieces " "))))) + +(defun geiser--insert-with-face (str face) + (let ((p (point))) + (insert str) + (put-text-property p (point) 'face face))) + (provide 'geiser-base) ;;; geiser-base.el ends here diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index e504b30..e5c30eb 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -44,7 +44,7 @@ (geiser-edit--define-custom-visit geiser-edit-symbol-method geiser-mode - "How the new buffer is opened when invoking \\[geiser-edit-symbol-at-point]") + "How the new buffer is opened when invoking \\[geiser-edit-symbol-at-point].") ;;; Auxiliar functions: @@ -83,15 +83,17 @@ (re-search-forward (geiser-edit--symbol-re symbol) nil t)) (goto-char (match-beginning 0))))) -(defun geiser-edit--try-edit (symbol ret) - (let* ((loc (geiser-eval--retort-result ret)) - (file (geiser-edit--location-file loc)) - (line (geiser-edit--location-line loc))) +(defun geiser-edit--try-edit-location (symbol loc &optional method) + (let ((file (geiser-edit--location-file loc)) + (line (geiser-edit--location-line loc))) (unless file (error "Couldn't find edit location for '%s'" symbol)) (unless (file-readable-p file) (error "Couldn't open '%s' for read" file)) - (geiser-edit--visit-file file geiser-edit-symbol-method) + (geiser-edit--visit-file file (or method geiser-edit-symbol-method)) (geiser-edit--goto-line symbol line))) +(defsubst geiser-edit--try-edit (symbol ret) + (geiser-edit--try-edit-location symbol (geiser-eval--retort-result ret))) + ;;; Commands: diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el index f85b530..3520925 100644 --- a/elisp/geiser-mode.el +++ b/elisp/geiser-mode.el @@ -194,6 +194,7 @@ interacting with the Geiser REPL is at your disposal. (geiser-mode--triple-chord ?d ?a 'geiser-autodoc-mode) (geiser-mode--triple-chord ?d ?d 'geiser-doc-symbol-at-point) +(geiser-mode--triple-chord ?d ?g 'geiser-xref-generic-methods) (geiser-mode--triple-chord ?d ?m 'geiser-doc-module) (geiser-mode--triple-chord ?e ?m 'geiser-edit-module) 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 +;; 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 . + +;;; 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 diff --git a/elisp/geiser.el b/elisp/geiser.el index 8a62ea5..7415390 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -86,6 +86,7 @@ geiser-mode geiser-repl geiser-doc + geiser-xref geiser-edit geiser-completion geiser-autodoc -- cgit v1.2.3