libmojave/stdlib/lm_rformat_tex.ml

   1 (*
   2  * Formatting to LaTeX documents.
   3  *
   4  * ----------------------------------------------------------------
   5  *
   6  * @begin[license]
   7  * Copyright (C) 2004 Mojave Group, Caltech
   8  *
   9  * This library is free software; you can redistribute it and/or
  10  * modify it under the terms of the GNU Lesser General Public
  11  * License as published by the Free Software Foundation,
  12  * version 2.1 of the License.
  13  *
  14  * This library is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17  * Lesser General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU Lesser General Public
  20  * License along with this library; if not, write to the Free Software
  21  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  22  *
  23  * Additional permission is given to link this library with the
  24  * OpenSSL project's "OpenSSL" library, and with the OCaml runtime,
  25  * and you may distribute the linked executables.  See the file
  26  * LICENSE.libmojave for more details.
  27  *
  28  * Author: Jason Hickey
  29  * @email{jyh@cs.caltech.edu}
  30  * @end[license]
  31  *)
  32 open Lm_rformat_raw
  33 open Lm_rformat
  34
  35 (*
  36  * We hack the indentation in the TeX printer.
  37  * Format the data into lines, and print the tabstops in
  38  * the background color.
  39  *
  40  * The prefix is the white space that is inserted to
  41  * get the left margin right.
  42  *)
  43 type tex_buffer =
  44    { mutable tex_current_line : (bool * string) list;
  45      mutable tex_prefix       : string;
  46      tex_print_string         : string -> unit;
  47      tex_print_newline        : unit -> unit
  48    }
  49
  50 (*
  51  * Have to escape special characters.
  52  *)
  53 let tex_escape_string _linebreaks s =
  54    let len = String.length s in
  55    let rec collect i j =
  56       if j = len then
  57          if i = 0 then
  58              s
  59          else if i < j then
  60             String.sub s i (j - i)
  61          else
  62             ""
  63       else
  64          match s.[j] with
  65             ' ' ->
  66                collect_escape i j "\\ "
  67           | '_' ->
  68                collect_escape i j "\\_"
  69           | '{' ->
  70                collect_escape i j "\\{"
  71           | '}' ->
  72                collect_escape i j "\\}"
  73           | '|' ->
  74                collect_escape i j "\\|"
  75           | '<' ->
  76                collect_escape_space i j "\\lt"
  77           | '>' ->
  78                collect_escape_space i j "\\gt"
  79           | '^'
  80           | '&'
  81           | '#'
  82           | '['
  83           | ']'
  84           | '\\'
  85           | '$'
  86           | '%' as c->
  87                collect_escape_space i j (Printf.sprintf "\\char%i" (Char.code c))
  88           | _ ->
  89                collect i (succ j)
  90    and collect_esc i j s' =
  91       if i < j then
  92          String.sub s i (j - i) ^ s'
  93       else
  94          s'
  95    and collect_escape i j s =
  96       collect_esc i j (s ^ collect (succ j) (succ j))
  97    and collect_escape_space i j s =
  98       let s' = collect (succ j) (succ j) in
  99       let s'' =
 100          if s' = "" then
 101             " "
 102          else
 103             match s'.[0] with
 104                ' ' | '\\' | '$' | '_' | '^' | '&' | '}' | '{' -> s'
 105           | _ ->
 106                " " ^ s'
 107       in
 108          collect_esc i j (s ^ s'')
 109    in
 110       collect 0 0
 111
 112 (*
 113  * Print strings.
 114  *)
 115 let tex_print_string buf s =
 116    buf.tex_current_line <- (true, s) :: buf.tex_current_line
 117
 118 let tex_print_invis buf s =
 119    buf.tex_current_line <- (false, s) :: buf.tex_current_line
 120
 121 (*
 122  * Extract the entire line.
 123  *)
 124 let tex_line buf =
 125    let rec collect line = function
 126       (vis, h) :: t ->
 127          collect ((if vis then (tex_escape_string true h) else h) ^ line) t
 128     | [] ->
 129          line
 130    in
 131       collect "" buf.tex_current_line
 132
 133 let tex_visible buf =
 134    let rec collect line = function
 135       (vis, h) :: t ->
 136          collect (if vis then h ^ line else line) t
 137     | [] ->
 138          line
 139    in
 140       collect "" buf.tex_current_line
 141
 142 let make_tag s =
 143    (false, "\\" ^ s ^ "{")
 144
 145 let tex_push_line buf tags =
 146    let line = tex_line buf in
 147       buf.tex_print_string line;
 148       buf.tex_current_line <- [];
 149       if line <> "" && line.[String.length line - 1] != '\n' then
 150          begin
 151             buf.tex_print_string (String.make (List.length tags) '}');
 152             buf.tex_print_string "\\\\\n";
 153             buf.tex_current_line <- List.map make_tag tags
 154          end
 155
 156 let tex_flush buf =
 157    tex_push_line buf []
 158
 159 (*
 160  * Set up all pending tabstops.
 161  *)
 162 let tex_tab_line buf =
 163    buf.tex_prefix ^ tex_visible buf
 164
 165 (*
 166  * Newline.
 167  * Compute all pending tabstops,
 168  * then push the line and the new tabstop.
 169  *)
 170 let tex_tab buf (col, _) tags =
 171    if col = 0 then
 172       begin
 173          tex_push_line buf tags;
 174          buf.tex_prefix <- ""
 175       end
 176    else
 177       let tabline = tex_tab_line buf in
 178          tex_push_line buf tags;
 179          let prefix =
 180             if col >= String.length tabline then
 181                tabline
 182             else
 183                String.sub tabline 0 col
 184          in
 185          let spacer = Printf.sprintf "\\phantom{%s}" (tex_escape_string false prefix) in
 186             buf.tex_prefix <- prefix;
 187             buf.tex_current_line <- buf.tex_current_line @ [false, spacer]
 188
 189 let tex_tag buf s =
 190    buf.tex_current_line <- (make_tag s) :: buf.tex_current_line
 191
 192 let tex_etag buf _ =
 193    buf.tex_current_line <- (false, "}") :: buf.tex_current_line
 194
 195 (*
 196  * A TeX printer.
 197  *)
 198 let make_tex_printer_aux raw =
 199    let { raw_print_string  = output_string;
 200          raw_print_newline = output_newline
 201        } = raw
 202    in
 203    let print_string s =
 204       output_string s 0 (String.length s)
 205    in
 206    let buf =
 207       { tex_current_line  = [];
 208         tex_prefix        = "";
 209         tex_print_string  = print_string;
 210         tex_print_newline = output_newline
 211       }
 212    in
 213    let info =
 214       { print_string    = tex_print_string buf;
 215         print_invis     = tex_print_invis buf;
 216         print_atomic    = tex_print_string buf;
 217         print_tab       = tex_tab buf;
 218         print_begin_tag = tex_tag buf;
 219         print_end_tag   = tex_etag buf
 220       }
 221    in
 222       buf, info
 223
 224 let make_tex_printer raw =
 225    snd (make_tex_printer_aux raw)
 226
 227 (*
 228  * Raw printer.
 229  *)
 230 let print_tex_raw rmargin buf raw =
 231    let tbuf, info = make_tex_printer_aux raw in
 232    let print_string s =
 233       raw.raw_print_string s 0 (String.length s)
 234    in
 235       print_string "\\texfalse\\iftex%\n";
 236       print_to_printer buf rmargin info;
 237       tex_flush tbuf;
 238       print_string "\\fi\\enmptab%\n";
 239       raw.raw_print_flush ()
 240
 241 (*
 242  * The channel and buffer versions.
 243  *)
 244 let print_tex_channel rmargin buf out =
 245    print_tex_raw rmargin buf (raw_channel_printer out)
 246
 247 let print_tex_buffer rmargin buf out =
 248    print_tex_raw rmargin buf (raw_buffer_printer out)
 249
 250 let print_tex_string rmargin buf =
 251    let out = Buffer.create 100 in
 252       print_tex_buffer rmargin buf out;
 253       Buffer.contents out
 254
 255 (*!
 256  * @docoff
 257  *
 258  * -*-
 259  * Local Variables:
 260  * Caml-master: "compile"
 261  * End:
 262  * -*-
 263  *)