From efcd8cb194be705dd8691a1be21fd2361978d9e3 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 6 Jan 2009 23:08:33 +0100 Subject: [PATCH] FUEL: Tags and authors support in help browser. --- extra/fuel/fuel.factor | 21 +++++++++++++++++-- misc/fuel/fuel-help.el | 24 +++++++++++++++++++++- misc/fuel/fuel-markup.el | 44 +++++++++++++++++++++++++++++++++++++++- 3 files changed, 85 insertions(+), 4 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index e5397e8f0a..0cb19ad0eb 100644 --- a/extra/fuel/fuel.factor +++ b/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 diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el index 4d16ca3cba..d9e983d737 100644 --- a/misc/fuel/fuel-help.el +++ b/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)))) diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el index 067aac4c17..8a32bf8cf1 100644 --- a/misc/fuel/fuel-markup.el +++ b/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))