FUEL: cool breadcrumb navigation for help pages

modern-harvey2
Björn Lindqvist 2017-07-04 15:23:04 +02:00
parent 7c22d09f47
commit 1265bb3b5c
5 changed files with 58 additions and 22 deletions

View File

@ -108,7 +108,7 @@ PRIVATE>
! Help support ! 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 -- ) : fuel-get-article-title ( name -- )
articles get at [ article-title ] [ f ] if* fuel-eval-set-result ; articles get at [ article-title ] [ f ] if* fuel-eval-set-result ;

View File

@ -1,6 +1,10 @@
USING: fuel.help.private help.markup help.syntax strings ; USING: fuel.help.private help.markup help.syntax strings ;
IN: fuel.help 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 HELP: find-word
{ $values { "name" string } { "word/f" "word or f" } } { $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." } ; { $description "Prefer to use search which takes the execution context into account. If that fails, fall back on a search of all words." } ;

View File

@ -1,6 +1,7 @@
! Copyright (C) 2009 Jose Antonio Ortega Ruiz. ! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: fuel.help.tests
{ {
@ -22,3 +23,8 @@ IN: fuel.help.tests
} [ } [
"help.handbook" vocab-describe-words "help.handbook" vocab-describe-words
] unit-test ] unit-test
{ f t } [
"io" vocab-help-article?
"help.lint" vocab-help-article?
] unit-test

View File

@ -3,10 +3,24 @@
USING: accessors arrays assocs combinators combinators.short-circuit USING: accessors arrays assocs combinators combinators.short-circuit
fry help help.crossref help.markup help.markup.private help.topics fry help help.crossref help.markup help.markup.private help.topics
help.vocabs io io.streams.string kernel make namespaces parser 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 ; vocabs.metadata vocabs.parser words ;
IN: fuel.help 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 ;
<PRIVATE <PRIVATE
: find-word ( name -- word/f ) : find-word ( name -- word/f )
@ -26,8 +40,6 @@ IN: fuel.help
: parent-topics ( word -- seq ) : parent-topics ( word -- seq )
help-path [ dup article-title swap 2array ] map ; inline help-path [ dup article-title swap 2array ] map ; inline
SYMBOLS: $doc-path $next-link $prev-link ;
: next/prev-link ( link link-symbol -- 3arr ) : next/prev-link ( link link-symbol -- 3arr )
swap [ name>> ] [ [ link-long-text ] with-string-writer ] bi 3array ; swap [ name>> ] [ [ 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 \ article swap dup article-title swap
[ [
{ {
[ \ $vocabulary swap vocabulary>> 2array , ] [ vocabulary>> vocab-crumbs \ $fuel-nav-crumbs prefix , ]
[ [
>link >link
[ prev-article [ \ $prev-link next/prev-link , ] when* ] [ prev-article [ \ $prev-link next/prev-link , ] when* ]
@ -82,6 +94,7 @@ SYMBOL: describe-words
dup require \ article swap dup >vocab-link dup require \ article swap dup >vocab-link
[ [
{ {
[ name>> vocab-crumbs but-last \ $fuel-nav-crumbs prefix , ]
[ vocab-authors [ \ $authors prefix , ] when* ] [ vocab-authors [ \ $authors prefix , ] when* ]
[ vocab-tags [ \ $tags prefix , ] when* ] [ vocab-tags [ \ $tags prefix , ] when* ]
[ summary [ { $heading "Summary" } swap 2array , ] when* ] [ summary [ { $heading "Summary" } swap 2array , ] when* ]
@ -120,3 +133,9 @@ PRIVATE>
: format-index ( seq -- seq ) : format-index ( seq -- seq )
[ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ; [ [ >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 ;

View File

@ -94,7 +94,10 @@
(button-get button 'markup-label) (button-get button 'markup-label)
(button-get button 'markup-link-type))))) (button-get button 'markup-link-type)))))
(defun fuel-markup--nav-crumbs (e)
(fuel-markup--links e " > ")
(newline))
;;; Markup printers: ;;; Markup printers:
(defconst fuel-markup--printers (defconst fuel-markup--printers
@ -117,12 +120,13 @@
($errors . fuel-markup--errors) ($errors . fuel-markup--errors)
($example . fuel-markup--example) ($example . fuel-markup--example)
($examples . fuel-markup--examples) ($examples . fuel-markup--examples)
($fuel-nav-crumbs . fuel-markup--nav-crumbs)
($heading . fuel-markup--heading) ($heading . fuel-markup--heading)
($index . fuel-markup--index) ($index . fuel-markup--index)
($instance . fuel-markup--instance) ($instance . fuel-markup--instance)
($io-error . fuel-markup--io-error) ($io-error . fuel-markup--io-error)
($link . fuel-markup--link) ($link . fuel-markup--link)
($links . fuel-markup--links) ($links . (lambda (e) (fuel-markup--links e ", ")))
($list . fuel-markup--list) ($list . fuel-markup--list)
($low-level-note . fuel-markup--low-level-note) ($low-level-note . fuel-markup--low-level-note)
($markup-example . fuel-markup--markup-example) ($markup-example . fuel-markup--markup-example)
@ -166,7 +170,6 @@
($vocab-link . fuel-markup--vocab-link) ($vocab-link . fuel-markup--vocab-link)
($vocab-links . fuel-markup--vocab-links) ($vocab-links . fuel-markup--vocab-links)
($vocab-subsection . fuel-markup--vocab-subsection) ($vocab-subsection . fuel-markup--vocab-subsection)
($vocabulary . fuel-markup--vocabulary)
($warning . fuel-markup--warning) ($warning . fuel-markup--warning)
(article . fuel-markup--article) (article . fuel-markup--article)
(describe-words . fuel-markup--describe-words) (describe-words . fuel-markup--describe-words)
@ -227,7 +230,7 @@
(defun fuel-markup--article (e) (defun fuel-markup--article (e)
(setq fuel-markup--maybe-nl nil) (setq fuel-markup--maybe-nl nil)
(insert (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-title)) (insert (fuel-markup--put-face (cadr e) 'fuel-font-lock-markup-title))
(newline 2) (newline 1)
(fuel-markup--print (car (cddr e)))) (fuel-markup--print (car (cddr e))))
(defun fuel-markup--heading (e) (defun fuel-markup--heading (e)
@ -338,11 +341,20 @@
link))) link)))
(fuel-markup--insert-button label link type))) (fuel-markup--insert-button label link type)))
(defun fuel-markup--links (e) (defun fuel-markup--links (e sep)
(dolist (link (cdr e)) "Inserts a sequence of links. Used for rendering see also lists
(fuel-markup--link (list '$link link)) and breadcrumb navigation. The items in e can either be strings
(insert ", ")) or lists."
(delete-char -2)) (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) (defun fuel-markup--index-quotation (q)
(cond ((null q) nil) (cond ((null q) nil)
@ -386,11 +398,6 @@
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))) (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(when res (fuel-markup--print res)))) (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 () (defun fuel-markup--parse-classes ()
(let ((elems)) (let ((elems))
(while (looking-at ".+ classes$") (while (looking-at ".+ classes$")
@ -584,11 +591,11 @@ the 'words.' word emits."
(defun fuel-markup--see-also (e) (defun fuel-markup--see-also (e)
(fuel-markup--insert-heading "See also") (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) (defun fuel-markup--related (e)
(fuel-markup--insert-heading "See also") (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) (defun fuel-markup--shuffle (e)
(insert "\nShuffle word. Re-arranges the stack " (insert "\nShuffle word. Re-arranges the stack "