FUEL: big refactoring of fuel-xref-mode and the fuel.xref vocab
The big difference is that links to words are now grouped by vocab and sorted alphabetically which I think makes *fuel xref* much more usable when you have lots of words in the listdb4
Björn Lindqvist
John Benediktsson
parent
82c71577d2
commit
2b1e080ccd
|
|
@ -4,3 +4,11 @@ IN: fuel.xref.tests
|
|||
{ t } [
|
||||
"fuel" apropos-xref empty? not
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"fuel" vocab-xref length 2 =
|
||||
] unit-test
|
||||
|
||||
{ { } } [
|
||||
"i-dont-exist!" callees-xref
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -2,9 +2,9 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: accessors arrays assocs definitions help.topics io.pathnames
|
||||
kernel math math.order memoize namespaces sequences sets sorting
|
||||
tools.completion tools.crossref vocabs vocabs.parser vocabs.hierarchy
|
||||
words ;
|
||||
kernel math math.order math.statistics memoize namespaces sequences sets
|
||||
sorting tools.completion tools.crossref vocabs vocabs.parser
|
||||
vocabs.hierarchy words ;
|
||||
|
||||
IN: fuel.xref
|
||||
|
||||
|
|
@ -12,7 +12,7 @@ IN: fuel.xref
|
|||
|
||||
: normalize-loc ( seq -- path line )
|
||||
[ dup length 0 > [ first absolute-path ] [ drop f ] if ]
|
||||
[ dup length 1 > [ second ] [ drop 1 ] if ] bi ;
|
||||
[ dup length 1 > [ second ] when ] bi ;
|
||||
|
||||
: get-loc ( object -- loc ) normalize-loc 2array ;
|
||||
|
||||
|
|
@ -22,12 +22,15 @@ IN: fuel.xref
|
|||
: vocab>xref ( vocab -- xref )
|
||||
dup dup >vocab-link where normalize-loc 4array ;
|
||||
|
||||
: sort-xrefs ( seq -- seq' )
|
||||
[ first ] sort-with ;
|
||||
|
||||
: format-xrefs ( seq -- seq' )
|
||||
[ word? ] filter [ word>xref ] map ;
|
||||
|
||||
: group-xrefs ( xrefs -- xrefs' )
|
||||
natural-sort [ second 1array ] collect-by
|
||||
! Put the path to the vocab in the key
|
||||
[ [ [ third ] map-find drop suffix ] keep ] assoc-map
|
||||
>alist natural-sort ;
|
||||
|
||||
: filter-prefix ( seq prefix -- seq )
|
||||
[ drop-prefix nip length 0 = ] curry filter members ;
|
||||
|
||||
|
|
@ -44,13 +47,15 @@ MEMO: (vocab-words) ( name -- seq )
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: callers-xref ( word -- seq ) usage format-xrefs sort-xrefs ;
|
||||
: callers-xref ( word -- seq ) usage format-xrefs group-xrefs ;
|
||||
|
||||
: callees-xref ( word -- seq ) uses format-xrefs sort-xrefs ;
|
||||
: callees-xref ( word -- seq ) uses format-xrefs group-xrefs ;
|
||||
|
||||
: apropos-xref ( str -- seq ) words-matching keys format-xrefs ;
|
||||
: apropos-xref ( str -- seq ) words-matching keys format-xrefs group-xrefs ;
|
||||
|
||||
: vocab-xref ( vocab -- seq ) words format-xrefs ;
|
||||
: vocab-xref ( vocab -- seq )
|
||||
dup ".private" append [ words ] bi@ append
|
||||
format-xrefs group-xrefs ;
|
||||
|
||||
: word-location ( word -- loc ) where get-loc ;
|
||||
|
||||
|
|
|
|||
|
|
@ -51,12 +51,6 @@ cursor at the first ocurrence of the used word."
|
|||
:group 'fuel-faces
|
||||
:group 'fuel)
|
||||
|
||||
(defface fuel-xref-vocab-face '((t))
|
||||
"Vocabulary names in cross-reference buffers."
|
||||
:group 'fuel-xref
|
||||
:group 'fuel-faces
|
||||
:group 'fuel)
|
||||
|
||||
(defvar-local fuel-xref--word nil)
|
||||
|
||||
|
||||
|
|
@ -71,7 +65,7 @@ cursor at the first ocurrence of the used word."
|
|||
(let ((file (button-get button 'file))
|
||||
(line (button-get button 'line)))
|
||||
(when (not file)
|
||||
(error "No file for this ref"))
|
||||
(error "No file for this ref (it's probably a primitive)"))
|
||||
(when (not (file-readable-p file))
|
||||
(error "File '%s' is not readable" file))
|
||||
(let ((word fuel-xref--word))
|
||||
|
|
@ -88,6 +82,11 @@ cursor at the first ocurrence of the used word."
|
|||
|
||||
;;; The xref buffer:
|
||||
|
||||
(defun fuel-xref--eval<x--y> (arg word context)
|
||||
"A helper for the very common task of calling an ( x -- y ) factor word."
|
||||
(let ((cmd (list :fuel* (list (list arg word)) context)))
|
||||
(fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
|
||||
(defun fuel-xref--buffer ()
|
||||
(or (get-buffer "*fuel xref*")
|
||||
(with-current-buffer (get-buffer-create "*fuel xref*")
|
||||
|
|
@ -95,103 +94,104 @@ cursor at the first ocurrence of the used word."
|
|||
(fuel-popup-mode)
|
||||
(current-buffer))))
|
||||
|
||||
(defvar fuel-xref--help-string
|
||||
"(Press RET or click to follow crossrefs, or h for help on word at point)")
|
||||
(defun fuel-xref--pluralize-count (count item)
|
||||
(let ((fmt (if (= count 1) "%d %s" "%d %ss")))
|
||||
(format fmt count item)))
|
||||
|
||||
(defun fuel-xref--title (word cc count thing)
|
||||
(put-text-property 0 (length word) 'font-lock-face 'bold word)
|
||||
(cond ((zerop count) (format "No known %s %s %s" thing cc word))
|
||||
((= 1 count) (format "1 %s %s %s:" thing cc word))
|
||||
(t (format "%s %ss %s %s:" count thing cc word))))
|
||||
(defun fuel-xref--insert-link (title file line-num)
|
||||
(insert-text-button title
|
||||
:type 'fuel-xref--button-type
|
||||
'help-echo (format "File: %s (%s)" file line-num)
|
||||
'file file
|
||||
'line line-num))
|
||||
|
||||
(defun fuel-xref--insert-ref (ref &optional no-vocab)
|
||||
(when (and (stringp (cl-first ref))
|
||||
(stringp (cl-third ref))
|
||||
(numberp (cl-fourth ref)))
|
||||
(insert " ")
|
||||
(insert-text-button (cl-first ref)
|
||||
:type 'fuel-xref--button-type
|
||||
'help-echo (format "File: %s (%s)"
|
||||
(cl-third ref)
|
||||
(cl-fourth ref))
|
||||
'file (cl-third ref)
|
||||
'line (cl-fourth ref))
|
||||
(when (and (not no-vocab) (stringp (cl-second ref)))
|
||||
(insert (format " (in %s)" (cl-second ref))))
|
||||
(newline)
|
||||
t))
|
||||
(defun fuel-xref--insert-word (word vocab file line-num)
|
||||
(insert " ")
|
||||
(fuel-xref--insert-link word file line-num)
|
||||
(insert (if line-num (format " line %s" line-num)
|
||||
" primitive"))
|
||||
(newline))
|
||||
|
||||
(defun fuel-xref--fill-buffer (word cc refs &optional no-vocab app thing)
|
||||
(defun fuel-xref--insert-vocab-words (vocab-def xrefs)
|
||||
(destructuring-bind (vocab file) vocab-def
|
||||
(insert "in ")
|
||||
(fuel-xref--insert-link (or vocab "unknown vocabs") file 1)
|
||||
(let ((count-str (fuel-xref--pluralize-count (length xrefs) "word")))
|
||||
(insert (format " %s:\n" count-str))))
|
||||
(dolist (xref xrefs)
|
||||
(apply 'fuel-xref--insert-word xref))
|
||||
(newline))
|
||||
|
||||
(defun fuel-xref--display-word-groups (search-str cc xref-groups)
|
||||
"Should be called in a with-current-buffer context"
|
||||
(let ((inhibit-read-only t)
|
||||
(count 0))
|
||||
(with-current-buffer (fuel-xref--buffer)
|
||||
(let ((start (if app (goto-char (point-max))
|
||||
(erase-buffer)
|
||||
(point-min))))
|
||||
(dolist (ref refs)
|
||||
(when (fuel-xref--insert-ref ref no-vocab) (setq count (1+ count))))
|
||||
(newline)
|
||||
(goto-char start)
|
||||
(save-excursion
|
||||
(insert (fuel-xref--title word cc count (or thing "word")) "\n\n"))
|
||||
count))))
|
||||
(title-str (format "Words %s %s:\n\n" cc search-str)))
|
||||
(erase-buffer)
|
||||
(insert (propertize title-str 'font-lock-face 'bold))
|
||||
(dolist (group xref-groups)
|
||||
(apply 'fuel-xref--insert-vocab-words group)))
|
||||
(goto-char (point-min))
|
||||
(message "")
|
||||
(fuel-popup--display (current-buffer)))
|
||||
|
||||
(defun fuel-xref--fill-and-display (word cc refs &optional no-vocab thing)
|
||||
(let ((count (fuel-xref--fill-buffer word cc refs no-vocab nil (or thing "word"))))
|
||||
(if (zerop count)
|
||||
(error (fuel-xref--title word cc 0 (or thing "word")))
|
||||
(message "")
|
||||
(fuel-popup--display (fuel-xref--buffer)))))
|
||||
(defun fuel-xref--display-vocabs (search-str cc xrefs)
|
||||
"Should be called in a with-current-buffer context"
|
||||
(put-text-property 0 (length search-str) 'font-lock-face 'bold search-str)
|
||||
(let* ((inhibit-read-only t)
|
||||
(xrefs (remove-if (lambda (el) (not (nth 2 el))) xrefs))
|
||||
(count-str (fuel-xref--pluralize-count (length xrefs) "vocab"))
|
||||
(title-str (format "%s %s %s:\n\n" count-str cc search-str)))
|
||||
(erase-buffer)
|
||||
(insert title-str)
|
||||
(loop for (vocab _ file line-num) in xrefs do
|
||||
(insert " ")
|
||||
(fuel-xref--insert-link vocab file line-num)
|
||||
(newline)))
|
||||
(goto-char (point-min))
|
||||
(message "")
|
||||
(fuel-popup--display (current-buffer)))
|
||||
|
||||
(defun fuel-xref--callers (word)
|
||||
(let ((cmd `(:fuel* (((:quote ,word) fuel-callers-xref)))))
|
||||
(fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(fuel-xref--eval<x--y> (list :quote word) 'fuel-callers-xref ""))
|
||||
|
||||
(defun fuel-xref--show-callers (word)
|
||||
(let ((refs (fuel-xref--callers word)))
|
||||
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word word))
|
||||
(fuel-xref--fill-and-display word "using" refs)))
|
||||
(let ((res (fuel-xref--callers word)))
|
||||
(with-current-buffer (fuel-xref--buffer)
|
||||
(setq fuel-xref--word word)
|
||||
(fuel-xref--display-word-groups word "calling" res))))
|
||||
|
||||
(defun fuel-xref--word-callers-files (word)
|
||||
(mapcar 'cl-third (fuel-xref--callers word)))
|
||||
(mapcar 'cadar (fuel-xref--callers word)))
|
||||
|
||||
(defun fuel-xref--show-callees (word)
|
||||
(let* ((cmd `(:fuel* (((:quote ,word) fuel-callees-xref))))
|
||||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
|
||||
(fuel-xref--fill-and-display word "used by" res)))
|
||||
(let ((res (fuel-xref--eval<x--y> (list :quote word) 'fuel-callees-xref "")))
|
||||
(with-current-buffer (fuel-xref--buffer)
|
||||
(setq fuel-xref--word nil)
|
||||
(fuel-xref--display-word-groups word "used by" res))))
|
||||
|
||||
(defun fuel-xref--apropos (str)
|
||||
(let* ((cmd `(:fuel* ((,str fuel-apropos-xref))))
|
||||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
|
||||
(fuel-xref--fill-and-display str "containing" res)))
|
||||
(let ((res (fuel-xref--eval<x--y> str 'fuel-apropos-xref "")))
|
||||
(with-current-buffer (fuel-xref--buffer)
|
||||
(setq fuel-xref--word nil)
|
||||
(fuel-xref--display-word-groups str "containing" res))))
|
||||
|
||||
(defun fuel-xref--show-vocab (vocab &optional app)
|
||||
(let* ((cmd `(:fuel* ((,vocab fuel-vocab-xref)) ,vocab))
|
||||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
|
||||
(fuel-xref--fill-buffer vocab "in vocabulary" res t app)))
|
||||
|
||||
(defun fuel-xref--show-vocab-words (vocab &optional private)
|
||||
(fuel-xref--show-vocab vocab)
|
||||
(when private
|
||||
(fuel-xref--show-vocab (format "%s.private" (substring-no-properties vocab))
|
||||
t))
|
||||
(fuel-popup--display (fuel-xref--buffer))
|
||||
(goto-char (point-min)))
|
||||
(defun fuel-xref--show-vocab-words (vocab)
|
||||
(let ((res (fuel-xref--eval<x--y> vocab 'fuel-vocab-xref vocab)))
|
||||
(with-current-buffer (fuel-xref--buffer)
|
||||
(setq fuel-xref--word nil)
|
||||
(fuel-xref--display-word-groups vocab "in vocabulary" res))))
|
||||
|
||||
(defun fuel-xref--show-vocab-usage (vocab)
|
||||
(let* ((cmd `(:fuel* ((,vocab fuel-vocab-usage-xref))))
|
||||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
|
||||
(fuel-xref--fill-and-display vocab "using" res t "vocab")))
|
||||
(let ((res (fuel-xref--eval<x--y> vocab 'fuel-vocab-usage-xref "")))
|
||||
(with-current-buffer (fuel-xref--buffer)
|
||||
(setq fuel-xref--word nil)
|
||||
(fuel-xref--display-vocabs vocab "using" res))))
|
||||
|
||||
(defun fuel-xref--show-vocab-uses (vocab)
|
||||
(let* ((cmd `(:fuel* ((,vocab fuel-vocab-uses-xref))))
|
||||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil))
|
||||
(fuel-xref--fill-and-display vocab "used by" res t "vocab")))
|
||||
(let ((res (fuel-xref--eval<x--y> vocab 'fuel-vocab-uses-xref "")))
|
||||
(with-current-buffer (fuel-xref--buffer)
|
||||
(setq fuel-xref--word nil)
|
||||
(fuel-xref--display-vocabs vocab "used by" res))))
|
||||
|
||||
|
||||
;;; User commands:
|
||||
|
|
@ -258,11 +258,10 @@ With prefix argument, force reload of vocabulary list."
|
|||
"Show a list of words in current file.
|
||||
With prefix argument, ask for the vocab."
|
||||
(interactive "P")
|
||||
(let ((vocab (or (and (not arg) (factor-current-vocab))
|
||||
(let ((vocab (or (and (not arg) (factor-find-in))
|
||||
(fuel-completion--read-vocab nil))))
|
||||
(when vocab
|
||||
(fuel-xref--show-vocab-words vocab
|
||||
(factor-file-has-private)))))
|
||||
(fuel-xref--show-vocab-words vocab))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -284,7 +283,6 @@ With prefix argument, ask for the vocab."
|
|||
(set-keymap-parent fuel-xref-mode-map button-buffer-map)
|
||||
(define-key fuel-xref-mode-map "h" 'fuel-xref-show-help)
|
||||
|
||||
(font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-xref-vocab-face)))
|
||||
(setq buffer-read-only t))
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue