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