basis/help/html/html.factor

   1 ! Copyright (C) 2008, 2011 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: checksums checksums.sha io.encodings.utf8
   4 io.encodings.binary io.encodings.string io.files io.files.temp
   5 io.directories html.streams help help.home kernel assocs
   6 sequences make words accessors arrays help.topics vocabs
   7 vocabs.hierarchy help.vocabs namespaces io vocabs.loader
   8 serialize fry memoize unicode.case math.order sorting debugger
   9 html xml.syntax xml.writer math.parser sets hashtables ;
  10 FROM: io.encodings.ascii => ascii ;
  11 FROM: ascii => ascii? ;
  12 IN: help.html
  13
  14 GENERIC: topic>filename* ( topic -- name prefix )
  15
  16 M: word topic>filename*
  17     dup vocabulary>> [
  18         [ name>> ] [ vocabulary>> ] bi 2array "word"
  19     ] [ drop f f ] if ;
  20
  21 M: link topic>filename* name>> dup [ "article" ] [ topic>filename* ] if ;
  22 M: word-link topic>filename* name>> topic>filename* ;
  23 M: vocab-spec topic>filename* vocab-name "vocab" ;
  24 M: vocab-tag topic>filename* name>> "tag" ;
  25 M: vocab-author topic>filename* name>> "author" ;
  26 M: f topic>filename* drop \ f topic>filename* ;
  27
  28 : topic>filename ( topic -- filename )
  29     topic>filename* dup [
  30         [
  31             % "-" %
  32             dup array? [ "," join ] when
  33             utf8 encode sha1 checksum-bytes hex-string
  34             % ".html" %
  35         ] "" make
  36     ] [ 2drop f ] if ;
  37
  38 M: topic url-of topic>filename ;
  39
  40 : help-stylesheet ( -- xml )
  41     "vocab:help/html/stylesheet.css" ascii file-contents
  42     [XML <style><-></style> XML] ;
  43
  44 : help-navbar ( -- xml )
  45     [XML
  46         <div class="navbar">
  47         <b> Factor Documentation </b> |
  48         <a href="/">Home</a> |
  49         <a href="article-conventions.html">Glossary</a> |
  50         <form method="get" action="/search" style="display:inline;">
  51             <input name="search" type="text"/>
  52             <button type="submit">Search</button>
  53         </form>
  54         <a href="http://factorcode.org" style="float:right; padding: 4px;">factorcode.org</a>
  55         </div>
  56      XML] ;
  57
  58 : help>html ( topic -- xml )
  59     [ article-title " - Factor Documentation" append ]
  60     [ drop help-stylesheet ]
  61     [
  62         [ help-navbar ]
  63         [ [ print-topic ] with-html-writer ]
  64         bi* append
  65     ] tri
  66     simple-page ;
  67
  68 : generate-help-file ( topic -- )
  69     dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
  70
  71 : all-vocabs-really ( -- seq )
  72     all-vocabs-recursive >hashtable no-roots remove-redundant-prefixes
  73     [ vocab-name "scratchpad" = not ] filter ;
  74
  75 : all-topics ( -- topics )
  76     [
  77         articles get keys [ >link ] map %
  78         all-words [ >link ] map %
  79         all-authors [ <vocab-author> ] map %
  80         all-tags [ <vocab-tag> ] map %
  81         all-vocabs-really %
  82     ] { } make ;
  83
  84 : serialize-index ( index file -- )
  85     [ [ [ topic>filename ] dip ] { } assoc-map-as object>bytes ] dip
  86     binary set-file-contents ;
  87
  88 : generate-indices ( -- )
  89     articles get keys [ [ >link ] [ article-title ] bi ] { } map>assoc "articles.idx" serialize-index
  90     all-words [ dup name>> ] { } map>assoc "words.idx" serialize-index
  91     all-vocabs-really [ dup vocab-name ] { } map>assoc "vocabs.idx" serialize-index ;
  92
  93 : (generate-help-files) ( -- )
  94     all-topics [ '[ _ generate-help-file ] try ] each ;
  95
  96 : generate-help-files ( -- )
  97     [
  98         recent-searches off
  99         recent-words off
 100         recent-articles off
 101         recent-vocabs off
 102         (generate-help-files)
 103     ] with-scope ;
 104
 105 : generate-help ( -- )
 106     "docs" temp-file
 107     [ make-directories ]
 108     [
 109         [
 110             generate-indices
 111             generate-help-files
 112         ] with-directory
 113     ] bi ;
 114
 115 MEMO: load-index ( name -- index )
 116     binary file-contents bytes>object ;
 117
 118 TUPLE: result title href ;
 119
 120 : partition-exact ( string results -- results' )
 121     [ title>> = ] with partition append ;
 122
 123 : offline-apropos ( string index -- results )
 124     load-index over >lower
 125     '[ [ drop _ ] dip >lower subseq? ] assoc-filter
 126     [ swap result boa ] { } assoc>map
 127     [ title>> ] sort-with
 128     partition-exact ;
 129
 130 : article-apropos ( string -- results )
 131     "articles.idx" offline-apropos ;
 132
 133 : word-apropos ( string -- results )
 134     "words.idx" offline-apropos ;
 135
 136 : vocab-apropos ( string -- results )
 137     "vocabs.idx" offline-apropos ;