extra/codebook/codebook.factor

   1 ! Copyright (C) 2010 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs calendar calendar.format
   4 combinators combinators.short-circuit fry io io.backend
   5 io.directories io.directories.hierarchy io.encodings.binary
   6 io.encodings.detect io.encodings.utf8 io.files io.files.info
   7 io.files.temp io.files.types io.files.unique io.launcher
   8 io.pathnames kernel locals math math.parser namespaces sequences
   9 sorting strings system unicode xml.syntax xml.writer
  10 xmode.catalog xmode.marker xmode.tokens ;
  11 IN: codebook
  12
  13 ! Usage: "my/source/tree" codebook
  14 ! Writes tree.opf, tree.ncx, and tree.html to a temporary directory
  15 ! Writes tree.mobi to resource:codebooks
  16 ! Requires kindlegen to compile tree.mobi for Kindle
  17
  18 CONSTANT: codebook-style
  19     {
  20         { COMMENT1 [ [XML <i><font color="#555555"><-></font></i> XML] ] }
  21         { COMMENT2 [ [XML <i><font color="#555555"><-></font></i> XML] ] }
  22         { COMMENT3 [ [XML <i><font color="#555555"><-></font></i> XML] ] }
  23         { COMMENT4 [ [XML <i><font color="#555555"><-></font></i> XML] ] }
  24         { DIGIT    [ [XML    <font color="#333333"><-></font>     XML] ] }
  25         { FUNCTION [ [XML <b><font color="#111111"><-></font></b> XML] ] }
  26         { KEYWORD1 [ [XML <b><font color="#111111"><-></font></b> XML] ] }
  27         { KEYWORD2 [ [XML <b><font color="#111111"><-></font></b> XML] ] }
  28         { KEYWORD3 [ [XML <b><font color="#111111"><-></font></b> XML] ] }
  29         { KEYWORD4 [ [XML <b><font color="#111111"><-></font></b> XML] ] }
  30         { LABEL    [ [XML <b><font color="#333333"><-></font></b> XML] ] }
  31         { LITERAL1 [ [XML    <font color="#333333"><-></font>     XML] ] }
  32         { LITERAL2 [ [XML    <font color="#333333"><-></font>     XML] ] }
  33         { LITERAL3 [ [XML    <font color="#333333"><-></font>     XML] ] }
  34         { LITERAL4 [ [XML    <font color="#333333"><-></font>     XML] ] }
  35         { MARKUP   [ [XML <b><font color="#333333"><-></font></b> XML] ] }
  36         { OPERATOR [ [XML <b><font color="#111111"><-></font></b> XML] ] }
  37         [ drop ]
  38     }
  39
  40 : first-line ( filename encoding -- line )
  41     [ readln ] with-file-reader ;
  42
  43 TUPLE: code-file
  44     name encoding mode ;
  45
  46 : include-file-name? ( name -- ? )
  47     {
  48         [ path-components [ "." head? ] any? not ]
  49         [ link-info regular-file? ]
  50     } 1&& ;
  51
  52 : code-files ( dir -- files )
  53     '[
  54         [ include-file-name? ] filter [
  55             dup detect-file dup binary?
  56             [ f ] [ 2dup dupd first-line find-mode ] if
  57             code-file boa
  58         ] map [ mode>> ] filter [ name>> ] sort-with
  59     ] with-directory-tree-files ;
  60
  61 : html-name-char ( char -- str )
  62     {
  63         { [ dup alpha? ] [ 1string ] }
  64         { [ dup digit? ] [ 1string ] }
  65         [ >hex 6 CHAR: 0 pad-head "_" "_" surround ]
  66     } cond ;
  67
  68 : file-html-name ( name -- name )
  69     [ html-name-char ] { } map-as concat ".html" append ;
  70
  71 : toc-list ( files -- list )
  72     [ name>> ] map natural-sort [
  73         [ file-html-name ] keep
  74         [XML <li><a href=<->><-></a></li> XML]
  75     ] map ;
  76
  77 ! insert zero-width non-joiner between all characters so words can wrap anywhere
  78 : zwnj ( string -- s|t|r|i|n|g )
  79     [ CHAR: \u00200c "" 2sequence ] { } map-as concat ;
  80
  81 ! We wrap every line in <tt> because Kindle tends to forget the font when
  82 ! moving back pages
  83 : htmlize-tokens ( tokens line# -- html-tokens )
  84     swap [
  85         [ str>> zwnj ] [ id>> ] bi codebook-style case
  86     ] map [XML <tt><font size="-2" color="#666666"><-></font> <-></tt> XML]
  87     "\n" 2array ;
  88
  89 : line#>string ( i line#len -- i-string )
  90     [ number>string ] [ CHAR: \s pad-head ] bi* ;
  91
  92 :: code>html ( dir file -- page )
  93     file name>> :> name
  94     "Generating HTML for " write name write "..." print flush
  95     dir [ file [ name>> ] [ encoding>> ] bi file-lines ] with-directory :> lines
  96     lines length 1 + number>string length :> line#len
  97     file mode>> load-mode :> rules
  98     f lines [| l i | l rules tokenize-line i 1 + line#len line#>string htmlize-tokens ]
  99     map-index concat nip :> html-lines
 100     <XML <!DOCTYPE html> <html>
 101         <head>
 102             <title><-name-></title>
 103             <meta http-equiv="Content-type" content="text/html; charset=utf-8" />
 104         </head>
 105         <body>
 106             <h2><-name-></h2>
 107             <pre><-html-lines-></pre>
 108             <mbp:pagebreak xmlns:mbp="http://www.mobipocket.com/mbp" />
 109         </body>
 110     </html> XML> ;
 111
 112 :: code>toc-html ( dir name files -- html )
 113     "Generating HTML table of contents" print flush
 114
 115     now timestamp>rfc822 :> timestamp
 116     dir absolute-path :> source
 117     dir [
 118         files toc-list :> toc
 119
 120         <XML <!DOCTYPE html> <html>
 121             <head>
 122                 <title><-name-></title>
 123                 <meta http-equiv="Content-type" content="text/html; charset=utf-8" />
 124             </head>
 125             <body>
 126                 <h1><-name-></h1>
 127                 <font size="-2">Generated from<br/>
 128                 <b><tt><-source-></tt></b><br/>
 129                 at <-timestamp-></font><br/>
 130                 <br/>
 131                 <ul><-toc-></ul>
 132                 <mbp:pagebreak xmlns:mbp="http://www.mobipocket.com/mbp" />
 133             </body>
 134         </html> XML>
 135     ] with-directory ;
 136
 137 :: code>ncx ( dir name files -- xml )
 138     "Generating NCX table of contents" print flush
 139
 140     files [| file i |
 141         file name>> :> name
 142         name file-html-name :> filename
 143         i 2 + number>string :> istr
 144
 145         [XML <navPoint class="book" id=<-filename-> playOrder=<-istr->>
 146             <navLabel><text><-name-></text></navLabel>
 147             <content src=<-filename-> />
 148         </navPoint> XML]
 149     ] map-index :> file-nav-points
 150
 151     <XML <?xml version="1.0" encoding="UTF-8" ?>
 152     <ncx version="2005-1" xmlns="http://www.daisy.org/z3986/2005/ncx/">
 153         <navMap>
 154             <navPoint class="book" id="toc" playOrder="1">
 155                 <navLabel><text>Table of Contents</text></navLabel>
 156                 <content src="_toc.html" />
 157             </navPoint>
 158             <-file-nav-points->
 159         </navMap>
 160     </ncx> XML> ;
 161
 162 :: code>opf ( dir name files -- xml )
 163     "Generating OPF manifest" print flush
 164     name ".ncx"  append :> ncx-name
 165
 166     files [
 167         name>> file-html-name dup
 168         [XML <item id=<-> href=<-> media-type="text/html" /> XML]
 169     ] map :> html-manifest
 170
 171     files [ name>> file-html-name [XML <itemref idref=<-> /> XML] ] map :> html-spine
 172
 173     <XML <?xml version="1.0" encoding="UTF-8" ?>
 174     <package
 175         version="2.0"
 176         xmlns="http://www.idpf.org/2007/opf"
 177         unique-identifier=<-name->>
 178         <metadata xmlns:dc="http://purl.org/dc/elements/1.1/">
 179             <dc:title><-name-></dc:title>
 180             <dc:language>en</dc:language>
 181             <meta name="cover" content="my-cover-image" />
 182         </metadata>
 183         <manifest>
 184             <item href="cover.jpg" id="my-cover-image" media-type="image/jpeg" />
 185             <item id="html-toc" href="_toc.html" media-type="text/html" />
 186             <-html-manifest->
 187             <item id="toc" href=<-ncx-name-> media-type="application/x-dtbncx+xml" />
 188         </manifest>
 189         <spine toc="toc">
 190             <itemref idref="html-toc" />
 191             <-html-spine->
 192         </spine>
 193         <guide>
 194             <reference type="toc" title="Table of Contents" href="_toc.html" />
 195         </guide>
 196     </package> XML> ;
 197
 198 : write-dest-file ( xml name ext -- )
 199     append utf8 [ write-xml ] with-file-writer ;
 200
 201 SYMBOL: kindlegen-path
 202 kindlegen-path [ "kindlegen" ] initialize
 203
 204 SYMBOL: codebook-output-path
 205 codebook-output-path [ "resource:codebooks" ] initialize
 206
 207 : kindlegen ( path -- )
 208     [ kindlegen-path get "-unicode" ] dip 3array try-process ;
 209
 210 : kindle-path ( directory name extension -- path )
 211     [ append-path ] dip append ;
 212
 213 :: codebook ( src-dir -- )
 214     codebook-output-path get normalize-path :> dest-dir
 215
 216     "Generating ebook for " write src-dir write " in " write dest-dir print flush
 217
 218     dest-dir make-directories
 219     [
 220         [
 221             src-dir file-name :> name
 222             src-dir code-files :> files
 223
 224             src-dir name files code>opf
 225             name ".opf" write-dest-file
 226
 227             "vocab:codebook/cover.jpg" "." copy-file-into
 228
 229             src-dir name files code>ncx
 230             name ".ncx" write-dest-file
 231
 232             src-dir name files code>toc-html
 233             "_toc.html" "" write-dest-file
 234
 235             files [| file |
 236                 src-dir file code>html
 237                 file name>> file-html-name "" write-dest-file
 238             ] each
 239
 240             "." name ".opf" kindle-path kindlegen
 241             "." name ".mobi" kindle-path dest-dir copy-file-into
 242
 243             dest-dir name ".mobi" kindle-path :> mobi-path
 244
 245             "Job's finished: " write mobi-path print flush
 246         ] cleanup-unique-directory
 247     ] with-temp-directory ;