steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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 list
db4
Björn Lindqvist 2014-11-06 01:20:19 +01:00 committed by John Benediktsson
parent 82c71577d2
commit 2b1e080ccd
3 changed files with 110 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extra/fuel/xref/xref-tests.factor
View File

@ -4,3 +4,11 @@ IN: fuel.xref.tests
{ t } [ { t } [
"fuel" apropos-xref empty? not "fuel" apropos-xref empty? not
] unit-test ] unit-test
{ t } [
"fuel" vocab-xref length 2 =
] unit-test
{ { } } [
"i-dont-exist!" callees-xref
] unit-test

27
extra/fuel/xref/xref.factor
View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs definitions help.topics io.pathnames USING: accessors arrays assocs definitions help.topics io.pathnames
kernel math math.order memoize namespaces sequences sets sorting kernel math math.order math.statistics memoize namespaces sequences sets
tools.completion tools.crossref vocabs vocabs.parser vocabs.hierarchy sorting tools.completion tools.crossref vocabs vocabs.parser
words ; vocabs.hierarchy words ;
IN: fuel.xref IN: fuel.xref
@ -12,7 +12,7 @@ IN: fuel.xref
: normalize-loc ( seq -- path line ) : normalize-loc ( seq -- path line )
[ dup length 0 > [ first absolute-path ] [ drop f ] if ] [ 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 ; : get-loc ( object -- loc ) normalize-loc 2array ;
@ -22,12 +22,15 @@ IN: fuel.xref
: vocab>xref ( vocab -- xref ) : vocab>xref ( vocab -- xref )
dup dup >vocab-link where normalize-loc 4array ; dup dup >vocab-link where normalize-loc 4array ;
: sort-xrefs ( seq -- seq' )
[ first ] sort-with ;
: format-xrefs ( seq -- seq' ) : format-xrefs ( seq -- seq' )
[ word? ] filter [ word>xref ] map ; [ 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 ) : filter-prefix ( seq prefix -- seq )
[ drop-prefix nip length 0 = ] curry filter members ; [ drop-prefix nip length 0 = ] curry filter members ;
@ -44,13 +47,15 @@ MEMO: (vocab-words) ( name -- seq )
PRIVATE> 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 ; : word-location ( word -- loc ) where get-loc ;

174
misc/fuel/fuel-xref.el
View File

@ -51,12 +51,6 @@ cursor at the first ocurrence of the used word."
:group 'fuel-faces :group 'fuel-faces
:group 'fuel) :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) (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)) (let ((file (button-get button 'file))
(line (button-get button 'line))) (line (button-get button 'line)))
(when (not file) (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)) (when (not (file-readable-p file))
(error "File '%s' is not readable" file)) (error "File '%s' is not readable" file))
(let ((word fuel-xref--word)) (let ((word fuel-xref--word))
@ -88,6 +82,11 @@ cursor at the first ocurrence of the used word."
;;; The xref buffer: ;;; 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 () (defun fuel-xref--buffer ()
(or (get-buffer "*fuel xref*") (or (get-buffer "*fuel xref*")
(with-current-buffer (get-buffer-create "*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) (fuel-popup-mode)
(current-buffer)))) (current-buffer))))
(defvar fuel-xref--help-string (defun fuel-xref--pluralize-count (count item)
"(Press RET or click to follow crossrefs, or h for help on word at point)") (let ((fmt (if (= count 1) "%d %s" "%d %ss")))
(format fmt count item)))
(defun fuel-xref--title (word cc count thing) (defun fuel-xref--insert-link (title file line-num)
(put-text-property 0 (length word) 'font-lock-face 'bold word) (insert-text-button title
(cond ((zerop count) (format "No known %s %s %s" thing cc word)) :type 'fuel-xref--button-type
((= 1 count) (format "1 %s %s %s:" thing cc word)) 'help-echo (format "File: %s (%s)" file line-num)
(t (format "%s %ss %s %s:" count thing cc word)))) 'file file
'line line-num))
(defun fuel-xref--insert-ref (ref &optional no-vocab) (defun fuel-xref--insert-word (word vocab file line-num)
(when (and (stringp (cl-first ref)) (insert " ")
(stringp (cl-third ref)) (fuel-xref--insert-link word file line-num)
(numberp (cl-fourth ref))) (insert (if line-num (format " line %s" line-num)
(insert " ") " primitive"))
(insert-text-button (cl-first ref) (newline))
: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--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) (let ((inhibit-read-only t)
(count 0)) (title-str (format "Words %s %s:\n\n" cc search-str)))
(with-current-buffer (fuel-xref--buffer) (erase-buffer)
(let ((start (if app (goto-char (point-max)) (insert (propertize title-str 'font-lock-face 'bold))
(erase-buffer) (dolist (group xref-groups)
(point-min)))) (apply 'fuel-xref--insert-vocab-words group)))
(dolist (ref refs) (goto-char (point-min))
(when (fuel-xref--insert-ref ref no-vocab) (setq count (1+ count)))) (message "")
(newline) (fuel-popup--display (current-buffer)))
(goto-char start)
(save-excursion
(insert (fuel-xref--title word cc count (or thing "word")) "\n\n"))
count))))
(defun fuel-xref--fill-and-display (word cc refs &optional no-vocab thing) (defun fuel-xref--display-vocabs (search-str cc xrefs)
(let ((count (fuel-xref--fill-buffer word cc refs no-vocab nil (or thing "word")))) "Should be called in a with-current-buffer context"
(if (zerop count) (put-text-property 0 (length search-str) 'font-lock-face 'bold search-str)
(error (fuel-xref--title word cc 0 (or thing "word"))) (let* ((inhibit-read-only t)
(message "") (xrefs (remove-if (lambda (el) (not (nth 2 el))) xrefs))
(fuel-popup--display (fuel-xref--buffer))))) (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) (defun fuel-xref--callers (word)
(let ((cmd `(:fuel* (((:quote ,word) fuel-callers-xref))))) (fuel-xref--eval<x--y> (list :quote word) 'fuel-callers-xref ""))
(fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(defun fuel-xref--show-callers (word) (defun fuel-xref--show-callers (word)
(let ((refs (fuel-xref--callers word))) (let ((res (fuel-xref--callers word)))
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word word)) (with-current-buffer (fuel-xref--buffer)
(fuel-xref--fill-and-display word "using" refs))) (setq fuel-xref--word word)
(fuel-xref--display-word-groups word "calling" res))))
(defun fuel-xref--word-callers-files (word) (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) (defun fuel-xref--show-callees (word)
(let* ((cmd `(:fuel* (((:quote ,word) fuel-callees-xref)))) (let ((res (fuel-xref--eval<x--y> (list :quote word) 'fuel-callees-xref "")))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) (with-current-buffer (fuel-xref--buffer)
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil)) (setq fuel-xref--word nil)
(fuel-xref--fill-and-display word "used by" res))) (fuel-xref--display-word-groups word "used by" res))))
(defun fuel-xref--apropos (str) (defun fuel-xref--apropos (str)
(let* ((cmd `(:fuel* ((,str fuel-apropos-xref)))) (let ((res (fuel-xref--eval<x--y> str 'fuel-apropos-xref "")))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) (with-current-buffer (fuel-xref--buffer)
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil)) (setq fuel-xref--word nil)
(fuel-xref--fill-and-display str "containing" res))) (fuel-xref--display-word-groups str "containing" res))))
(defun fuel-xref--show-vocab (vocab &optional app) (defun fuel-xref--show-vocab-words (vocab)
(let* ((cmd `(:fuel* ((,vocab fuel-vocab-xref)) ,vocab)) (let ((res (fuel-xref--eval<x--y> vocab 'fuel-vocab-xref vocab)))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) (with-current-buffer (fuel-xref--buffer)
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil)) (setq fuel-xref--word nil)
(fuel-xref--fill-buffer vocab "in vocabulary" res t app))) (fuel-xref--display-word-groups vocab "in vocabulary" res))))
(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-usage (vocab) (defun fuel-xref--show-vocab-usage (vocab)
(let* ((cmd `(:fuel* ((,vocab fuel-vocab-usage-xref)))) (let ((res (fuel-xref--eval<x--y> vocab 'fuel-vocab-usage-xref "")))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) (with-current-buffer (fuel-xref--buffer)
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil)) (setq fuel-xref--word nil)
(fuel-xref--fill-and-display vocab "using" res t "vocab"))) (fuel-xref--display-vocabs vocab "using" res))))
(defun fuel-xref--show-vocab-uses (vocab) (defun fuel-xref--show-vocab-uses (vocab)
(let* ((cmd `(:fuel* ((,vocab fuel-vocab-uses-xref)))) (let ((res (fuel-xref--eval<x--y> vocab 'fuel-vocab-uses-xref "")))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) (with-current-buffer (fuel-xref--buffer)
(with-current-buffer (fuel-xref--buffer) (setq fuel-xref--word nil)) (setq fuel-xref--word nil)
(fuel-xref--fill-and-display vocab "used by" res t "vocab"))) (fuel-xref--display-vocabs vocab "used by" res))))
;;; User commands: ;;; User commands:
@ -258,11 +258,10 @@ With prefix argument, force reload of vocabulary list."
"Show a list of words in current file. "Show a list of words in current file.
With prefix argument, ask for the vocab." With prefix argument, ask for the vocab."
(interactive "P") (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)))) (fuel-completion--read-vocab nil))))
(when vocab (when vocab
(fuel-xref--show-vocab-words vocab (fuel-xref--show-vocab-words vocab))))
(factor-file-has-private)))))
@ -284,7 +283,6 @@ With prefix argument, ask for the vocab."
(set-keymap-parent fuel-xref-mode-map button-buffer-map) (set-keymap-parent fuel-xref-mode-map button-buffer-map)
(define-key fuel-xref-mode-map "h" 'fuel-xref-show-help) (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)) (setq buffer-read-only t))