FUEL: Nicer xref buffers.

db4
Jose A. Ortega Ruiz 2008-12-21 17:33:53 +01:00
parent ad728652d8
commit 3630933b09
3 changed files with 45 additions and 27 deletions

View File

@ -166,14 +166,11 @@ M: source-file fuel-pprint path>> fuel-pprint ;
first2 [ (normalize-path) ] dip 2array fuel-eval-set-result
] when* ; inline
: fuel-xref-desc ( word -- str )
[ name>> ]
[ vocabulary>> [ " (" prepend ")" append ] [ "" ] if* ] bi append ; inline
: fuel-format-xrefs ( seq -- seq )
[ word? ] filter [
[ fuel-xref-desc ]
[ where [ first2 [ (normalize-path) ] dip ] [ f f ] if* ] bi 3array
[ name>> ]
[ vocabulary>> ]
[ where [ first2 [ (normalize-path) ] dip ] [ f f ] if* ] tri 4array
] map [ [ first ] dip first <=> ] sort ; inline
: fuel-callers-xref ( word -- )

View File

@ -96,5 +96,10 @@ C-cC-eC-r is the same as C-cC-er)).
- SPC/S-SPC : scroll up/down
- TAB/S-TAB : next/previous headline
- C-cz : switch to listener
- q: bury buffer
- q : bury buffer
* In crossref buffers
- TAB/BACKTAB : navigate links
- RET/mouse click : follow link
- q : bury buffer

View File

@ -13,6 +13,9 @@
;;; Code:
(require 'fuel-eval)
(require 'fuel-popup)
(require 'fuel-font-lock)
(require 'fuel-base)
(require 'button)
@ -24,13 +27,19 @@
"FUEL's cross-referencing engine."
:group 'fuel)
(fuel-font-lock--defface fuel-font-lock-xref-link
'link fuel-xref "highlighting links in cross-reference buffers")
(fuel-font-lock--defface fuel-font-lock-xref-vocab
'italic fuel-xref "vocabulary names in cross-reference buffers")
;;; Buttons:
(define-button-type 'fuel-xref--button-type
'action 'fuel-xref--follow-link
'follow-link t
'face 'default)
'face 'fuel-font-lock-xref-link)
(defun fuel-xref--follow-link (button)
(let ((file (button-get button 'file))
@ -50,43 +59,50 @@
(defvar fuel-xref--help-string "(Press RET or click to follow crossrefs)")
(defun fuel-xref--fill-buffer (title refs)
(let ((inhibit-read-only t))
(defun fuel-xref--title (word cc count)
(cond ((zerop count) (format "No known words %s '%s'." cc word))
((= 1 count) (format "1 word %s '%s':" cc word))
(t (format "%s words %s '%s':" count cc word))))
(defun fuel-xref--fill-buffer (word cc refs)
(let ((inhibit-read-only t)
(count 0))
(with-current-buffer (fuel-xref--buffer)
(erase-buffer)
(insert title "\n\n")
(dolist (ref refs)
(when (and (first ref) (second ref) (numberp (third ref)))
(when (and (stringp (first ref))
(stringp (third ref))
(numberp (fourth ref)))
(insert " ")
(insert-text-button (first ref)
:type 'fuel-xref--button-type
'help-echo (format "File: %s (%s)"
(second ref)
(third ref))
'file (second ref)
'line (third ref))
'file (third ref)
'line (fourth ref))
(when (stringp (second ref))
(insert (format " (in %s)" (second ref))))
(setq count (1+ count))
(newline)))
(when refs
(insert "\n\n" fuel-xref--help-string "\n"))
(goto-char (point-min))
(insert (fuel-xref--title word (if cc "using" "used by") count) "\n\n")
(when (> count 0)
(goto-char (point-max))
(insert "\n" fuel-xref--help-string "\n"))
(goto-char (point-min))
(current-buffer))))
(defun fuel-xref--show-callers (word)
(let* ((cmd `(:fuel* (((:quote ,word) fuel-callers-xref))))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
(title (format (if res "Callers of '%s':"
"No callers found for '%s'")
word)))
(set-buffer (fuel-xref--fill-buffer title res))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(set-buffer (fuel-xref--fill-buffer word t res))
(fuel-popup--display)))
(defun fuel-xref--show-callees (word)
(let* ((cmd `(:fuel* (((:quote ,word) fuel-callees-xref))))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
(title (format (if res "Words called by '%s':"
"No callees found for '%s'")
word)))
(set-buffer (fuel-xref--fill-buffer title res))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(set-buffer (fuel-xref--fill-buffer word nil res))
(fuel-popup--display)))
@ -108,7 +124,7 @@
(use-local-map fuel-xref-mode-map)
(setq mode-name "FUEL Xref")
(setq major-mode 'fuel-xref-mode)
(fuel-font-lock--font-lock-setup)
(font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-font-lock-xref-vocab)))
(setq buffer-read-only t))