! Copyright (C) 2008, 2011 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs colors.constants debugger fry help help.crossref help.home help.markup help.stylesheet help.topics help.vocabs html html.streams io io.directories io.encodings.binary io.encodings.utf8 io.files io.files.temp io.pathnames io.styles kernel make math.parser memoize namespaces sequences serialize splitting tools.completion vocabs vocabs.hierarchy words xml.syntax xml.writer ; FROM: io.encodings.ascii => ascii ; FROM: ascii => ascii? ; IN: help.html : escape-char ( ch -- ) dup ascii? [ dup H{ { CHAR: " "__quo__" } { CHAR: * "__star__" } { CHAR: : "__colon__" } { CHAR: < "__lt__" } { CHAR: > "__gt__" } { CHAR: ? "__que__" } { CHAR: \\ "__back__" } { CHAR: | "__pipe__" } { CHAR: / "__slash__" } { CHAR: , "__comma__" } { CHAR: @ "__at__" } { CHAR: # "__hash__" } { CHAR: % "__percent__" } } at [ % ] [ , ] ?if ] [ number>string "__" "__" surround % ] if ; : escape-filename ( string -- filename ) [ [ escape-char ] each ] "" make ; GENERIC: topic>filename* ( topic -- name prefix ) M: word topic>filename* dup vocabulary>> [ [ name>> ] [ vocabulary>> ] bi 2array "word" ] [ drop f f ] if ; M: link topic>filename* name>> dup [ "article" ] [ topic>filename* ] if ; M: word-link topic>filename* name>> topic>filename* ; M: vocab-spec topic>filename* vocab-name "vocab" ; M: vocab-tag topic>filename* name>> "tag" ; M: vocab-author topic>filename* name>> "author" ; M: f topic>filename* drop \ f topic>filename* ; : topic>filename ( topic -- filename ) topic>filename* [ [ % "-" % dup array? [ [ escape-filename ] map "," join ] [ escape-filename ] if % ".html" % ] "" make ] [ drop f ] if* ; M: topic url-of topic>filename ; M: pathname url-of string>> "resource:" ?head [ "https://github.com/slavapestov/factor/blob/master/" prepend ] [ drop f ] if ; : help-stylesheet ( -- xml ) "vocab:help/html/stylesheet.css" ascii file-contents [XML XML] ; : help-navbar ( -- xml ) "conventions" >link topic>filename [XML
XML] ; : $navigation-row ( content element label -- ) [ prefix 1array ] dip prefix , ; : ($navigation-links) ( topic -- ) help-path-style get [ [ [ prev-article [ 1array \ $long-link "Prev:" $navigation-row ] when* ] [ next-article [ 1array \ $long-link "Next:" $navigation-row ] when* ] bi ] { } make [ ($navigation-table) ] unless-empty ] with-style ; : $title ( topic -- ) title-style get { { page-color COLOR: FactorLightTan } } assoc-union dup [ [ [ ($title) ] [ ($navigation-path) ] [ ($navigation-links) ] tri ] with-nesting ] with-style ; : help>html ( topic -- xml ) [ article-title " - Factor Documentation" append ] [ drop help-stylesheet ] [ [ help-navbar ] [ [ [ $title ($blank-line) ] [ print-topic ] bi ] with-html-writer ] bi* append ] tri simple-page ; : generate-help-file ( topic -- ) dup topic>filename utf8 [ help>html write-xml ] with-file-writer ; : all-vocabs-really ( -- seq ) all-disk-vocabs-recursive no-roots remove-redundant-prefixes [ vocab-name "scratchpad" = ] reject ; : all-topics ( -- topics ) [ articles get keys [ >link ] map % all-words [ >link ] map % all-authors [