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

diff --git a/extra/fuel/xref/xref-tests.factor b/extra/fuel/xref/xref-tests.factor
index d1d9f0e98b4673a02f6d607660d89db600e5e354..a30581ae0e65ab8092d0b82d91ca8c1198d107f9 100644 (file)
--- a/extra/fuel/xref/xref-tests.factor
+++ b/extra/fuel/xref/xref-tests.factor
@@ -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

diff --git a/extra/fuel/xref/xref.factor b/extra/fuel/xref/xref.factor
index 572916d6596ef950a764dc3e419f1e0e670fadc1..5ca5911cf4c3545952d0ce2a62b84569ea0d83d8 100644 (file)
--- a/extra/fuel/xref/xref.factor
+++ b/extra/fuel/xref/xref.factor
@@ -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 ;
 

diff --git a/misc/fuel/fuel-xref.el b/misc/fuel/fuel-xref.el
index a4b5ac7108633155be473885d6b86760cf5b5d8a..043908a16640d3fea5ff05bd039d0bcddd89f6ed 100644 (file)
--- a/misc/fuel/fuel-xref.el
+++ b/misc/fuel/fuel-xref.el
@@ -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)
 
 \f
@@ -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."
 \f
 ;;; 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--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-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--fill-buffer (word cc refs &optional no-vocab app thing)
+(defun fuel-xref--pluralize-count (count item)
+  (let ((fmt (if (= count 1) "%d %s" "%d %ss")))
+    (format fmt count item)))
+
+(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-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--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))))
-
-(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)))))
+        (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--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)))
-
-(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)))
+  (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-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))))
 
 \f
 ;;; 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))))
 
 
 \f
@@ -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))
 
 \f