factor/basis/help/html/html.factor

138 lines
4.1 KiB
Factor

! Copyright (C) 2008, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: checksums checksums.sha io.encodings.utf8
io.encodings.binary io.encodings.string io.files io.files.temp
io.directories html.streams help help.home kernel assocs
sequences make words accessors arrays help.topics vocabs
vocabs.hierarchy help.vocabs namespaces io vocabs.loader
serialize fry memoize unicode.case math.order sorting debugger
html xml.syntax xml.writer math.parser sets hashtables ;
FROM: io.encodings.ascii => ascii ;
FROM: ascii => ascii? ;
IN: help.html
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? [ "," join ] when
utf8 encode sha1 checksum-bytes hex-string
% ".html" %
] "" make
] [ 2drop f ] if ;
M: topic url-of topic>filename ;
: help-stylesheet ( -- xml )
"vocab:help/html/stylesheet.css" ascii file-contents
[XML <style><-></style> XML] ;
: help-navbar ( -- xml )
[XML
<div class="navbar">
<b> Factor Documentation </b> |
<a href="/">Home</a> |
<a href="article-conventions.html">Glossary</a> |
<form method="get" action="/search" style="display:inline;">
<input name="search" type="text"/>
<button type="submit">Search</button>
</form>
<a href="http://factorcode.org" style="float:right; padding: 4px;">factorcode.org</a>
</div>
XML] ;
: help>html ( topic -- xml )
[ article-title " - Factor Documentation" append ]
[ drop help-stylesheet ]
[
[ help-navbar ]
[ [ print-topic ] 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-vocabs-recursive >hashtable no-roots remove-redundant-prefixes
[ vocab-name "scratchpad" = not ] filter ;
: 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 [ '[ _ generate-help-file ] try ] each ;
: generate-help-files ( -- )
[
recent-searches off
recent-words off
recent-articles off
recent-vocabs off
(generate-help-files)
] with-scope ;
: 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 ;
: partition-exact ( string results -- results' )
[ title>> = ] with partition append ;
: offline-apropos ( string index -- results )
load-index over >lower
'[ [ drop _ ] dip >lower subseq? ] assoc-filter
[ swap result boa ] { } assoc>map
[ title>> ] sort-with
partition-exact ;
: article-apropos ( string -- results )
"articles.idx" offline-apropos ;
: word-apropos ( string -- results )
"words.idx" offline-apropos ;
: vocab-apropos ( string -- results )
"vocabs.idx" offline-apropos ;