basis/help/html/html.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary
   4 io.files html.streams html.elements html.components help kernel
   5 assocs sequences make words accessors arrays help.topics vocabs
   6 tools.vocabs tools.vocabs.browser namespaces prettyprint io
   7 vocabs.loader serialize fry memoize unicode.case ;
   8 IN: help.html
   9
  10 : escape-char ( ch -- )
  11     dup H{
  12         { CHAR: " "__quote__" }
  13         { CHAR: * "__star__" }
  14         { CHAR: : "__colon__" }
  15         { CHAR: < "__lt__" }
  16         { CHAR: > "__gt__" }
  17         { CHAR: ? "__question__" }
  18         { CHAR: \\ "__backslash__" }
  19         { CHAR: | "__pipe__" }
  20         { CHAR: _ "__underscore__" }
  21         { CHAR: / "__slash__" }
  22         { CHAR: \\ "__backslash__" }
  23         { CHAR: , "__comma__" }
  24     } at [ % ] [ , ] ?if ;
  25
  26 : escape-filename ( string -- filename )
  27     [ [ escape-char ] each ] "" make ;
  28
  29 GENERIC: topic>filename* ( topic -- name prefix )
  30
  31 M: word topic>filename* [ name>> ] [ vocabulary>> ] bi 2array "word" ;
  32 M: link topic>filename* name>> "article" ;
  33 M: word-link topic>filename* name>> topic>filename* ;
  34 M: vocab-spec topic>filename* vocab-name "vocab" ;
  35 M: vocab-tag topic>filename* name>> "tag" ;
  36 M: vocab-author topic>filename* name>> "author" ;
  37
  38 : topic>filename ( topic -- filename )
  39     [
  40         topic>filename* % "-" %
  41         dup array?
  42         [ [ escape-filename ] map "," join ]
  43         [ escape-filename ]
  44         if % ".html" %
  45     ] "" make ;
  46
  47 M: topic browser-link-href topic>filename ;
  48
  49 : help-stylesheet ( -- )
  50     "resource:basis/help/html/stylesheet.css" ascii file-contents write ;
  51
  52 : help>html ( topic -- )
  53     dup topic>filename utf8 [
  54         dup article-title
  55         [ <style> help-stylesheet </style> ]
  56         [ [ help ] with-html-writer ] simple-page
  57     ] with-file-writer ;
  58
  59 : all-vocabs-really ( -- seq )
  60     #! Hack.
  61     all-vocabs values concat
  62     vocabs [ find-vocab-root not ] filter [ vocab ] map append ;
  63
  64 : all-topics ( -- topics )
  65     [
  66         ! articles get keys [ >link ] map %
  67         ! all-words [ >link ] map %
  68         ! all-authors [ <vocab-author> ] map %
  69         all-tags [ <vocab-tag> ] map %
  70         ! all-vocabs-really %
  71     ] { } make ;
  72
  73 : serialize-index ( index file -- )
  74     [ [ [ topic>filename ] dip ] { } assoc-map-as object>bytes ] dip
  75     binary set-file-contents ;
  76
  77 : generate-indices ( -- )
  78     articles get keys [ [ >link ] [ article-title ] bi ] { } map>assoc "articles.idx" serialize-index
  79     all-words [ dup name>> ] { } map>assoc "words.idx" serialize-index
  80     all-vocabs-really [ dup vocab-name ] { } map>assoc "vocabs.idx" serialize-index ;
  81
  82 : generate-help ( -- )
  83     all-topics [ help>html ] each ;
  84
  85 MEMO: load-index ( name -- index )
  86     binary file-contents bytes>object ;
  87
  88 TUPLE: result title href ;
  89
  90 M: result link-title title>> ;
  91
  92 M: result link-href href>> ;
  93
  94 : offline-apropos ( string index -- results )
  95     load-index swap >lower
  96     '[ [ drop _ ] dip >lower subseq? ] assoc-filter
  97     [ swap result boa ] { } assoc>map ;
  98
  99 : article-apropos ( string -- results )
 100     "articles.idx" offline-apropos ;
 101
 102 : word-apropos ( string -- results )
 103     "words.idx" offline-apropos ;
 104
 105 : vocab-apropos ( string -- results )
 106     "vocabs.idx" offline-apropos ;