FUEL: Tags and authors support in help browser.

extra/fuel/fuel.factor

@@ -319,13 +319,15 @@ SYMBOL: vocab-list
     ] { } assoc>map [  ] filter ;
 
 : fuel-vocab-children-help ( name -- element )
-    all-child-vocabs fuel-vocab-children ;
+    all-child-vocabs fuel-vocab-children ; inline
 
 : (fuel-vocab-help) ( name -- element )
     \ article swap dup >vocab-link
     [
         {
-            [ summary [ , ] [ "No summary available" , ] if* ]
+            [ vocab-authors [ \ $authors prefix , ] when* ]
+            [ vocab-tags [ \ $tags prefix , ] when* ]
+            [ summary [ { $heading "Summary" } swap 2array , ] when* ]
             [ drop \ $nl , ]
             [ vocab-help [ article content>> % ] when* ]
             [ name>> fuel-vocab-children-help % ]
@@ -342,6 +344,21 @@ SYMBOL: vocab-list
 : fuel-index ( quot: ( -- seq ) -- )
     call (fuel-index) fuel-eval-set-result ; inline
 
+MEMO: (fuel-get-vocabs/author) ( author -- element )
+    [ "Vocabularies by " prepend \ $heading swap 2array ]
+    [ authored fuel-vocab-children ] 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 ;
+
+: fuel-get-vocabs/tag ( tag -- )
+    (fuel-get-vocabs/tag fuel-eval-set-result ;
+
+
 ! -run=fuel support
 
 : fuel-startup ( -- ) "listener" run-file ; inline

misc/fuel/fuel-help.el

@@ -146,7 +146,7 @@
       (message ""))))
 
 (defun fuel-help--get-vocab (name)
-  (message "Retrieving vocabulary help ...")
+  (message "Retrieving help vocabulary for vocabulary '%s' ..." name)
   (let* ((cmd `(:fuel* ((,name fuel-vocab-help)) "fuel" (,name)))
          (ret (fuel-eval--send/wait cmd 2000))
          (res (fuel-eval--retort-result ret)))
@@ -155,6 +155,26 @@
       (fuel-help--insert-contents (list name name 'vocab) res)
       (message ""))))
 
+(defun fuel-help--get-vocab/author (author)
+  (message "Retrieving vocabularies by %s ..." author)
+  (let* ((cmd `(:fuel* ((,author fuel-get-vocabs/author)) "fuel" t))
+         (ret (fuel-eval--send/wait cmd))
+         (res (fuel-eval--retort-result ret)))
+    (if (not res)
+        (message "No vocabularies by %s" author)
+      (fuel-help--insert-contents (list author author 'author) res)
+      (message ""))))
+
+(defun fuel-help--get-vocab/tag (tag)
+  (message "Retrieving vocabularies tagged '%s' ..." tag)
+  (let* ((cmd `(:fuel* ((,tag fuel-get-vocabs/tag)) "fuel" t))
+         (ret (fuel-eval--send/wait cmd))
+         (res (fuel-eval--retort-result ret)))
+    (if (not res)
+        (message "No vocabularies tagged '%s'" tag)
+      (fuel-help--insert-contents (list tag tag 'tag) res)
+      (message ""))))
+
 (defun fuel-help--follow-link (link label type &optional no-cache)
   (let* ((llink (list link label type))
          (cached (and (not no-cache) (fuel-help--cache-get llink))))
@@ -163,6 +183,8 @@
           (cond ((eq type 'word) (fuel-help--word-help nil link))
                 ((eq type 'article) (fuel-help--get-article link label))
                 ((eq type 'vocab) (fuel-help--get-vocab link))
+                ((eq type 'author) (fuel-help--get-vocab/author label))
+                ((eq type 'tag) (fuel-help--get-vocab/tag label))
                 ((eq type 'bookmarks) (fuel-help-display-bookmarks))
                 (t (error "Links of type %s not yet implemented" type))))
       (fuel-help--insert-contents llink cached))))

misc/fuel/fuel-markup.el

@@ -84,7 +84,11 @@
 ;;; Markup printers:
 
 (defconst fuel-markup--printers
-  '(($class-description . fuel-markup--class-description)
+  '(($all-tags . fuel-markup--all-tags)
+    ($all-authors . fuel-markup--all-authors)
+    ($author . fuel-markup--author)
+    ($authors . fuel-markup--authors)
+    ($class-description . fuel-markup--class-description)
     ($code . fuel-markup--code)
     ($command . fuel-markup--command)
     ($contract . fuel-markup--contract)
@@ -129,6 +133,8 @@
     ($synopsis . fuel-markup--synopsis)
     ($syntax . fuel-markup--syntax)
     ($table . fuel-markup--table)
+    ($tag . fuel-markup--tag)
+    ($tags . fuel-markup--tags)
     ($unchecked-example . fuel-markup--example)
     ($value . fuel-markup--value)
     ($values . fuel-markup--values)
@@ -336,6 +342,42 @@
   (fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
   (newline))
 
+(defun fuel-markup--tag (e)
+  (fuel-markup--link (list '$link (cadr e) (cadr e) 'tag)))
+
+(defun fuel-markup--tags (e)
+  (when (cdr e)
+    (fuel-markup--insert-heading "Tags: " t)
+    (dolist (tag (cdr e))
+      (fuel-markup--tag (list '$tag tag))
+      (insert ", "))
+    (delete-backward-char 2)
+    (fuel-markup--insert-newline)))
+
+(defun fuel-markup--all-tags (e)
+  (let* ((cmd `(:fuel* (all-tags :get) "fuel" t))
+         (tags (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (fuel-markup--list
+     (cons '$list (mapcar (lambda (tag) (list '$link tag tag 'tag)) tags)))))
+
+(defun fuel-markup--author (e)
+  (fuel-markup--link (list '$link (cadr e) (cadr e) 'author)))
+
+(defun fuel-markup--authors (e)
+  (when (cdr e)
+    (fuel-markup--insert-heading "Authors: " t)
+    (dolist (a (cdr e))
+      (fuel-markup--author (list '$author a))
+      (insert ", "))
+    (delete-backward-char 2)
+    (fuel-markup--insert-newline)))
+
+(defun fuel-markup--all-authors (e)
+  (let* ((cmd `(:fuel* (all-authors :get) "fuel" t))
+         (authors (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (fuel-markup--list
+     (cons '$list (mapcar (lambda (a) (list '$link a a 'author)) authors)))))
+
 (defun fuel-markup--list (e)
   (fuel-markup--insert-nl-if-nb)
   (dolist (elt (cdr e))