matita/matita/contribs/lambdadelta/bin/xhtbl/xhtbl.ml

   1 module A = Arg
   2 module F = Filename
   3 module L = List
   4
   5 module O  = Options
   6 module TP = TextParser
   7 module TL = TextLexer
   8 module TU = TextUnparser
   9 module P1 = Pass1
  10 module P2 = Pass2
  11 module P3 = Pass3
  12 module M  = Matrix
  13 module XU = XmlUnparser
  14
  15 let help    = "Usage: xhtbl [ -LX | -O <dir> | -d0 | -d1 | -d2 | -e1 | -e2 | -p0 | -p1 | -p2 | <file> ]*"
  16 let help_L  = " Output lexer tokens"
  17 let help_O  = "<dir>  Set this output directory"
  18 let help_X  = " Clear all options"
  19 let help_b  = "<uri>  Set this base uri for relative links"
  20 let help_d0 = " Output table contents after phase zero (parsing)"
  21 let help_d1 = " Output table contents after phase one (sizing)"
  22 let help_d2 = " Output table contents after phase two (filling)"
  23 let help_e1 = " Disabled"
  24 let help_e2 = " Output debug information during phase two (filling)"
  25 let help_p0 = " Process until phase zero (parsing)"
  26 let help_p1 = " Process until phase one (sizing)"
  27 let help_p2 = " Process until phase two (filling)"
  28
  29 let hook = "xhtbl"
  30
  31 let includes, tables = ref [], ref []
  32
  33 let process_directive och bname (name, table, css, uri, ext) =
  34    tables := name :: !tables;
  35    if !O.d0 then TU.debug table;
  36    if not !O.p0 then begin
  37       let size = P1.process table in
  38       if !O.d1 then TU.debug table;
  39       if not !O.p1 then begin
  40          let matrix = M.make size in
  41          let _ = P2.process table matrix in
  42          if !O.d2 then TU.debug table;
  43          if not !O.p2 then P3.process css uri ext matrix;
  44          let name = if name = "" then bname else name in
  45          XU.output och name matrix
  46       end
  47    end
  48
  49 let process_file fname =
  50    let bname = F.chop_extension (F.basename fname) in
  51    if List.mem bname !includes then ()
  52    else begin
  53       let ich = open_in fname in
  54       let lexbuf = Lexing.from_channel ich in
  55       let ns, ds = TP.script TL.token lexbuf in
  56       close_in ich; includes := bname :: !includes;
  57       let ns = ("", "http://www.w3.org/1999/xhtml") :: ns in
  58       let och = XU.open_out bname ns in
  59       L.iter (process_directive och bname) ds;
  60       XU.close_out och
  61    end
  62
  63 let main () =
  64    A.parse [
  65       "-L", A.Set O.debug_lexer, help_L;
  66       "-O", A.String ((:=) O.output_dir), help_O;
  67       "-X", A.Unit O.clear, help_X;
  68       "-b", A.String ((:=) O.baseuri), help_b;
  69       "-d0", A.Set O.d0, help_d0;
  70       "-d1", A.Set O.d1, help_d1;
  71       "-d2", A.Set O.d2, help_d2;
  72       "-e1", A.Set O.e1, help_e1;
  73       "-e2", A.Set O.e2, help_e2;
  74       "-p0", A.Set O.p0, help_p0;
  75       "-p1", A.Set O.p1, help_p1;
  76       "-p2", A.Set O.p2, help_p2;
  77    ] process_file help;
  78    XU.write_hook hook !includes !tables
  79
  80 let _ = main ()