! Copyright (C) 2008, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs colors.constants debugger fry
-help help.crossref help.home help.markup help.stylesheet
-help.topics help.vocabs html html.streams io io.directories
-io.encodings.binary io.encodings.utf8 io.files io.files.temp
-io.pathnames io.styles kernel make math.parser memoize
-namespaces sequences serialize splitting tools.completion vocabs
-vocabs.hierarchy words xml.syntax xml.writer ;
+USING: accessors arrays ascii assocs colors
+combinators.short-circuit debugger formatting help help.home
+help.topics help.vocabs html html.streams io.directories
+io.encodings.ascii io.encodings.binary io.encodings.utf8
+io.files io.files.temp io.pathnames kernel make math math.parser
+namespaces regexp sequences sequences.deep serialize sets
+sorting splitting strings system tools.completion vocabs
+vocabs.hierarchy words xml.data xml.syntax xml.traversal
+xml.writer ;
FROM: io.encodings.ascii => ascii ;
FROM: ascii => ascii? ;
IN: help.html
: escape-char ( ch -- )
dup ascii? [
dup H{
- { CHAR: " "__quo__" }
+ { CHAR: \" "__quo__" }
{ CHAR: * "__star__" }
{ CHAR: : "__colon__" }
{ CHAR: < "__lt__" }
M: pathname url-of
string>> "resource:" ?head [
- "https://github.com/slavapestov/factor/blob/master/"
+ "https://github.com/factor/factor/blob/master/"
prepend
] [ drop f ] if ;
-: help-stylesheet ( -- xml )
+: help-stylesheet ( stylesheet -- xml )
"vocab:help/html/stylesheet.css" ascii file-contents
- [XML <style><-></style> XML] ;
+ swap "\n" glue [XML <style><-></style> XML] ;
-: help-navbar ( -- xml )
+: help-meta ( -- xml )
+ [XML
+ <meta
+ name="viewport"
+ content="width=device-width, initial-scale=1"
+ charset="utf-8"
+ />
+ <meta
+ name="theme-color"
+ content="#f5f5f5"
+ media="(prefers-color-scheme: light)"
+ />
+ <meta
+ name="theme-color"
+ content="#373e48"
+ media="(prefers-color-scheme: dark)"
+ />
+ XML] ;
+
+: help-script ( -- xml )
+ [XML
+ <script type="text/javascript">
+ document.addEventListener('keydown', function (event) {
+ if (event.code == 'Slash') {
+ let input = document.getElementById('search');
+ if (input != null) {
+ if input !== document.activeElement) {
+ event.preventDefault();
+ setTimeout(function() {
+ input.focus().select()
+ }, 0);
+ }
+ }
+ }
+ });
+ </script>
+ XML] ;
+
+: help-header ( stylesheet -- xml )
+ help-stylesheet help-meta swap help-script 3append ;
+
+: help-nav ( -- xml )
"conventions" >link topic>filename
[XML
- <div class="navbar">
- <b> Factor Documentation </b> |
- <a href="/">Home</a> |
- <a href=<->>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>
+ <nav>
+ <form method="get" action="/search" style="float: right;">
+ <input placeholder="Search" id="search" name="search" type="text" tabindex="1" />
+ <input type="submit" value="Go" tabindex="1" />
+ </form>
+ <a href="https://factorcode.org">
+ <img src="favicon.ico" width="24" height="24" />
+ </a>
+ <a href="/">Handbook</a>
+ <a href=<->>Glossary</a>
+ </nav>
XML] ;
-: $navigation-row ( content element label -- )
- [ prefix 1array ] dip prefix , ;
+: help-footer ( -- xml )
+ version-info "\n" split1 drop
+ [XML
+ <footer>
+ <p>
+ This documentation was generated offline from a
+ <code>load-all</code> image. If you want, you can also
+ browse the documentation from within the <a
+ href="article-ui-tools.html">UI developer tools</a>. See
+ the <a href="https://factorcode.org">Factor website</a>
+ for more information.
+ </p>
+ <p><-></p>
+ </footer>
+ XML] ;
-: ($navigation-links) ( topic -- )
- help-path-style get [
- [
- [ prev-article [ 1array \ $long-link "Prev:" $navigation-row ] when* ]
- [ next-article [ 1array \ $long-link "Next:" $navigation-row ] when* ]
- bi
- ] { } make [ ($navigation-table) ] unless-empty
- ] with-style ;
-
-: $title ( topic -- )
- title-style get
- { { page-color COLOR: FactorLightTan } } assoc-union dup
+: bijective-base26 ( n -- name )
+ [ dup 0 > ] [ 1 - 26 /mod CHAR: a + ] "" produce-as nip reverse! ;
+
+: css-class ( style classes -- name )
+ dup '[ drop _ assoc-size 1 + bijective-base26 ] cache ;
+
+: fix-css-style ( style -- style' )
+ R/ font-size: \d+pt;/ [
+ "font-size: " ?head drop "pt;" ?tail drop
+ string>number 2 -
+ "font-size: %dpt;" sprintf
+ ] re-replace-with
+
+ R/ padding: \d+px;/ [
+ "padding: " ?head drop "px;" ?tail drop
+ string>number dup even? [ 2 * 1 + ] [ 2 * ] if
+ number>string "padding: " "px;" surround
+ ] re-replace-with
+
+ R/ width: \d+px;/ [
+ drop ""
+ ] re-replace-with
+
+ R/ font-family: monospace;/ [
+ " white-space: pre-wrap; line-height: 125%;" append
+ ] re-replace-with
+
+ dup { "font-family: monospace;" "background-color:" } [ subseq-of? ] with all? [
+ " margin: 10px 0px;" append
+ ] when
+
+ dup { "border:" "background-color:" } [ subseq-of? ] with all? [
+ " border-radius: 5px;" append
+ ] when ;
+
+: fix-help-header ( classes -- classes )
+ dup [
+ [ ".a" head? ] [ "#f4efd9;" subseq-of? ] bi and
+ ] find [
+ "padding: 10px;" "padding: 0px;" replace
+ "background-color: #f4efd9;" "background-color: white;" replace
+ "}" ?tail drop
+ " border-bottom: 1px dashed #d5d5d5 width: 100%; padding-top: 15px; padding-bottom: 10px; }"
+ append swap pick set-nth {
+ ".a a { color: black; font-size: 24pt; line-height: 100%; }"
+ ".a * a { color: #2a5db0; font-size: 12pt; }"
+ ".a td { border: none; }"
+ ".a tr:hover { background-color: white; }"
+ } prepend
+ ] [ drop ] if* ;
+
+: dark-mode-css ( classes -- classes' )
+ { "" "/* Dark mode */" "@media (prefers-color-scheme:dark) {" }
+ swap [
+ R/ {[^}]+}/ [
+ "{" ?head drop "}" ?tail drop ";" split
+ [ [ blank? ] trim ] map harvest [ ";" append ] map
+ [ R/ (#[0-9a-fA-F]+|white|black);/ re-contains? ] filter
+ [
+ R/ (#[0-9a-fA-F]+|white|black);/ [
+ >string H{
+ { "#000000;" "#bdc1c6;" }
+ { "#2a5db0;" "#8ab4f8;" }
+ { "#333333;" "#d5d5d5;" }
+ { "#373e48;" "#ffffff;" }
+ { "#8b4500;" "orange;" }
+ { "#e3e2db;" "#444444;" }
+ { "white;" "#202124;" }
+ { "black;" "white;" }
+ } ?at [
+ but-last parse-color inverse-color color>hex ";" append
+ ] unless
+ ] re-replace-with
+ ] map " " join "{ " " }" surround
+ ] re-replace-with " " prepend
+ dup "{ }" subseq-of? [ drop f ] when
+ ] map harvest append "}" suffix ;
+
+: css-classes ( classes -- stylesheet )
[
- [
- [ ($title) ]
- [ ($navigation-path) ]
- [ ($navigation-links) ] tri
- ] with-nesting
- ] with-style ;
+ [ fix-css-style " { " "}" surround ] [ "." prepend ] bi* prepend
+ ] { } assoc>map fix-help-header dup dark-mode-css append join-lines ;
+
+:: css-styles-to-classes ( body -- stylesheet body )
+ H{ } clone :> classes
+ body [
+ dup xml-chunk? [
+ seq>> [
+ dup {
+ [ tag? ]
+ [ "style" attr ]
+ [ "class" attr not ]
+ } 1&& [
+ [ clone [ V{ } like ] change-alist ] change-attrs
+ "style" over delete-at* drop classes css-class
+ "class" rot set-at
+ ] [ drop ] if
+ ] deep-each
+ ] [ drop ] if
+ ] each classes sort-values css-classes body ;
+
+: retina-image ( path -- path' )
+ dup "@2x" subseq-of? [ "." split1-last "@2x." glue ] unless ;
+
+: ?copy-file ( from to -- )
+ dup file-exists? [ 2drop ] [ copy-file ] if ;
+
+: cache-images ( body -- body' )
+ dup [
+ dup xml-chunk? [
+ seq>> [
+ T{ name { main "img" } } over tag-named? [
+ dup "src" attr
+ retina-image dup file-name
+ [ ?copy-file ] keep
+ "src" set-attr
+ ] [ drop ] if
+ ] deep-each
+ ] [ drop ] if
+ ] each ;
: help>html ( topic -- xml )
[ article-title " - Factor Documentation" append ]
- [ drop help-stylesheet ]
[
- [ help-navbar ]
- [ [ [ $title ($blank-line) ] [ print-topic ] bi ] with-html-writer ]
- bi* append
- ] tri
- simple-page ;
+ [ print-topic ] with-html-writer
+ css-styles-to-classes cache-images
+ "resource:extra/websites/factorcode/favicon.ico" dup file-name ?copy-file
+ [ help-header help-nav ] dip help-footer
+ [XML <-><div class="page"><-><-></div> XML]
+ ] bi simple-page ;
: generate-help-file ( topic -- )
dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
: all-vocabs-really ( -- seq )
- all-disk-vocabs-recursive no-roots remove-redundant-prefixes
+ all-disk-vocabs-recursive filter-vocabs
[ vocab-name "scratchpad" = ] reject ;
: all-topics ( -- topics )
: article-apropos ( string -- results )
"articles.idx" offline-apropos ;
-: word-apropos ( string -- results )
- "words.idx" offline-apropos ;
-
: vocab-apropos ( string -- results )
"vocabs.idx" offline-apropos ;
+
+: generate-qualified-index ( index -- )
+ H{ } clone [
+ '[
+ over "," split1 nip ".html" ?tail drop
+ [ swap ":" glue 2array ] [ _ push-at ] bi
+ ] assoc-each
+ ] keep [ swap ] { } assoc-map-as
+ "qualified.idx" binary [ serialize ] with-file-writer ;
+
+: qualified-index ( str index -- str index' )
+ over ":" split1 [
+ "qualified.idx"
+ dup file-exists? [ pick generate-qualified-index ] unless
+ load-index completions keys concat
+ ] [ drop f ] if [ append ] unless-empty ;
+
+: word-apropos ( string -- results )
+ "words.idx" load-index qualified-index completions ;