FUEL: $describe-vocab and child vocab lists implemented.

diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index b5fc84dcf76df514c4c214b4d70d5f9cf4ca2c5b..1770f320eb1d28db958373f4c1ba04765219204b 100644 (file)
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -6,7 +6,7 @@ compiler.units continuations debugger definitions help help.crossref
 help.markup help.topics io io.pathnames io.streams.string kernel lexer
 make math math.order memoize namespaces parser quotations prettyprint
 sequences sets sorting source-files strings summary tools.crossref
-tools.vocabs vectors vocabs vocabs.parser words ;
+tools.vocabs tools.vocabs.browser vectors vocabs vocabs.parser words ;
 
 IN: fuel
 
@@ -298,16 +298,45 @@ MEMO: fuel-find-word ( name -- word/f )
     fuel-find-word [ [ auto-use? on (fuel-word-see) ] with-scope ] [ f ] if*
     fuel-eval-set-result ; inline
 
+: fuel-vocab-help-row ( vocab -- element )
+    [ vocab-name ]
+    [ dup summary " " append swap vocab-status-string append ]
+    bi 2array ;
+
+: fuel-vocab-help-root-heading ( root -- element )
+    [ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
+
+SYMBOL: vocab-list
+
+: fuel-vocab-children-table ( vocabs -- element )
+    [ fuel-vocab-help-row ] map vocab-list prefix ;
+
+: fuel-vocab-children ( assoc -- seq )
+    [
+        [ drop f ] [
+            [ fuel-vocab-help-root-heading ]
+            [ fuel-vocab-children-table ] bi*
+            [ 2array ] [ drop f ] if*
+        ] if-empty
+    ] { } assoc>map [  ] filter ;
+
+: fuel-vocab-children-help ( name -- element )
+    all-child-vocabs fuel-vocab-children ;
+
 : (fuel-vocab-help) ( name -- element )
     \ article swap dup >vocab-link
     [
-        [ summary [ , ] [ "No summary available" , ] if* ]
-        [ drop \ $nl , ]
-        [ vocab-help article [ content>> % ] when* ] tri
+        {
+            [ summary [ , ] [ "No summary available" , ] if* ]
+            [ drop \ $nl , ]
+            [ vocab-help [ article content>> % ] when* ]
+            [ name>> fuel-vocab-children-help % ]
+        } cleave
     ] { } make 3array ;
 
 : fuel-vocab-help ( name -- )
-    (fuel-vocab-help) fuel-eval-set-result ; inline
+    dup empty? [ fuel-vocab-children-help ] [ (fuel-vocab-help) ] if
+    fuel-eval-set-result ; inline
 
 : (fuel-index) ( seq -- seq )
     [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;

diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el
index ab81f466847b046e5c56e8751da077b7ba96dbb6..e5988d139277b614e426282bcd3dca3fe6ab93b4 100644 (file)
--- a/misc/fuel/fuel-edit.el
+++ b/misc/fuel/fuel-edit.el
@@ -34,7 +34,7 @@
   (let* ((vocabs (fuel-completion--vocabs refresh))
          (prompt "Vocabulary name: "))
     (if vocabs
-        (completing-read prompt vocabs nil t nil fuel-edit--vocab-history)
+        (completing-read prompt vocabs nil nil nil fuel-edit--vocab-history)
       (read-string prompt nil fuel-edit--vocab-history))))
 
 (defun fuel-edit--edit-article (name)

diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el
index 319fb23b5a8fd43b6a798bd8ef560eae181c7987..a251f35dddb3906e407e1d92d644f852d90422ac 100644 (file)
--- a/misc/fuel/fuel-markup.el
+++ b/misc/fuel/fuel-markup.el
@@ -90,6 +90,7 @@
     ($contract . fuel-markup--contract)
     ($curious . fuel-markup--curious)
     ($definition . fuel-markup--definition)
+    ($describe-vocab . fuel-markup--describe-vocab)
     ($description . fuel-markup--description)
     ($doc-path . fuel-markup--doc-path)
     ($emphasis . fuel-markup--emphasis)
@@ -138,7 +139,8 @@
     ($vocab-subsection . fuel-markup--vocab-subsection)
     ($vocabulary . fuel-markup--vocabulary)
     ($warning . fuel-markup--warning)
-    (article . fuel-markup--article)))
+    (article . fuel-markup--article)
+    (vocab-list . fuel-markup--vocab-list)))
 
 (make-variable-buffer-local
  (defvar fuel-markup--maybe-nl nil))
@@ -164,10 +166,11 @@
 (defun fuel-markup--maybe-nl ()
   (setq fuel-markup--maybe-nl (point)))
 
-(defun fuel-markup--insert-newline (&optional justification)
+(defun fuel-markup--insert-newline (&optional justification nosqueeze)
   (fill-region (save-excursion (beginning-of-line) (point))
                (point)
-               (or justification 'left))
+               (or justification 'left)
+               nosqueeze)
   (newline))
 
 (defsubst fuel-markup--insert-nl-if-nb (&optional no-fill)
@@ -314,6 +317,18 @@
     (fuel-markup--vocab-link (list '$vocab-link link))
     (insert " ")))
 
+(defun fuel-markup--vocab-list (e)
+  (let ((rows (mapcar '(lambda (elem)
+                         (list (list '$vocab-link (car elem)) (cadr elem)))
+                      (cdr e))))
+    (fuel-markup--table (cons '$table rows))))
+
+(defun fuel-markup--describe-vocab (e)
+  (fuel-markup--insert-nl-if-nb)
+  (let* ((cmd `(:fuel* ((,(cadr e) fuel-vocab-help)) "fuel" t))
+         (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (when res (fuel-markup--print res))))
+
 (defun fuel-markup--vocabulary (e)
   (fuel-markup--insert-heading "Vocabulary: " t)
   (fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
@@ -328,20 +343,29 @@
 
 (defun fuel-markup--table (e)
   (fuel-markup--insert-newline)
+  (delete-blank-lines)
   (newline)
-  (let ((start (point))
-        (col-delim "<~end-of-col~>")
-        (col-no (length (cadr e))))
+  (let* ((table-time-before-update 0)
+         (table-time-before-reformat 0)
+         (start (point))
+         (col-delim "<~end-of-col~>")
+         (col-no (length (cadr e)))
+         (width (/ (- (window-width) 10) col-no))
+         (step 100)
+         (count 0)
+         (inst '(lambda ()
+                  (table-capture start (point) col-delim nil nil width col-no)
+                  (goto-char (point-max))
+                  (table-recognize -1)
+                  (newline)
+                  (setq start (point)))))
     (dolist (row (cdr e))
       (dolist (col row)
         (fuel-markup--print col)
-        (insert col-delim)))
-    (table-capture start (point)
-                   col-delim nil nil
-                   (/ (- (window-width) 10) col-no) col-no))
-  (goto-char (point-max))
-  (table-recognize -1)
-  (newline))
+        (insert col-delim)
+        (setq count (1+ count))
+        (when (zerop (mod count step)) (funcall inst))))
+    (unless (zerop (mod count step)) (funcall inst))))
 
 (defun fuel-markup--instance (e)
   (insert " an instance of ")