misc/fuel/fuel-xref.el

   1 ;;; fuel-xref.el -- showing cross-reference info
   2
   3 ;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
   4 ;; See http://factorcode.org/license.txt for BSD license.
   5
   6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
   7 ;; Keywords: languages, fuel, factor
   8 ;; Start date: Sat Dec 20, 2008 22:00
   9
  10 ;;; Comentary:
  11
  12 ;; A mode and utilities for showing cross-reference information.
  13
  14 ;;; Code:
  15
  16 (require 'fuel-edit)
  17 (require 'fuel-completion)
  18 (require 'fuel-help)
  19 (require 'fuel-eval)
  20 (require 'fuel-syntax)
  21 (require 'fuel-popup)
  22 (require 'fuel-font-lock)
  23 (require 'fuel-base)
  24
  25 (require 'button)
  26
  27 \f
  28 ;;; Customization:
  29
  30 (defgroup fuel-xref nil
  31   "FUEL's cross-referencing engine."
  32   :group 'fuel)
  33
  34 (defcustom fuel-xref-follow-link-to-word-p t
  35   "Whether, when following a link to a caller, we position the
  36 cursor at the first ocurrence of the used word."
  37   :group 'fuel-xref
  38   :type 'boolean)
  39
  40 (fuel-edit--define-custom-visit
  41  fuel-xref-follow-link-method
  42  fuel-xref
  43  "How new buffers are opened when following a crossref link.")
  44
  45 (fuel-font-lock--defface fuel-font-lock-xref-link
  46   'link fuel-xref "highlighting links in cross-reference buffers")
  47
  48 (fuel-font-lock--defface fuel-font-lock-xref-vocab
  49   'italic fuel-xref "vocabulary names in cross-reference buffers")
  50
  51 \f
  52 ;;; Buttons:
  53
  54 (define-button-type 'fuel-xref--button-type
  55   'action 'fuel-xref--follow-link
  56   'follow-link t
  57   'face 'fuel-font-lock-xref-link)
  58
  59 (defun fuel-xref--follow-link (button)
  60   (let ((file (button-get button 'file))
  61         (line (button-get button 'line)))
  62     (when (not file)
  63       (error "No file for this ref"))
  64     (when (not (file-readable-p file))
  65       (error "File '%s' is not readable" file))
  66     (let ((word fuel-xref--word))
  67       (fuel-edit--visit-file file fuel-xref-follow-link-method)
  68       (when (numberp line) (goto-line line))
  69       (when (and word fuel-xref-follow-link-to-word-p)
  70         (and (re-search-forward (format "\\_<%s\\_>" word)
  71                                 (fuel-syntax--end-of-defun-pos)
  72                                 t)
  73              (goto-char (match-beginning 0)))))))
  74
  75 \f
  76 ;;; The xref buffer:
  77
  78 (fuel-popup--define fuel-xref--buffer
  79   "*fuel xref*" 'fuel-xref-mode)
  80
  81 (make-local-variable (defvar fuel-xref--word nil))
  82
  83 (defvar fuel-xref--help-string
  84   "(Press RET or click to follow crossrefs, or h for help on word at point)")
  85
  86 (defun fuel-xref--title (word cc count thing)
  87   (put-text-property 0 (length word) 'font-lock-face 'bold word)
  88   (cond ((zerop count) (format "No known %s %s %s" thing cc word))
  89         ((= 1 count) (format "1 %s %s %s:" thing cc word))
  90         (t (format "%s %ss %s %s:" count thing cc word))))
  91
  92 (defun fuel-xref--insert-ref (ref &optional no-vocab)
  93   (when (and (stringp (first ref))
  94              (stringp (third ref))
  95              (numberp (fourth ref)))
  96     (insert "  ")
  97     (insert-text-button (first ref)
  98                         :type 'fuel-xref--button-type
  99                         'help-echo (format "File: %s (%s)"
 100                                            (third ref)
 101                                            (fourth ref))
 102                         'file (third ref)
 103                         'line (fourth ref))
 104     (when (and (not no-vocab) (stringp (second ref)))
 105       (insert (format " (in %s)" (second ref))))
 106     (newline)
 107     t))
 108
 109 (defun fuel-xref--fill-buffer (word cc refs &optional no-vocab app thing)
 110   (let ((inhibit-read-only t)
 111         (count 0))
 112     (with-current-buffer (fuel-xref--buffer)
 113       (let ((start (if app (goto-char (point-max))
 114                      (erase-buffer)
 115                      (point-min))))
 116         (dolist (ref refs)
 117           (when (fuel-xref--insert-ref ref no-vocab) (setq count (1+ count))))
 118         (newline)
 119         (goto-char start)
 120         (save-excursion
 121           (insert (fuel-xref--title word cc count (or thing "word")) "\n\n"))
 122         count))))
 123
 124 (defun fuel-xref--fill-and-display (word cc refs &optional no-vocab thing)
 125   (let ((count (fuel-xref--fill-buffer word cc refs no-vocab nil (or thing "word"))))
 126     (if (zerop count)
 127         (error (fuel-xref--title word cc 0 (or thing "word")))
 128       (message "")
 129       (fuel-popup--display (fuel-xref--buffer)))))
 130
 131 (defun fuel-xref--callers (word)
 132   (let ((cmd `(:fuel* (((:quote ,word) fuel-callers-xref)))))
 133     (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 134
 135 (defun fuel-xref--show-callers (word)
 136   (let ((refs (fuel-xref--callers word)))
 137     (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word word))
 138     (fuel-xref--fill-and-display word "using" refs)))
 139
 140 (defun fuel-xref--word-callers-files (word)
 141   (mapcar 'third (fuel-xref--callers word)))
 142
 143 (defun fuel-xref--show-callees (word)
 144   (let* ((cmd `(:fuel* (((:quote ,word) fuel-callees-xref))))
 145          (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 146     (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
 147     (fuel-xref--fill-and-display word "used by" res)))
 148
 149 (defun fuel-xref--apropos (str)
 150   (let* ((cmd `(:fuel* ((,str fuel-apropos-xref))))
 151          (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 152     (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
 153     (fuel-xref--fill-and-display str "containing" res)))
 154
 155 (defun fuel-xref--show-vocab (vocab &optional app)
 156   (let* ((cmd `(:fuel* ((,vocab fuel-vocab-xref)) ,vocab))
 157          (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 158     (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
 159     (fuel-xref--fill-buffer vocab "in vocabulary" res t app)))
 160
 161 (defun fuel-xref--show-vocab-words (vocab &optional private)
 162   (fuel-xref--show-vocab vocab)
 163   (when private
 164     (fuel-xref--show-vocab (format "%s.private" (substring-no-properties vocab))
 165                            t))
 166   (fuel-popup--display (fuel-xref--buffer))
 167   (goto-char (point-min)))
 168
 169 (defun fuel-xref--show-vocab-usage (vocab)
 170   (let* ((cmd `(:fuel* ((,vocab fuel-vocab-usage-xref))))
 171          (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 172     (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
 173     (fuel-xref--fill-and-display vocab "using" res t "vocab")))
 174
 175 (defun fuel-xref--show-vocab-uses (vocab)
 176   (let* ((cmd `(:fuel* ((,vocab fuel-vocab-uses-xref))))
 177          (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 178     (with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
 179     (fuel-xref--fill-and-display vocab "used by" res t "vocab")))
 180
 181 \f
 182 ;;; User commands:
 183
 184 (defvar fuel-xref--word-history nil)
 185
 186 (defun fuel-show-callers (&optional arg)
 187   "Show a list of callers of word or vocabulary at point.
 188 With prefix argument, ask for word."
 189   (interactive "P")
 190   (let ((word (if arg (fuel-completion--read-word "Find callers for: "
 191                                                   (fuel-syntax-symbol-at-point)
 192                                                   fuel-xref--word-history)
 193                 (fuel-syntax-symbol-at-point))))
 194     (when word
 195       (message "Looking up %s's users ..." word)
 196       (if (and (not arg)
 197                (fuel-edit--looking-at-vocab))
 198           (fuel-xref--show-vocab-usage word)
 199         (fuel-xref--show-callers word)))))
 200
 201 (defun fuel-show-callees (&optional arg)
 202   "Show a list of callers of word or vocabulary at point.
 203 With prefix argument, ask for word."
 204   (interactive "P")
 205   (let ((word (if arg (fuel-completion--read-word "Find callees for: "
 206                                                   (fuel-syntax-symbol-at-point)
 207                                                   fuel-xref--word-history)
 208                 (fuel-syntax-symbol-at-point))))
 209     (when word
 210       (message "Looking up %s's callees ..." word)
 211       (if (and (not arg)
 212                (fuel-edit--looking-at-vocab))
 213           (fuel-xref--show-vocab-uses word)
 214         (fuel-xref--show-callees word)))))
 215
 216 (defvar fuel-xref--vocab-history nil)
 217
 218 (defun fuel-vocab-uses (&optional arg)
 219   "Show a list of vocabularies used by a given one.
 220 With prefix argument, force reload of vocabulary list."
 221   (interactive "P")
 222   (let ((vocab (fuel-completion--read-vocab arg
 223                                             (fuel-syntax-symbol-at-point)
 224                                             fuel-xref--vocab-history)))
 225     (fuel-xref--show-vocab-uses vocab)))
 226
 227 (defun fuel-vocab-usage (&optional arg)
 228   "Show a list of vocabularies that use a given one.
 229 With prefix argument, force reload of vocabulary list."
 230   (interactive "P")
 231   (let ((vocab (fuel-completion--read-vocab arg
 232                                             (fuel-syntax-symbol-at-point)
 233                                             fuel-xref--vocab-history)))
 234     (fuel-xref--show-vocab-usage vocab)))
 235
 236 (defun fuel-apropos (str)
 237   "Show a list of words containing the given substring."
 238   (interactive "MFind words containing: ")
 239   (message "Looking up %s's references ..." str)
 240   (fuel-xref--apropos str))
 241
 242 (defun fuel-show-file-words (&optional arg)
 243   "Show a list of words in current file.
 244 With prefix argument, ask for the vocab."
 245   (interactive "P")
 246   (let ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
 247                    (fuel-edit--read-vocabulary-name))))
 248     (when vocab
 249       (fuel-xref--show-vocab-words vocab
 250                                    (fuel-syntax--file-has-private)))))
 251
 252
 253 \f
 254 ;;; Xref mode:
 255
 256 (defun fuel-xref-show-help ()
 257   (interactive)
 258   (let ((fuel-help-always-ask nil))
 259     (fuel-help)))
 260
 261 (defvar fuel-xref-mode-map
 262   (let ((map (make-sparse-keymap)))
 263     (suppress-keymap map)
 264     (set-keymap-parent map button-buffer-map)
 265     (define-key map "h" 'fuel-xref-show-help)
 266     map))
 267
 268 (defun fuel-xref-mode ()
 269   "Mode for displaying FUEL cross-reference information.
 270 \\{fuel-xref-mode-map}"
 271   (interactive)
 272   (kill-all-local-variables)
 273   (buffer-disable-undo)
 274   (use-local-map fuel-xref-mode-map)
 275   (set-syntax-table fuel-syntax--syntax-table)
 276   (setq mode-name "FUEL Xref")
 277   (setq major-mode 'fuel-xref-mode)
 278   (font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-font-lock-xref-vocab)))
 279   (setq buffer-read-only t))
 280
 281 \f
 282 (provide 'fuel-xref)
 283 ;;; fuel-xref.el ends here