1 ;;; fuel-xref.el -- showing cross-reference info -*- lexical-binding: t -*-
3 ;; Copyright (C) 2008, 2009, 2010 Jose Antonio Ortega Ruiz
4 ;; See http://factorcode.org/license.txt for BSD license.
6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
7 ;; Keywords: languages, fuel, factor
8 ;; Start date: Sat Dec 20, 2008 22:00
12 ;; A mode and utilities for showing cross-reference information.
17 (require 'fuel-completion)
23 (require 'factor-mode)
32 (defgroup fuel-xref nil
33 "FUEL's cross-referencing engine."
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."
42 (defcustom fuel-xref-follow-link-method nil
43 "How new buffers are opened when following a crossref link."
45 :type '(choice (const :tag "Other window" window)
46 (const :tag "Other frame" frame)
47 (const :tag "Current window" nil)))
49 (defface fuel-xref-link-face '((t (:inherit link)))
50 "Highlighting links in cross-reference buffers."
55 (defvar-local fuel-xref--word nil)
60 (define-button-type 'fuel-xref--button-type
61 'action 'fuel-xref--follow-link
63 'face 'fuel-xref-link-face)
65 (defun fuel-xref--follow-link (button)
66 (let ((file (button-get button 'file))
67 (line (button-get button 'line)))
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)
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)
81 (goto-char (match-beginning 0)))))))
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))))
91 (defun fuel-xref--buffer ()
92 (or (get-buffer "*fuel xref*")
93 (with-current-buffer (get-buffer-create "*fuel xref*")
98 (defun fuel-xref--pluralize-count (count item)
99 (let ((fmt (if (= count 1) "%d %s" "%d %ss")))
100 (format fmt count item)))
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)
109 (defun fuel-xref--insert-word (word vocab file line-num)
111 (fuel-xref--insert-link word file line-num)
112 (insert (if line-num (format " line %s" line-num)
116 (defun fuel-xref--insert-vocab-words (vocab-def xrefs)
117 (destructuring-bind (vocab file) vocab-def
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))))
123 (apply 'fuel-xref--insert-word xref))
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)))
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))
136 (fuel-popup--display (current-buffer)))
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)))
147 (loop for (vocab _ file line-num) in xrefs do
149 (fuel-xref--insert-link vocab file line-num)
151 (goto-char (point-min))
153 (fuel-popup--display (current-buffer)))
155 (defun fuel-xref--callers (word)
156 (fuel-xref--eval<x--y>
159 (factor-current-vocab)))
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))))
167 (defun fuel-xref--word-callers-files (word)
168 (mapcar 'cadar (fuel-xref--callers word)))
170 (defun fuel-xref--show-callees (word)
171 (let ((res (fuel-xref--eval<x--y>
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))))
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))))
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))))
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))))
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))))
206 (defvar fuel-xref--word-history nil)
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."
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))))
217 (message "Looking up %s's users ..." word)
220 (fuel-xref--show-vocab-usage word)
221 (fuel-xref--show-callers word)))))
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."
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))))
232 (message "Looking up %s's callees ..." word)
235 (fuel-xref--show-vocab-uses word)
236 (fuel-xref--show-callees word)))))
238 (defvar fuel-xref--vocab-history nil)
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."
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)))
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."
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)))
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))
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."
268 (let ((vocab (or (and (not arg) (factor-current-vocab))
269 (fuel-completion--read-vocab nil))))
271 (fuel-xref--show-vocab-words vocab))))
277 (defun fuel-xref-show-help ()
279 (let ((fuel-help-always-ask nil))
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)
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)
293 (setq buffer-read-only t))
298 ;;; fuel-xref.el ends here