From 1265bb3b5c337cac87b9cfa3027817506a1c0a0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Tue, 4 Jul 2017 15:23:04 +0200 Subject: [PATCH] FUEL: cool breadcrumb navigation for help pages --- extra/fuel/fuel.factor | 2 +- extra/fuel/help/help-docs.factor | 4 ++++ extra/fuel/help/help-tests.factor | 8 ++++++- extra/fuel/help/help.factor | 27 +++++++++++++++++---- misc/fuel/fuel-markup.el | 39 ++++++++++++++++++------------- 5 files changed, 58 insertions(+), 22 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 527220baf4..7768102915 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -108,7 +108,7 @@ PRIVATE> ! Help support -: fuel-get-article ( name -- ) lookup-article fuel-eval-set-result ; +: fuel-get-article ( name -- ) fuel.help:get-article fuel-eval-set-result ; : fuel-get-article-title ( name -- ) articles get at [ article-title ] [ f ] if* fuel-eval-set-result ; diff --git a/extra/fuel/help/help-docs.factor b/extra/fuel/help/help-docs.factor index 1389c65c1f..7b6a743345 100644 --- a/extra/fuel/help/help-docs.factor +++ b/extra/fuel/help/help-docs.factor @@ -1,6 +1,10 @@ USING: fuel.help.private help.markup help.syntax strings ; IN: fuel.help +HELP: get-article +{ $values { "name" string } { "str" string } } +{ $description "If an article and a vocab share name, we render the vocab instead." } ; + HELP: find-word { $values { "name" string } { "word/f" "word or f" } } { $description "Prefer to use search which takes the execution context into account. If that fails, fall back on a search of all words." } ; diff --git a/extra/fuel/help/help-tests.factor b/extra/fuel/help/help-tests.factor index 914951fb42..629c3aa909 100644 --- a/extra/fuel/help/help-tests.factor +++ b/extra/fuel/help/help-tests.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2009 Jose Antonio Ortega Ruiz. ! See http://factorcode.org/license.txt for BSD license. -USING: fuel.help.private help help.topics sequences tools.test ; +USING: fuel.help fuel.help.private help help.topics sequences +tools.test ; IN: fuel.help.tests { @@ -22,3 +23,8 @@ IN: fuel.help.tests } [ "help.handbook" vocab-describe-words ] unit-test + +{ f t } [ + "io" vocab-help-article? + "help.lint" vocab-help-article? +] unit-test diff --git a/extra/fuel/help/help.factor b/extra/fuel/help/help.factor index 433c40a03b..b7b7d05a67 100644 --- a/extra/fuel/help/help.factor +++ b/extra/fuel/help/help.factor @@ -3,10 +3,24 @@ USING: accessors arrays assocs combinators combinators.short-circuit fry help help.crossref help.markup help.markup.private help.topics help.vocabs io io.streams.string kernel make namespaces parser -prettyprint see sequences summary vocabs vocabs.hierarchy +prettyprint see sequences splitting summary vocabs vocabs.hierarchy vocabs.metadata vocabs.parser words ; IN: fuel.help +SYMBOLS: $doc-path $next-link $prev-link $fuel-nav-crumbs ; + +: common-crumbs ( -- crumbs ) + { "handbook" "vocab-index" } [ dup article-title \ article 3array ] map ; + +: vocab-own-crumbs ( vocab -- crumbs ) + "." split unclip [ + [ CHAR: . suffix ] dip append + ] accumulate swap suffix + [ dup "." split last \ vocab 3array ] map ; + +: vocab-crumbs ( vocab -- crumbs ) + vocab-own-crumbs common-crumbs prepend ; + > ] [ [ link-long-text ] with-string-writer ] bi 3array ; @@ -35,7 +47,7 @@ SYMBOLS: $doc-path $next-link $prev-link ; \ article swap dup article-title swap [ { - [ \ $vocabulary swap vocabulary>> 2array , ] + [ vocabulary>> vocab-crumbs \ $fuel-nav-crumbs prefix , ] [ >link [ prev-article [ \ $prev-link next/prev-link , ] when* ] @@ -82,6 +94,7 @@ SYMBOL: describe-words dup require \ article swap dup >vocab-link [ { + [ name>> vocab-crumbs but-last \ $fuel-nav-crumbs prefix , ] [ vocab-authors [ \ $authors prefix , ] when* ] [ vocab-tags [ \ $tags prefix , ] when* ] [ summary [ { $heading "Summary" } swap 2array , ] when* ] @@ -120,3 +133,9 @@ PRIVATE> : format-index ( seq -- seq ) [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ; + +: vocab-help-article? ( name -- ? ) + dup lookup-vocab [ help>> = ] [ drop f ] if* ; + +: get-article ( name -- str ) + dup vocab-help-article? [ vocab-help ] [ lookup-article ] if ; diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el index 7ea0e9efb6..088ce11273 100644 --- a/misc/fuel/fuel-markup.el +++ b/misc/fuel/fuel-markup.el @@ -94,7 +94,10 @@ (button-get button 'markup-label) (button-get button 'markup-link-type))))) - +(defun fuel-markup--nav-crumbs (e) + (fuel-markup--links e " > ") + (newline)) + ;;; Markup printers: (defconst fuel-markup--printers @@ -117,12 +120,13 @@ ($errors . fuel-markup--errors) ($example . fuel-markup--example) ($examples . fuel-markup--examples) + ($fuel-nav-crumbs . fuel-markup--nav-crumbs) ($heading . fuel-markup--heading) ($index . fuel-markup--index) ($instance . fuel-markup--instance) ($io-error . fuel-markup--io-error) ($link . fuel-markup--link) - ($links . fuel-markup--links) + ($links . (lambda (e) (fuel-markup--links e ", "))) ($list . fuel-markup--list) ($low-level-note . fuel-markup--low-level-note) ($markup-example . fuel-markup--markup-example) @@ -166,7 +170,6 @@ ($vocab-link . fuel-markup--vocab-link) ($vocab-links . fuel-markup--vocab-links) ($vocab-subsection . fuel-markup--vocab-subsection) - ($vocabulary . fuel-markup--vocabulary) ($warning . fuel-markup--warning) (article . fuel-markup--article) (describe-words . fuel-markup--describe-words) @@ -227,7 +230,7 @@ (defun fuel-markup--article (e) (setq fuel-markup--maybe-nl nil) (insert (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-title)) - (newline 2) + (newline 1) (fuel-markup--print (car (cddr e)))) (defun fuel-markup--heading (e) @@ -338,11 +341,20 @@ link))) (fuel-markup--insert-button label link type))) -(defun fuel-markup--links (e) - (dolist (link (cdr e)) - (fuel-markup--link (list '$link link)) - (insert ", ")) - (delete-char -2)) +(defun fuel-markup--links (e sep) + "Inserts a sequence of links. Used for rendering see also lists +and breadcrumb navigation. The items in e can either be strings +or lists." + (let ((links (cdr e))) + (when links + (dolist (link links) + (message (format "link %s" link)) + (fuel-markup--link + (if (listp link) + (cons '$link link) + (list '$link link))) + (insert sep)) + (delete-char (- (length sep)))))) (defun fuel-markup--index-quotation (q) (cond ((null q) nil) @@ -386,11 +398,6 @@ (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))) - (newline)) - (defun fuel-markup--parse-classes () (let ((elems)) (while (looking-at ".+ classes$") @@ -584,11 +591,11 @@ the 'words.' word emits." (defun fuel-markup--see-also (e) (fuel-markup--insert-heading "See also") - (fuel-markup--links (cons '$links (cdr e)))) + (fuel-markup--links (cons '$links (cdr e)) ", ")) (defun fuel-markup--related (e) (fuel-markup--insert-heading "See also") - (fuel-markup--links (cons '$links (cadr e)))) + (fuel-markup--links (cons '$links (cadr e)) ", ")) (defun fuel-markup--shuffle (e) (insert "\nShuffle word. Re-arranges the stack "