FUEL: Tags and authors support in help browser.

db4
Jose A. Ortega Ruiz 2009-01-06 23:08:33 +01:00
parent af78443832
commit efcd8cb194
3 changed files with 85 additions and 4 deletions

View File

@ -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

View File

@ -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))))

View File

@ -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))