FUEL: Vocab word lists in help browser.

extra/fuel/fuel.factor

@@ -306,20 +306,23 @@ MEMO: fuel-find-word ( name -- word/f )
 
 SYMBOL: vocab-list
 
-: fuel-vocab-children-table ( vocabs -- element )
+: fuel-vocab-help-table ( vocabs -- element )
     [ fuel-vocab-help-row ] map vocab-list prefix ;
 
-: fuel-vocab-children ( assoc -- seq )
+: fuel-vocab-list ( assoc -- seq )
     [
         [ drop f ] [
             [ fuel-vocab-help-root-heading ]
-            [ fuel-vocab-children-table ] bi*
+            [ fuel-vocab-help-table ] bi*
             [ 2array ] [ drop f ] if*
         ] if-empty
     ] { } assoc>map [  ] filter ;
 
 : fuel-vocab-children-help ( name -- element )
-    all-child-vocabs fuel-vocab-children ; inline
+    all-child-vocabs fuel-vocab-list ; inline
+
+: fuel-vocab-describe-words ( name -- element )
+    [ describe-words ] with-string-writer \ describe-words swap 2array ; inline
 
 : (fuel-vocab-help) ( name -- element )
     \ article swap dup >vocab-link
@@ -328,7 +331,7 @@ SYMBOL: vocab-list
             [ vocab-authors [ \ $authors prefix , ] when* ]
             [ vocab-tags [ \ $tags prefix , ] when* ]
             [ summary [ { $heading "Summary" } swap 2array , ] when* ]
-            [ drop \ $nl , ]
+            [ name>> fuel-vocab-describe-words , ]
             [ vocab-help [ article content>> % ] when* ]
             [ name>> fuel-vocab-children-help % ]
         } cleave
@@ -346,14 +349,14 @@ SYMBOL: vocab-list
 
 MEMO: (fuel-get-vocabs/author) ( author -- element )
     [ "Vocabularies by " prepend \ $heading swap 2array ]
-    [ authored fuel-vocab-children ] bi 2array ;
+    [ authored fuel-vocab-list ] bi 2array ;
 
 : fuel-get-vocabs/author ( author -- )
     (fuel-get-vocabs/author) fuel-eval-set-result ;
 
 MEMO: (fuel-get-vocabs/tag ( tag -- element )
     [ "Vocabularies tagged " prepend \ $heading swap 2array ]
-    [ tagged fuel-vocab-children ] bi 2array ;
+    [ tagged fuel-vocab-list ] bi 2array ;
 
 : fuel-get-vocabs/tag ( tag -- )
     (fuel-get-vocabs/tag fuel-eval-set-result ;

misc/fuel/fuel-markup.el

@@ -91,6 +91,7 @@
     ($class-description . fuel-markup--class-description)
     ($code . fuel-markup--code)
     ($command . fuel-markup--command)
+    ($command-map . fuel-markup--null)
     ($contract . fuel-markup--contract)
     ($curious . fuel-markup--curious)
     ($definition . fuel-markup--definition)
@@ -146,6 +147,7 @@
     ($vocabulary . fuel-markup--vocabulary)
     ($warning . fuel-markup--warning)
     (article . fuel-markup--article)
+    (describe-words . fuel-markup--describe-words)
     (vocab-list . fuel-markup--vocab-list)))
 
 (make-variable-buffer-local
@@ -342,6 +344,64 @@
   (fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
   (newline))
 
+(defun fuel-markup--parse-classes ()
+  (let ((elems))
+    (while (looking-at ".+ classes$")
+      (let ((heading `($heading ,(match-string-no-properties 0)))
+            (rows))
+        (forward-line)
+        (when (looking-at "Class *.+$")
+          (push (split-string (match-string-no-properties 0) nil t) rows)
+          (forward-line))
+        (while (not (looking-at "$"))
+          (let* ((objs (split-string (thing-at-point 'line) nil t))
+                 (class (list '$link (car objs) (car objs) 'word))
+                 (super (and (cadr objs)
+                             (list (list '$link (cadr objs) (cadr objs) 'word))))
+                 (slots (when (cddr objs)
+                          (list (mapcar '(lambda (s) (list s " ")) (cddr objs))))))
+            (push `(,class ,@super ,@slots) rows))
+          (forward-line))
+        (push `(,heading ($table ,@(reverse rows))) elems))
+      (forward-line))
+    (reverse elems)))
+
+(defun fuel-markup--parse-words ()
+  (let ((elems))
+    (while (looking-at ".+ words\\|Primitives$")
+      (let ((heading `($heading ,(match-string-no-properties 0)))
+            (rows))
+        (forward-line)
+        (when (looking-at "Word *Stack effect$")
+          (push '("Word" "Stack effect") rows)
+          (forward-line))
+        (while (looking-at "\\(.+?\\) +\\(( .*\\)?$")
+          (let ((word `($link ,(match-string-no-properties 1)
+                              ,(match-string-no-properties 1)
+                              word))
+                (se (and (match-string-no-properties 2)
+                         `(($snippet ,(match-string-no-properties 2))))))
+            (push `(,word ,@se) rows))
+          (forward-line))
+        (push `(,heading ($table ,@(reverse rows))) elems))
+      (forward-line))
+    (reverse elems)))
+
+(defun fuel-markup--parse-words-desc (desc)
+  (with-temp-buffer
+    (insert desc)
+    (goto-char (point-min))
+    (when (re-search-forward "^Words$" nil t)
+      (forward-line 2)
+      (let ((elems '(($heading "Words"))))
+        (push (fuel-markup--parse-classes) elems)
+        (push (fuel-markup--parse-words) elems)
+        (reverse elems)))))
+
+(defun fuel-markup--describe-words (e)
+  (when (cadr e)
+    (fuel-markup--print (fuel-markup--parse-words-desc (cadr e)))))
+
 (defun fuel-markup--tag (e)
   (fuel-markup--link (list '$link (cadr e) (cadr e) 'tag)))
 
@@ -526,6 +586,8 @@
         (fuel-markup--code (list '$code res))
       (fuel-markup--snippet (list '$snippet word)))))
 
+(defun fuel-markup--null (e))
+
 (defun fuel-markup--synopsis (e)
   (insert (format " %S " e)))