! (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.temp io.files.types io.files.unique io.launcher
io.pathnames kernel locals math math.parser namespaces sequences
sorting strings system unicode 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->