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