basis/help/html/html.factor

   1 ! Copyright (C) 2008, 2011 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays ascii assocs colors
   4 combinators.short-circuit debugger formatting help help.home
   5 help.topics help.vocabs html html.streams io.directories
   6 io.encodings.ascii io.encodings.binary io.encodings.utf8
   7 io.files io.files.temp io.pathnames kernel make math math.parser
   8 namespaces regexp sequences sequences.deep serialize sets
   9 sorting splitting strings system tools.completion vocabs
  10 vocabs.hierarchy words xml.data xml.syntax xml.traversal
  11 xml.writer ;
  12 FROM: io.encodings.ascii => ascii ;
  13 FROM: ascii => ascii? ;
  14 IN: help.html
  15
  16 ERROR: not-printable ch ;
  17
  18 : check-printable ( ch -- ch )
  19     dup printable? [ not-printable ] unless ;
  20
  21 : escape-char ( ch -- )
  22     dup ascii? [
  23         [
  24             H{
  25                 { CHAR: \" "__quo__" }
  26                 { CHAR: * "__star__" }
  27                 { CHAR: : "__colon__" }
  28                 { CHAR: < "__lt__" }
  29                 { CHAR: > "__gt__" }
  30                 { CHAR: ? "__que__" }
  31                 { CHAR: \\ "__back__" }
  32                 { CHAR: | "__pipe__" }
  33                 { CHAR: / "__slash__" }
  34                 { CHAR: , "__comma__" }
  35                 { CHAR: @ "__at__" }
  36                 { CHAR: # "__hash__" }
  37                 { CHAR: % "__percent__" }
  38             } at
  39         ] [ % ] [ check-printable , ] ?if
  40     ] [ number>string "__" "__" surround % ] if ;
  41
  42 : escape-filename ( string -- filename )
  43     [ [ escape-char ] each ] "" make ;
  44
  45 GENERIC: topic>filename* ( topic -- name prefix )
  46
  47 M: word topic>filename*
  48     dup vocabulary>> [
  49         [ name>> ] [ vocabulary>> ] bi 2array "word"
  50     ] [ drop f f ] if ;
  51
  52 M: link topic>filename* name>> dup [ "article" ] [ topic>filename* ] if ;
  53 M: word-link topic>filename* name>> topic>filename* ;
  54 M: vocab-spec topic>filename* vocab-name "vocab" ;
  55 M: vocab-tag topic>filename* name>> "tag" ;
  56 M: vocab-author topic>filename* name>> "author" ;
  57 M: f topic>filename* drop \ f topic>filename* ;
  58
  59 : topic>filename ( topic -- filename )
  60     topic>filename* [
  61         [
  62             % "-" %
  63             dup array?
  64             [ [ escape-filename ] map "," join ]
  65             [ escape-filename ]
  66             if % ".html" %
  67         ] "" make
  68     ] [ drop f ] if* ;
  69
  70 M: topic url-of topic>filename ;
  71
  72 M: pathname url-of
  73     string>> "resource:" ?head [
  74         "https://github.com/factor/factor/blob/master/"
  75         prepend
  76     ] [ drop f ] if ;
  77
  78 : help-stylesheet ( stylesheet -- xml )
  79     "vocab:help/html/stylesheet.css" ascii file-contents
  80     swap "\n" glue [XML <style><-></style> XML] ;
  81
  82 : help-meta ( -- xml )
  83     [XML
  84         <meta
  85             name="viewport"
  86             content="width=device-width, initial-scale=1"
  87             charset="utf-8"
  88         />
  89         <meta
  90             name="theme-color"
  91             content="#f5f5f5"
  92             media="(prefers-color-scheme: light)"
  93         />
  94         <meta
  95             name="theme-color"
  96             content="#373e48"
  97             media="(prefers-color-scheme: dark)"
  98         />
  99     XML] ;
 100
 101 : help-script ( -- xml )
 102     [XML
 103         <script type="text/javascript">
 104         document.addEventListener('keydown', function (event) {
 105             if (event.code == 'Slash') {
 106                 let input = document.getElementById('search');
 107                 if (input != null) {
 108                     if (input !== document.activeElement) {
 109                         event.preventDefault();
 110                         setTimeout(function() {
 111                             input.focus();
 112                         }, 0);
 113                     }
 114                 }
 115             }
 116         });
 117         </script>
 118     XML] ;
 119
 120 : help-header ( stylesheet -- xml )
 121     help-stylesheet help-meta swap help-script 3append ;
 122
 123 : help-nav ( -- xml )
 124     "conventions" >link topic>filename
 125     [XML
 126         <nav>
 127             <form method="get" action="/search" style="float: right;">
 128                 <input placeholder="Search" id="search" name="search" type="text" tabindex="1" />
 129                 <input type="submit" value="Go" tabindex="1" />
 130             </form>
 131             <a href="https://factorcode.org">
 132             <img src="favicon.ico" width="24" height="24" />
 133             </a>
 134             <a href="/">Handbook</a>
 135             <a href=<->>Glossary</a>
 136         </nav>
 137     XML] ;
 138
 139 : help-footer ( -- xml )
 140     version-info "\n" split1 drop
 141     [XML
 142         <footer>
 143         <p>
 144         This documentation was generated offline from a
 145         <code>load-all</code> image.  If you want, you can also
 146         browse the documentation from within the <a
 147         href="article-ui-tools.html">UI developer tools</a>. See
 148         the <a href="https://factorcode.org">Factor website</a>
 149         for more information.
 150         </p>
 151         <p><-></p>
 152         </footer>
 153     XML] ;
 154
 155 : bijective-base26 ( n -- name )
 156     [ dup 0 > ] [ 1 - 26 /mod CHAR: a + ] "" produce-as nip reverse! ;
 157
 158 : css-class ( style classes -- name )
 159     dup '[ drop _ assoc-size 1 + bijective-base26 ] cache ;
 160
 161 : fix-css-style ( style -- style' )
 162     R/ font-size: \d+pt;/ [
 163         "font-size: " ?head drop "pt;" ?tail drop
 164         string>number 2 -
 165         "font-size: %dpt;" sprintf
 166     ] re-replace-with
 167
 168     R/ padding: \d+px;/ [
 169         "padding: " ?head drop "px;" ?tail drop
 170         string>number 2 * number>string
 171         "padding: " "px;" surround
 172     ] re-replace-with
 173
 174     R/ width: \d+px;/ [
 175        drop ""
 176     ] re-replace-with
 177
 178     R/ font-family: monospace;/ [
 179         " margin-top: 0.5em; margin-bottom: 0.5em; width: fit-content; white-space: pre-wrap; line-height: 125%;" append
 180     ] re-replace-with ;
 181
 182 : fix-help-header ( classes -- classes )
 183     dup [
 184         [ ".a" head? ] [ "#f4efd9;" subseq-of? ] bi and
 185     ] find [
 186         "padding: 10px;" "" replace
 187         "background-color: #f4efd9;" "" replace
 188         "}" ?tail drop
 189         " border-bottom: 1px dashed #d5d5d5; width: 100%; padding-top: 10px; padding-bottom: 10px; }"
 190         append swap pick set-nth {
 191             ".a a { color: black; font-size: 24pt; line-height: 100%; }"
 192             ".a * a { color: #2a5db0; font-size: 12pt; }"
 193             ".a td { border: none; }"
 194             ".a tr:hover { background-color: transparent }"
 195         } prepend
 196     ] [ drop ] if* ;
 197
 198 : dark-mode-css ( classes -- classes' )
 199     { "" "/* Dark mode */" "@media (prefers-color-scheme:dark) {" }
 200     swap [
 201         R/ {[^}]+}/ [
 202             "{" ?head drop "}" ?tail drop ";" split
 203             [ [ blank? ] trim ] map harvest [ ";" append ] map
 204             [ R/ (#[0-9a-fA-F]+|white|black);/ re-contains? ] filter
 205             [
 206                 R/ (#[0-9a-fA-F]+|white|black);/ [
 207                     >string H{
 208                         { "#000000;" "#bdc1c6;" }
 209                         { "#2a5db0;" "#8ab4f8;" }
 210                         { "#333333;" "#d5d5d5;" }
 211                         { "#373e48;" "#ffffff;" }
 212                         { "#8b4500;" "orange;" }
 213                         { "#d5d5d5;" "#666;" }
 214                         { "#e3e2db;" "#444444;" }
 215                         { "white;" "#202124;" }
 216                         { "black;" "white;" }
 217                         { "transparent;" "transparent;" }
 218                     } ?at [
 219                         but-last parse-color inverse-color color>hex ";" append
 220                     ] unless
 221                 ] re-replace-with
 222             ] map " " join "{ " " }" surround
 223         ] re-replace-with "    " prepend
 224         dup "{  }" subseq-of? [ drop f ] when
 225     ] map harvest append "}" suffix ;
 226
 227 : css-classes ( classes -- stylesheet )
 228     [
 229         [ fix-css-style " { " "}" surround ] [ "." prepend ] bi* prepend
 230     ] { } assoc>map fix-help-header dup dark-mode-css append join-lines ;
 231
 232 :: css-styles-to-classes ( body -- stylesheet body )
 233     H{ } clone :> classes
 234     body [
 235         dup xml-chunk? [
 236             seq>> [
 237                 dup {
 238                     [ tag? ]
 239                     [ "style" attr ]
 240                     [ "class" attr not ]
 241                 } 1&& [
 242                     [ clone [ V{ } like ] change-alist ] change-attrs
 243                     "style" over delete-at* drop classes css-class
 244                     "class" rot set-at
 245                 ] [ drop ] if
 246             ] deep-each
 247         ] [ drop ] if
 248     ] each classes sort-values css-classes body ;
 249
 250 : retina-image ( path -- path' )
 251     dup "@2x" subseq-of? [ "." split1-last "@2x." glue ] unless ;
 252
 253 : ?copy-file ( from to -- )
 254     dup file-exists? [ 2drop ] [ copy-file ] if ;
 255
 256 : cache-images ( body -- body' )
 257     dup [
 258         dup xml-chunk? [
 259             seq>> [
 260                 T{ name { main "img" } } over tag-named? [
 261                     dup "src" attr
 262                     retina-image dup file-name
 263                     [ ?copy-file ] keep
 264                     "src" set-attr
 265                 ] [ drop ] if
 266             ] deep-each
 267         ] [ drop ] if
 268     ] each ;
 269
 270 : help>html ( topic -- xml )
 271     [ article-title " - Factor Documentation" append ]
 272     [
 273         [ print-topic ] with-html-writer
 274         css-styles-to-classes cache-images
 275         "resource:extra/websites/factorcode/favicon.ico" dup file-name ?copy-file
 276         [ help-header help-nav ] dip help-footer
 277         [XML <-><div class="page"><-><-></div> XML]
 278     ] bi simple-page ;
 279
 280 : generate-help-file ( topic -- )
 281     dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
 282
 283 : all-vocabs-really ( -- seq )
 284     all-disk-vocabs-recursive filter-vocabs
 285     [ vocab-name "scratchpad" = ] reject ;
 286
 287 : all-topics ( -- topics )
 288     [
 289         articles get keys [ >link ] map %
 290         all-words [ >link ] map %
 291         all-authors [ <vocab-author> ] map %
 292         all-tags [ <vocab-tag> ] map %
 293         all-vocabs-really %
 294     ] { } make ;
 295
 296 : serialize-index ( index file -- )
 297     binary [
 298         [ [ topic>filename ] dip ] { } assoc-map-as serialize
 299     ] with-file-writer ;
 300
 301 : generate-article-index ( -- )
 302     articles get [ [ >link ] [ article-title ] bi* ] assoc-map
 303     "articles.idx" serialize-index ;
 304
 305 : generate-word-index ( -- )
 306     all-words [ dup name>> ] { } map>assoc
 307     "words.idx" serialize-index ;
 308
 309 : generate-vocab-index ( -- )
 310     all-vocabs-really [ dup vocab-name ] { } map>assoc
 311     "vocabs.idx" serialize-index ;
 312
 313 : generate-indices ( -- )
 314     generate-article-index
 315     generate-word-index
 316     generate-vocab-index ;
 317
 318 : generate-help-files ( -- )
 319     H{
 320         { recent-searches f }
 321         { recent-words f }
 322         { recent-articles f }
 323         { recent-vocabs f }
 324     } [
 325         all-topics [ '[ _ generate-help-file ] try ] each
 326     ] with-variables ;
 327
 328 : generate-help ( -- )
 329     "docs" cache-file
 330     [ make-directories ]
 331     [
 332         [
 333             generate-indices
 334             generate-help-files
 335         ] with-directory
 336     ] bi ;
 337
 338 MEMO: load-index ( name -- index )
 339     binary file-contents bytes>object ;
 340
 341 : offline-apropos ( string index -- results )
 342     load-index completions ;
 343
 344 : article-apropos ( string -- results )
 345     "articles.idx" offline-apropos ;
 346
 347 : vocab-apropos ( string -- results )
 348     "vocabs.idx" offline-apropos ;
 349
 350 : generate-qualified-index ( index -- )
 351     H{ } clone [
 352         '[
 353             over "," split1 nip ".html" ?tail drop
 354             [ swap ":" glue 2array ] [ _ push-at ] bi
 355         ] assoc-each
 356     ] keep [ swap ] { } assoc-map-as
 357     "qualified.idx" binary [ serialize ] with-file-writer ;
 358
 359 : qualified-index ( str index -- str index' )
 360     over ":" split1 [
 361         "qualified.idx"
 362         dup file-exists? [ pick generate-qualified-index ] unless
 363         load-index completions keys concat
 364     ] [ drop f ] if [ append ] unless-empty ;
 365
 366 : word-apropos ( string -- results )
 367     "words.idx" load-index qualified-index completions ;