! (c)2010 Joe Groff bsd license
USING: accessors arrays assocs calendar calendar.format
combinators combinators.short-circuit fry io io.backend
io.directories io.directories.hierarchy io.encodings.binary
io.encodings.detect io.encodings.utf8 io.files io.files.info
io.files.types io.files.unique io.launcher io.pathnames kernel
locals math math.parser namespaces sequences sorting strings
system unicode.categories xml.syntax xml.writer xmode.catalog
xmode.marker xmode.tokens ;
IN: codebook
! Usage: "my/source/tree" codebook
! Writes tree.opf, tree.ncx, and tree.html to a temporary directory
! Writes tree.mobi to resource:codebooks
! Requires kindlegen to compile tree.mobi for Kindle
CONSTANT: codebook-style
{
{ COMMENT1 [ [XML <-> XML] ] }
{ COMMENT2 [ [XML <-> XML] ] }
{ COMMENT3 [ [XML <-> XML] ] }
{ COMMENT4 [ [XML <-> XML] ] }
{ DIGIT [ [XML <-> XML] ] }
{ FUNCTION [ [XML <-> XML] ] }
{ KEYWORD1 [ [XML <-> XML] ] }
{ KEYWORD2 [ [XML <-> XML] ] }
{ KEYWORD3 [ [XML <-> XML] ] }
{ KEYWORD4 [ [XML <-> XML] ] }
{ LABEL [ [XML <-> XML] ] }
{ LITERAL1 [ [XML <-> XML] ] }
{ LITERAL2 [ [XML <-> XML] ] }
{ LITERAL3 [ [XML <-> XML] ] }
{ LITERAL4 [ [XML <-> XML] ] }
{ MARKUP [ [XML <-> XML] ] }
{ OPERATOR [ [XML <-> XML] ] }
[ drop ]
}
: first-line ( filename encoding -- line )
[ readln ] with-file-reader ;
TUPLE: code-file
name encoding mode ;
: include-file-name? ( name -- ? )
{
[ path-components [ "." head? ] any? not ]
[ link-info regular-file? ]
} 1&& ;
: code-files ( dir -- files )
'[
[ include-file-name? ] filter [
dup detect-file dup binary?
[ f ] [ 2dup dupd first-line find-mode ] if
code-file boa
] map [ mode>> ] filter [ name>> ] sort-with
] with-directory-tree-files ;
: html-name-char ( char -- str )
{
{ [ dup alpha? ] [ 1string ] }
{ [ dup digit? ] [ 1string ] }
[ >hex 6 CHAR: 0 pad-head "_" "_" surround ]
} cond ;
: file-html-name ( name -- name )
[ html-name-char ] { } map-as concat ".html" append ;
: toc-list ( files -- list )
[ name>> ] map natural-sort [
[ file-html-name ] keep
[XML ><-> XML]
] map ;
! insert zero-width non-joiner between all characters so words can wrap anywhere
: zwnj ( string -- s|t|r|i|n|g )
[ CHAR: \u00200c "" 2sequence ] { } map-as concat ;
! We wrap every line in because Kindle tends to forget the font when
! moving back pages
: htmlize-tokens ( tokens line# -- html-tokens )
swap [
[ str>> zwnj ] [ id>> ] bi codebook-style case
] map [XML <-> <-> XML]
"\n" 2array ;
: line#>string ( i line#len -- i-string )
[ number>string ] [ CHAR: \s pad-head ] bi* ;
:: code>html ( dir file -- page )
file name>> :> name
"Generating HTML for " write name write "..." print flush
dir [ file [ name>> ] [ encoding>> ] bi file-lines ] with-directory :> lines
lines length 1 + number>string length :> line#len
file mode>> load-mode :> rules
f lines [| l i | l rules tokenize-line i 1 + line#len line#>string htmlize-tokens ]
map-index concat nip :> html-lines
<-name->
<-name->
<-html-lines->