include "xhtml-trans.cd";; (* XHTML 1 Transitional DTD *) type Special = Xbr | Xspan | Xbdo | Xmap | Xobject | Ximg | Xapplet | Xiframe;; type Fontstyle = Xtt | Xi | Xb | Xbig | Xsmall | Xu | Xs | Xstrike | Xfont | Xbasefont;; type Phrase = Xem | Xstrong | Xdfn | Xcode | Xq | Xsamp | Xkbd | Xvar | Xcite | Xabbr | Xacronym | Xsub | Xsup;; type InlineForms = Xinput | Xselect | Xtextarea | Xlabel | Xbutton;; type MiscInline = Xins | Xdel | Xscript;; type Misc = Xnoscript | MiscInline;; type Inline = Xa | Special | Fontstyle | Phrase | InlineForms;; type Inlines = [ (Char | Inline | MiscInline)* ];; type Heading = Xh1 | Xh2 | Xh3 | Xh4 | Xh5 | Xh6;; type Lists = Xul | Xol | Xdl | Xmenu | Xdir;; type Blocktext = Xpre | Xhr | Xblockquote | Xaddress | Xcenter | Xnoframes;; type Block = Xp | Heading | Xdiv | Lists | Blocktext | Xfieldset | Xtable | Xisindex;; type Blocks = [ (Block | Xform | Misc)* ];; type Flow = [ (Char | Block | Xform | Inline | Misc)* ];; let fun do_body (Xbody -> String) l -> do_flows l;; let fun do_head (Xhead -> String) [_* t ; _] -> [ '\\title{' !t '}\n\\author{}\n\\date{Auto-generated by html2latex}\n' ];; let fun do_flows (Flow -> String) s -> transform s with | c & Char -> [ c ] | x & Block -> do_block x | x & Inline -> do_inline x;; let fun do_inlines ([ (Char | Inline | Misc)* ] -> String) s -> transform s with | c & Char -> [ c ] | x & Inline -> do_inline x;; let fun do_inline (Inline -> String) | <a>l -> (transform l with | c & Char -> [c] | x & (Special | Fontstyle | Phrase | InlineForms) -> do_inline x) | fs & Fontstyle -> do_fontstyle fs | p & Phrase -> do_phrase p | <img alt=s>_ -> s | _ -> "";; let fun do_fontstyle(Fontstyle -> String) | <tt>i -> [ '{\\tt ' !(do_inlines i) '}' ] | <i>i -> [ '{\\it ' !(do_inlines i) '}' ] | <b>i -> [ '{\\bf ' !(do_inlines i) '}' ] | <big>i -> [ '{\\big ' !(do_inlines i) '}' ] | <small>i -> [ '{\\small ' !(do_inlines i) '}' ] | <_>l -> do_inlines l;; let fun do_phrase(Phrase -> String) | <(`em|`strong|`dfn|`samp|`cite|`abbr|`acronym)>i -> [ '{\\em ' !(do_inlines i) '}' ] | <(`code|`kbd)>i -> [ '{\\tt ' !(do_inlines i) '}' ] | <q>i -> [ '{\\it ' !(do_inlines i) '}' ] | <sub>i -> [ '\\(_{\\mbox{' !(do_inlines i) '}}\\)' ] | <sup>i -> [ '\\(^{\\mbox{' !(do_inlines i) '}}\\)' ] | <var>i -> [ '\\(' !(do_inlines i) '\\)' ];; let fun do_heading (Heading \ Xh1 -> String) | <h1>i -> [ '\\section{ ' !(do_inlines i) '}\n' ] | <h2>i -> [ '\\subsection{ ' !(do_inlines i) '}\n' ] | <h3>i -> [ '\\subsubsection{ ' !(do_inlines i) '}\n' ] | <h4>i -> [ '\\subsubsubsection{ ' !(do_inlines i) '}\n' ] | <h5>i -> [ '\\subsubsubsubsection{ ' !(do_inlines i) '}\n' ] | <h6>i -> [ '\\subsubsubsubsubsection{ ' !(do_inlines i) '}\n' ];; let fun do_lis ([ Xli+ ] -> String) l -> transform l with <li>f -> [ '\\item ' !(do_flows f) '\n' ];; let fun do_ul_content (arg : [ Xli+ ]) : String = [ '\\begin{itemize}\n' !(do_lis arg) '\\end{itemize}\n' ];; let fun do_ol_content (arg : [ Xli+ ]) : String = [ '\\begin{enumerate}\n' !(do_lis arg) '\\end{enumerate}\n' ];; let fun do_dl_content (arg : [ (Xdt|Xdd)+ ]) : String = [ '\\begin{description}\n' !(do_ds arg) '\\end{description}\n' ];; let fun do_ds ([ (Xdt | Xdd)* ] -> String) | [] -> "" | [ dts::Xdt* <dd>f; rest ] -> [ '\\item[' !(cat_dts dts) '] ' !(do_flows f) '\n' !(do_ds rest) ] | [ dts::Xdt* ] -> [ '\\item[' !(cat_dts dts) ']\n' ];; let fun cat_dts ([ Xdt* ] -> String) | [] -> "" | [<dt>i] -> do_inlines i | [<dt>i; rest] -> [ !(do_inlines i) ', ' !(cat_dts rest) ];; let fun do_blocktext (Blocktext -> String) | <center>f -> [ '\\begin{center}\n' !(do_flows f) '\\end{center}\n'] | <(`blockquote|`pre)>f -> do_flows f | _ -> "";; let fun do_block (Block -> String) | <p>l -> do_inlines l | <h1>_ -> "" | h & Heading -> do_heading h | <ul>l -> do_ul_content l | <ol>l -> do_ol_content l | <dl>l -> do_dl_content l | t & Xtable -> do_table t | bt & Blocktext -> do_blocktext bt | _ -> "";; let fun do_html (Xhtml -> String) <html>[ (h & Xhead) (b & Xbody) ] -> [ '\\documentclass{article}\n' !(do_head h) '\\begin{document}\n\\maketitle\n' !(do_body b) '\\end{document}\n' ];; let fun do_table (Xtable -> String) _ -> raise "<table> nothandled";; match load_xml "tst_html2latex.xml" with | x & Xhtml -> print (do_html x) | _ -> raise "Input file is not XHTML !";;