factor/basis/help/html/html.factor

121 lines
3.5 KiB
Factor

! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary
io.files io.files.temp io.directories html.streams html.elements help kernel
assocs sequences make words accessors arrays help.topics vocabs
tools.vocabs tools.vocabs.browser namespaces prettyprint io
vocabs.loader serialize fry memoize unicode.case math.order
sorting debugger ;
IN: help.html
: escape-char ( ch -- )
dup H{
{ CHAR: " "__quo__" }
{ CHAR: * "__star__" }
{ CHAR: : "__colon__" }
{ CHAR: < "__lt__" }
{ CHAR: > "__gt__" }
{ CHAR: ? "__que__" }
{ CHAR: \\ "__back__" }
{ CHAR: | "__pipe__" }
{ CHAR: / "__slash__" }
{ CHAR: , "__comma__" }
{ CHAR: @ "__at__" }
} at [ % ] [ , ] ?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 [
[
% "-" %
dup array?
[ [ escape-filename ] map "," join ]
[ escape-filename ]
if % ".html" %
] "" make
] [ 2drop f ] if ;
M: topic browser-link-href topic>filename ;
: help-stylesheet ( -- )
"resource:basis/help/html/stylesheet.css" ascii file-contents write ;
: help>html ( topic -- )
dup topic>filename utf8 [
dup article-title
[ <style> help-stylesheet </style> ]
[ [ help ] with-html-writer ] simple-page
] with-file-writer ;
: all-vocabs-really ( -- seq )
#! Hack.
all-vocabs values concat
vocabs [ find-vocab-root not ] filter [ vocab ] map append ;
: all-topics ( -- topics )
[
articles get keys [ >link ] map %
all-words [ >link ] map %
all-authors [ <vocab-author> ] map %
all-tags [ <vocab-tag> ] map %
all-vocabs-really %
] { } make ;
: serialize-index ( index file -- )
[ [ [ topic>filename ] dip ] { } assoc-map-as object>bytes ] dip
binary set-file-contents ;
: generate-indices ( -- )
articles get keys [ [ >link ] [ article-title ] bi ] { } map>assoc "articles.idx" serialize-index
all-words [ dup name>> ] { } map>assoc "words.idx" serialize-index
all-vocabs-really [ dup vocab-name ] { } map>assoc "vocabs.idx" serialize-index ;
: generate-help-files ( -- )
all-topics [ '[ _ help>html ] try ] each ;
: generate-help ( -- )
"docs" temp-file
[ make-directories ]
[
[
generate-indices
generate-help-files
] with-directory
] bi ;
MEMO: load-index ( name -- index )
binary file-contents bytes>object ;
TUPLE: result title href ;
: offline-apropos ( string index -- results )
load-index swap >lower
'[ [ drop _ ] dip >lower subseq? ] assoc-filter
[ swap result boa ] { } assoc>map
[ [ title>> ] compare ] sort ;
: article-apropos ( string -- results )
"articles.idx" offline-apropos ;
: word-apropos ( string -- results )
"words.idx" offline-apropos ;
: vocab-apropos ( string -- results )
"vocabs.idx" offline-apropos ;