misc/fuel/fuel-xref.el

   1 ;;; fuel-xref.el -- showing cross-reference info -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2008, 2009, 2010 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-popup)
  21 (require 'fuel-menu)
  22 (require 'fuel-base)
  23 (require 'factor-mode)
  24
  25 (require 'button)
  26
  27 \f
  28 ;;; Customization:
  29
  30 ;;;###autoload
  31 (defgroup fuel-xref nil
  32   "FUEL's cross-referencing engine."
  33   :group 'fuel)
  34
  35 (defcustom fuel-xref-follow-link-to-word-p t
  36   "Whether, when following a link to a caller, we position the
  37 cursor at the first ocurrence of the used word."
  38   :group 'fuel-xref
  39   :type 'boolean)
  40
  41 (defcustom fuel-xref-follow-link-method nil
  42   "How new buffers are opened when following a crossref link."
  43   :group 'fuel-xref
  44   :type '(choice (const :tag "Other window" window)
  45                  (const :tag "Other frame" frame)
  46                  (const :tag "Current window" nil)))
  47
  48 (defface fuel-xref-link-face '((t (:inherit link)))
  49   "Highlighting links in cross-reference buffers."
  50   :group 'fuel-xref
  51   :group 'fuel-faces
  52   :group 'fuel)
  53
  54 (defvar-local fuel-xref--word nil)
  55
  56 \f
  57 ;;; Buttons:
  58
  59 (define-button-type 'fuel-xref--button-type
  60   'action 'fuel-xref--follow-link
  61   'follow-link t
  62   'face 'fuel-xref-link-face)
  63
  64 (defun fuel-xref--follow-link (button)
  65   (let ((file (button-get button 'file))
  66         (line (button-get button 'line)))
  67     (when (not file)
  68       (error "No file for this ref (it's probably a primitive)"))
  69     (when (not (file-readable-p file))
  70       (error "File '%s' is not readable" file))
  71     (let ((word fuel-xref--word))
  72       (fuel-edit--visit-file file fuel-xref-follow-link-method)
  73       (when (numberp line)
  74         (goto-char (point-min))
  75         (forward-line (1- line)))
  76       (when (and word fuel-xref-follow-link-to-word-p)
  77         (and (re-search-forward (format "\\_<%s\\_>" word)
  78                                 (factor-end-of-defun-pos)
  79                                 t)
  80              (goto-char (match-beginning 0)))))))
  81
  82 \f
  83 ;;; The xref buffer:
  84
  85 (defun fuel-xref--eval<x--y> (arg word context)
  86   "A helper for the very common task of calling an ( x -- y ) factor word."
  87   (let ((cmd (list :fuel* (list (list arg word)) context)))
  88     (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
  89
  90 (defun fuel-xref--buffer ()
  91   (or (get-buffer "*fuel xref*")
  92       (with-current-buffer (get-buffer-create "*fuel xref*")
  93         (fuel-xref-mode)
  94         (fuel-popup-mode)
  95         (current-buffer))))
  96
  97 (defun fuel-xref--pluralize-count (count item)
  98   (let ((fmt (if (= count 1) "%d %s" "%d %ss")))
  99     (format fmt count item)))
 100
 101 (defun fuel-xref--insert-link (title file line-num)
 102   (insert-text-button title
 103                       :type 'fuel-xref--button-type
 104                       'help-echo (format "File: %s (%s)" file line-num)
 105                       'file file
 106                       'line line-num))
 107
 108 (defun fuel-xref--insert-word (word vocab file line-num)
 109   (insert "  ")
 110   (fuel-xref--insert-link word file line-num)
 111   (insert (if line-num (format " line %s" line-num)
 112             " primitive"))
 113   (newline))
 114
 115 (defun fuel-xref--insert-vocab-words (vocab-def xrefs)
 116   (destructuring-bind (vocab file) vocab-def
 117     (insert "in ")
 118     (fuel-xref--insert-link (or vocab "unknown vocabs") file 1)
 119     (let ((count-str (fuel-xref--pluralize-count (length xrefs) "word")))
 120       (insert (format " %s:\n" count-str))))
 121   (dolist (xref xrefs)
 122     (apply 'fuel-xref--insert-word xref))
 123   (newline))
 124
 125 (defun fuel-xref--display-word-groups (search-str cc xref-groups)
 126   "Should be called in a with-current-buffer context"
 127   (let ((inhibit-read-only t)
 128         (title-str (format "Words %s %s:\n\n" cc search-str)))
 129     (erase-buffer)
 130     (insert (propertize title-str 'font-lock-face 'bold))
 131     (dolist (group xref-groups)
 132       (apply 'fuel-xref--insert-vocab-words group)))
 133   (goto-char (point-min))
 134   (message "")
 135   (fuel-popup--display (current-buffer)))
 136
 137 (defun fuel-xref--display-vocabs (search-str cc xrefs)
 138   "Should be called in a with-current-buffer context"
 139   (put-text-property 0 (length search-str) 'font-lock-face 'bold search-str)
 140   (let* ((inhibit-read-only t)
 141          (xrefs (remove-if (lambda (el) (not (nth 2 el))) xrefs))
 142          (count-str (fuel-xref--pluralize-count (length xrefs) "vocab"))
 143          (title-str (format "%s %s %s:\n\n" count-str cc search-str)))
 144     (erase-buffer)
 145     (insert title-str)
 146     (loop for (vocab _ file line-num) in xrefs do
 147           (insert "  ")
 148           (fuel-xref--insert-link vocab file line-num)
 149           (newline)))
 150   (goto-char (point-min))
 151   (message "")
 152   (fuel-popup--display (current-buffer)))
 153
 154 (defun fuel-xref--callers (word)
 155   (fuel-xref--eval<x--y>
 156    (list :quote word)
 157    'fuel-callers-xref
 158    (factor-current-vocab)))
 159
 160 (defun fuel-xref--show-callers (word)
 161   (let ((res (fuel-xref--callers word)))
 162     (with-current-buffer (fuel-xref--buffer)
 163       (setq fuel-xref--word word)
 164       (fuel-xref--display-word-groups word "calling" res))))
 165
 166 (defun fuel-xref--word-callers-files (word)
 167   (mapcar 'cadar (fuel-xref--callers word)))
 168
 169 (defun fuel-xref--show-callees (word)
 170   (let ((res (fuel-xref--eval<x--y>
 171               (list :quote word)
 172               'fuel-callees-xref
 173               (factor-current-vocab))))
 174     (with-current-buffer (fuel-xref--buffer)
 175       (setq fuel-xref--word nil)
 176       (fuel-xref--display-word-groups word "used by" res))))
 177
 178 (defun fuel-xref--apropos (str)
 179   (let ((res (fuel-xref--eval<x--y> str 'fuel-apropos-xref "")))
 180     (with-current-buffer (fuel-xref--buffer)
 181       (setq fuel-xref--word nil)
 182       (fuel-xref--display-word-groups str "containing" res))))
 183
 184 (defun fuel-xref--show-vocab-words (vocab)
 185   (let ((res (fuel-xref--eval<x--y> vocab 'fuel-vocab-xref vocab)))
 186     (with-current-buffer (fuel-xref--buffer)
 187       (setq fuel-xref--word nil)
 188       (fuel-xref--display-word-groups vocab "in vocabulary" res))))
 189
 190 (defun fuel-xref--show-vocab-usage (vocab)
 191   (let ((res (fuel-xref--eval<x--y> vocab 'fuel-vocab-usage-xref "")))
 192     (with-current-buffer (fuel-xref--buffer)
 193       (setq fuel-xref--word nil)
 194       (fuel-xref--display-vocabs vocab "using" res))))
 195
 196 (defun fuel-xref--show-vocab-uses (vocab)
 197   (let ((res (fuel-xref--eval<x--y> vocab 'fuel-vocab-uses-xref "")))
 198     (with-current-buffer (fuel-xref--buffer)
 199       (setq fuel-xref--word nil)
 200       (fuel-xref--display-vocabs vocab "used by" res))))
 201
 202 \f
 203 ;;; User commands:
 204
 205 (defvar fuel-xref--word-history nil)
 206
 207 (defun fuel-show-callers (&optional arg)
 208   "Show a list of callers of word or vocabulary at point.
 209 With prefix argument, ask for word."
 210   (interactive "P")
 211   (let ((word (if arg (fuel-completion--read-word "Find callers for: "
 212                                                   (factor-symbol-at-point)
 213                                                   fuel-xref--word-history)
 214                 (factor-symbol-at-point))))
 215     (when word
 216       (message "Looking up %s's users ..." word)
 217       (if (and (not arg)
 218                (factor-on-vocab))
 219           (fuel-xref--show-vocab-usage word)
 220         (fuel-xref--show-callers word)))))
 221
 222 (defun fuel-show-callees (&optional arg)
 223   "Show a list of callers of word or vocabulary at point.
 224 With prefix argument, ask for word."
 225   (interactive "P")
 226   (let ((word (if arg (fuel-completion--read-word "Find callees for: "
 227                                                   (factor-symbol-at-point)
 228                                                   fuel-xref--word-history)
 229                 (factor-symbol-at-point))))
 230     (when word
 231       (message "Looking up %s's callees ..." word)
 232       (if (and (not arg)
 233                (factor-on-vocab))
 234           (fuel-xref--show-vocab-uses word)
 235         (fuel-xref--show-callees word)))))
 236
 237 (defvar fuel-xref--vocab-history nil)
 238
 239 (defun fuel-vocab-uses (&optional arg)
 240   "Show a list of vocabularies used by a given one.
 241 With prefix argument, force reload of vocabulary list."
 242   (interactive "P")
 243   (let ((vocab (fuel-completion--read-vocab arg
 244                                             (factor-symbol-at-point)
 245                                             fuel-xref--vocab-history)))
 246     (fuel-xref--show-vocab-uses vocab)))
 247
 248 (defun fuel-vocab-usage (&optional arg)
 249   "Show a list of vocabularies that use a given one.
 250 With prefix argument, force reload of vocabulary list."
 251   (interactive "P")
 252   (let ((vocab (fuel-completion--read-vocab arg
 253                                             (factor-symbol-at-point)
 254                                             fuel-xref--vocab-history)))
 255     (fuel-xref--show-vocab-usage vocab)))
 256
 257 (defun fuel-apropos (str)
 258   "Show a list of words containing the given substring."
 259   (interactive "MFind words containing: ")
 260   (message "Looking up %s's references ..." str)
 261   (fuel-xref--apropos str))
 262
 263 (defun fuel-show-file-words (&optional arg)
 264   "Show a list of words in current file.
 265 With prefix argument, ask for the vocab."
 266   (interactive "P")
 267   (let ((vocab (or (and (not arg) (factor-current-vocab))
 268                    (fuel-completion--read-vocab nil))))
 269     (when vocab
 270       (fuel-xref--show-vocab-words vocab))))
 271
 272
 273 \f
 274 ;;; Xref mode:
 275
 276 (defun fuel-xref-show-help ()
 277   (interactive)
 278   (let ((fuel-help-always-ask nil))
 279     (fuel-help)))
 280
 281 ;;;###autoload
 282 (define-derived-mode fuel-xref-mode fundamental-mode "FUEL Xref"
 283   "Mode for displaying FUEL cross-reference information.
 284 \\{fuel-xref-mode-map}"
 285   :syntax-table factor-mode-syntax-table
 286   (buffer-disable-undo)
 287
 288   (suppress-keymap fuel-xref-mode-map)
 289   (set-keymap-parent fuel-xref-mode-map button-buffer-map)
 290   (define-key fuel-xref-mode-map "h" 'fuel-xref-show-help)
 291
 292   (setq buffer-read-only t))
 293
 294 \f
 295 (provide 'fuel-xref)
 296
 297 ;;; fuel-xref.el ends here