1structure Doc2Tex = 2struct 3 4open ParseDoc 5 6 7fun occurs s ss = not (Substring.isEmpty (#2 (Substring.position s ss))); 8fun equal x y = (x = y) 9 10fun warn s = TextIO.output(TextIO.stdErr, s ^ "\n") 11fun die s = (TextIO.output(TextIO.stdErr, s ^ "\n"); 12 OS.Process.exit OS.Process.failure) 13fun out(str,s) = TextIO.output(str, s) 14 15fun every P ss = 16 case Substring.getc ss of 17 NONE => true 18 | SOME (c, ss') => P c andalso every P ss' 19 20fun mem x l = List.exists (fn e => e = x) l 21 22val verbstr = "|^$!()*&+-@/'\"" 23fun find_verbchar avoids ss = let 24 fun loop n = let 25 val candidate = String.extract(verbstr,n,SOME 1) 26 in 27 if occurs candidate ss orelse mem candidate avoids then loop (n + 1) 28 else candidate 29 end 30in 31 loop 0 32end handle Subscript => 33 raise Fail "bracketed string with too many exotic characters!" 34 35fun findvc3 avoids ss = 36 let 37 val c1 = find_verbchar avoids ss 38 val c2 = find_verbchar (c1::avoids) ss 39 val c3 = find_verbchar (c1::c2::avoids) ss 40 in 41 (c1,c2,c3) 42 end 43 44fun print_verb1(ss, ostr) = let 45 val vd = find_verbchar [] ss 46 val (com,argl,argr) = findvc3 [vd] ss 47 val verbtheta = 48 map (fn (a,b) => {redex = a, residue = b}) 49 [(UnicodeChars.ldquo, com ^ "ldquo" ^ argl ^ argr), 50 (UnicodeChars.rdquo, com ^ "rdquo" ^ argl ^ argr)] 51in 52 out(ostr, "{\\small\\Verb[commandchars=" ^ String.concat [com,argl,argr] ^ 53 "]" ^ vd); 54 out(ostr, stringfindreplace.subst verbtheta (Substring.string ss)); 55 out(ostr, vd ^ "}") 56end 57 58fun print_verbblock (ss, ostr) = 59 let 60 val (com,argl,argr) = findvc3 [] ss 61 val verbtheta = 62 map (fn (a,b) => {redex = a, residue = b}) 63 [(UnicodeChars.ldquo, com ^ "ldquo" ^ argl ^ argr), 64 (UnicodeChars.rdquo, com ^ "rdquo" ^ argl ^ argr)] 65 in 66 out(ostr,"\\begin{Verbatim}[commandchars=" ^ String.concat[com,argl,argr] ^ 67 "]\n"); 68 out(ostr, stringfindreplace.subst verbtheta (Substring.string ss)); 69 out(ostr, "\\end{Verbatim}\n") 70 end 71 72val lastminute_fixes = 73 String.translate (fn #"#" => "\\#" 74 | #"&" => "\\&" 75 | #"_" => "\\_" 76 | c => str c) 77 78fun print_markup(m, ostr) = 79 case m of 80 PARA => out(ostr, "\n\n") 81 | TEXT ss => out(ostr, lastminute_fixes (Substring.string ss)) 82 | EMPH ss => out(ostr, 83 "\\emph{" ^ lastminute_fixes (Substring.string ss) ^ "}") 84 | BRKT ss => print_verb1(ss, ostr) 85 | XMPL ss => print_verbblock(ss, ostr) 86 87fun print_type (ss, ostr) = 88 if occurs "\n" ss then 89 (out(ostr, "{\\small\n\\begin{verbatim}"); 90 out(ostr, Substring.string ss); 91 out(ostr, "\n\\end{verbatim}\n}\\egroup\n\n")) 92 else 93 (out(ostr, "\\noindent"); 94 print_verb1(ss, ostr); 95 out(ostr, "\\egroup\n\n")) 96 97fun print_list(ssl, ostr) = 98 case ssl of 99 [] => () 100 | [x] => out(ostr, lastminute_fixes (Substring.string x)) 101 | x::xs => (out(ostr, lastminute_fixes (Substring.string x) ^ ", "); 102 print_list (xs, ostr)) 103 104fun indent_munge mlist = 105 case mlist of 106 [] => [] 107 | ((x as XMPL _) :: (t as TEXT ts) :: rest) => 108 if every Char.isSpace ts then 109 x :: indent_munge rest 110 else 111 x :: TEXT (Substring.full "\\noindent ") :: t :: indent_munge rest 112 | m::ms => m :: indent_munge ms 113 114 115val ignored_sections = ["KEYWORDS", "LIBRARY", "STRUCTURE", "DOC"] 116fun should_ignore s = List.exists (fn t => t = s) ignored_sections 117 118fun print_section(s, ostr) = 119 case s of 120 TYPE ss => print_type(ss,ostr) 121 | FIELD (s, mlist) => 122 if should_ignore s then () 123 else (out(ostr, "\\" ^ s ^ "\n"); 124 app (fn m => print_markup(m, ostr)) (indent_munge mlist); 125 out(ostr, "\n\n")) 126 | SEEALSO ssl => (out(ostr, "\\SEEALSO\n"); 127 print_list (ssl, ostr); 128 out(ostr, ".\n\n")) 129 130fun print_docpart (slist, ostr) = let 131 fun find_structpart [] = NONE 132 | find_structpart (FIELD("STRUCTURE", [TEXT m])::_) = SOME m 133 | find_structpart (_ :: t) = find_structpart t 134 fun find_docpart [] = raise Fail "Can't happen - empty section list" 135 | find_docpart (FIELD("DOC", [TEXT m]) :: _) = m 136 | find_docpart (_ :: t) = raise Fail "Can't happen \\DOC not first entry" 137 val docpart = lastminute_fixes (Substring.string (find_docpart slist)) 138 val prettypart = 139 case find_structpart slist of 140 NONE => docpart 141 | SOME ss => docpart ^ "\\hfill(" ^ 142 lastminute_fixes (Substring.string ss) ^ ")" 143in 144 out (ostr, "\\DOC{"^docpart^"}{"^prettypart^"}\n\n") 145end 146 147val verbose = ref false 148 149fun do_the_work dir dset outstr = let 150 fun appthis dnm = let 151 val _ = if !verbose then warn ("Processing "^dnm) else () 152 val cname = core_dname dnm 153 val file = parse_file (OS.Path.concat(dir,dnm ^ ".doc")) 154 handle ParseError msg => die ("Parse error in "^dnm^": "^msg) 155 in 156 print_docpart(file, outstr); 157 app (fn s => print_section (s,outstr)) file; 158 out(outstr, "\\ENDDOC\n\n") 159 end handle e => die ("Exception raised (" ^ dnm ^ ".doc): " ^ 160 General.exnMessage e) 161in 162 Binaryset.app appthis dset 163end 164 165 166fun main () = let 167 fun handle_args (docdir, texfile) = let 168 val texfstr = TextIO.openAppend texfile 169 val docfiles = find_docfiles docdir 170 in 171 do_the_work docdir docfiles texfstr; 172 TextIO.closeOut texfstr; 173 OS.Process.exit OS.Process.success 174 end 175in 176 case CommandLine.arguments() of 177 [docdir, texfile] => handle_args (docdir, texfile) 178 | ["-v", docdir, texfile] => (verbose := true; handle_args(docdir,texfile)) 179 | _ => 180 (warn ("Usage: "^CommandLine.name()^ 181 " [-v] <doc directory> <TeX file>\n"); 182 warn (" -v be verbose about what's happening."); 183 OS.Process.exit OS.Process.failure) 184end 185 186 187end (* struct *) 188