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 ;
+
<PRIVATE
: find-word ( name -- word/f )
: parent-topics ( word -- seq )
help-path [ dup article-title swap 2array ] map ; inline
-SYMBOLS: $doc-path $next-link $prev-link ;
-
: next/prev-link ( link link-symbol -- 3arr )
swap [ name>> ] [ [ link-long-text ] with-string-writer ] bi 3array ;
\ 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* ]
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* ]
: 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 ;
(button-get button 'markup-label)
(button-get button 'markup-link-type)))))
-\f
+(defun fuel-markup--nav-crumbs (e)
+ (fuel-markup--links e " > ")
+ (newline))
+
;;; Markup printers:
(defconst fuel-markup--printers
($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)
($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)
(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)
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)
(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$")
(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 "