update in basic_2

[helm.git] / helm / www / lambdadelta / bin / xhtbl / xhtbl.ml

diff --git a/helm/www/lambdadelta/bin/xhtbl/xhtbl.ml b/helm/www/lambdadelta/bin/xhtbl/xhtbl.ml
index dc4ab9670e94de6a9a7e076f326070f967157666..6c5f8b01fc762b8700b906ead796a7ae09360cbb 100644 (file)
--- a/helm/www/lambdadelta/bin/xhtbl/xhtbl.ml
+++ b/helm/www/lambdadelta/bin/xhtbl/xhtbl.ml
@@ -16,6 +16,7 @@ let help    = "Usage: xhtbl [ -LX | -O <dir> | -d0 | -d1 | -d2 | -e1 | -e2 | -p0
 let help_L  = " Output lexer tokens"
 let help_O  = "<dir>  Set this output directory"
 let help_X  = " Clear all options"
+let help_b  = "<uri>  Set this base uri for relative links"
 let help_d0 = " Output table contents after phase zero (parsing)"
 let help_d1 = " Output table contents after phase one (sizing)"
 let help_d2 = " Output table contents after phase two (filling)"
@@ -29,9 +30,7 @@ let hook = "xhtbl"
 
 let includes, tables = ref [], ref []
 
-let set_output_dir s = O.output_dir := s
-
-let process_directive och bname (name, table, css) =
+let process_directive och bname (name, table, css, uri, ext) =
    tables := name :: !tables;
    if !O.d0 then TU.debug table;
    if not !O.p0 then begin
@@ -41,7 +40,7 @@ let process_directive och bname (name, table, css) =
          let matrix = M.make size in
          let _ = P2.process table matrix in
          if !O.d2 then TU.debug table;
-         if not !O.p2 then P3.process css matrix;
+         if not !O.p2 then P3.process css uri ext matrix;
         let name = if name = "" then bname else name in
          XU.output och name matrix
       end
@@ -51,17 +50,19 @@ let process_file fname =
    let bname = F.chop_extension (F.basename fname) in
    let ich = open_in fname in
    let lexbuf = Lexing.from_channel ich in
-   let ds = TP.script TL.token lexbuf in
+   let ns, ds = TP.script TL.token lexbuf in
    close_in ich; includes := bname :: !includes;
-   let och = XU.open_out true bname in 
+   let ns = ("", "http://www.w3.org/1999/xhtml") :: ns in
+   let och = XU.open_out bname ns in 
    L.iter (process_directive och bname) ds;
    XU.close_out och
 
 let main () =
    A.parse [
       "-L", A.Set O.debug_lexer, help_L;
-      "-O", A.String set_output_dir, help_O; 
+      "-O", A.String ((:=) O.output_dir), help_O; 
       "-X", A.Unit O.clear, help_X;
+      "-b", A.String ((:=) O.baseuri), help_b;
       "-d0", A.Set O.d0, help_d0;  
       "-d1", A.Set O.d1, help_d1;  
       "-d2", A.Set O.d2, help_d2;