<6>1 colscan.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: colscan.mll,v 1.5 2001/05/25 12:37:20 maranget Exp $ *) (***********************************************************************) { open Lexing 15 exception Error of string ;; let buf = Out.create_buff () ;; 20 } rule one = parse ' '*('0'|'1')?'.'?['0'-'9']*' '* {let lxm = lexeme lexbuf in float_of_string lxm} 25 | "" {raise (Error "Syntax error in color argument")} and other = parse ' '* ',' {one lexbuf} | "" {raise (Error "Syntax error in color argument")} 30 and three = parse "" {let fst = one lexbuf in let snd = other lexbuf in 35 let thrd = other lexbuf in fst,snd,thrd} and four = parse "" {let fst = one lexbuf in 40 let snd = other lexbuf in let thrd = other lexbuf in let fourth = other lexbuf in fst,snd,thrd,fourth} <6>2 cut.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) { open Lexing open Stack 15 let header = "$Id: cut.mll,v 1.30 2001/05/25 09:07:07 maranget Exp $" let verbose = ref 0 ;; 20 let language = ref "eng" ;; let tocbis = ref false ;; 25 exception Error of string (* Accumulate all META, LINK and similar tags that appear in the preamble 30 in order to output them in the preamble of every generated page. *) let header_buff = Out.create_buff () let common_headers = ref "";; 35 let adjoin_to_header s = Out.put header_buff s and adjoin_to_header_char c = Out.put_char header_buff c and finalize_header () = 40 common_headers := Out.to_string header_buff let html_buff = Out.create_buff () let html_head = ref "" and html_foot = ref "" 45 let phase = ref (-1) ;; let name = ref "main" 50 and count = ref 0 ;; let body = ref "<BODY>" and doctype = ref "" 55 and html = ref "<HTML>" ;; let changed_t = Hashtbl.create 17 60 let rec check_changed name = try let r = Hashtbl.find changed_t name in check_changed r with 65 | Not_found -> name let new_filename () = incr count ; let r1 = Printf.sprintf "%s%0.3d.html" !name !count in 70 let r2 = check_changed r1 in r2 ;; let out = ref (Out.create_null ()) 75 and out_prefix = ref (Out.create_null ()) and outname = ref "" and lastclosed = ref "" and otheroutname = ref "" and flowname_stack = (Stack.create "flowname" : string Stack.t) 80 and flow_stack = (Stack.create "flow" : Out.t Stack.t) ;; let toc = ref !out and tocname = ref !outname 85 and otherout = ref !out ;; let change_name oldname name = if !phase <= 0 then begin 90 Thread.change oldname name ; Cross.change oldname name ; outname := name ; Hashtbl.add changed_t oldname name end 95 let start_phase name = incr phase ; if !verbose > 0 then 100 prerr_endline ("Starting phase number: "^string_of_int !phase); outname := name ; tocname := name ; otheroutname := "" ; count := 0 ; 105 if !phase > 0 then begin out := (Out.create_chan (open_out name)) end ; toc := !out ;; 110 let openlist out = Out.put out "<UL>\n" and closelist out = Out.put out "</UL>\n" and itemref filename s out = Out.put out "<LI>" ; 115 Out.put out "<A HREF=\"" ; Out.put out filename ; Out.put out "\">" ; Out.put out s ; Out.put out "</A>\n" 120 and itemanchor filename label s out = Out.put out "<LI>" ; Out.put out "<A HREF=\"" ; Out.put out filename ; 125 Out.put_char out '#' ; Out.put out label ; Out.put out "\">" ; Out.put out s ; Out.put out "</A>\n" 130 and putanchor label out = Out.put out "<A NAME=\"" ; Out.put out label ; Out.put out "\"></A>" 135 and itemlist s out = Out.put out "<LI>" ; Out.put out s ;; 140 let putlink out name img alt = Out.put out "<A HREF=\"" ; Out.put out name ; Out.put out "\"><IMG SRC =\"" ; 145 Out.put out img ; Out.put out "\" ALT=\"" ; Out.put out alt ; Out.put out "\"></A>\n" ;; 150 let link_buff = Out.create_buff () let putlinks name = let links_there = ref false in 155 if !verbose > 0 then prerr_endline ("putlinks: "^name) ; begin try putlink link_buff (Thread.prev name) "previous_motif.gif" (if !language = "fra" then "Precedent" 160 else "Previous") ; links_there := true with Not_found -> () end ; begin try putlink link_buff (Thread.up name) "contents_motif.gif" 165 (if !language = "fra" then "Index" else "Contents") ; links_there := true with Not_found -> () end ; begin try 170 putlink link_buff (Thread.next name) "next_motif.gif" (if !language = "fra" then "Suivant" else "Next") ; links_there := true with Not_found -> () end ; 175 if !links_there then Some (Out.to_string link_buff) else None 180 let putlinks_start out outname = match putlinks outname with | Some s -> Out.put out s ; Out.put out "<HR>\n" | None -> () 185 let putlinks_end out outname = match putlinks outname with | Some s -> Out.put out "<HR>\n" ; Out.put out s 190 | None -> () let openhtml withlinks title out outname = Out.put out !doctype ; Out.put_char out '\n' ; 195 Out.put out !html ; Out.put_char out '\n' ; Out.put out "<HEAD>\n" ; Out.put out !common_headers; Out.put out "<TITLE>\n" ; let title = Save.tagout (Lexing.from_string title) in 200 Out.put out title ; Out.put out "\n</TITLE>\n" ; Out.put out "</HEAD>\n" ; Out.put out !body; Out.put out "\n" ; 205 if withlinks then putlinks_start out outname ; Out.put out !html_head 210 and closehtml withlinks name out = Out.put out !html_foot ; if withlinks then begin putlinks_end out name end ; 215 Out.put out "</BODY>\n" ; Out.put out "</HTML>\n" ; Out.close out ;; 220 let put_sec hd title hde out = Out.put out hd ; Out.put_char out '\n' ; Out.put out title ; Out.put out hde ; 225 Out.put_char out '\n' ;; let put s = Out.put !out s 230 and put_char c = Out.put_char !out c ;; let cur_level = ref (Section.value "DOCUMENT") and chapter = ref (Section.value "CHAPTER") 235 and depth = ref 2 ;; (* Open all lists in toc from chapter to sec, with sec > chapter *) 240 let rec do_open l1 l2 = if l1 < l2 then begin openlist !toc ; if !tocbis then openlist !out_prefix ; do_open (l1+1) l2 245 end ;; (* close from l1 down to l2 *) let rec do_close l1 l2 = 250 if l1 > l2 then begin closelist !toc ; if !tocbis then closelist !out_prefix ; do_close (l1-1) l2 end else 255 cur_level := l1 ;; let anchor = ref 0 ;; 260 let open_section sec name = if !phase > 0 then begin if !cur_level > sec then do_close !cur_level sec else if !cur_level < sec then do_open !cur_level sec ; 265 incr anchor ; let label = "toc"^string_of_int !anchor in itemanchor !outname label name !toc ; if !tocbis then itemanchor !outname label name !out_prefix ; putanchor label !out ; 270 cur_level := sec end else cur_level := sec and close_section sec = 275 if !phase > 0 then do_close !cur_level sec else cur_level := sec ;; 280 let close_chapter () = if !verbose > 0 then prerr_endline ("Close chapter out="^ !outname^" toc="^ !tocname) ; if !phase > 0 then begin closehtml true !outname !out ; 285 if !tocbis then begin let real_out = open_out !outname in Out.to_chan real_out !out_prefix ; Out.to_chan real_out !out ; close_out real_out 290 end else Out.close !out ; out := !toc end else begin lastclosed := !outname ; 295 outname := !tocname end and open_chapter name = outname := new_filename () ; 300 if !verbose > 0 then prerr_endline ("Open chapter out="^ !outname^" toc="^ !tocname^ " cur_level="^string_of_int !cur_level) ; if !phase > 0 then begin 305 if !tocbis then begin out_prefix := Out.create_buff () ; out := !out_prefix ; openhtml true name !out_prefix !outname end else begin 310 out := Out.create_chan (open_out !outname) ; openhtml true name !out !outname end ; itemref !outname name !toc ; cur_level := !chapter 315 end else begin if !verbose > 0 then prerr_endline ("link prev="^ !lastclosed^" next="^ !outname) ; Thread.setup !outname !tocname ; Thread.setprevnext !lastclosed !outname ; 320 cur_level := !chapter end ;; let setlink set target = if !phase = 0 && target <> "" then 325 set !outname target let open_notes sec_notes = if sec_notes <> !chapter || !outname = !tocname then begin otheroutname := !outname ; 330 outname := new_filename () ; if !phase > 0 then begin otherout := !out ; out := Out.create_chan (open_out !outname) ; Out.put !out !doctype ; Out.put_char !out '\n' ; 335 Out.put !out !html ; Out.put_char !out '\n' ; Out.put !out "<HEAD><TITLE>Notes</TITLE>\n" ; Out.put !out !common_headers ; Out.put !out "</HEAD>\n" ; Out.put !out !body ; 340 Out.put !out "\n" end end else otheroutname := "" 345 and close_notes () = if !otheroutname <> "" then begin Out.put !out "\n</BODY></HTML>\n" ; Out.close !out ; outname := !otheroutname ; 350 out := !otherout ; otheroutname := "" end ;; 355 let toc_buf = Out.create_buff () and arg_buf = Out.create_buff () ;; let stack = Stack.create "main" 360 ;; let save_state newchapter newdepth = if !verbose > 0 then prerr_endline ("New state: "^string_of_int newchapter) ; 365 push stack (!outname, Stack.save flowname_stack, Stack.save flow_stack, !chapter,!depth,!toc,!tocname,!cur_level,!lastclosed,!out_prefix) ; chapter := newchapter ; depth := newdepth ; 370 tocname := !outname ; lastclosed := "" ; toc := !out ;; 375 let restore_state () = if !verbose > 0 then prerr_endline ("Restore") ; let oldoutname, oldflowname, oldflow, oldchapter,olddepth,oldtoc,oldtocname, 380 oldlevel,oldlastclosed,oldprefix = pop stack in outname := oldoutname ; Stack.restore flowname_stack oldflowname ; Stack.restore flow_stack oldflow ; chapter := oldchapter ; 385 depth := olddepth ; toc := oldtoc ; tocname := oldtocname ; lastclosed := !lastclosed ; cur_level := oldlevel ; 390 out_prefix := oldprefix ;; let hevea_footer = ref false 395 let close_top lxm = putlinks_end !toc !tocname ; if !hevea_footer then begin Out.put !out "<!--FOOTER-->\n" ; begin try 400 Mysys.put_from_file (Filename.concat Mylib.libdir ("cutfoot-"^ !language^".html")) (Out.put !out) with Mysys.Error s -> begin Location.print_pos () ; 405 prerr_endline s end end end ; Out.put !toc lxm ; 410 if !tocname = "" then Out.flush !toc else Out.close !toc ;; 415 let open_toc () = if !phase > 0 then openlist !toc and close_toc () = if !phase > 0 then closelist !toc ;; 420 let close_all () = if !cur_level > !chapter then begin close_section !chapter ; close_chapter () ; close_toc () 425 end else if !cur_level = !chapter then begin close_chapter () ; close_toc () end ; cur_level := (Section.value "DOCUMENT") 430 let openflow title = let new_outname = new_filename () in push flowname_stack !outname ; outname := new_outname ; 435 if !phase > 0 then begin push flow_stack !out ; out := Out.create_chan (open_out !outname) ; openhtml false title !out !outname end 440 and closeflow () = if !phase > 0 then begin closehtml false !outname !out; Out.close !out ; 445 out := pop flow_stack end ; outname := pop flowname_stack 450 } rule main = parse | "<!--HEVEA" [^'>']* "-->" '\n'? {let lxm = lexeme lexbuf in 455 if !phase > 0 then begin put lxm ; put ("<!--HACHA command line is: ") ; for i = 0 to Array.length Sys.argv - 1 do put Sys.argv.(i) ; 460 put_char ' ' done ; put "-->\n" end ; main lexbuf} 465 | "<!--" "FLOW" ' '+ {let title = flowline lexbuf in openflow title ; main lexbuf} | "<!--" "LINKS" ' '+ 470 {linkline lexbuf ; main lexbuf} | "<!--" "END" ' '+ "FLOW" ' '* "-->" '\n'? {closeflow () ; main lexbuf} 475 | "<!--" "NAME" ' '+ {let name = tocline lexbuf in change_name !outname name ; main lexbuf} | "<!--" ("TOC"|"toc") ' '+ 480 {let arg = secname lexbuf in let sn = if String.uppercase arg = "NOW" then !chapter else Section.value arg in let name = tocline lexbuf in 485 if !verbose > 1 then begin prerr_endline ("TOC "^arg^" "^name) end; if sn < !chapter then begin if !cur_level >= !chapter then begin 490 close_section (!chapter) ; close_chapter () ; close_toc () end ; cur_level := sn 495 end else if sn = !chapter then begin if !cur_level < sn then begin open_toc () ; end else begin close_section !chapter ; 500 close_chapter () end ; open_chapter name end else if sn <= !chapter + !depth then begin (* sn > !chapter *) if !cur_level < !chapter then begin 505 open_toc () ; open_chapter "" end ; close_section sn ; open_section sn name 510 end ; main lexbuf} | "<!--CUT DEF" ' '+ {let chapter = Section.value (String.uppercase (secname lexbuf)) in skip_blanks lexbuf; 515 let depth = intarg lexbuf in skip_endcom lexbuf ; save_state chapter depth ; cur_level := Section.value "DOCUMENT" ; main lexbuf} 520 | "<!--SEC END" ' '* "-->" '\n'? {if !phase > 0 then begin if !tocbis && !out == !out_prefix then out := Out.create_buff () end ; 525 main lexbuf} | "<!--CUT END" ' '* "-->" '\n'? {close_all () ; restore_state () ; main lexbuf} 530 | "<!--BEGIN" ' '+ "NOTES" ' '+ {let sec_notes = secname lexbuf in skip_endcom lexbuf ; open_notes (Section.value sec_notes) ; main lexbuf} 535 | "<!--END" ' '+ "NOTES" ' '* "-->" '\n'? {if !otheroutname <> "" then close_notes (); main lexbuf} | "<!--" ' '* "FRENCH" ' '* "-->" 540 {language := "fra" ; main lexbuf} | "<A" ' '+ {if !phase > 0 then put (lexeme lexbuf) ; aargs lexbuf} 545 | "<!--HTML" ' '* "HEAD" ' '* "-->" '\n' ? {let head = save_html lexbuf in if !phase = 0 then html_head := head else 550 Out.put !out head; main lexbuf} | "<!--HTML" ' '* "FOOT" ' '* "-->" '\n' ? {let foot = save_html lexbuf in if !phase = 0 then 555 html_foot := foot ; main lexbuf} | "<!--FOOTER-->" '\n'? {close_all () ; if !phase > 0 then begin 560 hevea_footer := true ; Out.put !out !html_foot end ; footer lexbuf} | "<!DOCTYPE" [^'>']* '>' 565 {let lxm = lexeme lexbuf in if !phase = 0 then doctype := lxm else Out.put !out lxm; 570 main lexbuf} | "<HTML" [^'>']* '>' {let lxm = lexeme lexbuf in if !phase = 0 then html := lxm 575 else Out.put !out lxm; main lexbuf} | "<BODY" [^'>']* '>' {let lxm = lexeme lexbuf in 580 if !phase = 0 then body := lxm else begin Out.put !out lxm ; putlinks_start !out !outname 585 end ; main lexbuf} | "<HEAD" [^'>']* '>' {put (lexeme lexbuf); if !phase = 0 then begin 590 if !verbose > 0 then prerr_endline "Collect header" ; collect_header lexbuf end else main lexbuf} | "</BODY>" 595 {let lxm = lexeme lexbuf in close_all () ; if !phase > 0 then begin close_top lxm end} 600 | _ {let lxm = lexeme_char lexbuf 0 in if !phase > 0 then put_char lxm ; main lexbuf} | eof 605 {raise (Error ("No </BODY> tag in input file"))} and save_html = parse | "<!--END" ' '* ['A'-'Z']+ ' '* "-->" '\n'? {let s = Out.to_string html_buff in 610 if !verbose > 0 then prerr_endline ("save_html -> ``"^s^"''"); s} | _ {let lxm = lexeme_char lexbuf 0 in 615 Out.put_char html_buff lxm ; save_html lexbuf} | eof {raise (Misc.Fatal ("End of file in save_html"))} 620 and collect_header = parse | "</HEAD>" {let lxm = lexeme lexbuf in finalize_header () ; if !verbose > 0 then begin 625 prerr_string "Header is: ``" ; prerr_string !common_headers ; prerr_endline "''" end ; main lexbuf} 630 | "<TITLE" [^'>']* '>' {skip_title lexbuf ; collect_header lexbuf} | _ 635 {let lxm = lexeme_char lexbuf 0 in adjoin_to_header_char lxm; collect_header lexbuf} and skip_title = parse 640 | "</TITLE>" '\n'? {()} | _ {skip_title lexbuf} and footer = parse "</BODY>" _* 645 {let lxm = lexeme lexbuf in if !phase > 0 then begin close_top lxm end} | _ {footer lexbuf} 650 | eof {raise (Misc.Fatal ("End of file in footer (no </BODY> tag)"))} and secname = parse ['a'-'z' 'A'-'Z']+ {let r = lexeme lexbuf in r} 655 | "" {raise (Error "Bad section name syntax")} and intarg = parse ['0'-'9']+ {int_of_string (lexeme lexbuf)} | "" {!depth} 660 and tocline = parse "-->" '\n' ? {Out.to_string toc_buf} | _ {Out.put_char toc_buf (lexeme_char lexbuf 0) ; 665 tocline lexbuf} and arg = parse | "</ARG>" {Out.to_string arg_buf} | _ {Out.put_char arg_buf (Lexing.lexeme_char lexbuf 0) ; arg lexbuf} 670 | eof {raise (Misc.Fatal "Unclosed arg")} and flowline = parse | "<ARG TITLE>" {let title = arg lexbuf in 675 let _ = flowline lexbuf in title} | "-->" '\n'? {""} | eof {raise (Misc.Fatal "Unclosed comment")} 680 | _ {flowline lexbuf} and linkline = parse | "<ARG" ' '+ "PREV>" {let link = arg lexbuf in 685 setlink Thread.setprev link ; linkline lexbuf} | "<ARG" ' '+ "NEXT>" {let link = arg lexbuf in setlink Thread.setnext link ; 690 linkline lexbuf} | "<ARG" ' '+ "UP>" {let link = arg lexbuf in setlink Thread.setup link ; linkline lexbuf} 695 | "-->" '\n'? {()} | eof {raise (Misc.Fatal "Unclosed comment")} | _ {linkline lexbuf} 700 and aargs = parse | ("name"|"NAME") ' '* '=' ' '* {if !phase = 0 then begin let name = refname lexbuf in Cross.add name !outname 705 end else put (lexeme lexbuf) ; aargs lexbuf} | ("href"|"HREF") ' '* '=' ' '* {if !phase > 0 then begin 710 let lxm = lexeme lexbuf in let name = refname lexbuf in try let newname = if String.length name > 0 && String.get name 0 = '#' then 715 Cross.fullname !outname (String.sub name 1 (String.length name-1)) else name in put lxm ; put "\"" ; put newname ; 720 put "\"" with Not_found -> () end ; aargs lexbuf} | '>' 725 {if !phase > 0 then put_char '>' ; main lexbuf} | _ {if !phase > 0 then put_char (lexeme_char lexbuf 0) ; aargs lexbuf} 730 | eof {raise (Error "Bad <A ...> tag")} and refname = parse | '"' [^'"']* '"' 735 {let lxm = lexeme lexbuf in String.sub lxm 1 (String.length lxm-2)} | ['a'-'z''A'-'Z''0'-'9''.''_''-']+ {lexeme lexbuf} | "" {raise (Error "Bad reference name syntax")} 740 and skip_blanks = parse ' '* {()} and skip_endcom = parse 745 ' '* "-->" '\n'? {()} | "" {raise (Error "Bad HTML comment syntax")} and skip_aref = parse "</A>" {()} | _ {skip_aref lexbuf} <6>3 entry.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) { open Lexing 15 let header = "$Id: entry.mll,v 1.11 1999/12/07 16:12:15 maranget Exp $" let buff = Out.create_buff () ;; 20 let put s = Out.put buff s and put_char c = Out.put_char buff c ;; 25 type res = | Bang of string * string | Bar of string * string 30 | Eof of string * string ;; let extend r i = match r with | Bang (p,_) -> Bang (i,p) 35 | Bar (p,_) -> Bar (i,p) | Eof (p,_) -> Eof (i,p) ;; type key = string list * string list 40 exception Fini exception NoGood ;; 45 } rule entry = parse | "\\\"" {put "\\\"" ; entry lexbuf} | "\"!" 50 {put_char '!' ; entry lexbuf} | "\"@" {put_char '@' ; entry lexbuf} | "\"|" {put_char '|' ; entry lexbuf} 55 | '!' {Bang (Out.to_string buff,"")} | '@' {let s = Out.to_string buff in let r = entry lexbuf in extend r s} | '|' {Bar (Out.to_string buff,"")} 60 | eof {Eof (Out.to_string buff,"")} | _ {let lxm = lexeme_char lexbuf 0 in put_char lxm ; entry lexbuf} and idx = parse 65 | "\\indexentry" {let key = Save.arg lexbuf in let value = Save.arg lexbuf in key,value} | eof {raise Fini} 70 | _ {idx lexbuf} { 75 let read_key lexbuf = let bar () = match entry lexbuf with | Eof (s,_) -> begin match s with 80 | ""|"("|")" -> None | s -> if s.[0] = '(' then Some (String.sub s 1 (String.length s - 1)) else 85 Some s end | _ -> raise NoGood in let rec get_rec () = match entry lexbuf with 90 Bang (i,p) -> let l,see = get_rec () in (i,p)::l,see | Bar (i,p) -> let see = bar () in 95 [i,p],see | Eof (i,p) -> [i,p],None in let separe (l,see) = let rec sep_rec = function 100 [] -> [],[] | (x,y)::r -> let xs,ys = sep_rec r in x::xs,y::ys in let xs,ys = sep_rec l in 105 ((xs,ys),see) in separe (get_rec ()) let read_indexentry lexbuf = idx lexbuf 110 } <6>4 get.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) { open Misc open Parse_opts 15 open Lexing open Latexmacros open Lexstate open Stack 20 (* Compute functions *) let header = "$Id: get.mll,v 1.24 2001/02/12 10:05:29 maranget Exp $" exception Error of string 25 let sbool = function | true -> "true" | false -> "false" let get_this = ref (fun s -> assert false) 30 and get_fun = ref (fun f lexbuf -> assert false) and open_env = ref (fun _ -> ()) and close_env = ref (fun _ -> ()) and get_csname = ref (fun _ -> assert false) and main = ref (fun _ -> assert false) 35 ;; let bool_out = ref false and int_out = ref false 40 let int_stack = Stack.create "int_stack" and bool_stack = Stack.create "bool_stack" and group_stack = Stack.create "group_stack" and just_opened = ref false 45 type saved = bool * bool Stack.saved * bool * int Stack.saved * (unit -> unit) Stack.saved * bool 50 let check () = !bool_out, Stack.save bool_stack, !int_out, Stack.save int_stack, Stack.save group_stack, !just_opened 55 and hot (b,bs,i,is,gs,j) = bool_out := b ; Stack.restore bool_stack bs ; int_out := i ; Stack.restore int_stack is ; Stack.restore group_stack gs ; 60 just_opened := j let push_int x = if !verbose > 2 then prerr_endline ("PUSH INT: "^string_of_int x) ; 65 just_opened := false ; push int_stack x let open_ngroups n = let rec open_ngroups_rec = function 70 | 0 ->() | n -> push group_stack (fun () -> ()) ; open_ngroups_rec (n-1) in if !verbose > 2 then prerr_endline ("OPEN NGROUPS: "^string_of_int n) ; if n > 0 then begin 75 just_opened := true ; open_ngroups_rec n end let close_ngroups n = 80 let rec close_ngroups_rec = function | 0 -> () | n -> let f = pop group_stack in f() ; close_ngroups_rec (n-1) in 85 if !verbose > 2 then prerr_endline ("CLOSE NGROUPS: "^string_of_int n); close_ngroups_rec n let open_aftergroup f s = 90 if !verbose > 2 then prerr_endline ("OPEN AFTER: "^s) ; just_opened := true ; push group_stack f 95 } let command_name = '\\' ((['@''A'-'Z' 'a'-'z']+ '*'?) | [^ '@' 'A'-'Z' 'a'-'z']) rule result = parse 100 (* Skip comments and spaces *) | '%' [^ '\n'] * '\n' {result lexbuf} | [' ' '\n']+ {result lexbuf} (* Integers *) | ['0'-'9']+ 105 {let lxm = Lexing.lexeme lexbuf in push_int (int_of_string lxm) ; result lexbuf} | '\'' ['0'-'7']+ {let lxm = lexeme lexbuf in 110 push_int (int_of_string ("0o"^String.sub lxm 1 (String.length lxm-1))) ; result lexbuf} | "\"" ['0'-'9' 'a'-'f' 'A'-'F']+ {let lxm = lexeme lexbuf in 115 push_int (int_of_string ("0x"^String.sub lxm 1 (String.length lxm-1))) ; result lexbuf} | '`' {let token = !get_csname lexbuf in 120 after_quote (Lexing.from_string token) ; result lexbuf} | "true" {push bool_stack true ; result lexbuf} 125 | "false" {push bool_stack false ; result lexbuf} (* Operands *) | '+' | '-' 130 {let lxm = lexeme_char lexbuf 0 in let unary = !just_opened in if unary then begin let f = pop group_stack in open_aftergroup 135 (fun () -> if !verbose > 2 then begin prerr_endline ("UNARY: "^String.make 1 lxm) ; Stack.pretty string_of_int int_stack end ; 140 let x1 = pop int_stack in let r = match lxm with | '+' -> x1 | '-' -> 0 - x1 | _ -> assert false in 145 push_int r ; f()) "UNARY" end else begin close_ngroups 2 ; open_aftergroup (fun () -> 150 if !verbose > 2 then begin prerr_endline ("OPPADD: "^String.make 1 lxm) ; Stack.pretty string_of_int int_stack end ; let x2 = pop int_stack in 155 let x1 = pop int_stack in let r = match lxm with | '+' -> x1 + x2 | '-' -> x1 - x2 | _ -> assert false in 160 push_int r) "ADD"; open_ngroups 1 ; end ; result lexbuf} | '/' | '*' 165 {let lxm = lexeme_char lexbuf 0 in close_ngroups 1 ; open_aftergroup (fun () -> if !verbose > 2 then begin 170 prerr_endline ("MULTOP"^String.make 1 lxm) ; Stack.pretty string_of_int int_stack end ; let x2 = pop int_stack in let x1 = pop int_stack in 175 let r = match lxm with | '*' -> x1 * x2 | '/' -> x1 / x2 | _ -> assert false in push_int r) "MULT"; 180 result lexbuf} (* boolean openrands *) | '<' | '>' | '=' {let lxm = Lexing.lexeme_char lexbuf 0 in close_ngroups 3 ; 185 open_aftergroup (fun () -> if !verbose > 2 then begin prerr_endline ("COMP: "^String.make 1 lxm) ; Stack.pretty string_of_int int_stack 190 end ; let x2 = pop int_stack in let x1 = pop int_stack in push bool_stack (match lxm with 195 | '<' -> x1 < x2 | '>' -> x1 > x2 | '=' -> x1 = x2 | _ -> assert false) ; if !verbose > 2 then 200 Stack.pretty sbool bool_stack) "COMP" ; open_ngroups 2 ; result lexbuf} (* Parenthesis for integer computing *) 205 | '('|'{' {open_ngroups 2 ; result lexbuf} | ')'|'}' {close_ngroups 2 ; 210 result lexbuf} (* Commands *) | '#' ['1'-'9'] {let lxm = lexeme lexbuf in let i = Char.code (lxm.[1]) - Char.code '1' in 215 scan_arg (scan_this_arg result) i ; result lexbuf} | command_name {let lxm = lexeme lexbuf in let pat,body = Latexmacros.find lxm in 220 let args = make_stack lxm pat lexbuf in scan_body (function | Subst body -> scan_this result body | Toks l -> 225 List.iter (scan_this result) (List.rev l) | CamlCode f -> let rs = !get_fun f lexbuf in 230 scan_this result rs) body args ; result lexbuf} | _ {raise (Error ("Bad character in Get.result: ``"^lexeme lexbuf^"''"))} | eof {()} 235 and after_quote = parse | '\\' [^ 'A'-'Z' 'a'-'z'] eof {let lxm = lexeme lexbuf in push_int (Char.code lxm.[1]); 240 result lexbuf} | _ eof {let lxm = lexeme lexbuf in push_int (Char.code lxm.[0]); result lexbuf} 245 | "" {Misc.fatal "Cannot understand `-like numerical argument"} { let init latexget latexgetfun latexopenenv latexcloseenv latexcsname latexmain = 250 get_this := latexget ; get_fun := latexgetfun ; open_env := latexopenenv ; close_env := latexcloseenv ; get_csname := latexcsname ; 255 main := latexmain ;; let def_loc name f = Latexmacros.def name zero_pat (CamlCode f) ; 260 ;; let def_commands l = List.map (fun (name,f) -> 265 name,Latexmacros.replace name (Some (zero_pat,CamlCode f))) l let def_commands_int () = def_commands 270 ["\\value", (fun lexbuf -> let name = !get_this (save_arg lexbuf) in push_int (Counter.value_counter name)) ; "\\pushint", 275 (fun lexbuf -> let s = !get_this (save_arg lexbuf) in scan_this result s)] let def_commands_bool () = 280 let old_ints = def_commands_int () in let old_commands = def_commands ["\\(", (fun _ -> open_ngroups 7) ; "\\)", (fun _ -> close_ngroups 7) ; 285 "\\@fileexists", (fun lexbuf -> let name = !get_this (save_arg lexbuf) in push bool_stack (try 290 let _ = Myfiles.open_tex name in true with Myfiles.Except | Myfiles.Error _ -> false)) ; "\\@commandexists", (fun lexbuf -> 295 let name = !get_csname lexbuf in push bool_stack (Latexmacros.exists name)) ; "\\or", (fun _ -> close_ngroups 7 ; 300 open_aftergroup (fun () -> if !verbose > 2 then begin prerr_endline "OR" ; Stack.pretty sbool bool_stack 305 end ; let b1 = pop bool_stack in let b2 = pop bool_stack in push bool_stack (b1 || b2)) "OR"; open_ngroups 6) ; 310 "\\and", (fun _ -> close_ngroups 6 ; open_aftergroup (fun () -> 315 if !verbose > 2 then begin prerr_endline "AND" ; Stack.pretty sbool bool_stack end ; let b1 = pop bool_stack in 320 let b2 = pop bool_stack in push bool_stack (b1 && b2)) "AND"; open_ngroups 5) ; "\\not", (fun _ -> 325 close_ngroups 4 ; open_aftergroup (fun () -> if !verbose > 2 then begin prerr_endline "NOT" ; 330 Stack.pretty sbool bool_stack end ; let b1 = pop bool_stack in push bool_stack (not b1)) "NOT"; open_ngroups 3) ; 335 "\\boolean", (fun lexbuf -> let name = !get_this (save_arg lexbuf) in let b = try let r = !get_this 340 (string_to_arg ("\\if"^name^" true\\else false\\fi")) in match r with | "true" -> true | "false" -> false | _ -> raise (Misc.Fatal ("boolean value: "^r)) 345 with Latexmacros.Failed -> true in push bool_stack b) ; "\\isodd", (fun lexbuf -> 350 close_ngroups 3 ; open_aftergroup (fun () -> if !verbose > 2 then begin prerr_endline ("ISODD") ; 355 Stack.pretty string_of_int int_stack end ; let x = pop int_stack in push bool_stack (x mod 2 = 1) ; if !verbose > 2 then 360 Stack.pretty sbool bool_stack) "ISODD" ; open_ngroups 2) ] in let old_equal = try Some (Latexmacros.find_fail "\\equal") with Failed -> None in 365 def_loc "\\equal" (fun lexbuf -> let arg1 = save_arg lexbuf in let arg2 = save_arg lexbuf in scan_this !main "\\begin{@norefs}" ; 370 let again = List.map (fun (name,x) -> name,Latexmacros.replace name x) ((("\\equal",old_equal)::old_ints)@old_commands) in push bool_stack (!get_this arg1 = !get_this arg2) ; let _ = List.map (fun (name,x) -> Latexmacros.replace name x) again in 375 scan_this !main "\\end{@norefs}") let first_try s = 380 let l = String.length s in if l <= 0 then raise (Failure "first_try") ; let rec try_rec r i = if i >= l then r else match s.[i] with 385 | '0'|'1'|'2'|'3'|'4'|'5'|'6'|'7'|'8'|'9' -> try_rec (10*r + Char.code s.[i] - Char.code '0') (i+1) | _ -> raise (Failure ("first_try")) in try_rec 0 0 ;; 390 let get_int {arg=expr ; subst=subst} = if !verbose > 1 then prerr_endline ("get_int : "^expr) ; let r = 395 try first_try expr with Failure _ -> begin let old_int = !int_out in int_out := true ; start_normal subst ; !open_env "*int*" ; 400 let _ = def_commands_int () in open_ngroups 2 ; begin try scan_this result expr with | x -> begin 405 prerr_endline ("Error while scanning ``"^expr^"'' for integer result"); raise x end end ; 410 close_ngroups 2 ; !close_env "*int*" ; end_normal () ; if Stack.empty int_stack then raise (Error ("``"^expr^"'' has no value as an integer")); 415 let r = pop int_stack in int_out := old_int ; r end in if !verbose > 1 then prerr_endline ("get_int: "^expr^" = "^string_of_int r) ; 420 r let get_bool {arg=expr ; subst=subst} = if !verbose > 1 then 425 prerr_endline ("get_bool : "^expr) ; let old_bool = !bool_out in bool_out := true ; start_normal subst ; !open_env "*bool*" ; 430 def_commands_bool () ; open_ngroups 7 ; begin try scan_this result expr with | x -> begin 435 prerr_endline ("Error while scanning ``"^expr^"'' for boolean result"); raise x end end ; 440 close_ngroups 7 ; !close_env "*bool*" ; end_normal () ; if Stack.empty bool_stack then raise (Error ("``"^expr^"'' has no value as a boolean")); 445 let r = pop bool_stack in if !verbose > 1 then prerr_endline ("get_bool: "^expr^" = "^sbool r); bool_out := old_bool ; r 450 let get_length arg = if !verbose > 1 then prerr_endline ("get_length : "^arg) ; let r = Length.main (Lexing.from_string arg) in 455 if !verbose > 2 then begin prerr_string ("get_length : "^arg^" -> ") ; prerr_endline (Length.pretty r) end ; r 460 } <6>5 htmllex.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: htmllex.mll,v 1.9 2001/05/29 15:09:22 maranget Exp $ *) (***********************************************************************) { open Lexing open Lexeme 15 open Buff let txt_level = ref 0 and txt_stack = Stack.create "htmllex" 20 exception Error of string ;; let error msg lb = 25 raise (Error msg) let init table (s,t)= Hashtbl.add table s t ;; 30 let block = Hashtbl.create 17 ;; List.iter (init block) 35 ["CENTER", () ; "DIV", (); "BLOCKQUOTE", () ; "H1", () ; "H2", () ;"H3", () ;"H4", () ;"H5", () ;"H6", () ; "PRE", () ; "TABLE", () ; "TR",() ; "TD", () ; "TH",() ; "OL",() ; "UL",(); "P",() ; "LI",() ; "DL",() ; "DT", () ; "DD",() ; 40 ] ;; let ptop () = if not (Stack.empty txt_stack) then begin 45 let pos = Stack.top txt_stack in Location.print_this_fullpos pos ; prerr_endline "This opening tag is pending" end 50 let warnings = ref true let check_nesting lb name = try Hashtbl.find block (String.uppercase name) ; 55 if !txt_level <> 0 && !warnings then begin Location.print_fullpos () ; prerr_endline ("Warning, block level element: "^name^" nested inside text-level element") ; ptop () 60 end with | Not_found -> () let text = Hashtbl.create 17 65 ;; List.iter (init text) ["TT",TT ; "I",I ; "B",B ; "BIG",BIG ; "SMALL",SMALL ; 70 "STRIKE",STRIKE ; "S",S ; "U",U ; "FONT",FONT ; "EM",EM ; "STRONG",STRONG ; "DFN",DFN ; "CODE",CODE ; "SAMP",SAMP ; "KBD",KBD ; "VAR",VAR ; "CITE",CITE ; "ABBR",ABBR ; "ACRONYM",ACRONYM ; "Q",Q ; "SUB",SUB ; "SUP",SUP ; "A", A ; "SPAN", SPAN ; "SCRIPT", SCRIPT] ;; 75 let is_textlevel name = try let _ = Hashtbl.find text (String.uppercase name) in true 80 with | Not_found -> false let is_br name = "BR" = (String.uppercase name) let is_basefont name = "BASEFONT" = (String.uppercase name) 85 let set_basefont attrs lb = List.iter (fun (name,v,_) -> match String.uppercase name,v with | "SIZE",Some s -> 90 begin try Emisc.basefont := int_of_string s with | _ -> error "BASEFONT syntax" lb end 95 | _ -> ()) attrs let get_value lb = function | Some s -> s 100 | _ -> error "Bad attribute syntax" lb let norm_attrs lb attrs = List.map (fun (name,value,txt) -> 105 match String.uppercase name with | "SIZE" -> SIZE (get_value lb value),txt | "COLOR" -> COLOR (get_value lb value),txt | "FACE" -> FACE (get_value lb value),txt | _ -> OTHER, txt) 110 attrs let print_attrs s attrs = print_string s ; print_string ":" ; List.iter 115 (fun x -> match x with | name,Some value when name=s -> print_char ' ' ; print_string value | _ -> ()) 120 attrs ; print_char '\n' let ouvre lb name attrs txt = let uname = String.uppercase name in 125 try let tag = Hashtbl.find text uname in let attrs = norm_attrs lb attrs in incr txt_level ; Stack.push txt_stack (Location.get_pos ()) ; 130 Open (tag, attrs,txt) with | Not_found -> assert false and ferme lb name txt = 135 try let tag = Hashtbl.find text (String.uppercase name) in decr txt_level ; begin if not (Stack.empty txt_stack) then let _ = Stack.pop txt_stack in () 140 end ; Close (tag,txt) with | Not_found -> Text txt 145 let unquote s = 150 let l = String.length s in String.sub s 1 (l-2) ;; let buff = Buff.create () 155 and abuff = Buff.create () let put s = Buff.put buff s and putc c = Buff.put_char buff c 160 let aput s = Buff.put abuff s and aputc c = Buff.put_char abuff c 165 } let blank = [' ''\t''\n''\r'] 170 rule main = parse | (blank|"&nbsp;")+ {Blanks (lexeme lexbuf)} | "<!--" {put (lexeme lexbuf) ; in_comment lexbuf ; 175 Text (Buff.to_string buff)} | "<!" {put (lexeme lexbuf) ; in_tag lexbuf ; Text (Buff.to_string buff)} 180 | '<' {putc '<' ; let tag = read_tag lexbuf in if is_textlevel tag then begin let attrs = read_attrs lexbuf in 185 ouvre lexbuf tag attrs (Buff.to_string buff) end else if is_basefont tag then begin let attrs = read_attrs lexbuf in set_basefont attrs lexbuf ; Text (Buff.to_string buff) 190 end else begin check_nesting lexbuf tag ; in_tag lexbuf ; let txt = Buff.to_string buff in if is_br tag then 195 Blanks txt else Text txt end} | "</" 200 {put "</" ; let tag = read_tag lexbuf in in_tag lexbuf ; ferme lexbuf tag (Buff.to_string buff)} | eof {Eof} 205 | _ {putc (lexeme_char lexbuf 0) ; text lexbuf ; Text (Buff.to_string buff)} 210 and text = parse | [^'<'] {putc (lexeme_char lexbuf 0) ; text lexbuf} | "" {()} 215 and read_tag = parse | ['a'-'z''A'-'Z''0'-'9']* {let lxm = lexeme lexbuf in put lxm ; lxm} 220 and read_attrs = parse | blank+ {aput (lexeme lexbuf) ; read_attrs lexbuf} | ['a'-'z''A'-'Z''-''0'-'9']+ {let name = lexeme lexbuf in 225 aput name ; let v = read_avalue lexbuf in let atxt = Buff.to_string abuff in put atxt ; (name,v,atxt)::read_attrs lexbuf} 230 | '>' {put_char buff '>' ; []} | "" {error "Attribute syntax" lexbuf} and read_avalue = parse | blank* '=' blank* 235 {let lxm = lexeme lexbuf in aput lxm ; Some (read_aavalue lexbuf)} | "" {None} 240 and read_aavalue = parse | '\''[^'\'']*'\'' | '"'[^'"']*'"' {let lxm = lexeme lexbuf in aput lxm ; 245 unquote lxm} | '#'?['a'-'z''A'-'Z''0'-'9''-''+''_'':''.']+ {let lxm = lexeme lexbuf in aput lxm ; lxm} 250 | "" {error "Attribute syntax" lexbuf} and in_tag = parse | '>' {putc (lexeme_char lexbuf 0)} | _ {putc (lexeme_char lexbuf 0) ; in_tag lexbuf} 255 | eof {error "End of file in tag" lexbuf} and in_comment = parse | "-->" '\n'? {put (lexeme lexbuf)} 260 | _ {putc (lexeme_char lexbuf 0) ; in_comment lexbuf} | eof {error "End of file in comment" lexbuf} 265 { let to_string = function | Open (_,_,txt) | Close (_,txt) | Text txt | Blanks txt -> txt | Eof -> "Eof" 270 let rec cost = function | {tag=FONT ; attrs=attrs} -> (1,List.length attrs) | _ -> (1,0) 275 let tok_buff = ref None ;; let txt_buff = Buff.create () ;; 280 let rec read_tokens blanks lb = let t = main lb in match t with | Text txt -> Buff.put txt_buff txt ; read_tokens false lb 285 | Blanks txt -> Buff.put txt_buff txt ; read_tokens blanks lb | _ -> let txt = Buff.to_string txt_buff in match txt with | "" -> t 290 | _ -> tok_buff := Some t ; if blanks then Blanks txt else 295 Text txt let reset () = txt_level := 0 ; Stack.reset txt_stack ; 300 Buff.reset txt_buff ; Buff.reset buff ; Buff.reset abuff let next_token lb = 305 try match !tok_buff with | Some t -> tok_buff := None ; t | None -> read_tokens true lb with | e -> 310 reset () ; raise e } <6>6 infoRef.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) { let header = "$Id: infoRef.mll,v 1.22 2001/05/25 09:07:15 maranget Exp $" ;; 15 open Lexing open Misc 20 let compat_mem tbl key = try let _ = Hashtbl.find tbl key in true with Not_found -> false ;; 25 exception Error of string type node_t = { mutable name : string; mutable comment : string; 30 mutable previous : node_t option; mutable next : node_t option; mutable up : node_t option; mutable pos : int; } 35 ;; type menu_t = { mutable num : int; mutable nom : string; 40 mutable nod : node_t option; mutable nodes : node_t list; } ;; 45 let menu_list = ref [];; let nodes = Hashtbl.create 17;; let delayed = ref [];; 50 let current_node = ref None;; let menu_num = ref 0 ;; 55 let counter = ref 0 and pos_file = ref 0 ;; let abs_pos () = !counter + !pos_file 60 ;; let cur_file = ref (Parse_opts.name_out) ;; 65 let file_number = ref 1 ;; type label_t = { 70 mutable lab_name : string; mutable noeud : node_t option; };; let labels_list = ref [];; 75 let files = ref [];; let top_node = ref false;; let hot_start () = 80 menu_list := []; Hashtbl.clear nodes ; current_node := None ; menu_num := 0 ; counter := 0 ; 85 pos_file := 0 ; cur_file := Parse_opts.name_out ; files := [] ; top_node := false ; file_number := 1 ; 90 labels_list := [] ;; let infomenu arg = menu_num:=!menu_num+1; 95 menu_list := { num = !menu_num; nom = arg; nod = !current_node; nodes = []; 100 } ::!menu_list; Text.open_block "INFOLINE" ""; Text.put ("\\@menu"^string_of_int !menu_num^"\n"); Text.close_block "INFOLINE" ;; 105 let rec cherche_menu m = function | [] -> raise (Error ("Menu ``"^m^"'' not found")) | menu::r -> if menu.nom = m then menu 110 else cherche_menu m r ;; let rec cherche_menu_par_num n = function | [] -> raise (Error ("Menu not found")) 115 | menu::r -> if menu.num = n then menu else cherche_menu_par_num n r ;; 120 let ajoute_node_dans_menu n m = try let menu = cherche_menu m !menu_list in menu.nodes <- n :: menu.nodes; menu.nod 125 with _ -> None ;; let verifie name = 130 let nom = String.copy name in for i = 0 to String.length name -1 do match nom.[i] with | '\t' -> nom.[i] <- ' ' | ',' -> nom.[i] <- ' ' 135 | '.' -> nom.[i] <- '-' | '\n' -> nom.[i] <- ' ' | _ -> () done; nom 140 ;; 145 (* References *) let rec cherche_label s = function | [] -> raise Not_found | l::r -> if l.lab_name=s then l.noeud else cherche_label s r 150 ;; let rec change_label s = function | [] -> Misc.warning ("Cannot change label: ``"^s^"''") | l::r -> 155 if l.lab_name = s then l.noeud <- !current_node else change_label s r 160 let loc_name s1 = (* pose un label *) let _ = try let _ = cherche_label s1 !labels_list in Misc.warning ("Multiple use of label: "^s1) 165 with Not_found -> () in let l = { lab_name = s1; 170 noeud = !current_node ; } in labels_list := l:: !labels_list; Text.open_block "INFO" "" ; 175 Text.put "\\@name{" ; Text.put s1 ; Text.put "}" ; Text.close_block "INFO" ; if !verbose > 1 then prerr_endline ("InfoRef.loc_name, label="^s1); 180 ;; (* Sortie du fichier final *) 185 let out_cur = ref (Out.create_null ()) ;; let set_out chan = 190 if !verbose >3 then prerr_endline "Set_out"; out_cur := chan ;; let set_out_file s = 195 if !verbose >3 then prerr_endline ("Set_out_file :"^s); cur_file := s ;; let put s = 200 if !verbose >3 then prerr_endline ("put :"^s); counter:=!counter + String.length s; Out.put !out_cur s ;; 205 let put_char c = if !verbose >3 then prerr_endline ("put_char :"^String.make 1 c); counter:=!counter +1; 210 Out.put_char !out_cur c ;; let put_credits () = put "\n\n-------------------------------------\nThis file has been translated from LaTeX by HeVeA.\n\n"; 215 and put_header () = put "This file has been translated from LaTeX by HeVeA.\n" ;; 220 let next_file () = Out.close !out_cur ; file_number := !file_number +1; cur_file := Parse_opts.name_out ^ "-" ^ string_of_int !file_number ; if !verbose > 0 then 225 prerr_endline ("Change file to "^ !cur_file) ; set_out (Out.create_chan (open_out !cur_file)) ; files := (!cur_file,abs_pos ()) :: !files ; pos_file := abs_pos () ; put_header () ; 230 counter := 0 ;; 235 let noeud_name n = n.name ;; 240 let affiche_menu num = let menu = cherche_menu_par_num num !menu_list in if menu.nodes <> [] then begin put "* Menu:\n\n"; 245 let rec affiche_items = function | [] -> () | n::reste -> put ("* "^noeud_name n^"::\t"^n.comment^"\n"); affiche_items reste; 250 in affiche_items (List.rev menu.nodes); if !verbose >1 then prerr_endline ("Menu :"^menu.nom); end 255 ;; let do_affiche_tag_table s = put ("\n\nTag table:\n"^(if s<> "" then s^"\n" else "")) ; 260 Hashtbl.iter (fun nom n -> put ("Node: "^noeud_name n^""^string_of_int n.pos^"\n")) nodes; put "\nEnd tag table\n"; ;; 265 let affiche_tag_table ()= match !files with | [_] -> 270 do_affiche_tag_table "" | _ -> let rec do_indirect = function | [] -> () | (f,p)::reste -> 275 put (f^": "^string_of_int p^"\n"); do_indirect reste in Out.close !out_cur ; set_out (Out.create_chan (open_out Parse_opts.name_out)) ; 280 put_header () ; put "\nIndirect:\n"; do_indirect (List.rev !files); do_affiche_tag_table "(Indirect)" ;; 285 let affiche_node nom = if !top_node then begin put_credits () ; 290 top_node := false end ; let noeud = try Hashtbl.find nodes nom with Not_found -> raise (Error ("Node not found :"^nom)) 295 in if not Parse_opts.filter && !counter > 50000 then begin next_file () end; noeud.pos <- abs_pos (); 300 put "\n"; put ("Node: "^noeud_name noeud); (match noeud.next with | None -> () | Some n -> put (",\tNext: "^noeud_name n)); 305 (match noeud.previous with | None -> () | Some n -> put (",\tPrev: "^noeud_name n)); (match noeud.up with | None -> 310 if noeud.name = "Top" then begin put ",\tUp: (dir)." ; top_node := true end | Some n -> put (",\tUp: "^noeud_name n)); 315 put_char '\n'; if !verbose >1 then prerr_endline ("Node : "^noeud_name noeud); ;; 320 let affiche_ref key = try let l = cherche_label key !labels_list in match l with 325 | None -> () | Some node -> put ("*Note "^noeud_name node^"::") with | Not_found -> () (* A warning has already been given *) ;; 330 let footNote_label = ref "" ;; } 335 rule main = parse | "\\@menu" { 340 let num = numero lexbuf in affiche_menu num; main lexbuf} | "\\@node" { 345 let nom = finitLigne lexbuf in affiche_node nom; main lexbuf} | "\\@reference{" { 350 let key = arg lexbuf in affiche_ref key; main lexbuf} | "\\@name{" {let _ = arg lexbuf in 355 main lexbuf} | eof {affiche_tag_table ()} | _ 360 {let lxm = lexeme_char lexbuf 0 in put_char lxm; main lexbuf} and numero = parse 365 ['0'-'9']+ {let lxm = lexeme lexbuf in int_of_string lxm} | _ {raise (Error "Syntax error in info temp file")} 370 and finitLigne = parse [^'\n']+'\n' {let lxm = lexeme lexbuf in String.sub lxm 0 ((String.length lxm) -1)} | _ {raise ( Error "Syntax error in info temp file: no node name.")} 375 and arg = parse [^'}']+'}' {let lxm= lexeme lexbuf in String.sub lxm 0 ((String.length lxm) -1)} 380 | _ {raise (Error "Syntax error in info temporary file: invalid reference.")} and labels = parse | "\\@name{" {let key = arg lexbuf in 385 key::labels lexbuf} | _ {labels lexbuf} | eof {[]} 390 { let do_infonode opt num arg = let n = { name = verifie num; 395 comment = arg; previous = None; next = None; up = None; pos = 0; 400 } in if compat_mem nodes n.name then raise (Error ("Duplicate node name: "^n.name)); n.up <- (match opt with "" -> None 405 | m -> ajoute_node_dans_menu n m); Hashtbl.add nodes n.name n; Text.open_block "INFOLINE" ""; Text.put ("\\@node"^n.name^"\n"); Text.close_block "INFOLINE"; 410 current_node := Some n; if !verbose>1 then prerr_endline ("Node added :"^n.name^", "^n.comment) let infoextranode num nom text = delayed := (num,nom,text) :: !delayed 415 and flushextranodes () = let rec flush_rec = function | [] -> () | (num,nom,text) :: rest -> 420 do_infonode "" num nom ; Text.open_block "INFO" "" ; Text.put text ; Text.close_block "INFO" ; let labs = labels (Lexing.from_string text) in 425 List.iter (fun lab -> change_label lab !labels_list) labs ; flush_rec rest in flush_rec !delayed ; delayed := [] ;; 430 let infonode opt num arg = flushextranodes () ; do_infonode opt num arg 435 (* finalisation des liens entre les noeuds *) let rec do_finalize_nodes suivant = function | [] -> () | n::reste -> 440 if !verbose>2 then prerr_endline ("node :"^n.name); n.next <- suivant; (match suivant with | None -> () | Some suiv -> suiv.previous <- Some n ); 445 do_finalize_nodes (Some n) reste ;; let rec do_finalize_menus = function | [] -> () 450 | m::reste -> if m.nodes <> [] then begin do_finalize_nodes (match m.nod with None -> None 455 | Some n -> n.next) m.nodes; (match m.nod with None -> () | Some n -> 460 let first_node = List.hd (List.rev m.nodes) in n.next <- Some first_node; first_node.previous <- Some n; (* On descend dans l'arborescence des menus *) let last_node = List.hd m.nodes in 465 (match last_node.next with | None -> () | Some suiv -> suiv.previous <- Some n); (* On remonte les menus au meme niveau *) ); 470 do_finalize_menus reste; end ;; let finalize_nodes () = 475 if !verbose>2 then prerr_endline "finalizing nodes"; flushextranodes () ; do_finalize_menus (List.rev !menu_list); if !verbose>2 then prerr_endline "finalizing done."; ;; 480 let dump buff = let name,out_chan = match Parse_opts.name_out with | "" -> "", Out.create_chan stdout | s -> 485 let name = s^"-1" in name, Out.create_chan (open_out name) in if !verbose > 0 then prerr_endline ("Final dump in "^name) ; set_out out_chan ; 490 set_out_file name ; put_header () ; files := [name,abs_pos ()] ; main buff ; Out.close !out_cur ; 495 if !file_number = 1 then Mysys.rename !cur_file Parse_opts.name_out } <6>7 latexscan.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) (* $Id: latexscan.mll,v 1.212 2001/06/06 16:52:47 maranget Exp $ *) 15 { module type S = sig (* external entry points *) val no_prelude : unit -> unit 20 val main : Lexing.lexbuf -> unit val print_env_pos : unit -> unit (* additional resources needed for extension modules. *) val cur_env : string ref 25 val new_env : string -> unit val close_env : string -> unit val echo_toimage : unit -> bool val echo_global_toimage : unit -> bool 30 val fun_register : (unit -> unit) -> unit val newif_ref : string -> bool ref -> unit val top_open_block : string -> string -> unit val top_close_block : string -> unit val check_alltt_skip : Lexing.lexbuf -> unit 35 val skip_pop : Lexing.lexbuf -> unit (* ``def'' functions for initialisation only *) val def_code : string -> (Lexing.lexbuf -> unit) -> unit val def_name_code : string -> (string -> Lexing.lexbuf -> unit) -> unit val def_fun : string -> (string -> string) -> unit 40 val get_this_main : string -> string val check_this_main : string -> bool val get_prim : string -> string val get_prim_arg : Lexing.lexbuf -> string val get_prim_opt : string -> Lexing.lexbuf -> string 45 val get_csname : Lexing.lexbuf -> string end module Make (Dest : OutManager.S) (Image : ImageManager.S) = 50 struct open Misc open Parse_opts open Element open Lexing 55 open Myfiles open Latexmacros open Save open Tabular open Lexstate 60 open Stack open Subst let sbool = function | false -> "false" 65 | true -> "true" let last_letter name = 70 let c = String.get name (String.length name-1) in ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') ;; let top_par n = 75 if not (!display || !in_math) then Dest.par n ;; let if_level = ref 0 ;; 80 let cur_env = ref "" and after = ref [] and stack_env = Stack.create "stack_env" ;; 85 let echo_toimage () = get_level () = 0 && top_level () and echo_global_toimage () = top_level () let stack_env_pretty () = Stack.pretty (fun (x,_,_) -> x) stack_env 90 let fun_register f = if get_level () > 0 then after := f :: !after ;; 95 let inc_size i = let n = Dest.get_fontsize () in let new_size = if n+i <= 1 then 1 100 else if n+i >= 7 then 7 else n+i in Dest.open_mod (Font new_size) ;; 105 let big_size () = Dest.open_mod (Font 7) ;; (* Horizontal display *) 110 let top_open_display () = if !display then begin if !verbose > 1 then prerr_endline "open display" ; Dest.open_display () 115 end and top_item_display () = if !display then begin Dest.item_display () 120 end ;; let top_close_display () = if !display then begin 125 Dest.close_display () end (* Latex environment stuff *) 130 let print_env_pos () = let _,_,pos = Stack.pop stack_env in Location.print_this_pos pos ; prerr_endline ("Latex environment ``"^ !cur_env^"'' is pending") 135 ;; let new_env env = Latexmacros.open_group () ; push stack_env (!cur_env, !after, Location.get_pos ()) ; 140 cur_env := env ; after := [] ; if !verbose > 1 then begin Location.print_pos () ; Printf.fprintf stderr "Begin : %s <%d>" env (get_level ()); 145 prerr_endline "" end let error_env close_e open_e = raise 150 (Misc.Close ("Latex env error: ``"^close_e^"'' closes ``"^open_e^"''")) let close_env env = if !verbose > 1 then begin 155 Printf.fprintf stderr "End: %s <%d>" env (get_level ()); prerr_endline "" end ; if env = !cur_env then begin let e,a,_ = pop stack_env in 160 List.iter (fun f -> f ()) !after ; cur_env := e ; after := a ; Latexmacros.close_group () end else 165 error_env env !cur_env ;; let env_check () = !cur_env, !after, Stack.save stack_env and env_hot (e,a,s) = 170 cur_env := e ; after := a ; Stack.restore stack_env s 175 (* Top functions for blocks *) type array_type = {math : bool ; border : bool} type in_table = Table of array_type | NoTable | Tabbing ;; 180 let cur_format = ref [||] and stack_format = Stack.create "stack_format" and cur_col = ref 0 and stack_col = Stack.create "stack_col" 185 and in_table = ref NoTable and stack_table = Stack.create_init "stack_table" NoTable and first_col = ref false and first_border = ref false and stack_first = Stack.create "stack_first" 190 and stack_first_b = Stack.create "stack_first_b" and in_multi = ref false and stack_multi_flag = Stack.create "stack_multi_flag" and stack_multi = Stack.create "stack_multi" ;; 195 let pretty_array_type = function | Table {math = m ; border = b} -> "Table math="^(if m then "+" else "-")^ 200 " border="^(if b then "+" else "-") | NoTable -> "NoTable" | Tabbing -> "Tabbing" let prerr_array_state () = 205 prerr_endline (pretty_array_type !in_table) ; prerr_string " format:"; pretty_formats !cur_format ; prerr_endline "" ; prerr_endline (" cur_col="^string_of_int !cur_col) ; 210 prerr_endline (" first_col="^ (if !first_col then "true" else "false")) ;; let save_array_state () = 215 push stack_format !cur_format ; push stack_col !cur_col ; push stack_table !in_table ; push stack_first !first_col; push stack_first_b !first_border; 220 push stack_multi_flag !in_multi ; in_multi := false ; if !verbose > 1 then begin prerr_endline "Save array state:" ; prerr_array_state () 225 end and restore_array_state () = in_table := pop stack_table ; cur_col := pop stack_col ; 230 cur_format := pop stack_format ; first_col := pop stack_first ; first_border := pop stack_first_b; in_multi := pop stack_multi_flag ; if !verbose > 1 then begin 235 prerr_endline "Restore array state:" ; prerr_array_state () end ;; 240 let top_open_block block args = if !verbose > 2 then prerr_endline ("Top open: "^block); push stack_table !in_table ; in_table := NoTable ; begin match block with 245 | "PRE" -> push stack_display !display ; if !display then begin Dest.item_display () ; display := false 250 end ; Dest.open_block "PRE" args | "DISPLAY" -> push stack_display !display ; display := true ; 255 Dest.open_display () | "TABLE" -> save_array_state () ; in_table := NoTable ; top_item_display () ; 260 Dest.open_block "TABLE" args | "TR" -> Dest.open_block "TR" args | "TD" -> Dest.open_block "TD" args ; 265 top_open_display () | _ -> if !display then begin Dest.item_display () ; Dest.open_block block args ; Dest.open_display () 270 end else Dest.open_block block args end and top_close_block_aux close_fun block = 275 if !verbose > 2 then prerr_endline ("Top close: "^block) ; in_table := pop stack_table ; begin match block with | "PRE" -> display := pop stack_display ; 280 close_fun block ; top_item_display () | "DISPLAY" -> Dest.close_display () ; display := pop stack_display 285 | "TABLE" -> close_fun "TABLE" ; top_item_display () ; restore_array_state () | "TR" -> 290 close_fun "TR" | "TD" -> top_close_display () ; close_fun "TD" | _ -> 295 if !display then begin Dest.close_display () ; close_fun block ; Dest.item_display () end else close_fun block end 300 ;; let top_close_block block = top_close_block_aux Dest.close_block block and top_erase_block block = top_close_block_aux Dest.erase_block block 305 let top_open_group () = top_open_block "" "" ; new_env "" and top_close_group () = if !cur_env = "*mbox" then begin 310 top_close_block "" ; in_math := pop stack_in_math ; display := pop stack_display ; if !display then Dest.item_display () ; close_env "*mbox" end else begin 315 top_close_block "" ; close_env "" end ;; 320 let start_mbox () = push stack_table !in_table ; in_table := NoTable ; push stack_in_math !in_math ; in_math := false ; if !display then Dest.item_display () ; push stack_display !display ; display := false ; 325 Dest.open_block "" "" ; new_env "*mbox" ;; let get_fun_result f lexbuf = 330 if !verbose > 1 then prerr_endline ("get_fun") ; let r = Dest.to_string (fun () -> top_open_group () ; Dest.nostyle () ; 335 f lexbuf ; top_close_group ()) in if !verbose > 1 then begin prerr_endline ("get_fun -> ``"^r^"''") end ; 340 r let do_get_this start_lexstate restore_lexstate make_style lexfun {arg=s ; subst=subst} = 345 let par_val = Dest.forget_par () in start_lexstate subst; if !verbose > 1 then prerr_endline ("get_this : ``"^s^"''") ; verbose := !verbose - 1; 350 let lexer = Lexing.from_string s in let r = Dest.to_string (fun () -> if !display then Dest.open_display () ; top_open_group () ; make_style () ; 355 lexfun lexer ; top_close_group () ; if !display then Dest.close_display ()) in let _ = Dest.forget_par () in 360 verbose := !verbose + 1 ; if !verbose > 1 then begin prerr_endline ("get_this ``"^s^"'' -> ``"^r^"''") end ; restore_lexstate () ; 365 Dest.par par_val ; r let get_this_arg = do_get_this start_lexstate_subst restore_lexstate (fun () -> ()) 370 and get_this_string main s = do_get_this start_lexstate_subst restore_lexstate (fun () -> ()) main (string_to_arg s) 375 let more_buff = Out.create_buff () ;; let default_format = Tabular.Align 380 {hor="left" ; vert = "" ; wrap = false ; pre = "" ; post = "" ; width = Length.Default} and center_format = Tabular.Align 385 {hor="center" ; vert = "top" ; wrap = false ; pre = "" ; post = "" ; width = Length.Default} ;; 390 let is_table = function | Table _ -> true | _ -> false and is_noborder_table = function 395 | Table {border = b} -> not b | _ -> false and is_tabbing = function | Tabbing -> true 400 | _ -> false and math_table = function | Table {math = m} -> m | _ -> raise (Misc.Fatal "Array construct outside an array") 405 ;; exception EndInside ;; 410 exception NoMulti ;; let attribut name = function | "" -> "" 415 | s -> " "^name^"="^s and as_colspan = function | 1 -> "" | n -> " COLSPAN="^string_of_int n 420 let is_inside = function Tabular.Inside _ -> true | _ -> false 425 let is_border = function | Tabular.Border _ -> true | _ -> false and as_wrap = function 430 | Tabular.Align {wrap = w} -> w | _ -> false and as_pre = function | Tabular.Align {pre=s} -> s 435 | _ -> raise (Misc.Fatal "as_pre") and as_post = function | Tabular.Align {post=s} -> s | f -> raise (Misc.Fatal ("as_post "^pretty_format f)) 440 ;; let get_col format i = let r = if i >= Array.length format+1 then 445 raise (Misc.ScanError ("This array/tabular column has no specification")) else if i = Array.length format then default_format else format.(i) in if !verbose > 2 then begin Printf.fprintf stderr "get_col : %d: " i ; 450 prerr_endline (pretty_format r) ; prerr_string " <- " ; pretty_formats format ; prerr_newline () end ; 455 r ;; (* Paragraph breaks are different in tables *) let par_val t = 460 if is_table t then match get_col !cur_format !cur_col with | Tabular.Align {wrap=false} -> None | _ -> Some 0 else 465 Some 1 let show_inside main format i closing = (* if !verbose > -1 then begin 470 prerr_string ("show_inside: "^string_of_int i) end ; *) let t = ref i in begin try while true do 475 begin match get_col format !t with Tabular.Inside s -> let saved_table = !in_table in if math_table saved_table then scan_this main "$" 480 else scan_this main "{" ; let s = get_this_string main s in if math_table saved_table then scan_this main "$" 485 else scan_this main "}" ; Dest.make_inside s !in_multi; | Tabular.Border s -> Dest.make_border s; 490 if !first_border then first_border := false; | _ -> raise EndInside end ; t := !t+1 done with EndInside -> 495 if (!t = i) && (closing || !first_border) then Dest.make_border " "; end ; (* if !verbose > -1 then 500 prerr_endline (" -> "^string_of_int !t) ; *) !t ;; 505 let rec eat_inside format i b insides = if i >= Array.length format then (i , b , insides) else begin let f = get_col format i in if is_inside f then 510 eat_inside format (i+1) b (insides+1) else if is_border f then eat_inside format (i+1) (b+1) insides else i, b, insides end 515 ;; let rec find_end n format i b insides = match n with 0 -> eat_inside format i b insides | _ -> 520 let f = get_col format i in if is_inside f then find_end n format (i+1) b (insides +1) else if is_border f then find_end n format (i+1) (b+1) insides 525 else find_end (n-1) format (i+1) b insides ;; 530 let find_start i = if !first_border then 0 else i let find_align format = let t = ref 0 in while (is_inside (get_col format !t)) || (is_border (get_col format !t)) do 535 t := !t+1 done ; !t ;; 540 let next_no_border format n = let t = ref n in while is_border (get_col format !t) do t:= !t+1 done; 545 !t ;; let do_open_col main format span insides = let save_table = !in_table in 550 Dest.open_cell format span insides; if not (as_wrap format) && math_table !in_table then begin display := true ; Dest.open_display () end ; 555 if math_table !in_table && not (as_wrap format) then begin scan_this main "$" end else scan_this main "{" ; scan_this main (as_pre format) ; 560 in_table := save_table let open_col main = let _ = Dest.forget_par () in Dest.open_cell_group () ; 565 cur_col := show_inside main !cur_format !cur_col false; let format = (get_col !cur_format !cur_col) in do_open_col main format 1 0 ;; 570 let open_first_col main = first_col := true ; first_border := true; open_col main ;; 575 let erase_col main = let old_format = get_col !cur_format !cur_col in scan_this main (as_post old_format) ; if math_table !in_table && not (as_wrap old_format) then 580 scan_this main "$" else scan_this main "}" ; if !display then begin Dest.close_display () ; 585 display := false end ; Dest.erase_cell () ; Dest.erase_cell_group () ;; 590 let open_row () = cur_col := 0 ; Dest.new_row () 595 and close_row () = Dest.close_row () ;; 600 let do_hline main = if !verbose > 2 then begin Printf.fprintf stderr "hline: %d %d" !cur_col (Array.length !cur_format) ; prerr_newline () end ; 605 erase_col main ; Dest.erase_row () ; Dest.make_hline (Array.length !cur_format) (is_noborder_table !in_table); open_row () ; open_first_col main 610 ;; let do_multi n format main = if !verbose > 2 then begin prerr_string 615 ("multicolumn: n="^string_of_int n^" format:") ; pretty_formats format ; prerr_endline "" end ; 620 erase_col main ; let start_span = find_start !cur_col and k,b,insides = find_end n !cur_format !cur_col 0 0 in let end_span = k - b in 625 in_multi := true; let i = show_inside main format 0 true in 630 Dest.open_cell_group () ; do_open_col main (get_col format i) (end_span - start_span) insides; push stack_multi (!cur_format,k) ; cur_format := format ; cur_col := i ; 635 ;; let close_col_aux main content is_last = let old_format = get_col !cur_format !cur_col in 640 scan_this main (as_post old_format) ; if math_table !in_table && not (as_wrap old_format) then scan_this main "$" else scan_this main "}" ; 645 if !display then begin Dest.close_display () ; display := false end ; if is_last && Dest.is_empty () then Dest.erase_cell () 650 else begin if !in_multi then begin let _ = show_inside main !cur_format (!cur_col+1) true in in_multi := false ; let f,n = pop stack_multi in 655 cur_format := f ; cur_col := next_no_border f n; cur_col := show_inside main !cur_format !cur_col false; end else begin cur_col := !cur_col + 1; 660 cur_col := show_inside main !cur_format !cur_col true; end; Dest.close_cell content; if !first_col then begin first_col := false; 665 first_border := false; end end ; Dest.close_cell_group () ;; 670 let close_col main content = close_col_aux main content false and close_last_col main content = close_col_aux main content true and close_last_row () = 675 if !first_col then Dest.erase_row () else Dest.close_row () ;; 680 (* Compute functions *) let get_style lexfun {arg=s ; subst=env} = start_normal env ; 685 let lexer = Lexing.from_string s in let r = Dest.to_style (fun () -> lexfun lexer) in end_normal () ; r 690 (* Image stuff *) let iput_newpage () = Image.page () ;; 695 let stack_entry = Stack.create "stack_entry" and stack_out = Stack.create "stack_out" ;; let start_other_scan env lexfun lexbuf = 700 if !verbose > 1 then begin prerr_endline ("Start other scan ("^env^")") ; stack_env_pretty () ; prerr_endline ("Current env is: ``"^ !cur_env^"''") ; pretty (fun x -> x) stack_entry 705 end; save_lexstate () ; push stack_entry env ; rev stack_entry ; lexfun lexbuf 710 ;; let start_image_scan s image lexbuf = start_other_scan "toimage" (fun b -> Image.dump s image b) lexbuf ;; 715 let complete_scan main lexbuf = main lexbuf ; close_env (pop stack_out) ; top_close_block "" ; 720 if !verbose > 1 then begin prerr_endline "Complete scan" ; stack_env_pretty () ; prerr_endline ("Current env is: ``"^ !cur_env^"''") end 725 ;; let stop_other_scan comment main lexbuf = if !verbose > 1 then begin 730 prerr_endline "Stop image: env stack is" ; stack_env_pretty () ; prerr_endline ("Current env is: ``"^ !cur_env^"''") end; let _ = pop stack_entry in 735 if not comment then close_env !cur_env ; if not (Stack.empty stack_out) then begin complete_scan main lexbuf ; while not (Stack.empty stack_out) do let lexbuf = previous_lexbuf () in 740 complete_scan main lexbuf done end ; restore_lexstate () ;; 745 let includes_table = Hashtbl.create 17 and check_includes = ref false ;; 750 let add_includes l = check_includes := true ; List.iter (fun x -> Hashtbl.add includes_table x ()) l ;; 755 let check_include s = not !check_includes || begin try Hashtbl.find includes_table s ; true 760 with Not_found -> false end ;; 765 let mk_out_file () = match Parse_opts.name_out,!Parse_opts.destination with | "", Parse_opts.Info -> Out.create_buff () | "", _ -> Out.create_chan stdout | x , Parse_opts.Info -> Out.create_chan (open_out (x^".tmp")) | x , _ -> Out.create_chan (open_out x) 770 ;; let no_prelude () = if !verbose > 1 then prerr_endline "Filter mode" ; flushing := true ; 775 let _ = Dest.forget_par () in () ; Dest.set_out (mk_out_file ()) ;; let macro_depth = ref 0 780 ;; let debug = function | Not -> "Not" | Macro -> "Macro" 785 | Inside -> "Inside" ;; let rec expand_toks main = function 790 | [] -> () | s::rem -> expand_toks main rem ; scan_this main s 795 let expand_command main skip_blanks name lexbuf = if !verbose > 2 then begin Printf.fprintf stderr "expand_command: %s\n" name end ; let cur_subst = get_subst () in 800 let exec = if !alltt_loaded then function | Subst body -> if !verbose > 2 then 805 prerr_endline ("user macro: "^body) ; let old_alltt = !alltt in Stack.push stack_alltt old_alltt ; alltt := (match old_alltt with 810 | Not -> Not | _ -> Macro) ; (* Printf.fprintf stderr "Enter: %s, %s -> %s\n" name (debug old_alltt) (debug !alltt) ; 815 *) scan_this_may_cont main lexbuf cur_subst (string_to_arg body) ; let _ = Stack.pop stack_alltt in alltt := (match old_alltt, !alltt with 820 | Not, Inside -> Inside | (Macro|Inside), Not -> Not | _, _ -> old_alltt) (* Printf.fprintf stderr 825 "After: %s, %s -> %s\n" name (debug old_alltt) (debug !alltt) *) | Toks l -> expand_toks main l | CamlCode f -> f lexbuf else 830 function | Subst body -> if !verbose > 2 then prerr_endline ("user macro: "^body) ; scan_this_may_cont main lexbuf cur_subst (string_to_arg body) 835 | Toks l -> expand_toks main l | CamlCode f -> f lexbuf in let pat,body = Latexmacros.find name in let par_before = Dest.forget_par () in 840 if (if !in_math then Latexmacros.invisible name else not (effective !alltt) && is_subst body && last_letter name) 845 then begin if !verbose > 2 then prerr_endline ("skipping blanks ("^name^")"); skip_blanks lexbuf end else begin 850 if !verbose > 2 then begin prerr_endline ("not skipping blanks ("^name^")") end end ; let par_after = Dest.forget_par () in 855 Dest.par par_before ; let args = make_stack name pat lexbuf in let saw_par = !Save.seen_par in if (!verbose > 1) then begin prerr_endline 860 ("Expanding macro "^name^" {"^(string_of_int !macro_depth)^"}") ; macro_depth := !macro_depth + 1 end ; scan_body exec body args ; if (!verbose > 1) then begin 865 prerr_endline ("Cont after macro "^name^": ") ; macro_depth := !macro_depth - 1 end ; Dest.par par_after ; if saw_par then begin 870 top_par (par_val !in_table) end ;; let count_newlines s = 875 let l = String.length s in let rec c_rec i = if i >= l then 0 else match s.[i] with | '\n' -> 1 + c_rec (i+1) 880 | _ -> c_rec (i+1) in c_rec 0 ;; let check_case s = match !case with 885 | Lower -> String.lowercase s | Upper -> String.uppercase s | Neutral -> s and check_case_char c = match !case with 890 | Lower -> Char.lowercase c | Upper -> Char.uppercase c | Neutral -> c } 895 let command_name = '\\' (( ['@''A'-'Z' 'a'-'z']+ '*'?) | [^ 'A'-'Z' 'a'-'z']) rule main = parse (* comments *) | '%' 900 {expand_command main skip_blanks "\\@hevea@percent" lexbuf ; main lexbuf} (* Paragraphs *) | '\n' 905 {expand_command main skip_blanks "\\@hevea@newline" lexbuf ; main lexbuf} (* subscripts and superscripts *) | '_' {expand_command main skip_blanks "\\@hevea@underscore" lexbuf ; 910 main lexbuf} | '^' {expand_command main skip_blanks "\\@hevea@circ" lexbuf ; main lexbuf} (* Math mode *) 915 | "$" | "$$" {let lxm = lexeme lexbuf in (* ``$'' has nothing special *) let dodo = lxm <> "$" in if effective !alltt || not (is_plain '$') then begin 920 Dest.put lxm ; main lexbuf (* vicious case ``$x$$y$'' *) end else if dodo && not !display && !in_math then begin scan_this main "${}$" ; main lexbuf 925 end else begin (* General case *) let math_env = if dodo then "*display" else "*math" in if !in_math then begin in_math := pop stack_in_math ; if dodo then begin 930 Dest.close_maths dodo end else begin top_close_display () ; Dest.close_maths dodo end ; 935 display := pop stack_display ; if !display then begin Dest.item_display () end ; close_env math_env ; 940 main lexbuf end else begin push stack_in_math !in_math ; in_math := true ; let lexfun lb = 945 if !display then Dest.item_display () ; push stack_display !display ; if dodo then begin display := true ; Dest.open_maths dodo; 950 end else begin Dest.open_maths dodo; top_open_display () ; end; skip_blanks lb ; main lb in 955 new_env math_env ; lexfun lexbuf end end} (* Definitions of simple macros *) 960 (* inside tables and array *) | [' ''\n']* "&" {expand_command main skip_blanks "\\@hevea@amper" lexbuf ; main lexbuf} (* Substitution *) 965 | '#' ['1'-'9'] {let lxm = lexeme lexbuf in begin if effective !alltt || not (is_plain '#') then Dest.put lxm else 970 let i = Char.code lxm.[1] - Char.code '1' in scan_arg (if !alltt_loaded then (fun arg -> let old_alltt = !alltt in 975 alltt := Stack.pop stack_alltt ; scan_this_may_cont main lexbuf (get_subst ()) arg ; alltt := old_alltt ; Stack.push stack_alltt old_alltt) else 980 (fun arg -> scan_this_may_cont main lexbuf (get_subst ()) arg)) i end ; main lexbuf} (* Commands *) 985 | command_name {let name = lexeme lexbuf in expand_command main skip_blanks name lexbuf ; main lexbuf} (* Groups *) 990 | '{' {expand_command main skip_blanks "\\@hevea@obrace" lexbuf ; main lexbuf} | '}' {expand_command main skip_blanks "\\@hevea@cbrace" lexbuf ; 995 main lexbuf} | eof {()} | ' '+ {if effective !alltt then let lxm = lexeme lexbuf in Dest.put lxm 1000 else Dest.put_char ' '; main lexbuf} (* Alphabetic characters *) | ['a'-'z' 'A'-'Z']+ 1005 {let lxm = lexeme lexbuf in let lxm = check_case lxm in if !in_math then begin Dest.put_in_math lxm; end else 1010 Dest.put lxm ; main lexbuf} (* Numbers *) | ['0'-'9']+ {let lxm = lexeme lexbuf in 1015 Dest.put lxm; main lexbuf} (* Html specials *) | '~' {expand_command main skip_blanks "\\@hevea@tilde" lexbuf ; 1020 main lexbuf } (* Spanish stuff *) | '?' {expand_command main skip_blanks "\\@hevea@question" lexbuf ; main lexbuf} 1025 | '!' {expand_command main skip_blanks "\\@hevea@excl" lexbuf ; main lexbuf} (* One character *) | _ 1030 {let lxm = lexeme_char lexbuf 0 in let lxm = check_case_char lxm in Dest.put (Dest.iso lxm) ; main lexbuf} 1035 and gobble_one_char = parse | _ {()} | "" {fatal ("Gobble at end of file")} and complete_newline = parse 1040 | (' '* '\n')* {lexeme lexbuf} and latex2html_latexonly = parse | '%' + [ ' ' '\t' ] * "\\end{latexonly}" [ ^ '\n' ] * '\n' { () } 1045 | _ {latex2html_latexonly lexbuf} | eof {fatal "End of file in latex2html_latexonly"} 1050 and latexonly = parse '%'+ ' '* ("END"|"end") ' '+ ("LATEX"|"latex") [^'\n']* '\n' {stop_other_scan true main lexbuf} | '%'+ ' '* ("HEVEA"|"hevea") ' '* {latexonly lexbuf} 1055 | '%' {latex_comment lexbuf ; latexonly lexbuf} | "\\end" {let {arg=arg} = save_arg lexbuf in if arg = "latexonly" then begin 1060 top_close_block "" ; stop_other_scan false main lexbuf end else if arg = top stack_entry then begin let _ = pop stack_entry in push stack_out arg ; 1065 begin match Latexmacros.find (end_env arg) with _,(Subst body) -> scan_this_may_cont latexonly lexbuf (get_subst ()) (string_to_arg body) | _,_ -> 1070 raise (Misc.ScanError ("Bad closing macro in latexonly: ``"^arg^"''")) end end else latexonly lexbuf} | command_name | _ {latexonly lexbuf} 1075 | eof {if empty stack_lexbuf then () else begin let lexbuf = previous_lexbuf () in latexonly lexbuf 1080 end} and latex_comment = parse '\n' | eof {()} 1085 | [^'\n']+ {latex_comment lexbuf} and image = parse 1090 '%'+ ' '* ("END"|"end") ' '+ ("IMAGE"|"image") [^'\n']* '\n' {stop_other_scan true main lexbuf} | '%'+ ' '* ("HEVEA"|"hevea") ' '* {image lexbuf} | '%' 1095 {let lxm = lexeme lexbuf in Image.put lxm ; image_comment lexbuf ; image lexbuf} (* Substitution in image *) 1100 | '#' ['1'-'9'] {let lxm = lexeme lexbuf in let i = Char.code (lxm.[1]) - Char.code '1' in scan_arg (scan_this_arg image) i ; image lexbuf} 1105 | "\\end" {let lxm = lexeme lexbuf in Save.start_echo () ; let {arg=arg} = save_arg lexbuf in let true_arg = Save.get_echo () in 1110 if arg = "toimage" then begin top_close_block "" ; stop_other_scan false main lexbuf end else if arg = top stack_entry then begin let _ = pop stack_entry in 1115 push stack_out arg ; begin match Latexmacros.find (end_env arg) with _,(Subst body) -> scan_this_may_cont image lexbuf (get_subst ()) (string_to_arg body) 1120 | _,_ -> raise (Misc.ScanError ("Bad closing macro in image: ``"^arg^"''")) end end else begin Image.put lxm ; Image.put true_arg ; image lexbuf 1125 end} | command_name {let lxm = lexeme lexbuf in begin match lxm with (* Definitions of simple macros, bodies are not substituted *) 1130 | "\\def" | "\\gdef" -> Save.start_echo () ; skip_csname lexbuf ; skip_blanks lexbuf ; let _ = Save.defargs lexbuf in 1135 let _ = save_arg lexbuf in Image.put lxm ; let saved = Save.get_echo () in Image.put saved | "\\renewcommand" | "\\newcommand" | "\\providecommand" 1140 | "\\renewcommand*" | "\\newcommand*" | "\\providecommand*" -> Save.start_echo () ; let _ = save_arg lexbuf in let _ = save_opts ["0" ; ""] lexbuf in let _ = save_arg lexbuf in 1145 Image.put lxm ; let saved = Save.get_echo () in Image.put saved | "\\newenvironment" | "\\renewenvironment" | "\\newenvironment*" | "\\renewenvironment*" -> 1150 Save.start_echo () ; let _ = save_arg lexbuf in let _ = save_opts ["0" ; ""] lexbuf in let _ = save_arg lexbuf in let _ = save_arg lexbuf in 1155 Image.put lxm ; Image.put (Save.get_echo ()) | _ -> Image.put lxm end ; image lexbuf} | _ 1160 {let s = lexeme lexbuf in Image.put s ; image lexbuf} | eof {if empty stack_lexbuf then begin 1165 if not filter && top_lexstate () then raise (Misc.ScanError ("No \\end{document} found")) end else begin let lexbuf = previous_lexbuf () in image lexbuf 1170 end} and image_comment = parse '\n' {Image.put_char '\n'} 1175 | eof {()} | [^'\n']+ {let lxm = lexeme lexbuf in Image.put lxm ; image_comment lexbuf} 1180 and mbox_arg = parse | ' '+ | '\n' {mbox_arg lexbuf} | eof {if not (empty stack_lexbuf) then begin 1185 let lexbuf = previous_lexbuf () in if !verbose > 2 then begin prerr_endline "Poping lexbuf in mbox_arg" ; pretty_lexbuf lexbuf end ; 1190 mbox_arg lexbuf end else raise (Misc.ScanError "End of file in \\mbox argument")} | '{' | ("\\bgroup" ' '* '\n'? ' '*) {start_mbox ()} | "" 1195 {raise (Misc.ScanError "Cannot find a \\mbox argument here, use braces")} and no_skip = parse | "" {()} 1200 and skip_blanks_pop = parse ' '+ {skip_blanks_pop lexbuf} | '\n' {more_skip_pop lexbuf} | "" {()} | eof 1205 {if not (empty stack_lexbuf) then begin let lexbuf = previous_lexbuf () in if !verbose > 2 then begin prerr_endline "Poping lexbuf in skip_blanks" ; pretty_lexbuf lexbuf 1210 end ; skip_blanks_pop lexbuf end else ()} and more_skip_pop = parse 1215 '\n'+ {top_par (par_val !in_table)} | "" {skip_blanks_pop lexbuf} | eof {if not (empty stack_lexbuf) then begin let lexbuf = previous_lexbuf () in 1220 if !verbose > 2 then begin prerr_endline "Poping lexbuf in skip_blanks" ; pretty_lexbuf lexbuf end ; more_skip_pop lexbuf 1225 end else ()} and to_newline = parse | '\n' {()} | _ {Out.put_char more_buff (Lexing.lexeme_char lexbuf 0) ; 1230 to_newline lexbuf} | eof {if not (empty stack_lexbuf) then let lexbuf = previous_lexbuf () in to_newline lexbuf} 1235 and skip_blanks = parse ' '+ {skip_blanks lexbuf} | '\n' {more_skip lexbuf} | "" {()} 1240 and more_skip = parse '\n'+ {top_par (par_val !in_table)} | "" {skip_blanks lexbuf} 1245 and skip_spaces = parse ' ' * {()} | eof {()} 1250 and skip_false = parse | '%' {if is_plain '%' then skip_comment lexbuf ; skip_false lexbuf} | "\\ifthenelse" 1255 {skip_false lexbuf} | "\\if" ['a'-'z' 'A'-'Z''@']+ {if_level := !if_level + 1 ; skip_false lexbuf} | "\\else" ['a'-'z' 'A'-'Z''@']+ 1260 {skip_false lexbuf} | "\\else" {if !if_level = 0 then skip_blanks lexbuf else skip_false lexbuf} | "\\fi" ['a'-'z' 'A'-'Z']+ 1265 {skip_false lexbuf} | "\\fi" {if !if_level = 0 then begin skip_blanks lexbuf end else begin 1270 if_level := !if_level -1 ; skip_false lexbuf end} | _ {skip_false lexbuf} | "" {raise (Error "End of entry while skipping TeX conditional macro")} 1275 and comment = parse | ['%'' ']* ("BEGIN"|"begin") ' '+ ("IMAGE"|"image") {skip_comment lexbuf ; start_image_scan "" image lexbuf} (* Backward compatibility with latex2html *) 1280 | [ ' ' '\t' ] * "\\begin{latexonly}" {latex2html_latexonly lexbuf} | ['%'' ']* ("HEVEA"|"hevea") ' '* {()} | ['%'' ']* ("BEGIN"|"begin") ' '+ ("LATEX"|"latex") 1285 {skip_to_end_latex lexbuf} | "" {skip_comment lexbuf ; more_skip lexbuf} and skip_comment = parse 1290 | [^ '\n']* '\n' {if !verbose > 1 then prerr_endline ("Comment:"^lexeme lexbuf) ; if !flushing then Dest.flush_out () } | "" {raise (Misc.ScanError "Latex comment is not terminated")} 1295 and skip_to_end_latex = parse | '%' ['%'' ']* ("END"|"end") ' '+ ("LATEX"|"latex") {skip_comment lexbuf ; skip_spaces lexbuf} | _ 1300 {skip_to_end_latex lexbuf} | eof {fatal ("End of file in %BEGIN LATEX ... %END LATEX")} { let _ = () ;; 1305 (* A few subst definitions, with 2 optional arguments *) def "\\makebox" (latex_pat ["" ; ""] 3) (Subst "\\warning{makebox}\\mbox{#3}") ; def "\\framebox" (latex_pat ["" ; ""] 3) 1310 (Subst "\\warning{framebox}\\fbox{#3}") ;; let check_alltt_skip lexbuf = 1315 if not (effective !alltt) then skip_blanks lexbuf and skip_pop lexbuf = save_lexstate () ; skip_blanks_pop lexbuf ; 1320 restore_lexstate () ;; let def_code name f = def_init name f let def_name_code name f = def_init name (f name) 1325 ;; def_code "\\@hevea@percent" (fun lexbuf -> 1330 if effective !alltt || not (is_plain '%') then begin let lxm = lexeme lexbuf in Dest.put lxm ; main lexbuf end else begin 1335 comment lexbuf end) ;; def_code "\\@hevea@newline" 1340 (fun lexbuf -> let lxm = complete_newline lexbuf in let nlnum = count_newlines lxm in if !Lexstate.withinLispComment then begin 1345 if !verbose > 2 then prerr_endline "NL caught after LispComment" ; raise (Misc.EndOfLispComment nlnum) (* QNC *) end else begin if effective !alltt then begin Dest.put_char '\n' ; 1350 Dest.put lxm end else if nlnum >= 1 then expand_command main skip_blanks "\\par" lexbuf else Dest.put_separator () 1355 end) ;; let sub_sup lxm lexbuf = if effective !alltt || not (is_plain lxm) then Dest.put_char lxm 1360 else if not !in_math then begin warning ("``"^Char.escaped lxm^"''occuring outside math mode") ; Dest.put_char lxm end else begin let sup,sub = match lxm with 1365 '^' -> let sup = save_arg lexbuf in let sub = save_sub lexbuf in sup,unoption sub | '_' -> 1370 let sub = save_arg lexbuf in let sup = save_sup lexbuf in unoption sup,sub | _ -> assert false in Dest.standard_sup_sub (scan_this_arg main) (fun () -> ()) sup sub !display 1375 end ;; def_code "\\@hevea@underscore" (fun lexbuf -> sub_sup '_' lexbuf) ; def_code "\\@hevea@circ" (fun lexbuf -> sub_sup '^' lexbuf) 1380 ;; def_code "\\mathop" (fun lexbuf -> let symbol = save_arg lexbuf in 1385 let {limits=limits ; sup=sup ; sub=sub} = save_sup_sub lexbuf in begin match limits with | (Some Limits|None) when !display -> Dest.limit_sup_sub (scan_this_arg main) 1390 (fun _ -> scan_this_arg main symbol) sup sub !display | (Some IntLimits) when !display -> Dest.int_sup_sub true 3 (scan_this_arg main) (fun () -> scan_this_arg main symbol) 1395 sup sub !display | _ -> scan_this_arg main symbol ; Dest.standard_sup_sub (scan_this_arg main) 1400 (fun _ -> ()) sup sub !display end) ;; 1405 def_code "\\@hevea@obrace" (fun _ -> if !activebrace && is_plain '{' then top_open_group () else begin 1410 Dest.put_char '{' end) ; def_code "\\bgroup" (fun lexbuf -> 1415 top_open_group () ; check_alltt_skip lexbuf) ;; def_code "\\@hevea@cbrace" 1420 (fun _ -> if !activebrace && is_plain '}' then begin top_close_group () end else begin Dest.put_char '}' 1425 end) ; def_code "\\egroup" (fun lexbuf -> top_close_group () ; check_alltt_skip lexbuf) 1430 ;; def_code "\\@hevea@tilde" (fun lexbuf -> 1435 if effective !alltt || not (is_plain '~') then Dest.put_char '~' else Dest.put_nbsp ()) ;; 1440 def_code "\\@hevea@question" (fun lexbuf -> if if_next_char '`' lexbuf then begin gobble_one_char lexbuf ; if effective !alltt then Dest.put "?`" 1445 else Dest.put (Dest.iso '') end else Dest.put_char '?') ;; 1450 def_code "\\@hevea@excl" (fun lexbuf -> if if_next_char '`' lexbuf then begin gobble_one_char lexbuf ; if effective !alltt then Dest.put "!`" 1455 else Dest.put (Dest.iso '') end else Dest.put_char '!') ;; 1460 let get_this_main arg = get_this_string main arg let check_this_main s = if !verbose > 1 then prerr_endline ("check_this: ``"^s^"''"); 1465 start_normal (get_subst ()) ; let save_par = Dest.forget_par () in Dest.open_block "TEMP" ""; let r = try 1470 scan_this main s ; true with | x -> false in Dest.erase_block "TEMP" ; 1475 Dest.par save_par ; end_normal () ; if !verbose > 1 then prerr_endline ("check_this: ``"^s^"'' = "^sbool r); r 1480 let get_prim_onarg arg = let plain_sub = is_plain '_' and plain_sup = is_plain '^' and plain_dollar = is_plain '$' 1485 and plain_amper = is_plain '&' in unset_plain '_' ; unset_plain '^' ; unset_plain '$' ; unset_plain '&' ; let r = do_get_this start_normal end_normal Dest.nostyle 1490 main arg in plain_back plain_sub '_' ; plain_back plain_sup '^' ; plain_back plain_dollar '$' ; plain_back plain_amper '&' ; r 1495 let get_prim s = get_prim_onarg (string_to_arg s) let get_prim_arg lexbuf = let arg = save_arg lexbuf in get_prim_onarg arg 1500 and get_prim_opt def lexbuf = let arg = save_opt def lexbuf in get_prim_onarg arg 1505 let get_csname lexbuf = protect_save_string (fun lexbuf -> Save.csname lexbuf get_prim Subst.subst_this) lexbuf 1510 let def_fun name f = def_code name (fun lexbuf -> 1515 let arg = subst_arg lexbuf in scan_this main (f arg)) ;; (* Paragraphs *) 1520 let do_unskip () = let _ = Dest.forget_par () in Dest.unskip () ;; 1525 def_code "\\unskip" (fun lexbuf -> do_unskip () ; check_alltt_skip lexbuf) ;; 1530 def_code "\\par" (fun lexbuf -> match par_val !in_table with | None -> 1535 Dest.put_char ' ' ; check_alltt_skip lexbuf | pval -> top_par pval ; check_alltt_skip lexbuf) 1540 ;; (* Styles and packages *) let do_documentclass command lexbuf = 1545 Save.start_echo () ; let {arg=opt_arg} = save_opt "" lexbuf in let {arg=arg} = save_arg lexbuf in let real_args = Save.get_echo () in begin try if not !styleloaded then 1550 input_file 0 main (arg^".hva") with Myfiles.Except | Myfiles.Error _ -> raise (Misc.ScanError ("No base style")) end ; 1555 if command = "\\documentstyle" then begin let rec read_packages = function | [] -> () | pack :: rest -> scan_this main ("\\usepackage{"^pack^"}") ; 1560 read_packages rest in read_packages (Save.cite_arg (Lexing.from_string ("{"^opt_arg^"}"))) end ; Image.start () ; 1565 Image.put command ; Image.put real_args ; Image.put_char '\n' ; Dest.set_out (mk_out_file ()) ; Dest.stop () 1570 ;; def_name_code "\\documentstyle" do_documentclass ; def_name_code "\\documentclass" do_documentclass ;; 1575 let do_input lxm lexbuf = Save.start_echo () ; let arg = get_prim_arg lexbuf in 1580 let echo_arg = Save.get_echo () in if lxm <> "\\include" || check_include arg then begin let filename = if lxm = "\\bibliography" then Parse_opts.base_in^".bbl" else arg in 1585 begin try input_file !verbose main filename with Myfiles.Except -> Image.put lxm ; Image.put echo_arg ; 1590 Image.put "\n" ; | Myfiles.Error _ -> () end end ;; 1595 def_code "\\input" (do_input "\\input") ; def_code "\\include" (do_input "\\include") ; def_code "\\bibliography" (do_input "\\bibliography") ;; 1600 (* Command definitions *) let do_newcommand lxm lexbuf = Save.start_echo () ; 1605 let name = get_csname lexbuf in let nargs = save_opts ["0" ; ""] lexbuf in let body = subst_body lexbuf in let echo () = if echo_toimage () && lxm <> "\\@forcecommand" then begin 1610 Image.put lxm ; Image.put (Save.get_echo ()) ; Image.put_char '\n' end in let nargs,(def,defval) = match nargs with 1615 [a1 ; a2] -> Get.get_int (from_ok a1), (match a2 with | {arg=No s ; subst=env} -> false,mkarg s env | {arg=Yes s ; subst=env} -> true,mkarg s env) 1620 | _ -> assert false in let pat = latex_pat (if def then [do_subst_this defval] else []) nargs in match lxm with | "\\@forcecommand" -> Latexmacros.def name pat (Subst body) 1625 | "\\newcommand"|"\\newcommand*" -> echo () ; if Latexmacros.exists name then warning ("Ignoring (re-)definition of ``"^name^"'' by \\newcommand") else begin 1630 Latexmacros.def name pat (Subst body) end | "\\renewcommand"|"\\renewcommand*" -> if not (Latexmacros.exists name) then begin warning ("Defining ``"^name^"'' by \\renewcommand") 1635 end else echo () ; Latexmacros.def name pat (Subst body) | _ -> echo () ; 1640 if not (Latexmacros.exists name) then Latexmacros.def name pat (Subst body) ;; def_name_code "\\renewcommand" do_newcommand ; 1645 def_name_code "\\renewcommand*" do_newcommand ; def_name_code "\\newcommand" do_newcommand ; def_name_code "\\newcommand*" do_newcommand ; def_name_code "\\providecommand" do_newcommand ; def_name_code "\\providecommand*" do_newcommand ; 1650 def_name_code "\\@forcecommand" do_newcommand ;; def_name_code "\\newcolumntype" (fun lxm lexbuf -> 1655 Save.start_echo () ; let old_raw = !raw_chars in raw_chars := true ; let name = get_prim_arg lexbuf in raw_chars := old_raw ; 1660 let nargs = save_opt "0" lexbuf in let body = subst_body lexbuf in let rest = Save.get_echo () in if echo_toimage () then Image.put (lxm^rest^"\n") ; 1665 let col_cmd = Misc.column_to_command name in if Latexmacros.exists col_cmd then warning ("Not (re)-defining column type ``"^name^"'' with \\newcolumntype") else 1670 Latexmacros.def col_cmd (latex_pat [] (Get.get_int nargs)) (Subst body)) ;; 1675 let do_newenvironment lxm lexbuf = Save.start_echo () ; let name = get_prim_arg lexbuf in let nargs,optdef = match save_opts ["0" ; ""] lexbuf with 1680 | [x ; y ] -> x,y | _ -> assert false in let body1 = subst_body lexbuf in let body2 = subst_body lexbuf in if echo_toimage () then 1685 Image.put (lxm^Save.get_echo ()^"\n") ; let do_defs () = Latexmacros.def (start_env name) 1690 (latex_pat (match optdef with | {arg=No _} -> [] | {arg=Yes s ; subst=env} -> [do_subst_this (mkarg s env)]) (match nargs with 1695 | {arg=No _} -> 0 | {arg=Yes s ; subst=env} -> Get.get_int (mkarg s env))) (Subst body1) ; Latexmacros.def (end_env name) zero_pat (Subst body2) in 1700 if lxm = "\\newenvironment" || lxm = "\\newenvironment*" then if Latexmacros.exists (start_env name) || Latexmacros.exists (start_env name) then 1705 warning ("Not (re)-defining environment ``"^name^"'' with "^lxm) else do_defs () else begin 1710 if not (Latexmacros.exists (start_env name) && Latexmacros.exists (start_env name)) then warning 1715 ("Defining environment ``"^name^"'' with "^lxm) ; do_defs () end ;; 1720 def_name_code "\\newenvironment" do_newenvironment ; def_name_code "\\newenvironment*" do_newenvironment ; def_name_code "\\renewenvironment" do_newenvironment ; def_name_code "\\renewenvironment*" do_newenvironment ;; 1725 let do_newcounter name within = try Counter.def_counter name within ; Latexmacros.global_def 1730 ("\\the"^name) zero_pat (Subst ("\\arabic{"^name^"}")) with | Failed -> () let do_newtheorem lxm lexbuf = 1735 Save.start_echo () ; let name = get_prim_arg lexbuf in let numbered_like = match save_opts [""] lexbuf with | [x] -> x | _ -> assert false in 1740 let caption = subst_arg lexbuf in let within = match save_opts [""] lexbuf with | [x] -> x | _ -> assert false in if echo_global_toimage () then 1745 Image.put (lxm^Save.get_echo ()^"\n") ; let cname = match numbered_like,within with {arg=No _},{arg=No _} -> do_newcounter name "" ; name | _,{arg=Yes _} -> 1750 let within = get_prim_onarg (from_ok within) in do_newcounter name within ; name | {arg=Yes _},_ -> get_prim_onarg (from_ok numbered_like) in Latexmacros.global_def 1755 (start_env name) (latex_pat [""] 1) (Subst ("\\begin{flushleft}\\refstepcounter{"^cname^"}{\\bf "^caption^"~"^ "\\the"^cname^"}\\quad\\ifoptarg{\\purple[#1]\\quad}\\fi\\em")) ; Latexmacros.global_def 1760 (end_env name) zero_pat (Subst "\\end{flushleft}") ;; def_name_code "\\newtheorem" do_newtheorem ; 1765 def_name_code "\\renewtheorem" do_newtheorem ;; (* Command definitions, TeX style *) 1770 let do_def global lxm lexbuf = Save.start_echo () ; let name = get_csname lexbuf in Save.skip_blanks_init lexbuf ; let name,args_pat,body = 1775 if top_level () then let args_pat = Save.defargs lexbuf in let {arg=body} = save_arg lexbuf in name,args_pat,body else 1780 let args_pat = Save.defargs (Lexing.from_string (subst_this (Save.get_defargs lexbuf))) in let body = subst_body lexbuf in 1785 name,args_pat,body in let real_args = Save.get_echo () in if echo_toimage () || (global && echo_global_toimage ()) then begin Image.put (lxm^real_args) ; Image.put_char '\n' 1790 end ; (if global then global_def else def) name ([],args_pat) (Subst body) ;; 1795 def_name_code "\\def" (do_def false) ; def_name_code "\\gdef" (do_def true) ;; let do_let global lxm lexbuf = 1800 Save.start_echo () ; let name = get_csname lexbuf in Save.skip_equal lexbuf ; let alt = get_csname lexbuf in let real_args = Save.get_echo () in 1805 try let nargs,body = Latexmacros.find_fail alt in (if global then global_def else def) name nargs body ; if echo_toimage () || (global && echo_global_toimage ()) then begin 1810 Image.put lxm ; Image.put real_args ; Image.put "\n" end with 1815 | Failed -> warning ("Not binding "^name^" with "^lxm^", command "^alt^" does not exist") ;; def_name_code "\\let" (do_let false) ; 1820 ;; let do_global lxm lexbuf = let next = subst_arg lexbuf in begin match next with 1825 | "\\def" -> do_def true (lxm^next) lexbuf | "\\let" -> do_let true (lxm^next) lexbuf | _ -> warning "Ignored \\global" end ;; 1830 def_name_code "\\global" do_global ;; 1835 (* TeXisms *) def_code "\\noexpand" (fun lexbuf -> let arg = subst_arg lexbuf in 1840 Dest.put arg) ;; def_code "\\execafter" (fun lexbuf -> 1845 let arg = save_arg lexbuf in let next_arg = save_arg lexbuf in let cur_subst = get_subst () in scan_this_may_cont main lexbuf cur_subst next_arg ; scan_this_may_cont main lexbuf cur_subst arg) 1850 ;; def_code "\\csname" (fun lexbuf -> 1855 skip_blanks lexbuf ; let name = "\\"^get_prim (Save.incsname lexbuf) in check_alltt_skip lexbuf ; expand_command main skip_blanks name lexbuf) ;; 1860 def_code "\\string" (fun lexbuf -> let arg = subst_arg lexbuf in Dest.put arg) 1865 ;; let get_num_arg lexbuf = Save.num_arg lexbuf (fun s -> Get.get_int (string_to_arg s)) ;; 1870 let top_plain c = if not (is_plain c) then begin set_plain c ; 1875 fun_register (fun () -> unset_plain c) end and top_unplain c = if is_plain c then begin 1880 unset_plain c ; fun_register (fun () -> set_plain c) end ;; 1885 def_code "\\catcode" (fun lexbuf -> let char = Char.chr (Get.get_int (save_arg_with_delim "=" lexbuf)) in let code = get_num_arg lexbuf in 1890 begin match char,code with | ('\\',0) | ('{',1) | ('}',2) | ('$',3) | ('&' ,4) | ('#',6) | ('^',7) | ('_',8) | ('~',13) | ('%',14) -> top_plain char | ('{',(11|12)) | ('}',(11|12)) | ('$',(11|12)) | ('&' ,(11|12)) | 1895 ('#',(11|12)) | ('^',(11|12)) | ('_',(11|12)) | ('~',(11|12)) | ('%',(11|12)) | ('\\',(11|12)) -> top_unplain char | _ -> warning "This \\catcode operation is not permitted" end ; 1900 main lexbuf) ;; def_code "\\chardef" (fun lexbuf -> 1905 let csname = get_csname lexbuf in Save.skip_equal lexbuf ; let i = get_num_arg lexbuf in Latexmacros.def csname zero_pat (Subst (string_of_int i))) ;; 1910 (* Complicated use of output blocks *) def_code "\\left" (fun lexbuf -> let dprev = !display in 1915 Stack.push stack_display dprev ; display := true ; if not dprev then top_open_display () ; let delim = subst_arg lexbuf in 1920 let {sub=sub ; sup=sup} = save_sup_sub lexbuf in Dest.left delim (fun vsize -> Dest.int_sup_sub false vsize (scan_this_arg main) (fun () -> ()) sup sub true)) 1925 ;; (* Display is true *) def_code "\\right" (fun lexbuf -> 1930 let delim = subst_arg lexbuf in let vsize = Dest.right delim in let {sup=sup ; sub=sub} = save_sup_sub lexbuf in let do_what = (fun () -> ()) in Dest.int_sup_sub false vsize 1935 (scan_this_arg main) do_what sup sub !display ; let dprev = Stack.pop stack_display in if not dprev then top_close_display () ; display := dprev) ;; 1940 def_code "\\over" (fun lexbuf -> Dest.over !display lexbuf; skip_blanks lexbuf) 1945 ;; let check_not = function | "\\in" -> "\\notin" | "=" -> "\\neq" 1950 | "\\subset" -> "\\notsubset" | s -> "\\neg\\:"^s ;; def_fun "\\not" check_not 1955 ;; def_code "\\uppercase" (fun lexbuf -> let arg = save_arg lexbuf in 1960 let old_case = !case in case := Upper ; scan_this_arg main arg ; case := old_case) ; def_code "\\lowercase" 1965 (fun lexbuf -> let arg = save_arg lexbuf in let old_case = !case in case := Lower ; scan_this_arg main arg ; 1970 case := old_case) ;; (* list items *) def_code "\\@li" (fun _ -> Dest.item ()) ; 1975 def_code "\\@linum" (fun _ -> Dest.nitem ()) ; def_code "\\@dt" (fun lexbuf -> let arg = subst_arg lexbuf in Dest.ditem (scan_this main) arg ; 1980 check_alltt_skip lexbuf) ;; (* Html primitives *) 1985 def_code "\\@open" (fun lexbuf -> let tag = get_prim_arg lexbuf in let arg = get_prim_arg lexbuf in top_open_block tag arg) 1990 ;; def_code "\\@insert" (fun lexbuf -> let tag = get_prim_arg lexbuf in 1995 let arg = get_prim_arg lexbuf in Dest.insert_block tag arg ) ;; def_code "\\@close" 2000 (fun lexbuf -> let tag = get_prim_arg lexbuf in top_close_block tag) ;; 2005 def_code "\\@print" (fun lexbuf -> let {arg=arg} = save_arg lexbuf in Dest.put arg) ; ;; 2010 def_code "\\@printnostyle" (fun lexbuf -> let {arg=arg} = save_arg lexbuf in top_open_group () ; 2015 Dest.nostyle () ; Dest.put arg ; top_close_group ()) ;; 2020 def_code "\\@getprintnostyle" (fun lexbuf -> top_open_group () ; Dest.nostyle () ; let arg = get_prim_arg lexbuf in 2025 Dest.put arg ; top_close_group ()) ;; def_code "\\@getprint" 2030 (fun lexbuf -> let arg = get_prim_arg lexbuf in let buff = Lexing.from_string arg in Dest.put (Save.tagout buff)) ; ;; 2035 def_code "\\@subst" (fun lexbuf -> let arg = subst_arg lexbuf in Dest.put arg) 2040 ;; def_code "\\@notags" (fun lexbuf -> let arg = save_arg lexbuf in 2045 let arg = get_this_arg main arg in let r = let buff = Lexing.from_string arg in Save.tagout buff in Dest.put r) 2050 ;; def_code "\\@anti" (fun lexbuf -> let arg = save_arg lexbuf in let envs = get_style main arg in 2055 if !verbose > 2 then begin prerr_string ("Anti result: ") ; List.iter (fun s -> prerr_string (Element.pretty_text s^", ")) envs ; 2060 prerr_endline "" end ; Dest.erase_mods envs) ;; def_code "\\@style" 2065 (fun lexbuf -> let arg = get_prim_arg lexbuf in Dest.open_mod (Style arg) ) ;; def_code "\\@fontcolor" 2070 (fun lexbuf -> let arg = get_prim_arg lexbuf in Dest.open_mod (Color arg)) ;; def_code "\\@fontsize" 2075 (fun lexbuf -> let arg = save_arg lexbuf in Dest.open_mod (Font (Get.get_int arg)) ) ;; def_code "\\@nostyle" 2080 (fun lexbuf -> Dest.nostyle () ; check_alltt_skip lexbuf) ;; def_code "\\@clearstyle" (fun lexbuf -> Dest.clearstyle () ; check_alltt_skip lexbuf) ;; 2085 def_code "\\@incsize" (fun lexbuf -> let arg = save_arg lexbuf in inc_size (Get.get_int arg) ) ;; 2090 def_code "\\htmlcolor" (fun lexbuf -> let arg = get_prim_arg lexbuf in Dest.open_mod (Color ("\"#"^arg^"\"")) ) ;; 2095 def_code "\\usecounter" (fun lexbuf -> let arg = get_prim_arg lexbuf in Counter.set_counter arg 0 ; 2100 scan_this main ("\\let\\@currentlabel\\the"^arg) ; Dest.set_dcount arg ) ;; def_code "\\@fromlib" (fun lexbuf -> 2105 let arg = get_prim_arg lexbuf in start_lexstate (); Mysys.put_from_file (Filename.concat Mylib.libdir arg) Dest.put; restore_lexstate ()) ;; 2110 def_code "\\@imageflush" (fun lexbuf -> iput_newpage () ; check_alltt_skip lexbuf) ;; 2115 def_code "\\textalltt" (fun lexbuf -> let opt = get_prim_opt "CODE" lexbuf in let arg = save_arg lexbuf in let old = !alltt in 2120 scan_this main "\\mbox{" ; alltt := Inside ; Dest.open_group opt ; scan_this_arg main arg ; Dest.close_group () ; 2125 scan_this main "}" ; alltt := old ) ;; def_code "\\@itemdisplay" (fun lexbuf -> Dest.force_item_display ()) 2130 ;; def_code "\\@br" (fun lexbuf -> Dest.skip_line ()) ;; 2135 (* TeX conditionals *) let testif cell lexbuf = if !cell then check_alltt_skip lexbuf else skip_false lexbuf 2140 let setif cell b lexbuf = let old = !cell in fun_register (fun () -> cell := old) ; cell := b ; 2145 check_alltt_skip lexbuf ;; let extract_if name = let l = String.length name in 2150 if l <= 3 || String.sub name 0 3 <> "\\if" then raise (Error ("Bad newif: "^name)) ; String.sub name 3 (l-3) ;; 2155 let def_and_register name f = def name zero_pat (CamlCode f) ;; let tverb name cell lexbuf = 2160 if !verbose > 1 then Printf.fprintf stderr "Testing %s -> %b\n" name !cell ; testif cell lexbuf ;; 2165 let newif_ref name cell = def_and_register ("\\if"^name) (tverb name cell) ; def_and_register ("\\"^name^"true") (setif cell true) ; def_and_register ("\\"^name^"false") (setif cell false) ; 2170 register_cell name cell ; fun_register (fun () -> unregister_cell name) ;; let newif lexbuf = 2175 let arg = get_csname lexbuf in let saw_par = !Save.seen_par in begin try let name = extract_if arg in let cell = ref false in 2180 newif_ref name cell ; with Latexmacros.Failed -> () end ; if saw_par then begin top_par (par_val !in_table) 2185 end ;; exception FailedFirst ;; 2190 def_code "\\ifx" (fun lexbuf -> let arg1 = get_csname lexbuf in let arg2 = get_csname lexbuf in 2195 let r = try let m1 = try Latexmacros.find_fail arg1 with | Failed -> raise FailedFirst in 2200 let m2 = Latexmacros.find_fail arg2 in m1 = m2 with | FailedFirst -> begin 2205 try let _ = Latexmacros.find_fail arg2 in false with Failed -> true end | Failed -> false in if r then 2210 check_alltt_skip lexbuf else skip_false lexbuf) ;; def_code "\\ifu" 2215 (fun lexbuf -> let arg1 = get_csname lexbuf in try let _ = Latexmacros.find_fail arg1 in skip_false lexbuf 2220 with | Failed -> check_alltt_skip lexbuf) ;; def_code "\\newif" newif 2225 ;; def_code "\\else" (fun lexbuf -> skip_false lexbuf) ;; 2230 def_code "\\fi" (fun lexbuf -> check_alltt_skip lexbuf) ;; let sawdocument = ref false 2235 ;; newif_ref "symb" symbols ; newif_ref "iso" iso ; newif_ref "raw" raw_chars ; 2240 newif_ref "silent" silent; newif_ref "math" in_math ; newif_ref "mmode" in_math ; newif_ref "display" display ; newif_ref "french" french ; 2245 newif_ref "html" html; newif_ref "text" text; newif_ref "info" text; newif_ref "mathml" Parse_opts.mathml; newif_ref "entities" Parse_opts.entities; 2250 newif_ref "optarg" optarg; newif_ref "styleloaded" styleloaded; newif_ref "activebrace" activebrace; newif_ref "pedantic" pedantic ; newif_ref "fixpoint" fixpoint ; 2255 newif_ref "alltt@loaded" alltt_loaded ; newif_ref "filter" (ref filter) ; newif_ref "@sawdocument" sawdocument ; def_code "\\iftrue" (testif (ref true)) ; def_code "\\iffalse" (testif (ref false)) 2260 ;; def_code "\\if@toplevel" (fun lexbuf -> if echo_global_toimage () then check_alltt_skip lexbuf 2265 else skip_false lexbuf) ;; 2270 (* Bibliographies *) let bib_ref s1 s2 = scan_this main ("\\@bibref{"^s1^"}{"^s2^"}") ;; 2275 def_code "\\cite" (fun lexbuf -> let opt = save_opt "" lexbuf in check_alltt_skip lexbuf ; let args = List.map subst_this (Save.cite_arg lexbuf) in 2280 Dest.put_char '[' ; Dest.open_group "CITE" ; let rec do_rec = function [] -> () | [x] -> bib_ref x (Auxx.bget true x) 2285 | x::rest -> bib_ref x (Auxx.bget true x) ; Dest.put ", " ; do_rec rest in do_rec args ; 2290 if opt.arg <> "" then begin Dest.put ", " ; scan_this_arg main opt ; end ; Dest.close_group () ; 2295 Dest.put_char ']' ) ;; (* Includes *) def_code "\\includeonly" 2300 (fun lexbuf -> let arg = Save.cite_arg lexbuf in add_includes arg ) ;; 2305 (* Foot notes *) def_code "\\@stepanchor" (fun lexbuf -> let mark = Get.get_int (save_arg lexbuf) in 2310 Foot.step_anchor mark) ; def_code "\\@anchorval" (fun lexbuf -> let mark = Get.get_int (save_arg lexbuf) in Dest.put (string_of_int (Foot.get_anchor mark))) 2315 ;; def_code "\\@footnotetext" (fun lexbuf -> start_lexstate () ; 2320 let mark = Get.get_int (save_arg lexbuf) in let text = save_arg lexbuf in let text = do_get_this start_normal end_normal Dest.clearstyle 2325 main text in Foot.register mark (get_this_string main ("\\@fnmarknote{"^string_of_int mark^"}")) text ; 2330 restore_lexstate ()) ;; def_code "\\@footnoteflush" (fun lexbuf -> 2335 let sec_here = get_prim_arg lexbuf and sec_notes = get_prim "\\@footnotelevel" in start_lexstate () ; Foot.flush (scan_this main) sec_notes sec_here ; restore_lexstate ()) 2340 ;; (* Opening and closing environments *) 2345 def_code "\\begin" (fun lexbuf -> let cur_subst = get_subst () in let env = get_prim_arg lexbuf in new_env env ; 2350 top_open_block "" "" ; let macro = start_env env in let old_envi = save stack_entry in push stack_entry env ; begin try 2355 expand_command main no_skip macro lexbuf with | e -> restore stack_entry old_envi ; raise e 2360 end ; restore stack_entry old_envi) ;; 2365 def_code "\\@begin" (fun lexbuf -> let env = get_prim_arg lexbuf in new_env env ; top_open_block "" "") 2370 ;; def_code "\\end" (fun lexbuf -> let env = get_prim_arg lexbuf in 2375 expand_command main no_skip ("\\end"^env) lexbuf ; close_env env ; top_close_block "") ;; 2380 def_code "\\@raise@enddocument" (fun _ -> if not !sawdocument then fatal ("\\end{document} with no \\begin{document}") else if not (Stack.empty stack_env) then 2385 error_env "document" !cur_env else raise Misc.EndDocument) ;; 2390 def_code "\\@end" (fun lexbuf -> let env = get_prim_arg lexbuf in top_close_block "" ; close_env env) 2395 ;; let little_more lexbuf = to_newline lexbuf ; Out.to_string more_buff 2400 ;; def_code "\\endinput" (fun lexbuf -> let reste = little_more lexbuf in scan_this main reste ; 2405 raise Misc.EndInput) ;; (* Boxes *) 2410 def_code "\\mbox" (fun lexbuf -> mbox_arg lexbuf) ;; 2415 def_code "\\newsavebox" (fun lexbuf -> let name = get_csname lexbuf in try let _ = find_fail name in 2420 warning ("Not (re-)defining ``"^name^"'' with \\newsavebox") with | Failed -> global_def name zero_pat (CamlCode (fun _ -> ()))) ;; 2425 def_code "\\providesavebox" (fun lexbuf -> let name = get_csname lexbuf in try 2430 let _ = find_fail name in () with | Failed -> global_def name zero_pat (CamlCode (fun _ -> ()))) ;; 2435 let caml_print s = CamlCode (fun _ -> Dest.put s) let do_sbox global name body = if not (Latexmacros.exists name) then 2440 warning ("\\sbox on undefined bin ``"^name^"''") ; start_mbox () ; let to_print = get_this_arg main body in top_close_group () ; (if global then global_def else def) name zero_pat (caml_print to_print) 2445 ;; def_code "\\savebox" (fun lexbuf -> let name = get_csname lexbuf in 2450 warning "savebox"; skip_opt lexbuf ; skip_opt lexbuf ; let body = save_arg lexbuf in do_sbox false name body) 2455 ;; def_code "\\sbox" (fun lexbuf -> let name = get_csname lexbuf in 2460 let body = save_arg lexbuf in do_sbox false name body) ; def_code "\\gsbox" (fun lexbuf -> 2465 let name = get_csname lexbuf in let body = save_arg lexbuf in do_sbox true name body) ; ;; 2470 def_code "\\usebox" (fun lexbuf -> let name = get_csname lexbuf in top_open_group () ; Dest.nostyle () ; 2475 expand_command main skip_blanks name lexbuf ; top_close_group ()) ;; def_code "\\lrbox" 2480 (fun lexbuf -> close_env "lrbox" ; push stack_display !display ; display := false ; let name = get_csname lexbuf in 2485 Dest.open_aftergroup (fun s -> def name zero_pat (caml_print s) ; "") ; start_mbox ()) 2490 ;; def_code "\\endlrbox" (fun _ -> top_close_group () ; (* close mbox *) 2495 Dest.close_group () ; (* close after group *) display := pop stack_display ; new_env "lrbox") ;; 2500 (* chars *) def_code "\\char" (fun lexbuf -> let arg = get_num_arg lexbuf in 2505 if not !silent && (arg < 32 || (arg > 127 && arg < 161)) then begin Location.print_pos () ; prerr_endline ("Warning: \\char, check output"); end ; Dest.put (Dest.iso (Char.chr arg)) ; 2510 if not (effective !alltt) then check_alltt_skip lexbuf) ;; def_code "\\symbol" (fun lexbuf -> 2515 let arg = get_prim_arg lexbuf in scan_this main ("\\char"^arg)) ;; (* labels *) 2520 (* Counters *) let alpha_of_int i = String.make 1 (Char.chr (i-1+Char.code 'a')) and upalpha_of_int i = String.make 1 (Char.chr (i-1+Char.code 'A')) ;; 2525 let rec roman_of_int = function 0 -> "" | 1 -> "i" | 2 -> "ii" 2530 | 3 -> "iii" | 4 -> "iv" | 9 -> "ix" | i -> if i < 9 then "v"^roman_of_int (i-5) 2535 else let d = i / 10 and u = i mod 10 in String.make d 'x'^roman_of_int u ;; 2540 let uproman_of_int i = String.uppercase (roman_of_int i) ;; let fnsymbol_of_int = function 0 -> " " 2545 | 1 -> "*" | 2 -> "#" | 3 -> "%" | 4 -> "\167" | 5 -> "\182" 2550 | 6 -> "||" | 7 -> "**" | 8 -> "##" | 9 -> "%%" | i -> alpha_of_int (i-9) 2555 ;; let def_printcount name f = def_code name (fun lexbuf -> 2560 let cname = get_prim_arg lexbuf in let cval = Counter.value_counter cname in Dest.put (f cval)) ;; 2565 def_printcount "\\arabic" string_of_int ; def_printcount "\\alph" alpha_of_int ; def_printcount "\\Alph" upalpha_of_int ; def_printcount "\\roman" roman_of_int; def_printcount "\\Roman" uproman_of_int; 2570 def_printcount "\\fnsymbol" fnsymbol_of_int ;; let pad p l s = for i = l-String.length s downto 1 do 2575 Dest.put (Dest.iso_string p) done ;; def_code "\\@pad" 2580 (fun lexbuf -> let p = get_prim_arg lexbuf in let l = Get.get_int (save_arg lexbuf) in let arg = get_prim_arg lexbuf in pad p l arg ; 2585 Dest.put (Dest.iso_string arg)) ;; def_code "\\newcounter" (fun lexbuf -> 2590 Save.start_echo () ; let name = get_prim_arg lexbuf in let within = get_prim_opt "" lexbuf in let real_args = Save.get_echo () in if echo_global_toimage () then begin 2595 Image.put "\\newcounter" ; Image.put real_args ; Image.put_char '\n' end ; do_newcounter name within) 2600 ;; def_code "\\addtocounter" (fun lexbuf -> Save.start_echo () ; 2605 let name = get_prim_arg lexbuf in let arg = save_arg lexbuf in let real_args = Save.get_echo () in if echo_global_toimage () then begin Image.put "\\addtocounter" ; 2610 Image.put real_args ; Image.put_char '\n' end ; Counter.add_counter name (Get.get_int arg)) ;; 2615 def_code "\\setcounter" (fun lexbuf -> Save.start_echo () ; let name = get_prim_arg lexbuf in 2620 let arg = save_arg lexbuf in let real_args = Save.get_echo () in if echo_global_toimage () then begin Image.put "\\setcounter" ; Image.put real_args ; 2625 Image.put_char '\n' end ; Counter.set_counter name (Get.get_int arg) ) ;; 2630 def_code "\\stepcounter" (fun lexbuf -> Save.start_echo () ; let name = get_prim_arg lexbuf in let real_args = Save.get_echo () in 2635 if echo_global_toimage () then begin Image.put "\\stepcounter" ; Image.put real_args ; Image.put_char '\n' end ; 2640 Counter.step_counter name) ;; (* terminal output *) def_code "\\typeout" 2645 (fun lexbuf -> let what = get_prim_arg lexbuf in prerr_endline what ) ;; 2650 def_code "\\warning" (fun lexbuf -> let what = subst_arg lexbuf in warning what ) ;; 2655 (* spacing *) let stack_closed = Stack.create "stack_closed" ;; 2660 def_code "\\@saveclosed" (fun lexbuf -> push stack_closed (Dest.get_last_closed ()) ; check_alltt_skip lexbuf) 2665 ;; def_code "\\@restoreclosed" (fun lexbuf -> Dest.set_last_closed (pop stack_closed) ; 2670 check_alltt_skip lexbuf) ;; exception Cannot ;; 2675 def_code "\\@getlength" (fun lexbuf -> let arg = get_prim_arg lexbuf in let pxls = 2680 match Get.get_length arg with | Length.Pixel n -> n | Length.Char n -> Length.char_to_pixel n | _ -> 0 in Dest.put (string_of_int (pxls/2))) 2685 ;; let do_space vert lexbuf = let arg = subst_arg lexbuf in begin try 2690 let n = match Length.main (Lexing.from_string arg) with | Length.Char n -> n | Length.Pixel n -> Length.pixel_to_char n | _ -> raise Cannot in if vert then 2695 for i=1 to n do Dest.skip_line () done else for i=1 to n do 2700 Dest.put_nbsp (); (* "&nbsp;"*) done with Cannot -> warning ((if vert then "\\vspace" else "\\hspace")^ " with arg ``"^arg^"''") 2705 end ;; def_code "\\hspace" (fun lexbuf -> do_space false lexbuf) ; def_code "\\vspace" (fun lexbuf -> do_space true lexbuf) 2710 ;; (* Explicit groups *) def_code "\\begingroup" (fun lexbuf -> 2715 new_env "command-group" ; top_open_block "" "" ; check_alltt_skip lexbuf) ;; def_code "\\endgroup" 2720 (fun lexbuf -> top_close_block "" ; close_env !cur_env ; check_alltt_skip lexbuf) ;; 2725 (* alltt *) register_init "alltt" (fun () -> def_code "\\alltt" 2730 (fun _ -> if !verbose > 1 then prerr_endline "begin alltt" ; alltt := Inside ; fun_register (fun () -> alltt := Not) ; Dest.close_block "" ; Dest.open_block "PRE" "") ; 2735 def_code "\\endalltt" (fun _ -> if !verbose > 1 then prerr_endline "end alltt" ; Dest.close_block "PRE" ; Dest.open_block "" "")) 2740 ;; (* Multicolumn *) def_code "\\multicolumn" 2745 (fun lexbuf -> if not (is_table !in_table) then raise (ScanError "\\multicolumn should occur in some array") ; let n = Get.get_int (save_arg lexbuf) in let format = Tabular.main (save_arg lexbuf) in 2750 do_multi n format main) ;; def_code "\\hline" (fun lexbuf -> 2755 if not (is_table !in_table) then raise (ScanError "\\hline should occur in some array") ; do_hline main ; skip_blanks_pop lexbuf ; let _ = Dest.forget_par () in 2760 ()) ;; (* inside tabbing *) let do_tabul lexbuf = 2765 if is_tabbing !in_table then begin do_unskip () ; Dest.close_cell ""; Dest.open_cell default_format 1 0 end ; skip_blanks_pop lexbuf 2770 ;; def_code "\\>" do_tabul ; def_code "\\=" do_tabul ;; 2775 def_code "\\kill" (fun lexbuf -> if is_tabbing !in_table then begin do_unskip () ; 2780 Dest.close_cell ""; Dest.erase_row () ; Dest.new_row () ; Dest.open_cell default_format 1 0 end ; 2785 skip_blanks_pop lexbuf) ;; (* Tabular and arrays *) 2790 let check_width = function | Length.Char x -> " WIDTH="^string_of_int (Length.char_to_pixel x) 2795 | Length.Pixel x -> " WIDTH="^string_of_int x | Length.Percent x -> " WIDTH=\""^string_of_int x^"%\"" | _ -> "" 2800 ;; let get_table_attributes border len = let attrs = get_prim (if border then 2805 "\\@table@attributes@border" else "\\@table@attributes") in attrs^check_width len 2810 let open_tabbing lexbuf = let lexbuf = Lexstate.previous_lexbuf in let lexfun lb = Dest.open_table false "border=0 cellspacing=0 cellpadding=0" ; 2815 Dest.new_row (); Dest.open_cell default_format 1 0 in push stack_table !in_table ; in_table := Tabbing ; new_env "tabbing" ; 2820 def "\\a" zero_pat (CamlCode (fun lexbuf -> let acc = subst_arg lexbuf in let arg = subst_arg lexbuf in 2825 scan_this main ("\\"^acc^arg))) ; lexfun lexbuf ;; def_code "\\tabbing" open_tabbing 2830 ;; let close_tabbing _ = Dest.do_close_cell (); Dest.close_row (); 2835 Dest.close_table (); in_table := pop stack_table ; close_env "tabbing" ; ;; 2840 def_code "\\endtabbing" close_tabbing ;; let open_array env lexbuf = save_array_state (); 2845 Tabular.border := false ; let len = match env with | "tabular*"|"Tabular*" -> let arg = save_arg lexbuf in begin match Get.get_length (get_prim_onarg arg) with 2850 | Length.No s -> warning ("``tabular*'' with length argument: "^ do_subst_this arg) ; Length.Default | width -> width 2855 end | _ -> Length.Default in let attributes = match env with | "Tabular*" | "Array" | "Tabular" -> get_prim_opt "" lexbuf | _ -> skip_opt lexbuf ; "" in 2860 skip_opt lexbuf ; let format = save_arg lexbuf in let format = Tabular.main format in cur_format := format ; push stack_in_math !in_math ; 2865 in_table := Table {math = (env = "array") ; border = !Tabular.border} ; if !display then Dest.item_display () ; in_math := false ; 2870 push stack_display !display ; display := false ; begin match attributes with | "" -> if !Tabular.border then 2875 Dest.open_table true (get_table_attributes true len) else Dest.open_table false (get_table_attributes false len); | _ -> Dest.open_table !Tabular.border (attributes^check_width len) 2880 end ; open_row() ; open_first_col main ; skip_blanks_pop lexbuf ; ;; 2885 def_code "\\@array" (open_array "array") ; def_code "\\@tabular" (open_array "tabular") ; def_code "\\@tabular*" (open_array "tabular*") ;; 2890 def_code "\\@Array" (open_array "Array") ; def_code "\\@Tabular" (open_array "Tabular") ; def_code "\\@Tabular*" (open_array "Tabular*") ;; 2895 let close_array _ = do_unskip () ; close_last_col main "" ; close_last_row () ; 2900 Dest.close_table () ; restore_array_state () ; in_math := pop stack_in_math ; display := pop stack_display; if !display then Dest.item_display () ; 2905 ;; def_code "\\end@array" close_array ; def_code "\\end@tabular" close_array ; def_code "\\end@tabular*" close_array ; 2910 def_code "\\end@Array" close_array ; def_code "\\end@Tabular" close_array ; def_code "\\end@Tabular*" close_array ; ;; 2915 let do_amper lexbuf = if effective !alltt || not (is_plain '&') then begin let lxm = lexeme lexbuf in for i = 0 to String.length lxm -1 do 2920 Dest.put (Dest.iso lxm.[i]) done end else if is_table !in_table then begin close_col main "&nbsp;"; open_col main 2925 end ; if not (effective !alltt) && is_plain '&' then skip_blanks_pop lexbuf and do_bsbs lexbuf = do_unskip () ; 2930 skip_opt lexbuf ; if is_table !in_table then begin close_col main "&nbsp;" ; close_row () ; open_row () ; open_first_col main end else if is_tabbing !in_table then begin 2935 Dest.close_cell ""; Dest.close_row () ; Dest.new_row () ; Dest.open_cell default_format 1 0 end else begin 2940 if !display then warning "\\\\ in display mode, ignored" else Dest.skip_line () end ; 2945 skip_blanks_pop lexbuf ; let _ = Dest.forget_par () in () ;; def_code "\\@hevea@amper" do_amper ; 2950 def_code "\\\\" do_bsbs ; def_code "\\@HEVEA@amper" do_amper ; def_code "\\@HEVEA@bsbs" do_bsbs ; () ;; 2955 (* Other scanners *) def_code "\\latexonly" (fun lexbuf -> 2960 start_other_scan "latexonly" latexonly lexbuf) ;; def_code "\\toimage" (fun lexbuf -> 2965 start_image_scan "" image lexbuf) ;; def_code "\\@stopimage" (fun lexbuf -> 2970 Image.stop () ; check_alltt_skip lexbuf) ;; def_code "\\@restartimage" 2975 (fun lexbuf -> Image.restart () ; check_alltt_skip lexbuf) ;; 2980 def_code "\\@stopoutput" (fun lexbuf -> Dest.stop () ; 2985 check_alltt_skip lexbuf) ;; def_code "\\@restartoutput" (fun lexbuf -> 2990 Dest.restart () ; check_alltt_skip lexbuf) ;; 2995 (* Info format specific *) def_code "\\@infomenu" (fun lexbuf -> let arg = get_prim_arg lexbuf in 3000 Dest.infomenu arg) ;; def_code "\\@infonode" (fun lexbuf -> 3005 let opt = get_prim_opt "" lexbuf in let num = get_prim_arg lexbuf in let nom = get_prim_arg lexbuf in Dest.infonode opt num nom) ;; 3010 def_code "\\@infoextranode" (fun lexbuf -> let num = get_prim_arg lexbuf in let nom = get_prim_arg lexbuf in 3015 let text = get_prim_arg lexbuf in Dest.infoextranode num nom text) ;; def_code "\\@infoname" 3020 (fun lexbuf -> let arg = get_prim_arg lexbuf in Dest.loc_name arg) ;; 3025 let safe_len = function | Length.No _ -> Length.Default | l -> l ;; 3030 def_code "\\@printHR" (fun lexbuf -> let arg = get_prim_arg lexbuf in let taille = safe_len (Get.get_length (get_prim_arg lexbuf)) in Dest.horizontal_line arg taille (Length.Pixel 2)) 3035 ;; def_code"\\@hr" (fun lexbuf -> let attr = subst_opt "" lexbuf in 3040 let width = safe_len (Get.get_length (get_prim_arg lexbuf)) in let height = safe_len (Get.get_length (get_prim_arg lexbuf)) in Dest.horizontal_line attr width height) ;; 3045 (* Accents *) let aigu = function "a" -> "" | "e" -> "e" | "i" | "\\i" | "\\i " -> "" | "o" -> "" | "u" -> "" | "A" -> "" | "E" -> "E" | "I" | "\\I" | "\\I " -> "" 3050 | "O" -> "" | "U" -> "" | "y" -> "" | "Y" -> "" | "" | " " -> "'" | s -> s 3055 and grave = function "a" -> "a" | "e" -> "e" | "i" -> "" | "o" -> "" | "u" -> "" | "\\i" | "\\i " -> "" | "A" -> "A" | "E" -> "E" | "I" -> "" | "O" -> "" | "U" -> "" | "\\I" | "\\I " -> "" 3060 | "" | " " -> "`" | s -> s and circonflexe = function "a" -> "a" | "e" -> "e" | "i" -> "i" | "o" -> "o" | "u" -> "u" | "\\i" | "\\i " -> "i" 3065 | "A" -> "A" | "E" -> "E" | "I" -> "I" | "O" -> "O" | "U" -> "U" | "\\I" | "\\I " -> "I" | "" | " " -> "\\@print{^}" | s -> s 3070 and trema = function "a" -> "" | "e" -> "e" | "i" -> "i" | "o" -> "" | "u" -> "u" | "\\i" | "\\i " -> "i" | "A" -> "" | "E" -> "E" | "I" -> "I" | "O" -> "" | "U" -> "U" | "\\I" | "\\I " -> "I" 3075 | "" | " " -> "" | s -> s and cedille = function "c" -> "c" 3080 | "C" -> "C" | s -> s and tilde = function "a" -> "" | "A" -> "" 3085 | "o" -> "" | "O" -> "" | "n" -> "" | "N" -> "" | "" | " " -> "\\@print{~}" | s -> s ;; 3090 def_fun "\\'" aigu ; def_fun "\\`" grave ; 3095 def_fun "\\^" circonflexe ; def_fun "\\\"" trema ; def_fun "\\c" cedille ; def_fun "\\~" tilde ;; 3100 Get.init get_prim_onarg get_fun_result new_env close_env 3105 get_csname main ;; def_code "\\@primitives" 3110 (fun lexbuf -> let pkg = get_prim_arg lexbuf in exec_init pkg) ;; 3115 (* try e1 with _ -> e2 *) def_code "\\@try" (fun lexbuf -> let saved_location = Location.check () 3120 and env_saved = env_check () and saved = Hot.checkpoint () and saved_lexstate = Lexstate.check_lexstate () and saved_out = Dest.check () and saved_get = Get.check () 3125 and saved_aux = Auxx.check () in let e1 = save_arg lexbuf in let e2 = save_arg lexbuf in try top_open_block "TEMP" "" ; 3130 scan_this_arg main e1 ; top_close_block "TEMP" with e -> begin Location.hot saved_location ; env_hot env_saved ; 3135 Misc.print_verb 0 ("\\@try caught exception : "^Printexc.to_string e) ; Lexstate.hot_lexstate saved_lexstate ; Dest.hot saved_out ; Get.hot saved_get ; 3140 Auxx.hot saved_aux ; Hot.start saved ; scan_this_arg main e2 end) ;; 3145 def_code "\\@heveafail" (fun lexbuf -> let s = get_prim_arg lexbuf in raise (Misc.Purposly s)) 3150 ;; (* (* A la TeX ouput (more or less...) *) 3155 def_code "\\newwrite" (fun lexbuf -> let cmd = save_arg lexbuf in let file = ref stderr in def_code cmd 3160 (fun lexbuf -> let op = save_arg lexbuf in try match op with | "\\write" -> 3165 let what = subst_arg subst lexbuf in output_string !file what ; output_char !file '\n' | "\\closeout" -> close_out !file 3170 | "\\openout" -> let name = get_this_nostyle main (save_filename lexbuf) in file := open_out name | _ -> warning ("Unkown file operation: "^op) 3175 with Sys_error s -> warning ("TeX file error : "^s))) ;; let def_fileop me = 3180 def_code me (fun lexbuf -> let cmd = subst_arg lexbuf in scan_this_may_cont main lexbuf (cmd^me)) ;; 3185 def_fileop "\\write" ; def_fileop "\\openout" ; def_fileop "\\closeout" ;; 3190 *) end} <6>8 length.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: length.mll,v 1.13 2001/06/06 16:52:52 maranget Exp $ *) (***********************************************************************) { open Lexing 15 let header = "$Id: length.mll,v 1.13 2001/06/06 16:52:52 maranget Exp $" exception Cannot ;; 20 let font = 10 ;; let font_float = float font ;; 25 type t = Char of int | Pixel of int | Percent of int | No of string | Default let pretty = function | Char x -> string_of_int x^" chars" 30 | Pixel x -> string_of_int x^" pxls" | Percent x -> string_of_int x^"%" | Default -> "default" | No s -> "*"^s^"*" 35 let pixel_to_char x = (100 * x + 50)/(100 * font) and char_to_pixel x = font * x let mk_char x = Char (truncate (0.5 +. x)) let mk_pixel x = Pixel (truncate (0.5 +. x)) 40 and mk_percent x = Percent (truncate x) ;; let convert unit x = match unit with | "ex"|"em" -> mk_char x 45 | "pt" -> mk_pixel x | "in" -> mk_char ((x *. 72.27) /. font_float) | "cm" -> mk_char ((x *. 28.47) /. font_float) | "mm" -> mk_char ((x *. 2.847) /. font_float) | "pc" -> mk_char ((x *. 12.0) /. font_float) 50 | "@percent" -> mk_percent (100.0 *. x) | _ -> No unit ;; } 55 rule main_rule = parse '-' {let x,unit = positif lexbuf in convert unit (0.0 -. x)} | "" {let x,unit = positif lexbuf in convert unit x} 60 and positif = parse | ['0'-'9']*'.'?['0'-'9']+ {let lxm = lexeme lexbuf in float_of_string lxm,unit lexbuf} | "@percent" {1.0, "@percent"} 65 | "" {raise Cannot} and unit = parse | [' ''\n''\t''\r']+ {unit lexbuf} | [^' ''\n''\t''\r']* {lexeme lexbuf} 70 { open Lexing let main lexbuf = try main_rule lexbuf with 75 | Cannot -> let sbuf = lexbuf.lex_buffer in No (String.sub sbuf 0 lexbuf.lex_buffer_len) } <6>9 save.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) { open Lexing open Misc 15 let header = "$Id: save.mll,v 1.60 2001/02/12 10:05:39 maranget Exp $" let rec if_next_char c lb = if lb.lex_eof_reached then 20 false else let pos = lb.lex_curr_pos and len = lb.lex_buffer_len in if pos >= len then begin 25 warning "Refilling buffer" ; lb.refill_buff lb ; if_next_char c lb end else lb.lex_buffer.[pos] = c 30 let rec if_next_string s lb = if s = "" then true else 35 let pos = lb.lex_curr_pos and len = lb.lex_buffer_len and slen = String.length s in if pos + slen - 1 >= len then begin if lb.lex_eof_reached then begin 40 false end else begin lb.refill_buff lb ; if_next_string s lb end 45 end else String.sub lb.lex_buffer pos slen = s let verbose = ref 0 and silent = ref false ;; 50 let set_verbose s v = silent := s ; verbose := v ;; 55 exception Error of string ;; exception Delim of string ;; 60 let seen_par = ref false ;; let brace_nesting = ref 0 65 and arg_buff = Out.create_buff () and echo_buff = Out.create_buff () and tag_buff = Out.create_buff () ;; 70 let echo = ref false ;; let get_echo () = echo := false ; Out.to_string echo_buff 75 and start_echo () = echo := true ; Out.reset echo_buff and stop_echo () = echo := false ; Out.reset echo_buff ;; let empty_buffs () = 80 brace_nesting := 0 ; Out.reset arg_buff ; echo := false ; Out.reset echo_buff ; Out.reset tag_buff ;; 85 let error s = empty_buffs () ; raise (Error s) ;; 90 let my_int_of_string s = try int_of_string s with Failure "int_of_string" -> error ("Integer argument expected: ``"^s^"''") 95 exception Eof ;; exception NoOpt ;; 100 let put_echo s = if !echo then Out.put echo_buff s and put_echo_char c = if !echo then Out.put_char echo_buff c and blit_echo lb = 105 if !echo then Out.blit echo_buff lb ;; let put_both s = put_echo s ; Out.put arg_buff s 110 ;; let blit_both lexbuf = blit_echo lexbuf ; Out.blit arg_buff lexbuf let put_both_char c = 115 put_echo_char c ; Out.put_char arg_buff c ;; type kmp_t = Continue of int | Stop of string 120 let rec kmp_char delim next i c = if i < 0 then begin Out.put_char arg_buff c ; Continue 0 end else if c = delim.[i] then begin 125 if i >= String.length delim - 1 then Stop (Out.to_string arg_buff) else Continue (i+1) end else begin 130 if next.(i) >= 0 then Out.put arg_buff (String.sub delim 0 (i-next.(i))) ; kmp_char delim next next.(i) c end } 135 let command_name = '\\' (( ['@''A'-'Z' 'a'-'z']+ '*'?) | [^ 'A'-'Z' 'a'-'z']) let space = [' ''\t''\r'] rule opt = parse | space* '\n'? space* '[' 140 {put_echo (lexeme lexbuf) ; opt2 lexbuf} | eof {raise Eof} | "" {raise NoOpt} 145 and opt2 = parse | '{' {incr brace_nesting; put_both_char '{' ; opt2 lexbuf} | '}' { decr brace_nesting; 150 if !brace_nesting >= 0 then begin put_both_char '}' ; opt2 lexbuf end else begin error "Bad brace nesting in optional argument" end} 155 | ']' {if !brace_nesting > 0 then begin put_both_char ']' ; opt2 lexbuf end else begin put_echo_char ']' ; 160 Out.to_string arg_buff end} | _ {let s = lexeme_char lexbuf 0 in put_both_char s ; opt2 lexbuf } 165 and skip_comment = parse | eof {()} | '\n' space* {()} | _ {skip_comment lexbuf} 170 and check_comment = parse | '%' {skip_comment lexbuf} | "" {()} 175 and arg = parse space+ | '\n'+ {put_echo (lexeme lexbuf) ; arg lexbuf} | '{' {incr brace_nesting; put_echo_char '{' ; 180 arg2 lexbuf} | '%' {skip_comment lexbuf ; arg lexbuf} | "\\box" '\\' (['A'-'Z' 'a'-'z']+ '*'? | [^ 'A'-'Z' 'a'-'z']) {let lxm = lexeme lexbuf in 185 put_echo lxm ; lxm} | command_name {blit_both lexbuf ; skip_blanks lexbuf} 190 | '#' ['1'-'9'] {let lxm = lexeme lexbuf in put_echo lxm ; lxm} | [^ '}'] {let c = lexeme_char lexbuf 0 in 195 put_both_char c ; Out.to_string arg_buff} | eof {raise Eof} | "" {error "Argument expected"} 200 and first_char = parse | _ {let lxm = lexeme_char lexbuf 0 in put_echo_char lxm ; 205 lxm} | eof {raise Eof} and rest = parse | _ * eof 210 {let lxm = lexeme lexbuf in put_echo lxm ; lxm} and skip_blanks = parse 215 | space* '\n' {seen_par := false ; put_echo (lexeme lexbuf) ; more_skip lexbuf} | space* 220 {put_echo (lexeme lexbuf) ; Out.to_string arg_buff} and more_skip = parse (space* '\n' space*)+ {seen_par := true ; 225 put_echo (lexeme lexbuf) ; more_skip lexbuf} | "" {Out.to_string arg_buff} 230 and skip_equal = parse space* '='? space* {()} and arg2 = parse '{' 235 {incr brace_nesting; put_both_char '{' ; arg2 lexbuf} | '}' {decr brace_nesting; 240 if !brace_nesting > 0 then begin put_both_char '}' ; arg2 lexbuf end else begin put_echo_char '}' ; Out.to_string arg_buff 245 end} | "\\{" | "\\}" | "\\\\" {blit_both lexbuf ; arg2 lexbuf } | eof {error "End of file in argument"} 250 | [^'\\''{''}']+ {blit_both lexbuf ; arg2 lexbuf } | _ 255 {let c = lexeme_char lexbuf 0 in put_both_char c ; arg2 lexbuf} and csname = parse (space|'\n')+ 260 {(fun get_prim subst -> blit_echo lexbuf ; csname lexbuf get_prim subst)} | '{'? "\\csname" space* {(fun get_prim subst_fun -> blit_echo lexbuf ; 265 let r = incsname lexbuf in "\\"^get_prim r)} | "" {fun get_prim subst -> let r = arg lexbuf in subst r} and incsname = parse 270 "\\endcsname" '}'? {let lxm = lexeme lexbuf in put_echo lxm ; Out.to_string arg_buff} | _ {put_both_char (lexeme_char lexbuf 0) ; 275 incsname lexbuf} | eof {error "End of file in command name"} and cite_arg = parse space* '{' {cite_args_bis lexbuf} 280 | "" {error "No opening ``{'' in citation argument"} and cite_args_bis = parse (space|[^'}''\n''%'','])* {let lxm = lexeme lexbuf in lxm::cite_args_bis lexbuf} | '%' [^'\n']* '\n' {cite_args_bis lexbuf} 285 | ',' {cite_args_bis lexbuf} | (space|'\n')+ {cite_args_bis lexbuf} | '}' {[]} | "" {error "Bad syntax for \\cite argument"} 290 and num_arg = parse | (space|'\n')+ {(fun get_int -> num_arg lexbuf get_int)} | ['0'-'9']+ {fun get_int -> let lxm = lexeme lexbuf in 295 my_int_of_string lxm} | "'" ['0'-'7']+ {fun get_int ->let lxm = lexeme lexbuf in my_int_of_string ("0o"^String.sub lxm 1 (String.length lxm-1))} | '"' ['0'-'9' 'a'-'f' 'A'-'F']+ 300 {fun get_int ->let lxm = lexeme lexbuf in my_int_of_string ("0x"^String.sub lxm 1 (String.length lxm-1))} | '`' '\\' _ {fun get_int ->let c = lexeme_char lexbuf 2 in Char.code c} 305 | '`' '#' ['1'-'9'] {fun get_int -> let lxm = lexeme lexbuf in get_int (String.sub lxm 1 2)} | '`' _ 310 {fun get_int ->let c = lexeme_char lexbuf 1 in Char.code c} | "" {fun get_int -> let s = arg lexbuf in 315 get_int s} and filename = parse [' ''\n']+ {put_echo (lexeme lexbuf) ; filename lexbuf} 320 | [^'\n''{'' ']+ {let lxm = lexeme lexbuf in put_echo lxm ; lxm} | "" {arg lexbuf} and get_limits = parse space+ {get_limits lexbuf} 325 | "\\limits" {Some Limits} | "\\nolimits" {Some NoLimits} | "\\intlimits" {Some IntLimits} | eof {raise Eof} | "" {None} 330 and get_sup = parse | space* '^' {try Some (arg lexbuf) with Eof -> error "End of file after ^"} | eof {raise Eof} | "" {None} 335 and get_sub = parse | space* '_' {try Some (arg lexbuf) with Eof -> error "End of file after _"} | eof {raise Eof} 340 | "" {None} and defargs = parse | '#' ['1'-'9'] {let lxm = lexeme lexbuf in 345 put_echo lxm ; lxm::defargs lexbuf} | [^'{'] | "\\{" {blit_both lexbuf ; let r = in_defargs lexbuf in 350 r :: defargs lexbuf} | "" {[]} and in_defargs = parse | "\\{" | "\\#" {blit_both lexbuf ; in_defargs lexbuf} 355 | [^'{''#'] {put_both_char (lexeme_char lexbuf 0) ; in_defargs lexbuf} | "" {Out.to_string arg_buff} and get_defargs = parse [^'{']* {let r = lexeme lexbuf in r} 360 and tagout = parse | "<BR>" {Out.put_char tag_buff ' ' ; tagout lexbuf} | '<' {intag lexbuf} | "&nbsp;" {Out.put tag_buff " " ; tagout lexbuf} 365 | "&gt;" {Out.put tag_buff ">" ; tagout lexbuf} | "&lt;" {Out.put tag_buff "<" ; tagout lexbuf} | _ {Out.blit tag_buff lexbuf ; tagout lexbuf} | eof {Out.to_string tag_buff} 370 and intag = parse '>' {tagout lexbuf} | '"' {instring lexbuf} | _ {intag lexbuf} | eof {Out.to_string tag_buff} 375 and instring = parse '"' {intag lexbuf} | '\\' '"' {instring lexbuf} | _ {instring lexbuf} 380 | eof {Out.to_string tag_buff} and checklimits = parse "\\limits" {true} 385 | "\\nolimits" {false} | "" {false} and eat_delim_init = parse | eof {raise Eof} 390 | '{' {fun delim next _ -> put_echo_char '{' ; incr brace_nesting ; let r = arg2 lexbuf in 395 check_comment lexbuf ; if if_next_string delim lexbuf then begin skip_delim_rec lexbuf delim 0 ; r end else begin 400 Out.put_char arg_buff '{' ; Out.put arg_buff r ; Out.put_char arg_buff '}' ; eat_delim_rec lexbuf delim next 0 end} 405 | "" {eat_delim_rec lexbuf} and eat_delim_rec = parse | "\\{" {fun delim next i -> 410 put_echo "\\{" ; match kmp_char delim next i '\\' with | Stop _ -> error "Delimitors cannot end with ``\\''" | Continue i -> match kmp_char delim next i '{' with 415 | Stop s -> s | Continue i -> eat_delim_rec lexbuf delim next i} | '{' {fun delim next i -> 420 put_echo_char '{' ; Out.put arg_buff (if i > 0 then String.sub delim 0 i else "") ; Out.put_char arg_buff '{' ; incr brace_nesting ; let r = arg2 lexbuf in 425 Out.put arg_buff r ; Out.put_char arg_buff '}' ; eat_delim_rec lexbuf delim next 0} | _ {fun delim next i -> 430 let c = lexeme_char lexbuf 0 in put_echo_char c ; match kmp_char delim next i c with | Stop s -> s | Continue i -> eat_delim_rec lexbuf delim next i} 435 | eof {error ("End of file in delimited argument, read: "^ Out.to_string echo_buff)} 440 and skip_delim_init = parse | space|'\n' {skip_delim_init lexbuf} | "" {skip_delim_rec lexbuf} and skip_delim_rec = parse 445 | _ {fun delim i -> let c = lexeme_char lexbuf 0 in put_echo_char c ; if c <> delim.[i] then 450 raise (Delim delim) ; if i+1 < String.length delim then skip_delim_rec lexbuf delim (i+1)} | eof {fun delim i -> 455 error ("End of file checking delimiter ``"^delim^"''")} and check_equal = parse | '=' {true} | "" {false} 460 { let init_kmp s = let l = String.length s in let r = Array.create l (-1) in 465 let rec init_rec i j = if i+1 < l then begin if j = -1 || s.[i]=s.[j] then begin r.(i+1) <- j+1 ; 470 init_rec (i+1) (j+1) end else init_rec i r.(j) end in init_rec 0 (-1) ; 475 r let with_delim delim lexbuf = let next = init_kmp delim in check_comment lexbuf ; 480 let r = eat_delim_init lexbuf delim next 0 in r and skip_delim delim lexbuf = check_comment lexbuf ; 485 skip_delim_init lexbuf delim 0 let skip_blanks_init lexbuf = let _ = skip_blanks lexbuf in () 490 let arg_verbatim lexbuf = match first_char lexbuf with | '{' -> incr brace_nesting ; arg2 lexbuf 495 | c -> let delim = String.make 1 c in with_delim delim lexbuf } <6>10 subst.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: subst.mll,v 1.14 2001/05/25 12:37:29 maranget Exp $ *) (***********************************************************************) { open Misc open Lexstate 15 open Lexing let subst_buff = Out.create_buff () ;; 20 } let command_name = '\\' ((['@''A'-'Z' 'a'-'z']+ '*'?) | [^ 'A'-'Z' 'a'-'z']) rule subst = parse | '#' ['1'-'9'] 25 {let lxm = lexeme lexbuf in if is_plain '#' then begin let i = Char.code (lxm.[1]) - Char.code '1' in scan_arg (fun arg -> scan_this_arg subst arg) i 30 end else Out.put subst_buff lxm ; subst lexbuf} | '#' '#' {let lxm = lexeme lexbuf in 35 if is_plain '#' then Out.put_char subst_buff '#' else Out.put subst_buff lxm ; subst lexbuf} 40 | "\\#" | '\\' | [^'\\' '#']+ {Out.blit subst_buff lexbuf ; subst lexbuf} | "\\@print" {let lxm = lexeme lexbuf in Save.start_echo () ; 45 let _ = Save.arg lexbuf in let real_arg = Save.get_echo () in Out.put subst_buff lxm ; Out.put subst_buff real_arg ; subst lexbuf} 50 | command_name {Out.blit subst_buff lexbuf ; subst lexbuf} | eof {()} | "" {raise (Error "Empty lexeme in subst")} 55 { let do_subst_this ({arg=arg ; subst=env} as x) = if not (is_top env) then begin 60 try let _ = String.index arg '#' in if !verbose > 1 then begin Printf.fprintf stderr "subst_this : [%s]\n" arg ; prerr_args () 65 end ; let _ = scan_this_arg subst x in let r = Out.to_string subst_buff in if !verbose > 1 then prerr_endline ("subst_this ["^arg^"] = "^r); 70 r with Not_found -> arg end else arg ;; 75 let subst_this s = do_subst_this (mkarg s (get_subst ())) let subst_arg lexbuf = do_subst_this (save_arg lexbuf) and subst_opt def lexbuf = do_subst_this (save_opt def lexbuf) 80 let subst_body = subst_arg } <6>11 tabular.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) (* $Id: tabular.mll,v 1.26 2001/03/01 22:17:00 maranget Exp $ *) { open Misc 15 open Lexing open Table open Lexstate open Subst 20 exception Error of string ;; type align = {hor : string ; mutable vert : string ; wrap : bool ; 25 mutable pre : string ; mutable post : string ; width : Length.t} let make_hor = function 'c' -> "center" | 'l' -> "left" 30 | 'r' -> "right" | 'p'|'m'|'b' -> "left" | _ -> raise (Misc.Fatal "make_hor") and make_vert = function 35 | 'c'|'l'|'r' -> "" | 'p' -> "top" | 'm' -> "middle" | 'b' -> "bottom" | _ -> raise (Misc.Fatal "make_vert") 40 type format = Align of align | Inside of string | Border of string 45 ;; (* Patch vertical alignment (for HTML) *) let check_vert f = try 50 for i = 0 to Array.length f-1 do match f.(i) with | Align {vert=s} when s <> "" -> raise Exit | _ -> () done ; 55 f with Exit -> begin for i = 0 to Array.length f-1 do match f.(i) with | Align ({vert=""} as f) -> 60 f.vert <- "top" | _ -> () done ; f end 65 (* Compute missing length (for text) *) and check_length f = for i = 0 to Array.length f - 1 do match f.(i) with 70 | Align ({wrap=true ; width=Length.No _} as r) -> f.(i) <- Align {r with width = 75 Length.Percent (truncate (100.0 /. float (Array.length f)))} | _ -> () done 80 let border = ref false let push s e = s := e:: !s 85 and pop s = match !s with [] -> raise (Misc.Fatal "Empty stack in Latexscan") | e::rs -> s := rs ; e let out_table = Table.create (Inside "") 90 let pretty_format = function | Align {vert = v ; hor = h ; pre = pre ; post = post ; wrap = b ; width = w} -> "[>{"^pre^"}"^ 95 ", h="^h^", v="^v^ ", <{"^post^"}"^(if b then ", wrap" else "")^ ", w="^Length.pretty w^"]" | Inside s -> "@{"^s^"}" | Border s -> s 100 let pretty_formats f = Array.iter (fun f -> prerr_string (pretty_format f) ; prerr_string "; ") f 105 } rule tfone = parse '>' {let pre = subst_arg lexbuf in 110 tfmiddle lexbuf ; try apply out_table (function | Align a as r -> a.pre <- pre | _ -> raise (Error "Bad syntax in array argument (>)")) 115 with Table.Empty -> raise (Error "Bad syntax in array argument (>)")} | "" {tfmiddle lexbuf} and tfmiddle = parse 120 | [' ''\t''\n''\r'] {tfmiddle lexbuf} | ['c''l''r'] {let f = Lexing.lexeme_char lexbuf 0 in let post = tfpostlude lexbuf in emit out_table 125 (Align {hor = make_hor f ; vert = make_vert f ; wrap = false ; pre = "" ; post = post ; width = Length.Default})} | ['p''m''b'] {let f = Lexing.lexeme_char lexbuf 0 in let width = subst_arg lexbuf in 130 let my_width = Length.main (Lexing.from_string width) in let post = tfpostlude lexbuf in emit out_table (Align {hor = make_hor f ; vert = make_vert f ; wrap = true ; pre = "" ; post = post ; width = my_width})} 135 | '#' ['1'-'9'] {let lxm = lexeme lexbuf in let i = Char.code (lxm.[1]) - Char.code '1' in Lexstate.scan_arg (scan_this_arg tfmiddle) i} | [^'|' '@' '<' '>' '!' '#'] 140 {let lxm = lexeme lexbuf in let name = column_to_command lxm in let pat,body = Latexmacros.find name in let args = Lexstate.make_stack name pat lexbuf in Lexstate.scan_body 145 (function | Lexstate.Subst body -> scan_this lexformat body ; | _ -> assert false) body args ; let post = tfpostlude lexbuf in 150 if post <> "" then try Table.apply out_table (function | Align f -> f.post <- post 155 | _ -> Misc.warning ("``<'' after ``@'' in tabular arg scanning")) with | Table.Empty -> raise (Error ("``<'' cannot start tabular arg"))} | eof {()} 160 | "" {let rest = String.sub lexbuf.lex_buffer lexbuf.lex_curr_pos (lexbuf.lex_buffer_len - lexbuf.lex_curr_pos) in raise (Error ("Syntax of array format near: "^rest))} 165 and tfpostlude = parse '<' {subst_arg lexbuf} | "" {""} 170 and lexformat = parse '*' {let ntimes = save_arg lexbuf in let what = save_arg lexbuf in 175 let rec do_rec = function 0 -> lexformat lexbuf | i -> scan_this_arg lexformat what ; do_rec (i-1) in do_rec (Get.get_int ntimes)} 180 | '|' {border := true ; emit out_table (Border "|") ; lexformat lexbuf} | '@'|'!' {let lxm = Lexing.lexeme_char lexbuf 0 in let inside = subst_arg lexbuf in if lxm = '!' || inside <> "" then emit out_table (Inside inside) ; 185 lexformat lexbuf} | '#' ['1'-'9'] {let lxm = lexeme lexbuf in let i = Char.code (lxm.[1]) - Char.code '1' in Lexstate.scan_arg (scan_this_arg lexformat) i ; 190 lexformat lexbuf} | eof {()} | "" {tfone lexbuf ; lexformat lexbuf} 195 { open Parse_opts let main {arg=s ; subst=env} = 200 if !verbose > 1 then prerr_endline ("Table format: "^s); start_normal env ; lexformat (Lexing.from_string s) ; end_normal () ; let r = check_vert (trim out_table) in 205 begin match !destination with | (Text | Info) -> check_length r | Html -> () end ; if !verbose > 1 then begin 210 prerr_string "Format parsed: " ; pretty_formats r ; prerr_endline "" end ; r 215 } <6>12 verb.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: verb.mll,v 1.55 2001/06/05 13:18:41 maranget Exp $ *) (***********************************************************************) { exception VError of string 15 module type S = sig end ;; module Make (Dest : OutManager.S) (Image : ImageManager.S) (Scan : Latexscan.S) : S = 20 struct open Misc open Lexing open Save open Lexstate 25 open Latexmacros open Stack open Scan open Subst 30 exception Eof of string ;; (* For file verbatim scanning *) let input_verb = ref false 35 ;; (* For scanning by line *) let verb_delim = ref (Char.chr 0) and line_buff = Out.create_buff () 40 and process = ref (fun () -> ()) and finish = ref (fun () -> ()) ;; let env_extract s = 45 let i = String.index s '{' and j = String.rindex s '}' in String.sub s (i+1) (j-i-1) and newlines_extract s = 50 let rec do_rec i = if i < String.length s then begin if s.[i] = '\n' then 1+do_rec (i+1) else 55 0 end else 0 in do_rec 0 60 (* For scanning the ``listings'' way *) let lst_process_error _ lxm = warning ("listings, unknown character: ``"^Char.escaped lxm^"''") 65 let lst_char_table = Array.create 256 lst_process_error ;; let lst_init_char c f = lst_char_table.(Char.code c) <- f 70 let lst_init_chars s f = let last = String.length s - 1 in for i = 0 to last do lst_char_table.(Char.code s.[i]) <- f 75 done let lst_init_save_char c f = let old = lst_char_table.(Char.code c) in lst_char_table.(Char.code c) <- f old 80 let lst_init_save_chars s f = let last = String.length s - 1 in for i = 0 to last do lst_init_save_char s.[i] f 85 done (* Output functions *) let lst_gobble = ref 0 and lst_nlines = ref 0 90 and lst_first = ref 1 and lst_last = ref 9999 and lst_print = ref true and lst_string_spaces = ref true and lst_texcl = ref false 95 and lst_extended = ref false and lst_sensitive = ref true and lst_mathescape = ref false and lst_directives = ref false and lst_showlines = ref false 100 let lst_effective_spaces = ref false (* false => spaces are spaces *) and lst_save_spaces = ref false let lst_buff = Out.create_buff () 105 let lst_last_char = ref ' ' and lst_finish_comment = ref 0 let lst_put c = 110 lst_last_char := c ; Out.put_char lst_buff c and lst_direct_put c = lst_last_char := c ; 115 Dest.put_char c type lst_scan_mode = | Letter | Other | Empty | Start | Directive of bool (* bool flags some letter read *) 120 let lst_scan_mode = ref Empty type comment_type = | Nested of int 125 | Balanced of (char -> string -> bool) | Line type lst_top_mode = | Skip 130 | String of (char * (char * (Lexing.lexbuf -> char -> unit)) list) | Normal | Comment of comment_type | Delim of int * (char * (Lexing.lexbuf -> char -> unit)) list | Gobble of lst_top_mode * int | Escape of lst_top_mode * char * bool (* bool flags mathescape *) 135 let string_of_top_mode = function | Delim (i,_) -> "Delim: "^string_of_int i | Skip -> "Skip" | Comment (Balanced _) -> "Balanced" 140 | Comment (Nested n) -> "(Nested "^string_of_int n^")" | _ -> "?" let lst_top_mode = ref Skip 145 let lst_ptok s = prerr_endline (s^": "^Out.to_string lst_buff) (* Final ouput, with transformations *) let dest_string s = 150 for i = 0 to String.length s - 1 do Dest.put (Dest.iso s.[i]) done (* Echo, with case change *) 155 let dest_case s = Dest.put (match !case with | Upper -> String.uppercase s | Lower -> String.lowercase s 160 | _ -> s) (* Keywords *) let def_print s = 165 Latexmacros.def "\\@tmp@lst" zero_pat (CamlCode (fun _ -> dest_case s)) ; Latexmacros.def "\\@tmp@lst@print" zero_pat (CamlCode (fun _ -> dest_string s)) ;; 170 let lst_output_other () = if not (Out.is_empty lst_buff) then begin let arg = Out.to_string lst_buff in match !lst_top_mode with 175 | Normal -> def_print arg ; scan_this Scan.main ("\\lst@output@other{\\@tmp@lst}{\\@tmp@lst@print}") | _ -> 180 scan_this main "\\@NewLine" ; dest_string arg end and lst_output_letter () = 185 if not (Out.is_empty lst_buff) then begin match !lst_top_mode with | Normal -> let arg = Out.to_string lst_buff in def_print arg ; 190 scan_this Scan.main ("\\lst@output{\\@tmp@lst}{\\@tmp@lst@print}") | _ -> scan_this main "\\@NewLine" ; dest_string (Out.to_string lst_buff) end 195 and lst_output_directive () = if not (Out.is_empty lst_buff) then begin match !lst_top_mode with | Normal -> 200 let arg = Out.to_string lst_buff in def_print arg ; scan_this Scan.main ("\\lst@output@directive{\\@tmp@lst}{\\@tmp@lst@print}") | _ -> scan_this main "\\@NewLine" ; 205 dest_string (Out.to_string lst_buff) end let lst_output_token () = match !lst_scan_mode with 210 | Letter -> lst_output_letter () | Other -> lst_output_other () | Directive _ -> lst_output_directive () | Empty|Start -> scan_this main "\\@NewLine" 215 let lst_finalize inline = scan_this main "\\lst@forget@lastline" ; if inline || !lst_showlines then lst_output_token () 220 (* Process functions *) let lst_do_gobble mode n = 225 if n > 1 then lst_top_mode := Gobble (mode,n-1) else lst_top_mode := mode 230 let lst_do_escape mode endchar math lb lxm = if lxm = endchar then begin scan_this main "\\begingroup\\lst@escapebegin" ; if math then scan_this main "$" ; scan_this main (Out.to_string lst_buff) ; 235 if math then scan_this main "$" ; scan_this main "\\lst@escapeend\\endgroup" ; lst_top_mode := mode end else Out.put_char lst_buff lxm 240 let rec lst_process_newline lb c = if !verbose > 1 then 245 Printf.fprintf stderr "lst_process_newline\n" ; match !lst_top_mode with | Skip -> if !lst_nlines = !lst_first - 1 then begin lst_top_mode := Normal ; 250 scan_this Scan.main "\\let\\old@br\\@br\\def\\@br{ } " ; lst_process_newline lb c ; scan_this Scan.main "\\let\\@br\\old@br" end else 255 incr lst_nlines | Gobble (mode,_) -> lst_top_mode := mode ; lst_process_newline lb c | Escape (mode,cc,math) -> 260 lst_do_escape (Comment Line) cc math lb c ; if !lst_top_mode = Comment Line then lst_process_newline lb c | Comment Line -> lst_output_token () ; 265 scan_this Scan.main "\\endgroup" ; lst_top_mode := Normal ; lst_process_newline lb c | mode -> scan_this Scan.main "\\lsthk@InitVarEOL\\lsthk@EOL" ; 270 begin match !lst_scan_mode with | Empty -> lst_scan_mode := Start | Start -> () | _ -> lst_output_token () ; 275 lst_scan_mode := Start end ; incr lst_nlines ; if !lst_nlines <= !lst_last then begin scan_this Scan.main 280 "\\lsthk@InitVarBOL\\lsthk@EveryLine" ; if !lst_gobble > 0 then lst_top_mode := Gobble (mode,!lst_gobble) end else lst_top_mode := Skip 285 let lst_process_letter lb lxm = if !verbose > 1 then Printf.fprintf stderr "lst_process_letter: %c\n" lxm ; match !lst_top_mode with | Skip -> () 290 | Gobble (mode,n) -> lst_do_gobble mode n | Escape (mode,c,math) -> lst_do_escape mode c math lb lxm | _ -> match !lst_scan_mode with | Letter -> lst_put lxm | Directive true -> 295 lst_put lxm | Directive false -> lst_scan_mode := Directive true ; lst_put lxm | Empty|Start -> 300 lst_scan_mode := Letter ; lst_put lxm | Other -> lst_output_other () ; lst_scan_mode := Letter ; 305 lst_put lxm let lst_process_digit lb lxm = if !verbose > 1 then Printf.fprintf stderr "lst_process_digit: %c\n" lxm ; 310 match !lst_top_mode with | Skip -> () | Gobble (mode,n) -> lst_do_gobble mode n | Escape (mode,c,math) -> lst_do_escape mode c math lb lxm | _ -> match !lst_scan_mode with 315 | Letter|Other -> lst_put lxm | Directive _ -> lst_output_directive () ; lst_scan_mode := Other ; lst_put lxm 320 | Empty|Start -> lst_scan_mode := Other ; lst_put lxm let lst_process_other lb lxm = 325 if !verbose > 1 then Printf.fprintf stderr "process_other: %c\n" lxm ; match !lst_top_mode with | Skip -> () | Gobble (mode,n) -> lst_do_gobble mode n 330 | Escape (mode,c,math) -> lst_do_escape mode c math lb lxm | _ -> match !lst_scan_mode with | Other -> lst_put lxm | Empty|Start -> lst_scan_mode := Other ; 335 lst_put lxm | Directive _ -> lst_output_directive () ; lst_scan_mode := Other ; lst_put lxm 340 | Letter -> lst_output_letter () ; lst_scan_mode := Other ; lst_put lxm 345 (* Caml code for \stepcounter{lst@space} *) let lst_output_space () = Counter.step_counter "lst@spaces" let lst_process_space lb lxm = if !verbose > 1 then 350 Printf.fprintf stderr "process_space: ``%c''\n" lxm ; match !lst_top_mode with | Skip -> () | Gobble (mode,n) -> lst_do_gobble mode n | Escape (mode,c,math) -> lst_do_escape mode c math lb lxm 355 | _ -> begin match !lst_scan_mode with | Other -> lst_output_other () ; lst_scan_mode := Empty 360 | Letter|Directive true -> lst_output_token () ; lst_scan_mode := Empty | Empty|Directive false -> () | Start -> 365 lst_scan_mode := Empty end ; lst_output_space () let lst_process_start_directive old_process lb lxm = 370 match !lst_top_mode with | Normal -> begin match !lst_scan_mode with | Start -> lst_scan_mode := Directive false | _ -> old_process lb lxm 375 end | _ -> old_process lb lxm 380 exception EndVerb let lst_process_end endstring old_process lb lxm = if !verbose > 1 then Printf.fprintf stderr "process_end: ``%c''\n" lxm ; 385 if (not !input_verb || Stack.empty stack_lexbuf) && if_next_string endstring lb then begin Save.skip_delim endstring lb ; raise EndVerb 390 end else old_process lb lxm let lst_init_char_table inline = lst_init_chars 395 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@_$" lst_process_letter ; lst_init_chars "!\"#%&'()*+,-./:;<=>?[\\]^{}|`~" lst_process_other ; lst_init_chars "0123456789" lst_process_digit ; lst_init_chars " \t" lst_process_space ; 400 if inline then lst_init_char '\n' lst_process_space else lst_init_char '\n' lst_process_newline ;; 405 (* TeX escapes *) let start_escape mode endchar math = lst_output_token () ; lst_top_mode := Escape (mode, endchar, math) 410 let lst_process_escape math ec old_process lb lxm = if !verbose > 1 then Printf.fprintf stderr "lst_process_escape: %c\n" lxm ; match !lst_top_mode with 415 | Skip -> () | Gobble (mode,n) -> lst_do_gobble mode n | Escape _ -> old_process lb lxm | mode -> start_escape mode ec math 420 (* Strings *) let rec restore_char_table to_restore = let rec do_rec = function | [] -> () 425 | (c,f)::rest -> lst_init_char c f ; do_rec rest in do_rec to_restore 430 let lst_bs_string old_process lb lxm = old_process lb lxm ; let saved = Array.copy lst_char_table in let process_quoted _ lxm = lst_put lxm ; 435 Array.blit saved 0 lst_char_table 0 (Array.length saved) in Array.fill lst_char_table 0 (Array.length lst_char_table) process_quoted let lst_init_quote s = 440 let r = ref [] in for i = 0 to String.length s-1 do if s.[i] = 'b' then begin r := ('\\',lst_char_table.(Char.code '\\')) :: !r ; lst_init_save_char '\\' lst_bs_string 445 end done ; !r let lst_process_stringizer quote old_process lb lxm = match !lst_top_mode with 450 | Normal -> lst_output_token () ; let to_restore = lst_init_quote quote in lst_top_mode := String (lxm, to_restore) ; lst_save_spaces := !lst_effective_spaces ; 455 lst_effective_spaces := !lst_string_spaces ; scan_this Scan.main "\\begingroup\\lst@string@style" ; old_process lb lxm | String (c,to_restore) when lxm = c -> old_process lb lxm ; 460 lst_output_token () ; scan_this Scan.main "\\endgroup" ; restore_char_table to_restore ; lst_effective_spaces := !lst_save_spaces ; lst_top_mode := Normal 465 | _ -> old_process lb lxm (* Comment *) 470 let chars_string c s = let rec do_rec r i = if i < String.length s then if List.mem s.[i] r then 475 do_rec r (i+1) else do_rec (s.[i]::r) (i+1) else r in 480 do_rec [c] 0 let init_char_table_delim chars wrapper = List.map (fun c -> 485 let old_process = lst_char_table.(Char.code c) in lst_init_save_char c wrapper ; (c,old_process)) chars 490 let eat_delim k new_mode old_process lb c s = let chars = chars_string c s in let wrapper old_process lb c = match !lst_top_mode with | Delim (n,to_restore) -> 495 old_process lb c ; if n = 1 then begin lst_output_token () ; lst_top_mode := new_mode ; restore_char_table to_restore ; 500 k () end else lst_top_mode := Delim (n-1,to_restore) | _ -> assert false in let to_restore = init_char_table_delim chars wrapper in 505 lst_top_mode := Delim (1+String.length s, to_restore) ; wrapper old_process lb c let begin_comment () = lst_output_token () ; 510 scan_this Scan.main "\\begingroup\\lst@comment@style" let lst_process_BNC _ s old_process lb c = match !lst_top_mode with | Normal when if_next_string s lb -> begin_comment () ; 515 eat_delim (fun () -> ()) (Comment (Nested 0)) old_process lb c s | Comment (Nested n) when if_next_string s lb -> eat_delim (fun () -> ()) (Comment (Nested (n+1))) old_process lb c s | _ -> old_process lb c 520 and lst_process_ENC s old_process lb c = match !lst_top_mode with | Comment (Nested 0) when if_next_string s lb -> eat_delim (fun () -> scan_this Scan.main "\\endgroup") Normal 525 old_process lb c s | Comment (Nested n) when if_next_string s lb -> eat_delim (fun () -> ()) 530 (Comment (Nested (n-1))) old_process lb c s | _ -> old_process lb c let lst_process_BBC check s old_process lb c = match !lst_top_mode with 535 | Normal when if_next_string s lb -> begin_comment () ; eat_delim (fun () -> ()) (Comment (Balanced check)) 540 old_process lb c s | _ -> old_process lb c and lst_process_EBC s old_process lb c = match !lst_top_mode with | Comment (Balanced check) when 545 check c s && if_next_string s lb -> eat_delim (fun () -> scan_this Scan.main "\\endgroup") Normal old_process 550 lb c s | _ -> old_process lb c let lst_process_LC s old_process lb c = match !lst_top_mode with | Normal when if_next_string s lb -> 555 begin_comment () ; eat_delim (fun () -> ()) (if !lst_texcl then Escape (Normal,'\n', false) else Comment Line) old_process lb c s 560 | _ -> old_process lb c } 565 rule inverb = parse | _ {(fun put -> let c = lexeme_char lexbuf 0 in if c = !verb_delim then begin Dest.close_group () ; 570 end else begin put c ; inverb lexbuf put end)} | eof 575 {(fun put -> if not (empty stack_lexbuf) then let lexbuf = previous_lexbuf () in inverb lexbuf put else raise (VError ("End of file after \\verb")))} 580 and start_inverb = parse | _ {(fun put -> let c = lexeme_char lexbuf 0 in verb_delim := c ; 585 inverb lexbuf put)} | eof {(fun put -> if not (empty stack_lexbuf) then let lexbuf = previous_lexbuf () in 590 start_inverb lexbuf put else raise (VError ("End of file after \\verb")))} and scan_byline = parse 595 "\\end" [' ''\t']* '{' [^'}']+ '}' {let lxm = lexeme lexbuf in let env = env_extract lxm in if (not !input_verb || Stack.empty stack_lexbuf) 600 && env = !Scan.cur_env then begin !finish () ; scan_this Scan.main ("\\end"^env) ; Scan.top_close_block "" ; Scan.close_env !Scan.cur_env ; 605 Scan.check_alltt_skip lexbuf end else begin Out.put line_buff lxm ; scan_byline lexbuf end} 610 | '\n' {!process () ; scan_byline lexbuf} | _ {let lxm = lexeme_char lexbuf 0 in Out.put_char line_buff lxm ; 615 scan_byline lexbuf} | eof {if not (Stack.empty stack_lexbuf) then begin let lexbuf = previous_lexbuf () in scan_byline lexbuf 620 end else begin !finish () ; raise (Eof "scan_byline") end} 625 and listings = parse | eof {if not (Stack.empty stack_lexbuf) then begin let lexbuf = previous_lexbuf () in 630 listings lexbuf end else begin raise (Eof "listings") end} 635 | _ {let lxm = lexeme_char lexbuf 0 in lst_char_table.(Char.code lxm) lexbuf lxm ; listings lexbuf} 640 and eat_line = parse | eof {if not (Stack.empty stack_lexbuf) then begin let lexbuf = previous_lexbuf () in eat_line lexbuf 645 end else begin raise (Eof "eat_line") end} | [^'\n'] {eat_line lexbuf} 650 | '\n' {lst_process_newline lexbuf '\n'} and get_line = parse | eof {if not (Stack.empty stack_lexbuf) then begin 655 let lexbuf = previous_lexbuf () in get_line lexbuf end else begin raise (Eof "get_line") 660 end} | [^'\n'] {let lxm = lexeme_char lexbuf 0 in Out.put_char line_buff lxm ; get_line lexbuf} 665 | '\n' {Out.to_string line_buff} and do_escape = parse | eof {} | "\\esc" 670 {let arg = save_arg lexbuf in scan_this main "\\mbox{" ; scan_this_arg Scan.main arg ; scan_this main "}" ; do_escape lexbuf} 675 | _ {let lxm = Lexing.lexeme_char lexbuf 0 in Dest.put (Dest.iso lxm) ; do_escape lexbuf} { 680 let _ = () ;; let put_char_star = function | ' '|'\t' -> Dest.put_char '_' ; | c -> Dest.put (Dest.iso c) 685 and put_char = function | '\t' -> Dest.put_char ' ' | c -> Dest.put (Dest.iso c) ;; 690 let open_verb put lexbuf = Dest.open_group "CODE" ; start_inverb lexbuf put 695 ;; def_code "\\verb" (open_verb (fun c -> Dest.put (Dest.iso c))); def_code "\\verb*" (open_verb put_char_star); ();; 700 let put_line_buff_verb () = Out.iter put_char line_buff ; Out.reset line_buff 705 and put_line_buff_verb_star () = Out.iter put_char_star line_buff ; Out.reset line_buff ;; 710 let noeof lexer lexbuf = try lexer lexbuf with | Eof s -> raise 715 (Misc.Close ("End of file in environment: ``"^ !Scan.cur_env^"'' ("^s^")")) | EndVerb -> () let open_verbenv star = 720 Scan.top_open_block "PRE" "" ; process := if star then (fun () -> put_line_buff_verb_star () ; Dest.put_char '\n') else 725 (fun () -> put_line_buff_verb () ; Dest.put_char '\n') ; finish := if star then put_line_buff_verb_star else 730 put_line_buff_verb and close_verbenv _ = Scan.top_close_block "PRE" let put_html () = 735 Out.iter (fun c -> Dest.put_char c) line_buff ; Out.reset line_buff ;; let open_rawhtml lexbuf = 740 begin match !Parse_opts.destination with | Parse_opts.Html -> () | _ -> Misc.warning "rawhtml detected" end ; process := 745 (fun () -> put_html () ; Dest.put_char '\n') ; finish := put_html ; noeof scan_byline lexbuf and close_rawhtml _ = () 750 let open_forget lexbuf = process := (fun () -> Out.reset line_buff) ; finish := (fun () -> Out.reset line_buff) ; noeof scan_byline lexbuf 755 and close_forget _ = () let open_tofile chan lexbuf = process := 760 (fun () -> output_string chan (Out.to_string line_buff) ; output_char chan '\n') ; finish := (fun () -> 765 output_string chan (Out.to_string line_buff) ; close_out chan) ; noeof scan_byline lexbuf and close_tofile lexbuf = () 770 let put_line_buff_image () = Out.iter (fun c -> Image.put_char c) line_buff ; Out.reset line_buff 775 let open_verbimage lexbuf = process := (fun () -> put_line_buff_image () ; Image.put_char '\n') ; finish := put_line_buff_image ; noeof scan_byline lexbuf 780 and close_verbimage _ = () ;; 785 def_code "\\verbatim" (fun lexbuf -> open_verbenv false ; noeof scan_byline lexbuf) ; def_code "\\endverbatim" close_verbenv ; 790 def_code "\\verbatim*" (fun lexbuf -> open_verbenv true ; 795 noeof scan_byline lexbuf) ; def_code "\\endverbatim*" close_verbenv ; def_code "\\rawhtml" open_rawhtml ; def_code "\\endrawhtml" close_forget ; 800 def_code "\\verblatex" open_forget ; def_code "\\endverblatex" Scan.check_alltt_skip ; def_code "\\verbimage" open_verbimage ; def_code "\\endverbimage" Scan.check_alltt_skip ; () 805 ;; let init_verbatim () = (* comment clashes with the ``comment'' package *) Latexmacros.def "\\comment" zero_pat (CamlCode open_forget) ; 810 Latexmacros.def "\\endcomment" zero_pat (CamlCode Scan.check_alltt_skip) ; () ;; register_init "verbatim" init_verbatim 815 ;; (* The program package for JJL que j'aime bien *) let look_escape () = 820 let lexbuf = Lexing.from_string (Out.to_string line_buff) in do_escape lexbuf ;; let init_program () = 825 def_code "\\program" (fun lexbuf -> Scan.top_open_block "PRE" "" ; process := (fun () -> look_escape () ; Dest.put_char '\n') ; 830 finish := look_escape ; noeof scan_byline lexbuf) ; def_code "\\endprogram" close_verbenv ;; 835 register_init "program" init_program ;; (* The moreverb package *) 840 let tab_val = ref 8 let put_verb_tabs () = let char = ref 0 in Out.iter 845 (fun c -> match c with | '\t' -> let limit = !tab_val - !char mod !tab_val in for j = 1 to limit do Dest.put_char ' ' ; incr char 850 done ; | c -> Dest.put (Dest.iso c) ; incr char) line_buff ; Out.reset line_buff 855 let open_verbenv_tabs () = Scan.top_open_block "PRE" "" ; process := (fun () -> put_verb_tabs () ; Dest.put_char '\n') ; finish := put_verb_tabs 860 and close_verbenv_tabs lexbuf = Scan.top_close_block "PRE" ; Scan.check_alltt_skip lexbuf ;; 865 let line = ref 0 and interval = ref 1 ;; 870 let output_line inter_arg star = if !line = 1 || !line mod inter_arg = 0 then scan_this Scan.main ("\\listinglabel{"^string_of_int !line^"}") else Dest.put " " ; 875 if star then put_line_buff_verb_star () else put_verb_tabs () ; incr line 880 let open_listing start_arg inter_arg star = Scan.top_open_block "PRE" "" ; line := start_arg ; 885 let first_line = ref true in let inter = if inter_arg <= 0 then 1 else inter_arg in process := (fun () -> if !first_line then begin 890 first_line := false ; if not (Out.is_empty line_buff) then output_line inter_arg star ; end else output_line inter_arg star ; 895 Dest.put_char '\n') ; finish := (fun () -> if not (Out.is_empty line_buff) then output_line inter_arg star) 900 and close_listing lexbuf = Scan.top_close_block "PRE" ; Scan.check_alltt_skip lexbuf ;; 905 register_init "moreverb" (fun () -> def_code "\\verbatimwrite" 910 (fun lexbuf -> let name = Scan.get_prim_arg lexbuf in Scan.check_alltt_skip lexbuf ; let chan = open_out name in open_tofile chan lexbuf) ; 915 def_code "\\endverbatimwrite" Scan.check_alltt_skip ; def_code "\\verbatimtab" (fun lexbuf -> 920 let opt = Get.get_int (save_opt "\\verbatimtabsize" lexbuf) in tab_val := opt ; open_verbenv_tabs () ; Lexstate.save_lexstate () ; let first = get_line lexbuf in 925 Lexstate.restore_lexstate () ; scan_this Scan.main first ; Dest.put_char '\n' ; noeof scan_byline lexbuf) ; def_code "\\endverbatimtab" close_verbenv_tabs ; 930 (* def_code "\\verbatimtabinput" (fun lexbuf -> let opt = Get.get_int (save_opt "\\verbatimtabsize" lexbuf) in tab_val := opt ; 935 let name = Scan.get_prim_arg lexbuf in open_verbenv_tabs () ; verb_input scan_byline name ; close_verbenv_tabs lexbuf) ; *) 940 def_code "\\listinglabel" (fun lexbuf -> let arg = Get.get_int (save_arg lexbuf) in Dest.put (Printf.sprintf "%4d " arg)) ; 945 def_code "\\listing" (fun lexbuf -> let inter = Get.get_int (save_opt "1" lexbuf) in let start = Get.get_int (save_arg lexbuf) in interval := inter ; 950 open_listing start inter false ; noeof scan_byline lexbuf) ; def_code "\\endlisting" close_listing ; (* def_code "\\listinginput" 955 (fun lexbuf -> let inter = Get.get_int (save_opt "1" lexbuf) in let start = Get.get_int (save_arg lexbuf) in let name = Scan.get_prim_arg lexbuf in interval := inter ; 960 open_listing start inter false ; verb_input scan_byline name ; close_listing lexbuf) ; *) def_code "\\listingcont" 965 (fun lexbuf -> open_listing !line !interval false ; noeof scan_byline lexbuf) ; def_code "\\endlistingcont" close_listing ; 970 def_code "\\listing*" (fun lexbuf -> let inter = Get.get_int (save_opt "1" lexbuf) in let start = Get.get_int (save_arg lexbuf) in interval := inter ; 975 open_listing start inter true ; noeof scan_byline lexbuf) ; def_code "\\endlisting*" close_listing ; def_code "\\listingcont*" 980 (fun lexbuf -> Scan.check_alltt_skip lexbuf ; open_listing !line !interval false ; noeof scan_byline lexbuf) ; def_code "\\endlistingcont*" close_listing ; 985 ()) (* The comment package *) let init_comment () = 990 def_code "\\@excludecomment" open_forget ; def_code "\\end@excludecomment" Scan.check_alltt_skip ; ;; register_init "comment" init_comment 995 ;; (* The listings package *) (* 1000 Caml code for \def\lst@spaces {\whiledo{\value{lst@spaces}>0}{~\addtocounter{lst@spaces}{-1}}} *) let code_spaces lexbuf = 1005 let n = Counter.value_counter "lst@spaces" in if !lst_effective_spaces then for i = n-1 downto 0 do Dest.put_char '_' done 1010 else for i = n-1 downto 0 do Dest.put_nbsp () done ; Counter.set_counter "lst@spaces" 0 1015 ;; let code_double_comment process_B process_E lexbuf = let lxm_B = get_prim_arg lexbuf in let lxm_E = get_prim_arg lexbuf in 1020 if lxm_B <> "" && lxm_E <> "" then begin let head_B = lxm_B.[0] and rest_B = String.sub lxm_B 1 (String.length lxm_B-1) and head_E = lxm_E.[0] and rest_E = String.sub lxm_E 1 (String.length lxm_E-1) in 1025 lst_init_save_char head_B (process_B (fun c s -> c = head_E && s = rest_E) rest_B) ; 1030 lst_init_save_char head_E (process_E rest_E) end let code_line_comment lexbuf = let lxm_LC = get_prim_arg lexbuf in 1035 if lxm_LC <> "" then begin let head = lxm_LC.[0] and rest = String.sub lxm_LC 1 (String.length lxm_LC-1) in lst_init_save_char head (lst_process_LC rest) end 1040 let code_stringizer lexbuf = let mode = Scan.get_prim_arg lexbuf in let schars = Scan.get_prim_arg lexbuf in lst_init_save_chars schars (lst_process_stringizer mode) 1045 ;; let open_lst inline keys lab = scan_this Scan.main ("\\lsthk@PreSet\\lstset{"^keys^"}") ; (* For inline *) 1050 if inline then scan_this Scan.main "\\lsthk@InlineUnsave" ; (* Ignoring output *) lst_gobble := Get.get_int (string_to_arg "\\lst@gobble") ; lst_first := Get.get_int (string_to_arg "\\lst@first") ; 1055 lst_last := Get.get_int (string_to_arg "\\lst@last") ; lst_nlines := 0 ; lst_init_char_table inline ; scan_this Scan.main "\\lsthk@SelectCharTable" ; if !lst_extended then 1060 for i = 128 to 255 do lst_init_char (Char.chr i) lst_process_letter done ; scan_this Scan.main "\\lsthk@Init" ; (* Directives *) 1065 if !lst_directives then begin lst_init_save_char '#' lst_process_start_directive end ; (* Print key *) if not !lst_print then begin 1070 lst_last := -2 ; lst_first := -1 end ; (* Strings *) (* Escapes to TeX *) if !lst_mathescape then begin 1075 lst_init_save_char '$' (lst_process_escape true '$') end ; let begc = Scan.get_this_main "\\@getprintnostyle{\\lst@BET}" and endc = Scan.get_this_main "\\@getprintnostyle{\\lst@EET}" in if begc <> "" && endc <> "" then begin 1080 lst_init_save_char begc.[0] (lst_process_escape false endc.[0]) end ; scan_this Scan.main "\\lsthk@InitVar" ; lst_scan_mode := Empty ; if inline then 1085 lst_top_mode := Normal else lst_top_mode := Skip and close_lst inline = 1090 lst_finalize inline ; while !Scan.cur_env = "command-group" do scan_this Scan.main "\\endgroup" done ; scan_this Scan.main "\\lsthk@DeInit" 1095 ;; let lst_boolean lexbuf = let b = get_prim_arg lexbuf in Dest.put 1100 (match b with | "" -> "false" | s when s.[0] = 't' || s.[0] = 'T' -> "true" | _ -> "false") ;; 1105 def_code "\\@callopt" (fun lexbuf -> let csname = Scan.get_csname lexbuf in let old_raw = !raw_chars in 1110 let all_arg = get_prim_arg lexbuf in let lexarg = Lexing.from_string all_arg in let opt = Subst.subst_opt "" lexarg in let arg = Save.rest lexarg in let exec = csname^"["^opt^"]{"^arg^"}" in 1115 scan_this Scan.main exec) ;; let init_listings () = Scan.newif_ref "lst@print" lst_print ; Scan.newif_ref "lst@extendedchars" lst_extended ; 1120 Scan.newif_ref "lst@texcl" lst_texcl ; Scan.newif_ref "lst@sensitive" lst_sensitive ; Scan.newif_ref "lst@mathescape" lst_mathescape ; Scan.newif_ref "lst@directives" lst_directives ; Scan.newif_ref "lst@stringspaces" lst_string_spaces ; 1125 Scan.newif_ref "lst@showlines" lst_showlines ; def_code "\\lst@spaces" code_spaces ; def_code "\\lst@boolean" lst_boolean ; def_code "\\lst@def@stringizer" code_stringizer ; def_code "\\lst@AddTo" 1130 (fun lexbuf -> let sep = Scan.get_prim_arg lexbuf in let name = Scan.get_csname lexbuf in let old = try match Latexmacros.find_fail name with 1135 | _, Subst s -> s | _,_ -> "" with | Latexmacros.Failed -> "" in let toadd = get_prim_arg lexbuf in 1140 Latexmacros.def name zero_pat (Subst (if old="" then toadd else old^sep^toadd))) ; def_code "\\lst@lExtend" (fun lexbuf -> let name = Scan.get_csname lexbuf in 1145 try match Latexmacros.find_fail name with | _, Subst body -> let toadd = Subst.subst_arg lexbuf in Latexmacros.def name zero_pat (Subst (body^"%\n"^toadd)) 1150 | _, _ -> warning ("Cannot \\lst@lExtend ``"^name^"''") with | Latexmacros.Failed -> warning ("Cannot \\lst@lExtend ``"^name^"''")) ; 1155 def_code "\\lstlisting" (fun lexbuf -> Image.stop () ; let keys = Subst.subst_opt "" lexbuf in let lab = Scan.get_prim_arg lexbuf in 1160 let lab = if lab = " " then "" else lab in if lab <> "" then def "\\lst@intname" zero_pat (CamlCode (fun _ -> Dest.put lab)) ; open_lst false keys lab ; scan_this Scan.main "\\lst@pre\\@open@lstbox" ; 1165 scan_this Scan.main "\\lst@basic@style" ; (* Eat first line *) save_lexstate () ; noeof eat_line lexbuf ; restore_lexstate () ; 1170 (* For detecting endstring, must be done after eat_line *) lst_init_save_char '\\' (lst_process_end "end{lstlisting}") ; noeof listings lexbuf ; close_lst false ; scan_this Scan.main "\\@close@lstbox\\lst@post" ; 1175 Scan.top_close_block "" ; Scan.close_env !Scan.cur_env ; Image.restart () ; Scan.check_alltt_skip lexbuf) ; (* Init comments from .hva *) 1180 def_code "\\lst@balanced@comment" (fun lexbuf -> code_double_comment lst_process_BBC lst_process_EBC lexbuf) ; def_code "\\lst@nested@comment" (fun lexbuf -> 1185 code_double_comment lst_process_BNC lst_process_ENC lexbuf) ; def_code "\\lst@line@comment" code_line_comment ; def_code "\\lstinline" (fun lexbuf -> 1190 let keys = Subst.subst_opt "" lexbuf in let {arg=arg} = save_verbatim lexbuf in Scan.new_env "*lstinline*" ; scan_this main "\\mbox{" ; open_lst true keys "" ; 1195 Dest.open_group "CODE" ; begin try scan_this listings arg with | Eof _ -> () 1200 end ; close_lst true ; Dest.close_group () ; scan_this main "}" ; Scan.close_env "*lstinline*") ; 1205 def_code "\\lst@definelanguage" (fun lexbuf -> let dialect = get_prim_opt "" lexbuf in let language = get_prim_arg lexbuf in 1210 let base_dialect = get_prim_opt "!*!" lexbuf in match base_dialect with | "!*!" -> let keys = subst_arg lexbuf in 1215 let _ = save_opt "" lexbuf in scan_this main ("\\lst@definelanguage@{"^language^"}{"^ dialect^"}{"^keys^"}") | _ -> 1220 let base_language = get_prim_arg lexbuf in let keys = subst_arg lexbuf in let _ = save_opt "" lexbuf in scan_this main ("\\lst@derivelanguage@{"^ 1225 language^"}{"^ dialect^"}{"^ base_language^"}{"^base_dialect^"}{"^ keys^"}")) ;; 1230 register_init "listings" init_listings ;; let init_fancyvrb () = 1235 def_code "\\@Verbatim" (fun lexbuf -> open_verbenv false ; noeof scan_byline lexbuf) ; def_code "\\@endVerbatim" close_verbenv 1240 ;; register_init "fancyvrb" init_fancyvrb ;; 1245 def_code "\\@scaninput" (fun lexbuf -> 1250 let pre = save_arg lexbuf in let file = get_prim_arg lexbuf in let {arg=post ; subst=post_subst} = save_arg lexbuf in try let true_name,chan = Myfiles.open_tex file in 1255 if !verbose > 0 then message ("Scan input file: "^true_name) ; let filebuff = Lexing.from_channel chan in start_lexstate () ; let old_input = !input_verb in 1260 if old_input then warning "Nested \\@scaninput" ; input_verb := true ; Location.set true_name filebuff ; begin try record_lexbuf (Lexing.from_string post) post_subst ; 1265 scan_this_may_cont Scan.main filebuff top_subst pre ; with e -> restore_lexstate () ; Location.restore () ; 1270 close_in chan ; raise e end ; restore_lexstate () ; Location.restore () ; 1275 close_in chan ; input_verb := old_input with | Myfiles.Except -> warning ("Not opening file: "^file) 1280 | Myfiles.Error s -> warning s) end } <6>13 videoc.mll (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* Christian Queinnec, Universite Paris IV *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) 10 (* *) (***********************************************************************) (* <Christian.Queinnec@lip6.fr> The plugin for HeVeA that implements the VideoC style. $Id: videoc.mll,v 1.26 2001/05/25 12:37:35 maranget Exp $ 15 *) { module type T = sig 20 end;; module Make (Dest : OutManager.S) (Image : ImageManager.S) 25 (Scan : Latexscan.S) = struct open Misc open Parse_opts open Lexing 30 open Myfiles open Lexstate open Latexmacros open Subst open Scan 35 let header = "$Id: videoc.mll,v 1.26 2001/05/25 12:37:35 maranget Exp $" (* So I can synchronize my changes from Luc's ones *) 40 let qnc_header = "30 oct 2000" exception EndSnippet ;; 45 exception EndTeXInclusion ;; (* Re-link with these variables inserted in latexscan. *) 50 let withinSnippet = ref false;; let withinTeXInclusion = ref false;; let endSnippetRead = ref false;; (* Snippet global defaults *) 55 let snippetLanguage = ref "";; let enableLispComment = ref false;; let enableSchemeCharacters = ref false;; 60 (* Snippet Environment: run a series of hooks provided they exist as user macros. *) let runHook prefix parsing name = let run name = begin 65 if !verbose > 2 then prerr_endline ("Trying to run hook " ^ name); if Latexmacros.exists name then begin Lexstate.scan_this parsing name; () end end in let rec iterate name suffix = 70 run name; if suffix <> "" then iterate (name ^ (String.make 1 (String.get suffix 0))) (String.sub suffix 1 ((String.length suffix) - 1)) in iterate (prefix ^ name ^ "Hook") !snippetLanguage;; 75 let snippetRunHook parsing name = runHook "\\snippet" parsing name;; let snipRunHook parsing name = 80 runHook "\\snip" parsing name;; (* Hack for mutual recursion between modules: *) let handle_command = ref 85 ((function lexbuf -> function s -> ()) : (Lexing.lexbuf -> string -> unit));; (* Convert a reference to a hint such as "3" "annote.ann" "premier indice" into "3_annote_ann". This is needed for the annote tool. *) 90 let compute_hint_id number filename notename = let result = number ^ "_" ^ filename in let rec convert i = begin if i<String.length(result) 95 then let c = String.get result i in if true || ('a' <= c && c <= 'z') (* test *) || ('A' <= c && c <= 'z') || ('0' <= c && c <= '9') then () 100 else String.set result i '_'; convert (i+1); end in convert 0; result;; 105 let increment_internal_counter = let counter = ref 99 in function () -> begin 110 counter := !counter + 1; !counter end;; } 115 let command_name = '\\' ((['@''A'-'Z' 'a'-'z']+ '*'?) | [^ 'A'-'Z' 'a'-'z']) rule snippetenv = parse | eof { () } 120 | command_name {let csname = lexeme lexbuf in let pat,body = Latexmacros.find csname in begin match pat with | [],[] -> 125 let args = make_stack csname pat lexbuf in let cur_subst = get_subst () in let exec = function | Subst body -> if !verbose > 2 then 130 prerr_endline ("user macro in snippet: "^body) ; Lexstate.scan_this_may_cont Scan.main lexbuf cur_subst (string_to_arg body) | Toks l -> List.iter 135 (fun s -> scan_this Scan.main s) (List.rev l) | CamlCode f -> f lexbuf in scan_body exec body args | _ -> 140 raise (Misc.ScanError ("Command with arguments inside snippet")) end ; snippetenv lexbuf} | '\n' {Dest.put_tag "<BR>"; 145 Dest.put_char '\n'; snippetRunHook Scan.main "AfterLine"; snippetRunHook Scan.main "BeforeLine"; snippetenv lexbuf} | ' '|'\t' 150 {Dest.put_nbsp (); snippetenv lexbuf} | ';' + {Dest.put (lexeme lexbuf); Dest.put_char ' '; 155 if !enableLispComment then begin if !verbose > 1 then prerr_endline "Within snippet: Lisp comment entered"; Lexstate.withinLispComment := true; 160 Scan.top_open_block "SPAN" ("class=\"" ^ !snippetLanguage ^ "Comment\""); snippetRunHook Scan.main "BeforeComment"; try Scan.main lexbuf with (* until a \n is read *) | exc -> begin 165 snippetRunHook Scan.main "AfterComment"; Scan.top_close_block "SPAN"; Lexstate.withinLispComment := false; (* re-raise every exception but EndOfLispComment *) try raise exc with 170 | Misc.EndOfLispComment nlnum -> begin let addon = (if !endSnippetRead then "\\endsnippet" else "") in if !verbose > 1 then Printf.fprintf stderr "%d NL after LispComment %s\n" nlnum ((if !endSnippetRead then "and " else "")^addon); 175 let _ = Lexstate.scan_this snippetenv ((String.make (1+nlnum) '\n')^addon) in () end; end; 180 end; snippetenv lexbuf} | '#' {Dest.put_char '#'; if !enableSchemeCharacters 185 then begin if !verbose > 1 then prerr_endline "Within snippet: scheme characters enabled"; schemecharacterenv lexbuf end; 190 snippetenv lexbuf} | _ {Dest.put (Dest.iso (lexeme_char lexbuf 0)); snippetenv lexbuf} 195 (* Scheme characters are written as #\A or #\Newspace *) and schemecharacterenv = parse | command_name {let csname = lexeme lexbuf in 200 Dest.put csname} | "" { () } (* Swallow characters until the end of the line. *) 205 and skip_blanks_till_eol_included = parse | ' ' + {skip_blanks_till_eol_included lexbuf} | '\n' 210 { () } | "" { () } (* Parse a succession of things separated by commas. *) 215 and comma_separated_values = parse | [ ^ ',' ] * ',' {let lxm = lexeme lexbuf in let s = String.sub lxm 0 (String.length lxm - 1) in 220 if !verbose > 2 then prerr_endline ("CSV" ^ s); s :: comma_separated_values lexbuf} | eof { [] } 225 (* Trailer: Register local macros as global. *) { let caml_print s = CamlCode (fun _ -> Dest.put s) let snippet_def name d = Latexmacros.def name zero_pat (CamlCode d) 230 let rec do_endsnippet _ = if !Lexstate.withinLispComment then begin endSnippetRead := true; raise (Misc.EndOfLispComment 0) 235 end; if !Scan.cur_env = "snippet" then raise EndSnippet else raise (Misc.ScanError ("\\endsnippet without opening \\snippet")) 240 and do_texinclusion lexbuf = Scan.top_open_block "SPAN" ("class=\"" ^ !snippetLanguage ^ "Inclusion\""); snippetRunHook Scan.main "BeforeTeX"; 245 withinTeXInclusion := true; begin (* Until a \] is read *) try Scan.main lexbuf with | exc -> begin snippetRunHook Scan.main "AfterTeX"; 250 Scan.top_close_block "SPAN"; snippetRunHook Scan.main "Restart"; (* Re-raise every thing but EndTeXInclusion *) try raise exc with | EndTeXInclusion -> () 255 end; end ; and do_texexclusion _ = if !withinSnippet then begin 260 if !verbose > 2 then prerr_endline "\\] caught within TeX escape"; withinTeXInclusion := false; raise EndTeXInclusion end else raise (Misc.ScanError ("\\] without opening \\[ in snippet")) 265 and do_backslash_newline _ = Dest.put "\\\n"; Lexstate.scan_this snippetenv "\n" 270 and do_four_backslashes _ = Dest.put "\\" (* HACK: Define a macro with a body that is obtained via substitution. This is a kind of restricted \edef as in TeX. Syntax: \@EDEF\macroName{#2#1..} *) 275 and do_edef lxm lexbuf = let name = Scan.get_csname lexbuf in let body = subst_arg lexbuf in if Scan.echo_toimage () then 280 Image.put ("\\def"^name^"{"^body^"}\n") ; Latexmacros.def name zero_pat (caml_print body); () (* Syntax: \@MULEDEF{\macroName,\macroName,...}{#1#3...} 285 This is an awful hack extending the \@EDEF command. It locally rebinds the (comma-separated) \macronames to the corresponding (comma-separated) expansion of second argument. All \macronames should be a zero-ary macro. *) 290 and do_muledef lxm lexbuf = let names = subst_arg lexbuf in let bodies = subst_arg lexbuf in let rec bind lasti lastj = try let i = String.index_from names lasti ',' in 295 try let j = String.index_from bodies lastj ',' in let name = String.sub names lasti (i - lasti) in let body = String.sub bodies lastj (j - lastj) in if !verbose > 2 then prerr_endline (lxm ^ name ^ ";" ^ body); Latexmacros.def name zero_pat (caml_print body); 300 bind (i+1) (j+1) with Not_found -> failwith "Missing bodies for \\@MULEDEF" with Not_found -> let name = String.sub names lasti (String.length names - lasti) in let body = String.sub bodies lastj (String.length bodies - lastj) in 305 if !verbose > 2 then prerr_endline (lxm ^ name ^ ";" ^ body); Latexmacros.def name zero_pat (caml_print body) ; in bind 0 0; () 310 (* The command that starts the \snippet inner environment: *) and do_snippet lexbuf = if !withinSnippet 315 then raise (Misc.ScanError "No snippet within snippet.") else begin (* Obtain the current TeX value of \snippetDefaultLanguage *) let snippetDefaultLanguage = "\\snippetDefaultLanguage" in let language = get_prim_opt snippetDefaultLanguage lexbuf in 320 let language = if language = "" then snippetDefaultLanguage else language in skip_blanks_till_eol_included lexbuf; Dest.put "<BR>\n"; Scan.top_open_block "DIV" ("class=\"div" ^ language ^ "\""); 325 Dest.put "\n"; Scan.new_env "snippet"; (* Define commands local to \snippet *) snippet_def "\\endsnippet" do_endsnippet; snippet_def "\\[" do_texinclusion ; 330 snippet_def "\\]" do_texexclusion ; snippet_def "\\\\" do_four_backslashes ; snippet_def "\\\n" do_backslash_newline ; snippetLanguage := language; 335 enableLispComment := false; enableSchemeCharacters := false; withinSnippet := true; snippetRunHook Scan.main "Before"; try snippetenv lexbuf with 340 exc -> begin snippetRunHook Scan.main "AfterLine"; snippetRunHook Scan.main "After"; withinSnippet := false; Scan.close_env "snippet"; 345 Scan.top_close_block "DIV"; (* Re-raise all exceptions but EndSnippet *) try raise exc with EndSnippet -> () end; 350 end and do_enable_backslashed_chars lexbuf = let def_echo s = snippet_def s (fun _ -> Dest.put s) in let chars = subst_arg lexbuf in begin 355 if !verbose > 2 then prerr_endline ("\\enableBackslashedChar "^chars); for i=0 to (String.length chars - 1) do let charcommandname = "\\" ^ (String.sub chars i 1) in def_echo charcommandname; done; 360 end; () and do_enableLispComment lexbuf = enableLispComment := true; 365 () and do_disableLispComment lexbuf = enableLispComment := false; () 370 and do_enableSchemeCharacters lexbuf = enableSchemeCharacters := true; () 375 and do_disableSchemeCharacters lexbuf = enableSchemeCharacters := false; () and do_snippet_run_hook lexbuf = 380 let name = subst_arg lexbuf in begin snippetRunHook Scan.main name; () end 385 and do_snip_run_hook lexbuf = let name = subst_arg lexbuf in begin snipRunHook Scan.main name; () end 390 (* These macros are defined in Caml since they are not nullary macros. They require some arguments but they cannot get them in the snippet environment. So I code them by hand. *) 395 and do_vicanchor lexbuf = begin let {arg=style} = Lexstate.save_opt "" lexbuf in if !verbose > 2 then prerr_endline ("\\vicanchor"^style); let {arg=nfn} = Lexstate.save_opt "0,filename,notename" lexbuf in if !verbose > 2 then prerr_endline ("\\vicanchor"^style^nfn); 400 let fields = comma_separated_values (Lexing.from_string (nfn ^ ",")) in match fields with | [number;filename;notename] -> begin 405 let uniqueNumber = (* Would be better: truncate(Unix.gettimeofday()) *) increment_internal_counter() and hintId = compute_hint_id number filename notename in Dest.put_tag ("<A id=\"a" ^ string_of_int(uniqueNumber) ^ "__" ^ hintId 410 ^ "\" href=\"javascript: void showMessage('" ^ hintId ^ "')\" class=\"mousable\"><SPAN style=\"" ^ style ^ "\"><!-- " ^ nfn ^ " -->"); () end 415 | _ -> failwith "Missing comma-separated arguments" end and do_vicendanchor lexbuf = begin let {arg=nfn} = Lexstate.save_opt "0,filename,notename" lexbuf in 420 if !verbose > 2 then prerr_endline ("\\vicendanchor"^nfn); let fields = comma_separated_values (Lexing.from_string (nfn ^ ",")) in match fields with | [number;filename;notename] -> begin 425 Dest.put_tag ("</SPAN></A>"); () end | _ -> failwith "Missing comma-separated arguments" end 430 and do_vicindex lexbuf = begin let nfn = Lexstate.save_opt "0,filename,notename" lexbuf in Dest.put_char ' '; () 435 end ;; (* This is the initialization function of the plugin: *) 440 let init = function () -> begin (* Register global TeX macros: *) def_code "\\snippet" do_snippet; 445 def_name_code "\\@EDEF" do_edef; def_name_code "\\@MULEDEF" do_muledef; def_code "\\ViCEndAnchor" do_vicendanchor; def_code "\\ViCAnchor" do_vicanchor; 450 def_code "\\ViCIndex" do_vicindex; def_code "\\enableLispComment" do_enableLispComment; def_code "\\disableLispComment" do_disableLispComment; def_code "\\enableSchemeCharacters" do_enableSchemeCharacters; 455 def_code "\\disableSchemeCharacters" do_disableSchemeCharacters; def_code "\\enableBackslashedChars" do_enable_backslashed_chars; def_code "\\snippetRunHook" do_snippet_run_hook; def_code "\\snipRunHook" do_snip_run_hook; () 460 end;; register_init "videoc" init ;; 465 end} <6>14 auxx.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val rset : string -> string -> unit val rget : string -> string val bset : string -> string -> unit 15 val bget : bool -> string -> string val init : string -> unit val finalize : bool -> bool val bwrite : string -> string -> unit val rwrite : string -> string -> unit 20 val hot_start : unit -> unit type saved 25 val check : unit -> saved val hot : saved -> unit <6>15 buff.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: buff.mli,v 1.4 2001/05/28 17:28:55 maranget Exp $ *) (***********************************************************************) type t val create : unit -> t 15 val put_char : t -> char -> unit val put : t -> string -> unit val to_string : t -> string val reset : t -> unit <6>16 color.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val compute : string -> string -> string val define : string -> string -> string -> unit val define_named : string -> string -> string -> unit 15 val retrieve : string -> string val remove : string -> unit type saved val checkpoint : unit -> saved 20 val hot_start : saved -> unit <6>17 colscan.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: colscan.mli,v 1.5 2001/05/25 12:37:20 maranget Exp $ *) (***********************************************************************) exception Error of string val one : Lexing.lexbuf -> float val three : Lexing.lexbuf -> float * float * float 15 val four : Lexing.lexbuf -> float * float * float * float <6>18 counter.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) type saved val checkpoint : unit -> saved val hot_start : saved -> unit 15 val value_counter : string -> int val def_counter: string -> string -> unit val set_counter: string -> int -> unit val add_counter:string -> int -> unit 20 val step_counter: string -> unit val number_within: string -> string -> unit <6>19 cross.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val add : string -> string -> unit val fullname : string -> string -> string val change : string -> string -> unit <6>20 element.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) type text = Style of string | Font of int 15 | Color of string val pretty_text : text -> string <6>21 emisc.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: emisc.mli,v 1.1 2001/05/29 09:23:30 maranget Exp $ *) (***********************************************************************) val basefont : int ref val reset : unit -> unit <6>22 entry.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) type key = string list * string list exception NoGood exception Fini 15 val read_key : Lexing.lexbuf -> key * string option val read_indexentry : Lexing.lexbuf -> string * string <6>23 esponja.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: esponja.mli,v 1.1 2001/05/25 12:37:21 maranget Exp $ *) (***********************************************************************) val pess : bool ref val move : bool ref 15 val process : string -> in_channel -> out_channel -> bool val file : string -> bool <6>24 explode.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: explode.mli,v 1.4 2001/05/28 17:28:55 maranget Exp $ *) (***********************************************************************) val trees : Lexeme.style Tree.t list -> Htmltext.style Tree.t list <6>25 foot.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) type saved val checkpoint : unit -> saved val hot_start : saved -> unit 15 val step_anchor : int -> unit val get_anchor : int -> int val register : int -> string -> string -> unit 20 val flush : (string -> unit) -> string -> string -> unit val some : bool ref <6>26 get.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: get.mli,v 1.12 2001/05/25 12:37:22 maranget Exp $ *) (***********************************************************************) open Lexstate exception Error of string 15 val init : (string arg -> string) -> ((Lexing.lexbuf -> unit) -> Lexing.lexbuf -> string) -> (string -> unit) -> (string -> unit) -> 20 (Lexing.lexbuf -> string) -> (Lexing.lexbuf -> unit) -> unit type saved val check : unit -> saved 25 val hot : saved -> unit val get_int : string arg -> int val get_bool : string arg -> bool val get_length : string -> Length.t <6>27 hot.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: hot.mli,v 1.3 2001/05/25 12:37:23 maranget Exp $ *) (***********************************************************************) type saved val checkpoint : unit -> saved 15 val start : saved -> unit <6>28 htmllex.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: htmllex.mli,v 1.4 2001/05/28 17:28:55 maranget Exp $ *) (***********************************************************************) exception Error of string val ptop : unit -> unit 15 val to_string : Lexeme.token -> string val cost : Lexeme.style -> int * int val reset : unit -> unit val next_token : Lexing.lexbuf -> Lexeme.token <6>29 html.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) open Lexstate exception Error of string type block 15 val iso : char -> string val iso_string : string -> string val set_out : Out.t -> unit 20 val stop : unit -> unit val restart : unit -> unit val get_last_closed : unit -> block val set_last_closed : block -> unit val is_empty : unit -> bool 25 val get_fontsize : unit -> int val nostyle : unit -> unit val clearstyle : unit -> unit val open_mod : Element.text -> unit 30 val erase_mods : Element.text list -> unit val par : int option -> unit val forget_par : unit -> int option val open_block : string -> string -> unit val close_block : string -> unit 35 val force_block : string -> string -> unit val insert_block : string -> string -> unit val insert_attr : string -> string -> unit val open_maths : bool -> unit 40 val close_maths : bool -> unit val open_display : unit -> unit val close_display : unit -> unit val item_display : unit -> unit val force_item_display : unit -> unit 45 val erase_display : unit -> unit val standard_sup_sub : (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit val limit_sup_sub : 50 (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit val int_sup_sub : bool -> int -> (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit 55 val over : bool -> Lexing.lexbuf -> unit val left : string -> (int -> unit) -> unit val right : string -> int val set_dcount : string -> unit 60 val item : unit -> unit val nitem : unit -> unit val ditem : (string -> unit) -> string -> unit val erase_block : string -> unit val open_group : string -> unit 65 val open_aftergroup : (string -> string) -> unit val close_group : unit -> unit val put : string -> unit val put_char : char -> unit val flush_out : unit -> unit 70 val skip_line : unit -> unit val loc_name : string -> unit val open_chan : out_channel -> unit 75 val close_chan : unit -> unit val to_string : (unit -> unit) -> string val to_style : (unit -> unit) -> Element.text list val get_current_output : unit -> string 80 val finalize : bool -> unit val horizontal_line : string -> Length.t -> Length.t -> unit val put_separator : unit -> unit val unskip : unit -> unit 85 val put_tag : string -> unit val put_nbsp : unit -> unit val put_open_group : unit -> unit val put_close_group : unit -> unit val put_in_math : string -> unit 90 val open_table : bool -> string -> unit val new_row : unit -> unit val open_cell : Tabular.format -> int -> int -> unit 95 val erase_cell : unit -> unit val close_cell : string -> unit val do_close_cell : unit -> unit val open_cell_group : unit -> unit val close_cell_group : unit -> unit 100 val erase_cell_group : unit -> unit val close_row : unit -> unit val erase_row : unit -> unit val close_table : unit -> unit val make_border : string -> unit 105 val make_inside : string -> bool -> unit val make_hline : int -> bool -> unit val infomenu : string -> unit val infonode : string -> string -> string -> unit 110 val infoextranode : string -> string -> string -> unit val image : string -> string -> unit type saved 115 val check : unit -> saved val hot : saved -> unit <6>30 htmlparse.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: htmlparse.mli,v 1.4 2001/05/28 17:28:55 maranget Exp $ *) (***********************************************************************) exception Error of string val reset : unit -> unit 15 val main : Lexing.lexbuf -> Lexeme.style Tree.t list <6>31 htmltext.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: htmltext.mli,v 1.5 2001/05/28 17:28:56 maranget Exp $ *) (***********************************************************************) exception No type tsize = Int of int | Big | Small 15 type nat = Style of Lexeme.tag | Size of tsize | Color of string | Face of string 20 | Other type t_style = { nat : nat; txt : string; ctxt : string; } type style = t_style list 25 val cost : style -> int * int exception NoProp val get_prop : nat -> (nat -> bool) val is_font : nat -> bool val font_props : (nat -> bool) list 30 val neutral_prop : (nat -> bool) -> bool val same_style : t_style -> t_style -> bool type env = t_style list exception Split of t_style * env 35 val add_style : Lexeme.style -> env -> env val blanksNeutral : t_style -> bool <6>32 imageManager.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) module type S = sig 15 val start : unit -> unit val stop : unit -> unit val restart : unit -> unit val put_char : char -> unit 20 val put : string -> unit val dump : string -> (Lexing.lexbuf -> unit) -> Lexing.lexbuf -> unit val page : unit -> unit 25 val finalize : bool -> bool end <6>33 image.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val start : unit -> unit val stop : unit -> unit val restart : unit -> unit 15 val put_char : char -> unit val put : string -> unit 20 val dump : string -> (Lexing.lexbuf -> unit) -> Lexing.lexbuf -> unit val page : unit -> unit val finalize : bool -> bool <6>34 index.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val newindex : string -> string -> string -> string -> unit val changename : string -> string -> unit val treat: string -> string -> string -> string 15 val print: (string -> unit) -> string -> unit val finalize : bool -> bool <6>35 info.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) open Lexstate exception Error of string type block 15 val iso : char -> string val iso_string : string -> string val set_out : Out.t -> unit 20 val stop : unit -> unit val restart : unit -> unit val get_last_closed : unit -> block val set_last_closed : block -> unit val is_empty : unit -> bool 25 val get_fontsize : unit -> int val nostyle : unit -> unit val clearstyle : unit -> unit val open_mod : Element.text -> unit 30 val erase_mods : Element.text list -> unit val par : int option -> unit val forget_par : unit -> int option val open_block : string -> string -> unit val close_block : string -> unit 35 val force_block : string -> string -> unit val insert_block : string -> string -> unit val insert_attr : string -> string -> unit val open_maths : bool -> unit 40 val close_maths : bool -> unit val open_display : unit -> unit val close_display : unit -> unit val item_display : unit -> unit val force_item_display : unit -> unit 45 val erase_display : unit -> unit val standard_sup_sub : (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit val limit_sup_sub : 50 (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit val int_sup_sub : bool -> int -> (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit 55 val over : bool -> Lexing.lexbuf -> unit val left : string -> (int -> unit) -> unit val right : string -> int val set_dcount : string -> unit 60 val item : unit -> unit val nitem : unit -> unit val ditem : (string -> unit) -> string -> unit val erase_block : string -> unit val open_group : string -> unit 65 val open_aftergroup : (string -> string) -> unit val close_group : unit -> unit val put : string -> unit val put_char : char -> unit val flush_out : unit -> unit 70 val skip_line : unit -> unit val loc_name : string -> unit val open_chan : out_channel -> unit 75 val close_chan : unit -> unit val to_string : (unit -> unit) -> string val to_style : (unit -> unit) -> Element.text list val get_current_output : unit -> string 80 val finalize : bool -> unit val horizontal_line : string -> Length.t -> Length.t -> unit val put_separator : unit -> unit val unskip : unit -> unit 85 val put_tag : string -> unit val put_nbsp : unit -> unit val put_open_group : unit -> unit val put_close_group : unit -> unit val put_in_math : string -> unit 90 val open_table : bool -> string -> unit val new_row : unit -> unit val open_cell : Tabular.format -> int -> int -> unit 95 val erase_cell : unit -> unit val close_cell : string -> unit val do_close_cell : unit -> unit val open_cell_group : unit -> unit val close_cell_group : unit -> unit 100 val erase_cell_group : unit -> unit val close_row : unit -> unit val erase_row : unit -> unit val close_table : unit -> unit val make_border : string -> unit 105 val make_inside : string -> bool -> unit val make_hline : int -> bool -> unit val infomenu : string -> unit val infonode : string -> string -> string -> unit 110 val infoextranode : string -> string -> string -> unit val image : string -> string -> unit type saved 115 val check : unit -> saved val hot : saved -> unit <6>36 latexmacros.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) open Lexstate exception Failed 15 type saved val checkpoint : unit -> saved val hot_start : saved -> unit val pretty_table : unit -> unit 20 val register_init : string -> (unit -> unit) -> unit val exec_init : string -> unit val open_group : unit -> unit val close_group : unit -> unit 25 val get_level : unit -> int val exists : string -> bool val find : string -> Lexstate.pat * Lexstate.action val pretty_macro : Lexstate.pat -> Lexstate.action -> unit 30 val def : string -> Lexstate.pat -> Lexstate.action -> unit val global_def : string -> Lexstate.pat -> Lexstate.action -> unit (******************) (* For inside use *) 35 (******************) (* raises Failed if already defined *) val def_init : string -> (Lexing.lexbuf -> unit) -> unit (* raises Failed if not defined *) 40 val find_fail : string -> Lexstate.pat * Lexstate.action (* replace name new, Send back the Some (old definition for name) or None 45 - if new is Some (def) then def replaces the old definition, or a definition is created - if new is None, then undefine the last local binding for name. *) 50 val replace : string -> (Lexstate.pat * Lexstate.action) option -> (Lexstate.pat * Lexstate.action) option 55 val invisible : string -> bool <6>37 latexscan.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) open Lexstate module type S = sig 15 (* external entry points *) val no_prelude : unit -> unit val main : Lexing.lexbuf -> unit val print_env_pos : unit -> unit 20 (* additional resources needed for extension modules. *) val cur_env : string ref val new_env : string -> unit val close_env : string -> unit val echo_toimage : unit -> bool 25 val echo_global_toimage : unit -> bool val fun_register : (unit -> unit) -> unit val newif_ref : string -> bool ref -> unit val top_open_block : string -> string -> unit 30 val top_close_block : string -> unit val check_alltt_skip : Lexing.lexbuf -> unit val skip_pop : Lexing.lexbuf -> unit (* ``def'' functions for initialisation only *) val def_code : string -> (Lexing.lexbuf -> unit) -> unit 35 val def_name_code : string -> (string -> Lexing.lexbuf -> unit) -> unit val def_fun : string -> (string -> string) -> unit val get_this_main : string -> string val check_this_main : string -> bool val get_prim : string -> string 40 val get_prim_arg : Lexing.lexbuf -> string val get_prim_opt : string -> Lexing.lexbuf -> string val get_csname : Lexing.lexbuf -> string end 45 module Make (Dest : OutManager.S) (Image : ImageManager.S) : S <6>38 length.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: length.mli,v 1.6 2001/05/25 12:37:26 maranget Exp $ *) (***********************************************************************) val font : int type t = Char of int | Pixel of int | Percent of int | No of string | Default 15 val pretty : t -> string val font : int val pixel_to_char : int -> int val char_to_pixel : int -> int 20 val main: Lexing.lexbuf -> t <6>39 lexeme.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: lexeme.mli,v 1.4 2001/05/28 17:28:56 maranget Exp $ *) (***********************************************************************) type tag = | TT |I |B |BIG |SMALL | STRIKE | S |U |FONT 15 | EM |STRONG |DFN |CODE |SAMP | KBD |VAR |CITE |ABBR |ACRONYM | Q |SUB |SUP | A | SCRIPT | SPAN type atag = 20 | SIZE of string | COLOR of string | FACE of string | OTHER type attr = atag * string type attrs = attr list 25 type token = | Open of tag * attrs * string | Close of tag * string | Text of string 30 | Blanks of string | Eof type style = {tag : tag ; attrs : attrs ; txt : string ; ctxt : string} <6>40 lexstate.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) type action = | Subst of string 15 | Toks of string list | CamlCode of (Lexing.lexbuf -> unit) val pretty_action : action -> unit 20 type pat = string list * string list val pretty_pat : pat -> unit val is_subst : action -> bool val latex_pat: string list -> int -> pat val zero_pat : pat 25 val one_pat : pat type subst type 'a arg = {arg : 'a ; subst : subst } val mkarg : 'a -> subst -> 'a arg 30 val string_to_arg : 'a -> 'a arg val top_subst : subst val get_subst : unit -> subst 35 exception Error of string type alltt = Not | Inside | Macro val effective : alltt -> bool val raw_chars : bool ref 40 val display : bool ref val in_math : bool ref val alltt : alltt ref val french : bool ref val optarg : bool ref 45 val styleloaded : bool ref val activebrace : bool ref val html : bool ref val text : bool ref val alltt_loaded : bool ref 50 val is_plain : char -> bool val set_plain : char -> unit val unset_plain : char -> unit val plain_back : bool -> char -> unit 55 val withinLispComment : bool ref val afterLispCommentNewlines : int ref type case = Upper | Lower | Neutral 60 val case : case ref type closenv val top_level : unit -> bool 65 val is_top : subst -> bool val prerr_args : unit -> unit val full_pretty_subst : subst -> unit 70 val pretty_lexbuf : Lexing.lexbuf -> unit val scan_arg : (string arg -> 'a) -> int -> 'a val scan_body : 75 (action -> 'a) -> action -> subst -> 'a val stack_lexbuf : Lexing.lexbuf Stack.t val previous_lexbuf : unit -> Lexing.lexbuf val record_lexbuf : Lexing.lexbuf -> subst -> unit 80 val top_lexstate : unit -> bool (* Saving and restoring lexstates on a stack *) val protect_save_string : (Lexing.lexbuf -> string) -> Lexing.lexbuf -> string val save_lexstate : unit -> unit 85 val restore_lexstate : unit -> unit val start_lexstate : unit -> unit val start_lexstate_subst : subst -> unit (* Total checkpoint of lexstate *) 90 type saved_lexstate val check_lexstate : unit -> saved_lexstate val hot_lexstate : saved_lexstate -> unit val flushing : bool ref 95 val stack_in_math : bool Stack.t val stack_display : bool Stack.t val stack_alltt : alltt Stack.t val start_normal: subst -> unit 100 val end_normal : unit -> unit (* Super/Sub-script parsing *) type sup_sub = { limits : Misc.limits option; 105 sup : string arg; sub : string arg; } val unoption : string arg option -> string arg 110 val save_sup_sub : Lexing.lexbuf -> sup_sub val save_sup : Lexing.lexbuf -> string arg option val save_sub : Lexing.lexbuf -> string arg option (* Argument parsing *) type ok = | No of string | Yes of string 115 val from_ok : ok arg -> string arg val save_arg : Lexing.lexbuf -> string arg val save_filename : Lexing.lexbuf -> string arg val save_verbatim : Lexing.lexbuf -> string arg 120 val save_opt : string -> Lexing.lexbuf -> string arg val save_opts : string list -> Lexing.lexbuf -> ok arg list val save_arg_with_delim : string -> Lexing.lexbuf -> string arg val pretty_ok : ok -> string val skip_opt : Lexing.lexbuf -> unit 125 val skip_csname : Lexing.lexbuf -> unit val make_stack : string -> pat -> Lexing.lexbuf -> subst 130 val scan_this : (Lexing.lexbuf -> 'a ) -> string -> 'a val scan_this_arg : (Lexing.lexbuf -> 'a ) -> string arg -> 'a val scan_this_may_cont : (Lexing.lexbuf -> 'a ) -> Lexing.lexbuf -> subst -> string arg -> 'a 135 val real_input_file : int -> (Lexing.lexbuf -> unit) -> string -> in_channel -> unit val input_file : int -> (Lexing.lexbuf -> unit) -> string -> unit 140 val register_cell : string -> bool ref -> unit val unregister_cell : string -> unit type saved val checkpoint : unit -> saved 145 val hot_start : saved -> unit <6>41 location.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) type saved val check : unit -> saved val hot : saved -> unit 15 val get : unit -> string val set : string -> Lexing.lexbuf -> unit val restore : unit -> unit 20 type t val get_pos : unit -> t val print_pos : unit -> unit val print_fullpos : unit -> unit val print_this_pos : t -> unit 25 val print_this_fullpos : t -> unit <6>42 misc.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) exception Fatal of string exception NoSupport of string exception Purposly of string 15 exception ScanError of string exception UserError of string exception EndInput exception EndDocument exception Close of string 20 exception EndOfLispComment of int (* QNC *) val hot_start : unit -> unit val verbose : int ref val readverb : int ref 25 val silent : bool ref val column_to_command : string -> string val warning : string -> unit val print_verb : int -> string -> unit val message : string -> unit 30 val fatal : string -> 'a val not_supported : string -> 'a (* Copying hash tables, not very nice at present *) val copy_hashtbl : (string, 'a) Hashtbl.t -> (string, 'a) Hashtbl.t -> unit 35 val clone_hashtbl : (string, 'a) Hashtbl.t -> (string, 'a) Hashtbl.t val copy_int_hashtbl : (int, 'a) Hashtbl.t -> (int, 'a) Hashtbl.t -> unit val clone_int_hashtbl : (int, 'a) Hashtbl.t -> (int, 'a) Hashtbl.t val start_env : string -> string 40 val end_env : string -> string type limits = Limits | NoLimits | IntLimits <6>43 myfiles.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) exception Error of string exception Except 15 val open_tex : string -> string * in_channel val find : string -> string val changed : string -> string -> bool <6>44 mylib.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val static_libdir : string val libdir : string <6>45 mysys.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) exception Error of string val put_from_file : string -> (string -> unit) -> unit val copy_from_lib : string -> string -> unit 15 val rename : string -> string -> unit val remove : string -> unit <6>46 noimage.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val start : unit -> unit val stop : unit -> unit val restart : unit -> unit 15 val put_char : char -> unit val put : string -> unit 20 val dump : string -> (Lexing.lexbuf -> unit) -> Lexing.lexbuf -> unit val page : unit -> unit val finalize : bool -> bool <6>47 outManager.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) open Lexstate module type S = sig exception Error of string 15 type block val iso : char -> string val iso_string : string -> string 20 val set_out : Out.t -> unit val stop : unit -> unit val restart : unit -> unit val get_last_closed : unit -> block val set_last_closed : block -> unit 25 val is_empty : unit -> bool val get_fontsize : unit -> int val nostyle : unit -> unit val clearstyle : unit -> unit 30 val open_mod : Element.text -> unit val erase_mods : Element.text list -> unit val par : int option -> unit val forget_par : unit -> int option val open_block : string -> string -> unit 35 val close_block : string -> unit val force_block : string -> string -> unit val insert_block : string -> string -> unit val insert_attr : string -> string -> unit 40 val open_maths : bool -> unit val close_maths : bool -> unit val open_display : unit -> unit val close_display : unit -> unit val item_display : unit -> unit 45 val force_item_display : unit -> unit val erase_display : unit -> unit val standard_sup_sub : (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit 50 val limit_sup_sub : (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit val int_sup_sub : bool -> int -> (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit 55 val over : bool -> Lexing.lexbuf -> unit val left : string -> (int -> unit) -> unit val right : string -> int 60 val set_dcount : string -> unit val item : unit -> unit val nitem : unit -> unit val ditem : (string -> unit) -> string -> unit val erase_block : string -> unit 65 val open_group : string -> unit val open_aftergroup : (string -> string) -> unit val close_group : unit -> unit val put : string -> unit val put_char : char -> unit 70 val flush_out : unit -> unit val skip_line : unit -> unit val loc_name : string -> unit 75 val open_chan : out_channel -> unit val close_chan : unit -> unit val to_string : (unit -> unit) -> string val to_style : (unit -> unit) -> Element.text list val get_current_output : unit -> string 80 val finalize : bool -> unit val horizontal_line : string -> Length.t -> Length.t -> unit val put_separator : unit -> unit 85 val unskip : unit -> unit val put_tag : string -> unit val put_nbsp : unit -> unit val put_open_group : unit -> unit val put_close_group : unit -> unit 90 val put_in_math : string -> unit val open_table : bool -> string -> unit val new_row : unit -> unit 95 val open_cell : Tabular.format -> int -> int -> unit val erase_cell : unit -> unit val close_cell : string -> unit val do_close_cell : unit -> unit val open_cell_group : unit -> unit 100 val close_cell_group : unit -> unit val erase_cell_group : unit -> unit val close_row : unit -> unit val erase_row : unit -> unit val close_table : unit -> unit 105 val make_border : string -> unit val make_inside : string -> bool -> unit val make_hline : int -> bool -> unit val infomenu : string -> unit 110 val infonode : string -> string -> string -> unit val infoextranode : string -> string -> string -> unit val image : string -> string -> unit 115 type saved val check : unit -> saved val hot : saved -> unit end <6>48 out.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) type t val free : t -> unit 15 val create_buff : unit -> t val create_chan : out_channel -> t val create_null : unit -> t val is_null : t -> bool val is_empty : t -> bool 20 val reset : t -> unit val is_empty: t -> bool val put : t -> string -> unit 25 val blit : t -> Lexing.lexbuf -> unit val put_char : t -> char -> unit val flush: t -> unit val get_pos : t -> int val erase_start : int -> t -> unit 30 val iter : (char -> unit) -> t -> unit val to_string : t -> string val to_chan : out_channel -> t -> unit val copy : t -> t -> unit 35 val copy_fun : (string -> string) -> t -> t -> unit val copy_no_tag : t -> t -> unit val close : t -> unit val debug : out_channel -> t -> unit 40 val unskip : t -> unit <6>49 package.mli (***********************************************************************) (* *) (* HEVEA *) (* Luc Maranget, projet PARA, INRIA Rocquencourt *) 5 (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) (* *) 10 (***********************************************************************) (* $Id: package.mli,v 1.2 1999/10/13 08:21:26 maranget Exp $ *) module type S = sig end 15 module Make (Dest : OutManager.S) (Image : ImageManager.S) (Scan : Latexscan.S) : S <6>50 parse_opts.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) type input = File of string | Prog of string val symbols : bool ref 15 val iso : bool ref type language = Francais | English val language : language ref type destination = Html | Text | Info val destination : destination ref 20 val mathml : bool ref val entities : bool ref val pedantic : bool ref val fixpoint : bool ref val optimize : bool ref 25 val width : int ref val except : string list ref val path : string list ref val filter : bool 30 val styles : input list val base_in : string val name_in : string val base_out : string val name_out : string <6>51 pp.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: pp.mli,v 1.4 2001/05/28 17:28:56 maranget Exp $ *) (***********************************************************************) val ptree : out_channel -> Lexeme.style Tree.t -> unit val ptrees : out_channel -> Lexeme.style Tree.t list -> unit 15 val tree : out_channel -> Htmltext.style Tree.t -> unit val trees : out_channel -> Htmltext.style Tree.t list -> unit <6>52 save.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val if_next_char : char -> Lexing.lexbuf -> bool val if_next_string : string -> Lexing.lexbuf -> bool 15 exception Error of string exception Delim of string val empty_buffs : unit -> unit val set_verbose : bool -> int -> unit val seen_par : bool ref 20 exception Eof exception NoOpt val get_echo : unit -> string val start_echo : unit -> unit 25 val opt : Lexing.lexbuf -> string val arg : Lexing.lexbuf -> string val arg_verbatim : Lexing.lexbuf -> string val csname : Lexing.lexbuf -> (string -> string) -> (string -> string) -> string 30 val incsname : Lexing.lexbuf -> string val cite_arg : Lexing.lexbuf -> string list val rest : Lexing.lexbuf -> string val num_arg : Lexing.lexbuf -> (string -> int) -> int val skip_equal : Lexing.lexbuf -> unit 35 val check_equal : Lexing.lexbuf -> bool val filename : Lexing.lexbuf -> string (* Superscript and subscripts *) val get_limits : Lexing.lexbuf -> Misc.limits option val get_sup : Lexing.lexbuf -> string option 40 val get_sub : Lexing.lexbuf -> string option val defargs : Lexing.lexbuf -> string list val get_defargs : Lexing.lexbuf -> string val tagout : Lexing.lexbuf -> string 45 val checklimits : Lexing.lexbuf -> bool val skip_delim : string -> Lexing.lexbuf -> unit val with_delim : string -> Lexing.lexbuf -> string val skip_blanks_init : Lexing.lexbuf -> unit <6>53 section.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val value: string -> int <6>54 stack.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: stack.mli,v 1.8 2001/05/28 17:28:56 maranget Exp $ *) (***********************************************************************) exception Fatal of string type 'a t 15 val create : string -> 'a t val create_init : string -> 'a -> 'a t val reset : 'a t -> unit val name : 'a t -> string 20 val push : 'a t -> 'a -> unit val pop : 'a t -> 'a val top : 'a t -> 'a val pretty : ('a -> string) -> 'a t -> unit val length : 'a t -> int 25 val empty : 'a t -> bool val rev : 'a t -> unit val map : 'a t -> ('a -> 'a) -> unit type 'a saved 30 val empty_saved : 'a saved val save : 'a t -> 'a saved val restore : 'a t -> 'a saved -> unit val finalize : 'a t -> ('a -> bool) -> ('a -> unit) -> unit (* 35 finalize now p f apply f to now elements until now is empty or p is true for one element *) <6>55 subst.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: subst.mli,v 1.6 2001/05/25 12:37:29 maranget Exp $ *) (***********************************************************************) open Lexstate val do_subst_this : string arg -> string val subst_this : string -> string 15 val subst_arg : Lexing.lexbuf -> string val subst_opt : string -> Lexing.lexbuf -> string val subst_body : Lexing.lexbuf -> string <6>56 symb.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val put_delim : (unit -> unit) -> (string -> unit) -> string -> int -> unit <6>57 table.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1999 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) exception Empty type 'a t 15 val create : 'a -> 'a t val reset : 'a t -> unit val emit : 'a t -> 'a -> unit val apply : 'a t -> ('a -> unit) -> unit 20 val trim : 'a t -> 'a array val remove_last : 'a t -> unit val get_size : 'a t -> int <6>58 tabular.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: tabular.mli,v 1.11 2001/05/25 12:37:29 maranget Exp $ *) (***********************************************************************) exception Error of string type align = 15 {hor : string ; mutable vert : string ; wrap : bool ; mutable pre : string ; mutable post : string ; width : Length.t} type format = Align of align | Inside of string 20 | Border of string val border : bool ref val pretty_format : format -> string 25 val pretty_formats : format array -> unit val main : string Lexstate.arg -> format array <6>59 text.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) open Lexstate exception Error of string type block 15 val iso : char -> string val iso_string : string -> string val set_out : Out.t -> unit val stop : unit -> unit 20 val restart : unit -> unit val get_last_closed : unit -> block val set_last_closed : block -> unit val is_empty : unit -> bool 25 val get_fontsize : unit -> int val nostyle : unit -> unit val clearstyle : unit -> unit val open_mod : Element.text -> unit val erase_mods : Element.text list -> unit 30 val par : int option -> unit val forget_par : unit -> int option val open_block : string -> string -> unit val close_block : string -> unit val force_block : string -> string -> unit 35 val insert_block : string -> string -> unit val insert_attr : string -> string -> unit val open_maths : bool -> unit val close_maths : bool -> unit 40 val open_display : unit -> unit val close_display : unit -> unit val item_display : unit -> unit val force_item_display : unit -> unit val erase_display : unit -> unit 45 val standard_sup_sub : (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit val limit_sup_sub : (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit 50 val int_sup_sub : bool -> int -> (string arg -> unit) -> (unit -> unit) -> string arg -> string arg -> bool -> unit val over : bool -> Lexing.lexbuf -> unit 55 val left : string -> (int -> unit) -> unit val right : string -> int val set_dcount : string -> unit val item : unit -> unit 60 val nitem : unit -> unit val ditem : (string -> unit) -> string -> unit val erase_block : string -> unit val open_group : string -> unit val open_aftergroup : (string -> string) -> unit 65 val close_group : unit -> unit val put : string -> unit val put_char : char -> unit val flush_out : unit -> unit val skip_line : unit -> unit 70 val loc_name : string -> unit val open_chan : out_channel -> unit val close_chan : unit -> unit 75 val to_string : (unit -> unit) -> string val to_style : (unit -> unit) -> Element.text list val get_current_output : unit -> string val finalize : bool -> unit 80 val horizontal_line : string -> Length.t -> Length.t -> unit val put_separator : unit -> unit val unskip : unit -> unit val put_tag : string -> unit 85 val put_nbsp : unit -> unit val put_open_group : unit -> unit val put_close_group : unit -> unit val put_in_math : string -> unit 90 val open_table : bool -> string -> unit val new_row : unit -> unit val open_cell : Tabular.format -> int -> int -> unit val erase_cell : unit -> unit 95 val close_cell : string -> unit val do_close_cell : unit -> unit val open_cell_group : unit -> unit val close_cell_group : unit -> unit val erase_cell_group : unit -> unit 100 val close_row : unit -> unit val erase_row : unit -> unit val close_table : unit -> unit val make_border : string -> unit val make_inside : string -> bool -> unit 105 val make_hline : int -> bool -> unit val infomenu : string -> unit val infonode : string -> string -> string -> unit val infoextranode : string -> string -> string -> unit 110 val image : string -> string -> unit type saved val check : unit -> saved 115 val hot : saved -> unit <6>60 thread.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val setup : string -> string -> unit val setprev : string -> string -> unit val setnext : string -> string -> unit 15 val setprevnext : string -> string -> unit val next : string -> string val prev : string -> string val up : string -> string 20 val change : string -> string -> unit <6>61 tree.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: tree.mli,v 1.4 2001/05/28 17:28:56 maranget Exp $ *) (***********************************************************************) open Lexeme 15 type 'a t = | Text of string | Blanks of string | Node of 'a * ('a t) list 20 | ONode of string * string * ('a t) list <6>62 ultra.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: ultra.mli,v 1.4 2001/05/28 17:28:56 maranget Exp $ *) (***********************************************************************) val verbose : int ref val main : out_channel -> Lexeme.style Tree.t list -> unit <6>63 util.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: util.mli,v 1.5 2001/05/28 17:28:56 maranget Exp $ *) (***********************************************************************) val cost : ('a -> int * int) -> 'a Tree.t -> int * int val costs : ('a -> int * int) -> 'a Tree.t list -> int * int 15 val cost_compare : int * int -> int * int -> int val there : Htmltext.t_style -> Htmltext.style -> bool val inter : Htmltext.style -> Htmltext.style -> Htmltext.style val union : Htmltext.style -> Htmltext.style -> Htmltext.style val sub : Htmltext.style -> Htmltext.style -> Htmltext.style 20 val neutral : Htmltext.style -> Htmltext.style * Htmltext.style val is_blank : 'a Tree.t -> bool val is_blanks : 'a Tree.t list -> bool val nodes : Htmltext.style -> Htmltext.style Tree.t list -> Htmltext.style Tree.t list 25 val node : Htmltext.style -> Htmltext.style Tree.t list -> Htmltext.style Tree.t <6>64 verb.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: verb.mli,v 1.9 2001/05/25 12:37:32 maranget Exp $ *) (***********************************************************************) exception VError of string module type S = sig end 15 module Make (Dest : OutManager.S) (Image : ImageManager.S) (Scan : Latexscan.S) : S <6>65 version.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) val version : string <6>66 videoc.mli (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* Christian Queinnec, Universite Paris IV *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) 10 (* *) (***********************************************************************) (* <Christian.Queinnec@lip6.fr> The plugin for HeVeA that implements the VideoC style. 15 $Id: videoc.mli,v 1.7 2001/05/25 12:37:34 maranget Exp $ *) module type T = sig 20 end;; module Make (Dest : OutManager.S) (Image : ImageManager.S) (Scan : Latexscan.S) : T <6>67 auxx.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) open Misc let header = "$Id: auxx.ml,v 1.14 2001/05/25 09:07:06 maranget Exp $" 15 let rtable = Hashtbl.create 17 ;; let rset name value = 20 Hashtbl.add rtable name value ;; let rget name = 25 try Hashtbl.find rtable name with Not_found -> begin warning ("Undefined label: ``"^name^"''") ; "??" end ;; 30 let btable = Hashtbl.create 17 ;; let bset name value = Hashtbl.add btable name value ;; 35 let bget warn name = let r = try Hashtbl.find btable name with Not_found -> begin 40 if warn then warning ("Undefined citation: ``"^name^"''") ; "\\@verbarg{"^name^"}" end in r ;; 45 let auxfile = ref None and auxname = ref "" and something = ref false and changed = ref false 50 ;; let rseen = Hashtbl.create 17 and bseen = Hashtbl.create 17 ;; 55 let init base = let filename = base^".haux" in try let file = open_out filename in 60 auxname := filename ; auxfile := Some file with Sys_error s -> warning ("Cannot open out file: "^filename^" : "^s) 65 (* result is true when another run is needed *) and finalize check = match !auxfile with | None -> false 70 | Some file -> close_out file ; if not !something then Mysys.remove !auxname; if check then begin 75 let check_disappear table seen = Hashtbl.iter (fun key _ -> try Hashtbl.find seen key with Not_found -> 80 Misc.warning ("Disappear: "^key) ; changed := true) table in if not !changed then begin check_disappear rtable rseen ; 85 check_disappear btable bseen end ; if !changed then Misc.message "HeVeA Warning: Label(s) may have changed. Rerun me to get cross-references right." ; 90 !changed end else false ;; 95 let write table output_fun key pretty = match !auxfile with | None -> () | Some file -> something := true ; changed := 100 !changed || (try let olds = Hashtbl.find_all table key in match olds with | [] -> true | [old] -> pretty <> old 105 | _ -> false (* In that case, can't tell *) with Not_found -> true) ; output_fun file ;; 110 let bcheck key = try let _ = Hashtbl.find bseen key in warning ("Multiple definitions for citation: "^key) ; 115 false with | Not_found -> Hashtbl.add bseen key () ; true 120 let rcheck key = try let _ = Hashtbl.find rseen key in warning ("Multiple definitions for label: "^key) ; 125 false with | Not_found -> Hashtbl.add rseen key () ; true 130 let bwrite key pretty = if bcheck key then write btable 135 (fun file -> output_string file "\\bibcite{" ; output_string file key ; output_string file "}{" ; output_string file pretty ; 140 output_string file "}\n") key pretty and rwrite key pretty = if rcheck key then write rtable 145 (fun file -> output_string file "\\newlabel{" ; output_string file key ; output_string file "}{{" ; output_string file pretty ; 150 output_string file "}{X}}\n") key pretty ;; type saved = (string, string) Hashtbl.t * (string, unit) Hashtbl.t * 155 (string, string) Hashtbl.t * (string, unit) Hashtbl.t * out_channel option * string * bool * bool let check () = Misc.clone_hashtbl rtable, Misc.clone_hashtbl rseen, 160 Misc.clone_hashtbl btable, Misc.clone_hashtbl bseen, !auxfile, !auxname, !something, !changed let hot (srtable, srseen, sbtable, sbseen, 165 sauxfile, sauxname, ssomething, schanged) = Misc.copy_hashtbl srtable rtable ; Misc.copy_hashtbl srseen rseen ; Misc.copy_hashtbl sbtable btable ; Misc.copy_hashtbl sbseen bseen ; auxfile := sauxfile ; auxname := sauxname ; 170 something := ssomething ; changed := schanged (* Valid only juste before reading main input file *) let hot_start () = 175 Hashtbl.clear rtable ; Hashtbl.clear rseen ; Hashtbl.clear btable ; Hashtbl.clear bseen ; auxfile := None ; auxname := "" ; something := false ; 180 changed := false <6>68 buff.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: buff.ml,v 1.4 2001/05/28 17:28:55 maranget Exp $ *) (***********************************************************************) type t = {mutable t : string ; mutable p : int} ;; 15 let create () = {t = String.create 64 ; p = 0} let rec realloc d b = let l = String.length b.t in if b.p + d-1 >= l then begin 20 let new_t = String.create (2*l) in String.blit b.t 0 new_t 0 b.p ; b.t <- new_t ; realloc d b end 25 let put_char b c = realloc 1 b ; b.t.[b.p] <- c ; 30 b.p <- b.p + 1 let put b s = let l = String.length s in realloc l b ; 35 String.blit s 0 b.t b.p l ; b.p <- b.p + l let to_string b = let r = String.sub b.t 0 b.p in 40 b.p <- 0 ; r let reset b = b.p <- 0 <6>69 color.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: color.ml,v 1.9 2000/01/19 20:10:58 maranget Exp $" let default_color = "#000000" 15 ;; let table = Hashtbl.create 17 ;; type saved = (string, string) Hashtbl.t 20 let checkpoint () = let ctable = Hashtbl.create 17 in Misc.copy_hashtbl table ctable ; ctable 25 and hot_start ctable = Misc.copy_hashtbl ctable table let to_hex x = Printf.sprintf "%02x" (truncate (255.0 *. x)) 30 ;; let cmyk_to_rgb c m y k = 1.0 -. min 1.0 (c *. (1.0 -. k) +. k), 1.0 -. min 1.0 (m *. (1.0 -. k) +. k), 35 1.0 -. min 1.0 (y *. (1.0 -. k) +. k) ;; let hls_to_rgb h l s = let rgb q1 q2 hue = 40 let hue = if hue > 360.0 then hue -. 360.0 else if hue < 0.0 then hue +. 360.0 else hue in if hue < 60.0 then 45 q1 +. (q2 -. q1) /. 60.0 else if hue < 180.0 then q2 else if hue < 240.0 then q1 +. (q2 -. q1) *. (240.0 -. hue) /. 60.0 50 else q1 in let p2 = if l <= 0.5 then l *. (1.0 +. s) else l +. s -. (l *. s) in 55 let p1 = 2.0 *. l -. p2 in if s = 0.0 then l,l,l else rgb p1 p2 (h +. 100.0), 60 rgb p1 p2 h, rgb p1 p2 (h -. 120.0) ;; let hsv_to_rgb h s v = 65 if s = 0.0 then v,v,v else let h = h /. 60.0 in let i = truncate h in let f = h -. float i in 70 let p = v *. (1.0 -. s) in let q = v *. (1.0 -. (s *. f)) in let t = v *. (1.0 -. (s *. (1.0 -. f))) in match i with | 0 -> v,t,p 75 | 1 -> q,v,p | 2 -> p,v,t | 3 -> p,q,v | 4 -> t,p,v | 5 -> v,p,q 80 | _ -> Misc.fatal ("Bad HSV color specification") ;; 85 exception Failed ;; let do_compute mdl value = match mdl with | "gray" -> 90 let x = Colscan.one (Lexing.from_string value) in let xx = to_hex x in xx^xx^xx | "rgb" -> let r,g,b = Colscan.three(Lexing.from_string value) in 95 to_hex r^to_hex g^to_hex b | "cmyk" -> let c,m,y,k = Colscan.four (Lexing.from_string value) in let r,g,b = cmyk_to_rgb c m y k in to_hex r^to_hex g^to_hex b 100 | "hsv" -> let h,s,v = Colscan.three (Lexing.from_string value) in let r,g,b = hsv_to_rgb h s v in to_hex r^to_hex g^to_hex b | "hls" -> 105 let h,l,s = Colscan.three (Lexing.from_string value) in let r,g,b = hls_to_rgb h l s in to_hex r^to_hex g^to_hex b | "named" -> begin try Hashtbl.find table ("named@"^value) with 110 | Not_found -> begin Misc.warning ("Unkown name in the named color model: "^value) ; raise Failed end end 115 | _ -> Misc.warning ("Color.compute, unknown color model: "^mdl); raise Failed 120 let compute mdl value = try do_compute mdl value with Failed -> "" let define clr mdl value = 125 try Hashtbl.add table clr (do_compute mdl value) with Failed -> () ;; 130 let retrieve clr = try Hashtbl.find table clr with Not_found -> Misc.warning ("Color.retrieve, unknown color: "^clr); 135 default_color ;; let define_named name mdl value = define ("named@"^name) mdl value 140 ;; let remove clr = Hashtbl.remove table clr <6>70 colscan.ml 12 "colscan.mll" open Lexing 5 exception Error of string ;; let buf = Out.create_buff () ;; 10 let lex_tables = { Lexing.lex_base = "\000\000\001\000\255\255\003\000\012\000\027\000\039\000\002\000\ "; Lexing.lex_backtrk = "\000\000\001\000\255\255\255\255\000\000\000\000\000\000\000\000\ "; 15 Lexing.lex_default = "\255\255\255\255\000\000\255\255\255\255\255\255\255\255\255\255\ "; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \004\000\003\000\007\000\003\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\004\000\002\000\005\000\002\000\ \006\000\006\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\007\000\006\000\006\000\005\000\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\000\000\007\000\ \000\000\000\000\000\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\000\000\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ "; Lexing.lex_check = 20 "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\001\000\007\000\003\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\004\000\001\000\000\000\003\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\004\000\005\000\004\000\004\000\004\000\004\000\ \004\000\004\000\004\000\004\000\004\000\004\000\255\255\006\000\ \255\255\255\255\255\255\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\005\000\005\000\006\000\255\255\006\000\ \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\ \006\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ " } let rec one lexbuf = __ocaml_lex_one_rec lexbuf 0 and __ocaml_lex_one_rec lexbuf state = 25 match Lexing.engine lex_tables state lexbuf with 0 -> ( 23 "colscan.mll" let lxm = lexeme lexbuf in float_of_string lxm) 30 | 1 -> ( 25 "colscan.mll" raise (Error "Syntax error in color argument")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_one_rec lexbuf n 35 and other lexbuf = __ocaml_lex_other_rec lexbuf 1 and __ocaml_lex_other_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 28 "colscan.mll" 40 one lexbuf) | 1 -> ( 29 "colscan.mll" raise (Error "Syntax error in color argument")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_other_rec lexbuf n 45 and three lexbuf = __ocaml_lex_three_rec lexbuf 2 and __ocaml_lex_three_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 50 33 "colscan.mll" let fst = one lexbuf in let snd = other lexbuf in let thrd = other lexbuf in fst,snd,thrd) 55 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_three_rec lexbuf n and four lexbuf = __ocaml_lex_four_rec lexbuf 2 and __ocaml_lex_four_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 60 0 -> ( 39 "colscan.mll" let fst = one lexbuf in let snd = other lexbuf in let thrd = other lexbuf in 65 let fourth = other lexbuf in fst,snd,thrd,fourth) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_four_rec lexbuf n ;; <6>71 counter.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: counter.ml,v 1.10 2000/01/19 20:10:59 maranget Exp $" type t_counter = {mutable count : int ; 15 mutable within : t_counter option ; mutable related : t_counter list} let mk_bidon () = {count = 0 ; within = None ; related = []} 20 type t_checked = {cname : string ; cvalue : int ; cwithin : int option ; crelated : int list} 25 let cbidon = {cname = "" ; cvalue = (-1) ; cwithin = None ; crelated = []} let ctable = (Hashtbl.create 19 : (string,t_counter) Hashtbl.t);; 30 type saved = t_checked array let prerr_cc check_ctable cc = prerr_endline ("counter: "^cc.cname) ; 35 prerr_endline ("\tvalue = "^string_of_int cc.cvalue) ; prerr_endline ("\twithin = "^ begin match cc.cwithin with | None -> "None" 40 | Some j -> (check_ctable).(j).cname end) ; prerr_string "\trelated =" ; List.iter (fun j -> 45 prerr_string " " ; prerr_string (check_ctable).(j).cname) cc.crelated ; prerr_endline "" 50 let checkpoint () = let module H = struct type t = t_counter let equal = (==) let hash = Hashtbl.hash 55 end in let module RevHash = Hashtbl.Make (H) in let rev_table = RevHash.create 19 and count = ref 0 in Hashtbl.iter 60 (fun key value -> RevHash.add rev_table value (key, !count) ; incr count) ctable ; let to_int c = 65 try let _,j = RevHash.find rev_table c in j with | Not_found -> Misc.fatal "Counter.checkpoint" in 70 let t = Array.create !count cbidon in RevHash.iter (fun {count = value ; within = within ; related = related} (name, i) -> 75 t.(i) <- {cname = name ; cvalue = value ; cwithin = begin match within with 80 | None -> None | Some c -> Some (to_int c) end ; crelated = List.map to_int related}) rev_table ; 85 t and hot_start check_ctable = Hashtbl.clear ctable ; 90 let rec create_rec i = let cc = (check_ctable).(i) in try Hashtbl.find ctable cc.cname with 95 | Not_found -> let c = {count = cc.cvalue ; within = None ; related = []} in Hashtbl.add ctable cc.cname c; c.within <- begin match cc.cwithin with 100 | None -> None | Some j -> Some (create_rec j) end ; c.related <- List.map create_rec cc.crelated ; if !Misc.verbose > 1 then begin prerr_string "Restored " ; 105 prerr_cc check_ctable cc end ; c in for i = 0 to Array.length check_ctable - 1 do let _ = create_rec i in () 110 done ;; let unkown name where = Misc.warning ("Unknown counter: "^name^" in "^where) 115 let find_counter name = Hashtbl.find ctable name let value_counter name = 120 try let {count=c} = find_counter name in c with Not_found -> begin unkown name "\\value" ; 0 125 end ;; let def_counter name within = try 130 let _ = Hashtbl.find ctable name in Misc.warning ("Counter "^name^" is already defined, not defining it") ; raise Latexmacros.Failed with | Not_found -> begin 135 let within_c = try match within with "" -> None | _ -> Some (find_counter within) with Not_found -> begin unkown within ("\\newcounter{"^name^"}["^within^"]") ; None end in 140 let c = {count=0 ; within=within_c ; related = []} in Hashtbl.add ctable name c ; match within_c with | Some d -> d.related <- c :: d.related | _ -> () 145 end let number_within name within = try let c = find_counter name in 150 begin match c.within with | Some d -> d.related <- List.fold_right (fun e r -> if e == c then r else e :: r) d.related [] 155 | _ -> () end ; let d = find_counter within in c.within <- Some d ; d.related <- c :: d.related 160 with Not_found -> unkown (name^" or "^within) ("\\numberwithin") let add_counter name i = try 165 let c = find_counter name in c.count <- c.count + i with Not_found -> unkown name "\\addtocounter" let set_counter name x = 170 try let c = find_counter name in c.count <- x with Not_found -> unkown name "\\setcounter" ;; 175 let step_counter name = try let c = find_counter name in c.count <- c.count + 1; 180 List.iter (fun c -> c.count <- 0) c.related with Not_found -> unkown name ("\\stepcounter") ;; <6>72 cross.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: cross.ml,v 1.10 2000/03/28 13:52:53 maranget Exp $" let verbose = ref 0 ;; 15 let table = Hashtbl.create 37 ;; let add name file = 20 if !verbose > 0 then prerr_endline ("Register "^name^" in "^file) ; try let _ = Hashtbl.find table name in Location.print_pos () ; 25 prerr_endline ("Warning, multiple definitions for anchor: "^name) ; with | Not_found -> Hashtbl.add table name (ref file) ;; 30 let fullname myfilename name = try let filename = !(Hashtbl.find table name) in 35 let newname = if myfilename = filename then "#"^name else filename^"#"^name in 40 if !verbose > 0 then prerr_endline ("From "^name^" to "^newname) ; newname with Not_found -> begin Location.print_pos () ; 45 prerr_endline ("Warning, cannot find anchor: "^name) ; raise Not_found end ;; 50 let change oldname name = Hashtbl.iter (fun k x -> if !x = oldname then x := name) table <6>73 cutmain.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: cutmain.ml,v 1.15 2001/05/25 09:07:08 maranget Exp $" exception Error of string 15 ;; let filename = ref "" ;; 20 let outname = ref "index.html" ;; let main () = Arg.parse 25 [("-o", Arg.String (fun s -> outname := s), "filename, make htmlcut output go into file ``filename'' (defaults to index.html)"); ("-francais", Arg.Unit (fun () -> Cut.language := "fra"), ", French mode"); ("-tocbis", Arg.Unit (fun () -> Cut.tocbis := true), 30 ", Add small table of contents at the begining of files"); ("-v", Arg.Unit (fun () -> incr Cut.verbose), ", verbose flag") ] (fun s -> filename := s) ("hacha "^Version.version); let base = Filename.basename !filename in 35 Cut.name := (try Filename.chop_extension base with Invalid_argument _ -> base) ; let chan = try open_in !filename with Sys_error s -> raise (Error ("File error: "^s)) in let buf = Lexing.from_channel chan in Location.set !filename buf ; 40 Cut.start_phase !outname ; Cut.main buf ; Location.restore () ; let chan = try open_in !filename with Sys_error s -> raise (Error ("File error: "^s)) in let buf = Lexing.from_channel chan in 45 Location.set !filename buf ; Cut.start_phase !outname ; Cut.main buf ;; 50 let copy_gifs () = try Mysys.copy_from_lib Mylib.libdir "previous_motif.gif" ; Mysys.copy_from_lib Mylib.libdir "next_motif.gif" ; 55 Mysys.copy_from_lib Mylib.libdir "contents_motif.gif" with | Mysys.Error s -> Location.print_pos () ; prerr_endline s 60 let _ = try main () ; copy_gifs () with 65 | Error s -> prerr_endline s ; prerr_endline "Adios" ; exit 2 | Cut.Error s -> 70 Location.print_pos () ; prerr_endline ("Error while reading HTML: "^s) ; prerr_endline "Adios" ; exit 2 | Misc.Fatal s -> 75 Location.print_pos () ; prerr_endline ("Fatal error: "^s^" (please report to Luc.Maranget@inria.fr") ; prerr_endline "Adios" ; exit 2 80 | x -> Location.print_pos () ; prerr_endline ("Fatal error: spurious exception "^Printexc.to_string x^ " (please report to Luc.Maranget@inria.fr") ; 85 prerr_endline "Adios" ; exit 2 ;; exit 0;; <6>74 cut.ml 12 "cut.mll" open Lexing open Stack 5 let header = "$Id: cut.mll,v 1.30 2001/05/25 09:07:07 maranget Exp $" let verbose = ref 0 ;; 10 let language = ref "eng" ;; let tocbis = ref false ;; 15 exception Error of string (* Accumulate all META, LINK and similar tags that appear in the preamble 20 in order to output them in the preamble of every generated page. *) let header_buff = Out.create_buff () let common_headers = ref "";; 25 let adjoin_to_header s = Out.put header_buff s and adjoin_to_header_char c = Out.put_char header_buff c and finalize_header () = 30 common_headers := Out.to_string header_buff let html_buff = Out.create_buff () let html_head = ref "" and html_foot = ref "" 35 let phase = ref (-1) ;; let name = ref "main" 40 and count = ref 0 ;; let body = ref "<BODY>" and doctype = ref "" 45 and html = ref "<HTML>" ;; let changed_t = Hashtbl.create 17 50 let rec check_changed name = try let r = Hashtbl.find changed_t name in check_changed r with 55 | Not_found -> name let new_filename () = incr count ; let r1 = Printf.sprintf "%s%0.3d.html" !name !count in 60 let r2 = check_changed r1 in r2 ;; let out = ref (Out.create_null ()) 65 and out_prefix = ref (Out.create_null ()) and outname = ref "" and lastclosed = ref "" and otheroutname = ref "" and flowname_stack = (Stack.create "flowname" : string Stack.t) 70 and flow_stack = (Stack.create "flow" : Out.t Stack.t) ;; let toc = ref !out and tocname = ref !outname 75 and otherout = ref !out ;; let change_name oldname name = if !phase <= 0 then begin 80 Thread.change oldname name ; Cross.change oldname name ; outname := name ; Hashtbl.add changed_t oldname name end 85 let start_phase name = incr phase ; if !verbose > 0 then 90 prerr_endline ("Starting phase number: "^string_of_int !phase); outname := name ; tocname := name ; otheroutname := "" ; count := 0 ; 95 if !phase > 0 then begin out := (Out.create_chan (open_out name)) end ; toc := !out ;; 100 let openlist out = Out.put out "<UL>\n" and closelist out = Out.put out "</UL>\n" and itemref filename s out = Out.put out "<LI>" ; 105 Out.put out "<A HREF=\"" ; Out.put out filename ; Out.put out "\">" ; Out.put out s ; Out.put out "</A>\n" 110 and itemanchor filename label s out = Out.put out "<LI>" ; Out.put out "<A HREF=\"" ; Out.put out filename ; 115 Out.put_char out '#' ; Out.put out label ; Out.put out "\">" ; Out.put out s ; Out.put out "</A>\n" 120 and putanchor label out = Out.put out "<A NAME=\"" ; Out.put out label ; Out.put out "\"></A>" 125 and itemlist s out = Out.put out "<LI>" ; Out.put out s ;; 130 let putlink out name img alt = Out.put out "<A HREF=\"" ; Out.put out name ; Out.put out "\"><IMG SRC =\"" ; 135 Out.put out img ; Out.put out "\" ALT=\"" ; Out.put out alt ; Out.put out "\"></A>\n" ;; 140 let link_buff = Out.create_buff () let putlinks name = let links_there = ref false in 145 if !verbose > 0 then prerr_endline ("putlinks: "^name) ; begin try putlink link_buff (Thread.prev name) "previous_motif.gif" (if !language = "fra" then "Precedent" 150 else "Previous") ; links_there := true with Not_found -> () end ; begin try putlink link_buff (Thread.up name) "contents_motif.gif" 155 (if !language = "fra" then "Index" else "Contents") ; links_there := true with Not_found -> () end ; begin try 160 putlink link_buff (Thread.next name) "next_motif.gif" (if !language = "fra" then "Suivant" else "Next") ; links_there := true with Not_found -> () end ; 165 if !links_there then Some (Out.to_string link_buff) else None 170 let putlinks_start out outname = match putlinks outname with | Some s -> Out.put out s ; Out.put out "<HR>\n" | None -> () 175 let putlinks_end out outname = match putlinks outname with | Some s -> Out.put out "<HR>\n" ; Out.put out s 180 | None -> () let openhtml withlinks title out outname = Out.put out !doctype ; Out.put_char out '\n' ; 185 Out.put out !html ; Out.put_char out '\n' ; Out.put out "<HEAD>\n" ; Out.put out !common_headers; Out.put out "<TITLE>\n" ; let title = Save.tagout (Lexing.from_string title) in 190 Out.put out title ; Out.put out "\n</TITLE>\n" ; Out.put out "</HEAD>\n" ; Out.put out !body; Out.put out "\n" ; 195 if withlinks then putlinks_start out outname ; Out.put out !html_head 200 and closehtml withlinks name out = Out.put out !html_foot ; if withlinks then begin putlinks_end out name end ; 205 Out.put out "</BODY>\n" ; Out.put out "</HTML>\n" ; Out.close out ;; 210 let put_sec hd title hde out = Out.put out hd ; Out.put_char out '\n' ; Out.put out title ; Out.put out hde ; 215 Out.put_char out '\n' ;; let put s = Out.put !out s 220 and put_char c = Out.put_char !out c ;; let cur_level = ref (Section.value "DOCUMENT") and chapter = ref (Section.value "CHAPTER") 225 and depth = ref 2 ;; (* Open all lists in toc from chapter to sec, with sec > chapter *) 230 let rec do_open l1 l2 = if l1 < l2 then begin openlist !toc ; if !tocbis then openlist !out_prefix ; do_open (l1+1) l2 235 end ;; (* close from l1 down to l2 *) let rec do_close l1 l2 = 240 if l1 > l2 then begin closelist !toc ; if !tocbis then closelist !out_prefix ; do_close (l1-1) l2 end else 245 cur_level := l1 ;; let anchor = ref 0 ;; 250 let open_section sec name = if !phase > 0 then begin if !cur_level > sec then do_close !cur_level sec else if !cur_level < sec then do_open !cur_level sec ; 255 incr anchor ; let label = "toc"^string_of_int !anchor in itemanchor !outname label name !toc ; if !tocbis then itemanchor !outname label name !out_prefix ; putanchor label !out ; 260 cur_level := sec end else cur_level := sec and close_section sec = 265 if !phase > 0 then do_close !cur_level sec else cur_level := sec ;; 270 let close_chapter () = if !verbose > 0 then prerr_endline ("Close chapter out="^ !outname^" toc="^ !tocname) ; if !phase > 0 then begin closehtml true !outname !out ; 275 if !tocbis then begin let real_out = open_out !outname in Out.to_chan real_out !out_prefix ; Out.to_chan real_out !out ; close_out real_out 280 end else Out.close !out ; out := !toc end else begin lastclosed := !outname ; 285 outname := !tocname end and open_chapter name = outname := new_filename () ; 290 if !verbose > 0 then prerr_endline ("Open chapter out="^ !outname^" toc="^ !tocname^ " cur_level="^string_of_int !cur_level) ; if !phase > 0 then begin 295 if !tocbis then begin out_prefix := Out.create_buff () ; out := !out_prefix ; openhtml true name !out_prefix !outname end else begin 300 out := Out.create_chan (open_out !outname) ; openhtml true name !out !outname end ; itemref !outname name !toc ; cur_level := !chapter 305 end else begin if !verbose > 0 then prerr_endline ("link prev="^ !lastclosed^" next="^ !outname) ; Thread.setup !outname !tocname ; Thread.setprevnext !lastclosed !outname ; 310 cur_level := !chapter end ;; let setlink set target = if !phase = 0 && target <> "" then 315 set !outname target let open_notes sec_notes = if sec_notes <> !chapter || !outname = !tocname then begin otheroutname := !outname ; 320 outname := new_filename () ; if !phase > 0 then begin otherout := !out ; out := Out.create_chan (open_out !outname) ; Out.put !out !doctype ; Out.put_char !out '\n' ; 325 Out.put !out !html ; Out.put_char !out '\n' ; Out.put !out "<HEAD><TITLE>Notes</TITLE>\n" ; Out.put !out !common_headers ; Out.put !out "</HEAD>\n" ; Out.put !out !body ; 330 Out.put !out "\n" end end else otheroutname := "" 335 and close_notes () = if !otheroutname <> "" then begin Out.put !out "\n</BODY></HTML>\n" ; Out.close !out ; outname := !otheroutname ; 340 out := !otherout ; otheroutname := "" end ;; 345 let toc_buf = Out.create_buff () and arg_buf = Out.create_buff () ;; let stack = Stack.create "main" 350 ;; let save_state newchapter newdepth = if !verbose > 0 then prerr_endline ("New state: "^string_of_int newchapter) ; 355 push stack (!outname, Stack.save flowname_stack, Stack.save flow_stack, !chapter,!depth,!toc,!tocname,!cur_level,!lastclosed,!out_prefix) ; chapter := newchapter ; depth := newdepth ; 360 tocname := !outname ; lastclosed := "" ; toc := !out ;; 365 let restore_state () = if !verbose > 0 then prerr_endline ("Restore") ; let oldoutname, oldflowname, oldflow, oldchapter,olddepth,oldtoc,oldtocname, 370 oldlevel,oldlastclosed,oldprefix = pop stack in outname := oldoutname ; Stack.restore flowname_stack oldflowname ; Stack.restore flow_stack oldflow ; chapter := oldchapter ; 375 depth := olddepth ; toc := oldtoc ; tocname := oldtocname ; lastclosed := !lastclosed ; cur_level := oldlevel ; 380 out_prefix := oldprefix ;; let hevea_footer = ref false 385 let close_top lxm = putlinks_end !toc !tocname ; if !hevea_footer then begin Out.put !out "<!--FOOTER-->\n" ; begin try 390 Mysys.put_from_file (Filename.concat Mylib.libdir ("cutfoot-"^ !language^".html")) (Out.put !out) with Mysys.Error s -> begin Location.print_pos () ; 395 prerr_endline s end end end ; Out.put !toc lxm ; 400 if !tocname = "" then Out.flush !toc else Out.close !toc ;; 405 let open_toc () = if !phase > 0 then openlist !toc and close_toc () = if !phase > 0 then closelist !toc ;; 410 let close_all () = if !cur_level > !chapter then begin close_section !chapter ; close_chapter () ; close_toc () 415 end else if !cur_level = !chapter then begin close_chapter () ; close_toc () end ; cur_level := (Section.value "DOCUMENT") 420 let openflow title = let new_outname = new_filename () in push flowname_stack !outname ; outname := new_outname ; 425 if !phase > 0 then begin push flow_stack !out ; out := Out.create_chan (open_out !outname) ; openhtml false title !out !outname end 430 and closeflow () = if !phase > 0 then begin closehtml false !outname !out; Out.close !out ; 435 out := pop flow_stack end ; outname := pop flowname_stack 440 let lex_tables = { Lexing.lex_base = "\000\000\001\000\002\000\003\000\004\000\000\000\000\000\013\000\ \031\000\078\000\079\000\063\000\109\000\000\000\001\000\032\000\ \254\255\000\000\028\000\032\000\255\255\095\000\000\000\033\000\ \000\000\005\000\016\001\252\255\253\255\014\000\061\000\014\000\ \032\000\251\255\021\000\030\000\110\000\002\000\031\000\031\000\ \140\000\003\000\057\000\067\000\068\000\074\000\250\255\014\000\ \080\000\064\000\076\000\004\000\168\000\079\000\067\000\070\000\ \089\000\253\255\083\000\067\000\094\000\080\000\085\000\108\000\ \140\000\001\000\158\000\140\000\150\000\162\000\005\000\150\000\ \162\000\152\000\161\000\169\000\177\000\178\000\002\000\194\000\ \177\000\161\000\173\000\183\000\202\000\187\000\003\000\222\000\ \074\001\203\000\185\000\173\000\186\000\166\000\200\000\007\000\ \217\000\181\000\193\000\183\000\192\000\211\000\219\000\004\000\ \246\000\210\000\210\000\200\000\209\000\217\000\227\000\221\000\ \226\000\224\000\232\000\005\000\250\000\251\000\228\000\220\000\ \231\000\133\001\192\001\012\001\000\001\240\000\005\000\234\255\ \250\001\233\255\007\001\237\000\008\000\225\000\156\001\240\000\ \229\000\231\000\247\000\238\255\242\000\249\000\236\255\244\000\ \225\000\253\000\237\255\009\000\237\000\008\001\244\000\018\001\ \235\255\062\001\029\001\042\001\026\001\023\001\086\001\098\001\ \106\001\239\255\218\001\165\001\100\001\085\001\148\001\152\001\ \160\001\157\001\167\001\164\001\157\001\127\001\140\001\010\000\ \011\000\174\001\175\001\012\000\174\001\167\001\178\001\254\001\ \203\001\189\001\006\000\248\255\175\001\185\001\223\001\224\001\ \211\001\216\001\209\001\005\002\007\002\212\001\223\001\227\001\ \016\002\226\001\237\001\242\001\240\001\022\002\008\002\249\001\ \007\000\242\255\233\001\229\001\026\002\016\002\000\002\008\000\ \241\255\250\001\255\001\020\002\023\002\025\002\009\000\246\001\ \249\001\004\002\252\001\008\002\004\002\045\002\034\002\018\002\ \244\255\253\001\014\002\002\002\044\002\046\002\030\002\010\000\ \240\255\006\002\062\002\063\002\028\002\065\002\066\002\023\002\ \021\002\017\002\033\002\020\002\072\002\060\002\045\002\011\000\ \245\255\029\002\022\002\078\002\066\002\050\002\012\000\029\002\ \082\002\047\002\049\002\041\002\052\002\089\002\077\002\062\002\ \013\000\247\255\055\002\094\002\095\002\057\002\056\002\052\002\ \099\002\100\002\054\002\051\002\068\002\055\002\107\002\108\002\ \059\002"; Lexing.lex_backtrk = "\255\255\255\255\255\255\255\255\255\255\001\000\001\000\255\255\ \255\255\255\255\255\255\255\255\002\000\000\000\001\000\255\255\ \255\255\001\000\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\255\255\001\000\255\255\255\255\003\000\003\000\003\000\ \003\000\255\255\255\255\255\255\255\255\000\000\255\255\255\255\ \255\255\001\000\255\255\255\255\255\255\255\255\255\255\005\000\ \005\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\003\000\003\000\003\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\001\000\001\000\ \255\255\255\255\255\255\255\255\001\000\255\255\000\000\000\000\ \000\000\001\000\255\255\255\255\255\255\255\255\255\255\000\000\ \001\000\255\255\255\255\255\255\255\255\255\255\255\255\000\000\ \002\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\001\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\000\000\255\255\ \021\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\012\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \005\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\007\000\255\255\255\255\255\255\255\255\004\000\ \255\255\255\255\255\255\255\255\002\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \013\000\255\255\255\255\255\255\255\255\255\255\255\255\014\000\ \255\255\255\255\255\255\255\255\255\255\255\255\000\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\015\000\ \255\255\255\255\255\255\001\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\010\000\ \255\255\255\255\255\255\255\255\255\255\255\255\003\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \008\000\255\255\255\255\255\255\006\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\009\000\ \255\255"; 445 Lexing.lex_default = "\127\000\016\000\057\000\016\000\016\000\255\255\255\255\016\000\ \016\000\027\000\046\000\027\000\255\255\255\255\255\255\016\000\ \000\000\255\255\255\255\255\255\000\000\255\255\255\255\255\255\ \255\255\025\000\255\255\000\000\000\000\255\255\255\255\255\255\ \255\255\000\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\000\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\000\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\095\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\110\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\000\000\ \255\255\000\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\138\000\000\000\255\255\141\000\000\000\255\255\ \255\255\145\000\000\000\255\255\255\255\255\255\255\255\255\255\ \000\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \160\000\000\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\000\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\000\000\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\255\255\255\255\219\000\219\000\219\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\000\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255"; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\020\000\027\000\016\000\020\000\020\000\020\000\ \187\000\209\000\216\000\020\000\240\000\000\001\027\000\017\001\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \013\000\021\000\037\000\041\000\052\000\071\000\116\000\020\000\ \147\000\147\000\176\000\176\000\180\000\023\000\022\000\018\000\ \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ \087\000\087\000\084\000\064\000\128\000\115\000\104\000\096\000\ \089\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\079\000\017\000\019\000\020\000\024\000\ \044\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\066\000\047\000\028\000\042\000\021\000\ \038\000\034\000\035\000\036\000\039\000\040\000\043\000\029\000\ \036\000\045\000\067\000\048\000\022\000\030\000\036\000\025\000\ \040\000\049\000\050\000\051\000\061\000\058\000\056\000\057\000\ \059\000\060\000\026\000\026\000\020\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\031\000\ \062\000\063\000\016\000\037\000\040\000\032\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \052\000\041\000\065\000\077\000\026\000\068\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \069\000\070\000\072\000\073\000\074\000\075\000\076\000\020\000\ \078\000\080\000\081\000\082\000\083\000\020\000\053\000\085\000\ \054\000\086\000\090\000\091\000\092\000\055\000\093\000\094\000\ \129\000\057\000\255\255\255\255\057\000\255\255\095\000\255\255\ \097\000\098\000\099\000\100\000\101\000\255\255\087\000\087\000\ \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ \102\000\103\000\111\000\107\000\108\000\109\000\110\000\057\000\ \255\255\016\000\112\000\113\000\114\000\105\000\020\000\117\000\ \118\000\119\000\120\000\121\000\123\000\125\000\126\000\148\000\ \143\000\140\000\137\000\138\000\153\000\139\000\141\000\142\000\ \144\000\124\000\145\000\146\000\149\000\026\000\026\000\033\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\106\000\154\000\150\000\151\000\057\000\033\000\ \152\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\162\000\155\000\156\000\157\000\026\000\ \158\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\121\000\159\000\160\000\ \161\000\021\001\007\001\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\163\000\122\000\122\000\ \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ \123\000\135\000\244\000\255\255\223\000\197\000\192\000\224\000\ \188\000\178\000\225\000\032\001\177\000\124\000\174\000\175\000\ \136\000\175\000\179\000\181\000\198\000\182\000\183\000\255\255\ \185\000\255\255\163\000\186\000\189\000\255\255\190\000\191\000\ \191\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ \122\000\122\000\122\000\130\000\164\000\165\000\183\000\166\000\ \167\000\193\000\168\000\194\000\195\000\196\000\169\000\196\000\ \170\000\131\000\217\000\184\000\199\000\171\000\172\000\200\000\ \200\000\210\000\203\000\204\000\205\000\207\000\205\000\208\000\ \211\000\212\000\212\000\132\000\133\000\214\000\215\000\218\000\ \219\000\220\000\134\000\206\000\221\000\241\000\221\000\213\000\ \233\000\226\000\227\000\228\000\229\000\229\000\173\000\231\000\ \232\000\234\000\255\255\235\000\236\000\255\255\201\000\222\000\ \202\000\237\000\230\000\238\000\239\000\242\000\243\000\243\000\ \245\000\246\000\246\000\001\001\249\000\250\000\251\000\252\000\ \252\000\254\000\255\255\255\000\002\001\003\001\003\001\005\001\ \006\001\008\001\009\001\010\001\011\001\253\000\018\001\012\001\ \013\001\013\001\015\001\004\001\016\001\019\001\020\001\020\001\ \022\001\023\001\024\001\025\001\025\001\027\001\014\001\028\001\ \247\000\029\001\030\001\031\001\031\001\225\000\000\000\000\000\ \248\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\026\001\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\255\255\000\000\000\000\255\255\ \000\000\255\255\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000"; Lexing.lex_check = 450 "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\024\000\065\000\078\000\086\000\103\000\126\000\ \186\000\208\000\215\000\222\000\239\000\255\000\006\001\016\001\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \013\000\014\000\037\000\041\000\051\000\070\000\115\000\025\000\ \132\000\147\000\175\000\176\000\179\000\022\000\014\000\017\000\ \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\ \006\000\006\000\007\000\047\000\000\000\001\000\002\000\003\000\ \004\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\008\000\015\000\018\000\019\000\023\000\ \029\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\009\000\010\000\011\000\030\000\021\000\ \031\000\032\000\034\000\035\000\038\000\039\000\042\000\011\000\ \043\000\044\000\009\000\010\000\021\000\011\000\036\000\012\000\ \045\000\048\000\049\000\050\000\053\000\054\000\055\000\056\000\ \058\000\059\000\012\000\012\000\060\000\012\000\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\011\000\ \061\000\062\000\063\000\036\000\040\000\011\000\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \052\000\040\000\064\000\066\000\012\000\067\000\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \068\000\069\000\071\000\072\000\073\000\074\000\075\000\076\000\ \077\000\079\000\080\000\081\000\082\000\083\000\052\000\084\000\ \052\000\085\000\089\000\090\000\091\000\052\000\092\000\093\000\ \000\000\001\000\002\000\003\000\004\000\025\000\094\000\095\000\ \096\000\097\000\098\000\099\000\100\000\007\000\087\000\087\000\ \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ \101\000\102\000\105\000\106\000\107\000\108\000\109\000\008\000\ \015\000\110\000\111\000\112\000\113\000\104\000\114\000\116\000\ \117\000\118\000\119\000\120\000\123\000\124\000\125\000\131\000\ \133\000\135\000\136\000\137\000\130\000\138\000\140\000\141\000\ \143\000\123\000\144\000\145\000\148\000\026\000\026\000\011\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\104\000\130\000\149\000\150\000\009\000\010\000\ \151\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\153\000\154\000\155\000\156\000\026\000\ \157\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\026\000\026\000\026\000\026\000\026\000\ \026\000\026\000\026\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\121\000\158\000\159\000\ \160\000\164\000\165\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ \088\000\088\000\088\000\088\000\088\000\163\000\121\000\121\000\ \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ \122\000\134\000\166\000\110\000\167\000\168\000\169\000\167\000\ \170\000\171\000\167\000\163\000\172\000\122\000\173\000\174\000\ \134\000\177\000\178\000\180\000\168\000\181\000\182\000\138\000\ \184\000\141\000\162\000\185\000\188\000\145\000\189\000\190\000\ \191\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ \122\000\122\000\122\000\128\000\162\000\162\000\183\000\162\000\ \162\000\192\000\162\000\193\000\194\000\195\000\162\000\196\000\ \162\000\128\000\197\000\183\000\198\000\162\000\162\000\199\000\ \200\000\201\000\202\000\203\000\204\000\206\000\205\000\207\000\ \210\000\211\000\212\000\128\000\128\000\213\000\214\000\217\000\ \218\000\219\000\128\000\205\000\220\000\223\000\221\000\212\000\ \224\000\225\000\226\000\227\000\228\000\229\000\162\000\230\000\ \231\000\233\000\219\000\234\000\235\000\220\000\200\000\221\000\ \200\000\236\000\229\000\237\000\238\000\241\000\242\000\243\000\ \244\000\245\000\246\000\247\000\248\000\249\000\250\000\251\000\ \252\000\253\000\160\000\254\000\001\001\002\001\003\001\004\001\ \005\001\007\001\008\001\009\001\009\001\252\000\010\001\011\001\ \012\001\013\001\014\001\003\001\015\001\018\001\019\001\020\001\ \021\001\022\001\023\001\024\001\025\001\026\001\013\001\027\001\ \246\000\028\001\029\001\030\001\031\001\032\001\255\255\255\255\ \246\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\025\001\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\219\000\255\255\255\255\220\000\ \255\255\221\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255" } let rec main lexbuf = __ocaml_lex_main_rec lexbuf 0 and __ocaml_lex_main_rec lexbuf state = 455 match Lexing.engine lex_tables state lexbuf with 0 -> ( 454 "cut.mll" let lxm = lexeme lexbuf in if !phase > 0 then begin 460 put lxm ; put ("<!--HACHA command line is: ") ; for i = 0 to Array.length Sys.argv - 1 do put Sys.argv.(i) ; put_char ' ' 465 done ; put "-->\n" end ; main lexbuf) | 1 -> ( 470 466 "cut.mll" let title = flowline lexbuf in openflow title ; main lexbuf) | 2 -> ( 475 470 "cut.mll" linkline lexbuf ; main lexbuf) | 3 -> ( 473 "cut.mll" 480 closeflow () ; main lexbuf) | 4 -> ( 476 "cut.mll" let name = tocline lexbuf in 485 change_name !outname name ; main lexbuf) | 5 -> ( 480 "cut.mll" let arg = secname lexbuf in 490 let sn = if String.uppercase arg = "NOW" then !chapter else Section.value arg in let name = tocline lexbuf in if !verbose > 1 then begin 495 prerr_endline ("TOC "^arg^" "^name) end; if sn < !chapter then begin if !cur_level >= !chapter then begin close_section (!chapter) ; 500 close_chapter () ; close_toc () end ; cur_level := sn end else if sn = !chapter then begin 505 if !cur_level < sn then begin open_toc () ; end else begin close_section !chapter ; close_chapter () 510 end ; open_chapter name end else if sn <= !chapter + !depth then begin (* sn > !chapter *) if !cur_level < !chapter then begin open_toc () ; 515 open_chapter "" end ; close_section sn ; open_section sn name end ; 520 main lexbuf) | 6 -> ( 513 "cut.mll" let chapter = Section.value (String.uppercase (secname lexbuf)) in skip_blanks lexbuf; 525 let depth = intarg lexbuf in skip_endcom lexbuf ; save_state chapter depth ; cur_level := Section.value "DOCUMENT" ; main lexbuf) 530 | 7 -> ( 521 "cut.mll" if !phase > 0 then begin if !tocbis && !out == !out_prefix then out := Out.create_buff () 535 end ; main lexbuf) | 8 -> ( 527 "cut.mll" close_all () ; 540 restore_state () ; main lexbuf) | 9 -> ( 531 "cut.mll" let sec_notes = secname lexbuf in 545 skip_endcom lexbuf ; open_notes (Section.value sec_notes) ; main lexbuf) | 10 -> ( 536 "cut.mll" 550 if !otheroutname <> "" then close_notes (); main lexbuf) | 11 -> ( 540 "cut.mll" 555 language := "fra" ; main lexbuf) | 12 -> ( 543 "cut.mll" if !phase > 0 then put (lexeme lexbuf) ; 560 aargs lexbuf) | 13 -> ( 546 "cut.mll" let head = save_html lexbuf in if !phase = 0 then 565 html_head := head else Out.put !out head; main lexbuf) | 14 -> ( 570 553 "cut.mll" let foot = save_html lexbuf in if !phase = 0 then html_foot := foot ; main lexbuf) 575 | 15 -> ( 558 "cut.mll" close_all () ; if !phase > 0 then begin hevea_footer := true ; 580 Out.put !out !html_foot end ; footer lexbuf) | 16 -> ( 565 "cut.mll" 585 let lxm = lexeme lexbuf in if !phase = 0 then doctype := lxm else Out.put !out lxm; 590 main lexbuf) | 17 -> ( 572 "cut.mll" let lxm = lexeme lexbuf in if !phase = 0 then 595 html := lxm else Out.put !out lxm; main lexbuf) | 18 -> ( 600 579 "cut.mll" let lxm = lexeme lexbuf in if !phase = 0 then body := lxm else begin 605 Out.put !out lxm ; putlinks_start !out !outname end ; main lexbuf) | 19 -> ( 610 588 "cut.mll" put (lexeme lexbuf); if !phase = 0 then begin if !verbose > 0 then prerr_endline "Collect header" ; collect_header lexbuf 615 end else main lexbuf) | 20 -> ( 595 "cut.mll" let lxm = lexeme lexbuf in 620 close_all () ; if !phase > 0 then begin close_top lxm end) | 21 -> ( 625 601 "cut.mll" let lxm = lexeme_char lexbuf 0 in if !phase > 0 then put_char lxm ; main lexbuf) | 22 -> ( 630 605 "cut.mll" raise (Error ("No </BODY> tag in input file"))) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_main_rec lexbuf n and save_html lexbuf = __ocaml_lex_save_html_rec lexbuf 1 635 and __ocaml_lex_save_html_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 609 "cut.mll" let s = Out.to_string html_buff in 640 if !verbose > 0 then prerr_endline ("save_html -> ``"^s^"''"); s) | 1 -> ( 614 "cut.mll" 645 let lxm = lexeme_char lexbuf 0 in Out.put_char html_buff lxm ; save_html lexbuf) | 2 -> ( 618 "cut.mll" 650 raise (Misc.Fatal ("End of file in save_html"))) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_save_html_rec lexbuf n and collect_header lexbuf = __ocaml_lex_collect_header_rec lexbuf 2 and __ocaml_lex_collect_header_rec lexbuf state = 655 match Lexing.engine lex_tables state lexbuf with 0 -> ( 622 "cut.mll" let lxm = lexeme lexbuf in finalize_header () ; 660 if !verbose > 0 then begin prerr_string "Header is: ``" ; prerr_string !common_headers ; prerr_endline "''" end ; 665 main lexbuf) | 1 -> ( 632 "cut.mll" skip_title lexbuf ; collect_header lexbuf) 670 | 2 -> ( 635 "cut.mll" let lxm = lexeme_char lexbuf 0 in adjoin_to_header_char lxm; collect_header lexbuf) 675 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_collect_header_rec lexbuf n and skip_title lexbuf = __ocaml_lex_skip_title_rec lexbuf 3 and __ocaml_lex_skip_title_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 680 0 -> ( 640 "cut.mll" ()) | 1 -> ( 641 "cut.mll" 685 skip_title lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_title_rec lexbuf n and footer lexbuf = __ocaml_lex_footer_rec lexbuf 4 and __ocaml_lex_footer_rec lexbuf state = 690 match Lexing.engine lex_tables state lexbuf with 0 -> ( 645 "cut.mll" let lxm = lexeme lexbuf in if !phase > 0 then begin 695 close_top lxm end) | 1 -> ( 649 "cut.mll" footer lexbuf) 700 | 2 -> ( 650 "cut.mll" raise (Misc.Fatal ("End of file in footer (no </BODY> tag)"))) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_footer_rec lexbuf n 705 and secname lexbuf = __ocaml_lex_secname_rec lexbuf 5 and __ocaml_lex_secname_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 654 "cut.mll" 710 let r = lexeme lexbuf in r) | 1 -> ( 655 "cut.mll" raise (Error "Bad section name syntax")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_secname_rec lexbuf n 715 and intarg lexbuf = __ocaml_lex_intarg_rec lexbuf 6 and __ocaml_lex_intarg_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 720 658 "cut.mll" int_of_string (lexeme lexbuf)) | 1 -> ( 659 "cut.mll" !depth) 725 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_intarg_rec lexbuf n and tocline lexbuf = __ocaml_lex_tocline_rec lexbuf 7 and __ocaml_lex_tocline_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 730 0 -> ( 662 "cut.mll" Out.to_string toc_buf) | 1 -> ( 664 "cut.mll" 735 Out.put_char toc_buf (lexeme_char lexbuf 0) ; tocline lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_tocline_rec lexbuf n and arg lexbuf = __ocaml_lex_arg_rec lexbuf 8 740 and __ocaml_lex_arg_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 668 "cut.mll" Out.to_string arg_buf) 745 | 1 -> ( 669 "cut.mll" Out.put_char arg_buf (Lexing.lexeme_char lexbuf 0) ; arg lexbuf) | 2 -> ( 670 "cut.mll" 750 raise (Misc.Fatal "Unclosed arg")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_arg_rec lexbuf n and flowline lexbuf = __ocaml_lex_flowline_rec lexbuf 9 and __ocaml_lex_flowline_rec lexbuf state = 755 match Lexing.engine lex_tables state lexbuf with 0 -> ( 674 "cut.mll" let title = arg lexbuf in let _ = flowline lexbuf in 760 title) | 1 -> ( 678 "cut.mll" "") | 2 -> ( 765 679 "cut.mll" raise (Misc.Fatal "Unclosed comment")) | 3 -> ( 680 "cut.mll" flowline lexbuf) 770 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_flowline_rec lexbuf n and linkline lexbuf = __ocaml_lex_linkline_rec lexbuf 10 and __ocaml_lex_linkline_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 775 0 -> ( 684 "cut.mll" let link = arg lexbuf in setlink Thread.setprev link ; linkline lexbuf) 780 | 1 -> ( 688 "cut.mll" let link = arg lexbuf in setlink Thread.setnext link ; linkline lexbuf) 785 | 2 -> ( 692 "cut.mll" let link = arg lexbuf in setlink Thread.setup link ; linkline lexbuf) 790 | 3 -> ( 696 "cut.mll" ()) | 4 -> ( 697 "cut.mll" 795 raise (Misc.Fatal "Unclosed comment")) | 5 -> ( 698 "cut.mll" linkline lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_linkline_rec lexbuf n 800 and aargs lexbuf = __ocaml_lex_aargs_rec lexbuf 11 and __ocaml_lex_aargs_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 805 702 "cut.mll" if !phase = 0 then begin let name = refname lexbuf in Cross.add name !outname end else 810 put (lexeme lexbuf) ; aargs lexbuf) | 1 -> ( 709 "cut.mll" if !phase > 0 then begin 815 let lxm = lexeme lexbuf in let name = refname lexbuf in try let newname = if String.length name > 0 && String.get name 0 = '#' then 820 Cross.fullname !outname (String.sub name 1 (String.length name-1)) else name in put lxm ; put "\"" ; put newname ; 825 put "\"" with Not_found -> () end ; aargs lexbuf) | 2 -> ( 830 725 "cut.mll" if !phase > 0 then put_char '>' ; main lexbuf) | 3 -> ( 728 "cut.mll" 835 if !phase > 0 then put_char (lexeme_char lexbuf 0) ; aargs lexbuf) | 4 -> ( 731 "cut.mll" raise (Error "Bad <A ...> tag")) 840 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_aargs_rec lexbuf n and refname lexbuf = __ocaml_lex_refname_rec lexbuf 12 and __ocaml_lex_refname_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 845 0 -> ( 735 "cut.mll" let lxm = lexeme lexbuf in String.sub lxm 1 (String.length lxm-2)) | 1 -> ( 850 738 "cut.mll" lexeme lexbuf) | 2 -> ( 739 "cut.mll" raise (Error "Bad reference name syntax")) 855 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_refname_rec lexbuf n and skip_blanks lexbuf = __ocaml_lex_skip_blanks_rec lexbuf 13 and __ocaml_lex_skip_blanks_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 860 0 -> ( 742 "cut.mll" ()) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_blanks_rec lexbuf n 865 and skip_endcom lexbuf = __ocaml_lex_skip_endcom_rec lexbuf 14 and __ocaml_lex_skip_endcom_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 745 "cut.mll" 870 ()) | 1 -> ( 746 "cut.mll" raise (Error "Bad HTML comment syntax")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_endcom_rec lexbuf n 875 and skip_aref lexbuf = __ocaml_lex_skip_aref_rec lexbuf 15 and __ocaml_lex_skip_aref_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 880 748 "cut.mll" ()) | 1 -> ( 749 "cut.mll" skip_aref lexbuf) 885 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_aref_rec lexbuf n ;; <6>75 element.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: element.ml,v 1.1 2000/05/30 12:30:14 maranget Exp $" (* For text-level elements *) type text = 15 Style of string | Font of int | Color of string let pretty_text = function 20 Style s -> "Style: "^s | Font i -> "Font size: "^string_of_int i | Color s -> "Font color: "^s ;; <6>76 emisc.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: emisc.ml,v 1.1 2001/05/29 09:23:30 maranget Exp $ *) (***********************************************************************) let basefont = ref 3 15 let reset () = basefont := 3 <6>77 entry.ml 12 "entry.mll" open Lexing 5 let header = "$Id: entry.mll,v 1.11 1999/12/07 16:12:15 maranget Exp $" let buff = Out.create_buff () ;; 10 let put s = Out.put buff s and put_char c = Out.put_char buff c ;; 15 type res = | Bang of string * string | Bar of string * string 20 | Eof of string * string ;; let extend r i = match r with | Bang (p,_) -> Bang (i,p) 25 | Bar (p,_) -> Bar (i,p) | Eof (p,_) -> Eof (i,p) ;; type key = string list * string list 30 exception Fini exception NoGood ;; 35 let lex_tables = { Lexing.lex_base = "\000\000\001\000\253\255\000\000\254\255\000\000\000\000\000\000\ \000\000\001\000\001\000\000\000\000\000\000\000\255\255\247\255\ \251\255\002\000\250\255\002\000\249\255\248\255\252\255"; Lexing.lex_backtrk = "\255\255\255\255\255\255\002\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\008\000\255\255\008\000\255\255\255\255\255\255"; 40 Lexing.lex_default = "\015\000\002\000\000\000\255\255\000\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\000\000\000\000\ \000\000\255\255\000\000\255\255\000\000\000\000\000\000"; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\016\000\017\000\004\000\014\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \018\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\019\000\003\000\000\000\000\000\ \000\000\000\000\000\000\000\000\007\000\008\000\010\000\000\000\ \000\000\005\000\000\000\000\000\000\000\000\000\006\000\011\000\ \000\000\000\000\013\000\000\000\012\000\000\000\000\000\000\000\ \009\000\014\000\000\000\000\000\020\000\000\000\022\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \021\000\004\000\000\000"; Lexing.lex_check = 45 "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\000\000\000\000\017\000\019\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\255\255\017\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\000\000\001\000\255\255\255\255\ \255\255\255\255\255\255\255\255\006\000\007\000\009\000\255\255\ \255\255\003\000\255\255\255\255\255\255\255\255\005\000\010\000\ \255\255\255\255\012\000\255\255\011\000\255\255\255\255\255\255\ \008\000\013\000\255\255\255\255\000\000\255\255\017\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\001\000\255\255" } let rec entry lexbuf = __ocaml_lex_entry_rec lexbuf 0 and __ocaml_lex_entry_rec lexbuf state = 50 match Lexing.engine lex_tables state lexbuf with 0 -> ( 48 "entry.mll" put "\\\"" ; entry lexbuf) | 1 -> ( 55 50 "entry.mll" put_char '!' ; entry lexbuf) | 2 -> ( 52 "entry.mll" put_char '@' ; entry lexbuf) 60 | 3 -> ( 54 "entry.mll" put_char '|' ; entry lexbuf) | 4 -> ( 55 "entry.mll" 65 Bang (Out.to_string buff,"")) | 5 -> ( 56 "entry.mll" let s = Out.to_string buff in let r = entry lexbuf in 70 extend r s) | 6 -> ( 59 "entry.mll" Bar (Out.to_string buff,"")) | 7 -> ( 75 60 "entry.mll" Eof (Out.to_string buff,"")) | 8 -> ( 62 "entry.mll" let lxm = lexeme_char lexbuf 0 in put_char lxm ; entry lexbuf) 80 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_entry_rec lexbuf n and idx lexbuf = __ocaml_lex_idx_rec lexbuf 1 and __ocaml_lex_idx_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 85 0 -> ( 66 "entry.mll" let key = Save.arg lexbuf in let value = Save.arg lexbuf in key,value) 90 | 1 -> ( 69 "entry.mll" raise Fini) | 2 -> ( 70 "entry.mll" 95 idx lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_idx_rec lexbuf n ;; 100 73 "entry.mll" let read_key lexbuf = 105 let bar () = match entry lexbuf with | Eof (s,_) -> begin match s with | ""|"("|")" -> None | s -> 110 if s.[0] = '(' then Some (String.sub s 1 (String.length s - 1)) else Some s end 115 | _ -> raise NoGood in let rec get_rec () = match entry lexbuf with Bang (i,p) -> let l,see = get_rec () in 120 (i,p)::l,see | Bar (i,p) -> let see = bar () in [i,p],see | Eof (i,p) -> [i,p],None in 125 let separe (l,see) = let rec sep_rec = function [] -> [],[] | (x,y)::r -> 130 let xs,ys = sep_rec r in x::xs,y::ys in let xs,ys = sep_rec l in ((xs,ys),see) in 135 separe (get_rec ()) let read_indexentry lexbuf = idx lexbuf <6>78 esponjamain.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: esponjamain.ml,v 1.3 2001/05/28 17:28:55 maranget Exp $ *) (***********************************************************************) open Mysys open Esponja 15 let arg = ref [] ;; Arg.parse 20 ["-u", Arg.Set pess, "pessimize" ; "-v", Arg.Unit (fun () -> incr Ultra.verbose),"be verbose" ; "-n", Arg.Unit (fun () -> move := false ; incr Ultra.verbose), "do not change files"] (fun s -> arg := s :: !arg) 25 ("Usage: esponja [option*] < infile > outfile,\n or esponja [option*] files+ options are:") ;; let main () = 30 try begin match !arg with | [] -> ignore (process "" stdin stdout) | files -> 35 List.iter (fun f -> ignore (Esponja.file f)) (List.rev files) end ; exit 0 with | e -> 40 Printf.fprintf stderr "Unexpected exception: %s\n" (Printexc.to_string e) ; exit 1 ;; 45 main () ;; <6>79 esponja.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: esponja.ml,v 1.8 2001/05/29 09:23:31 maranget Exp $ *) (***********************************************************************) open Mysys 15 let pess = ref false and move = ref true ;; 20 let process in_name input output = let rec do_rec lexbuf = match Htmlparse.main lexbuf with | [] -> () | ts -> if !pess then 25 Pp.trees output (Explode.trees ts) else Ultra.main output ts ; do_rec lexbuf in try 30 let lexbuf = Lexing.from_channel input in Location.set in_name lexbuf ; Emisc.reset () ; do_rec lexbuf ; Location.restore () ; 35 true with | Htmllex.Error s -> if !Ultra.verbose > 0 then output_char stderr '\n' ; 40 Location.print_fullpos () ; Printf.fprintf stderr "Lexer error: %s\n" s ; Location.restore () ; false | Htmlparse.Error s -> 45 if !Ultra.verbose > 0 then output_char stderr '\n' ; Location.print_fullpos () ; Printf.fprintf stderr "Parser error: %s\n" s ; Htmllex.ptop () ; 50 Htmllex.reset () ; Location.restore () ; false | e -> Location.restore () ; 55 raise e let file in_name = if !Ultra.verbose > 0 then begin 60 Printf.fprintf stderr "Optimizing file: %s... " in_name ; flush stderr end ; let out_name = Filename.concat 65 (Filename.dirname in_name) (Filename.basename in_name ^ ".esp") in begin try let input = open_in in_name in 70 let out = try open_out out_name with Sys_error _ as e -> close_in input ; raise e in let size_in = in_channel_length input in 75 let ok = try process in_name input out with e -> close_in input ; close_out out ; raise e in close_in input ; flush out ; 80 let size_out = out_channel_length out in close_out out ; if ok && size_in > size_out then begin if !move then rename out_name in_name end else 85 remove out_name ; if !Ultra.verbose > 0 && ok then begin Printf.fprintf stderr "saved %d -> %d, %0.2f%%" size_in size_out ((float (size_in-size_out) *. 100.0) /. 90 float size_in) ; prerr_endline "" end ; ok with 95 | Sys_error msg -> Printf.fprintf stderr "File error: %s\n" msg ; false | e -> remove out_name ; 100 raise e end <6>80 explode.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: explode.ml,v 1.6 2001/05/28 17:28:55 maranget Exp $ *) (***********************************************************************) open Lexeme open Htmltext 15 open Tree let of_styles env r = match env with | [] -> r | _ -> Node (env,[r]) 20 let rec tree env t k = match t with | Text s -> of_styles env (Text s)::k 25 | Blanks s -> of_styles (List.filter (fun s -> not (Htmltext.blanksNeutral s)) env) (Blanks s):: k 30 | Node (s,ts) -> begin try let new_env = Htmltext.add_style s env in List.fold_right (tree new_env) ts k with 35 | Split (s,env) -> let ts = List.fold_right (tree []) ts [] in let now = if Util.is_blanks ts then (List.filter (fun s -> not (Htmltext.blanksNeutral s)) env) 40 else env in match ts with | [] -> k | _ -> 45 of_styles now (Node ([s],ts))::k end | ONode (so,sc,ts) -> ONode (so,sc, List.fold_right (tree env) ts [])::k 50 let trees ts = List.fold_right (tree []) ts [] <6>81 foot.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: foot.ml,v 1.18 2001/02/20 14:10:08 maranget Exp $" open Parse_opts 15 let some = ref false ;; let anchor = ref 0 20 ;; let mark_to_anchor = Hashtbl.create 17 and anchor_to_note = Hashtbl.create 17 ;; 25 type saved = (int, int) Hashtbl.t * (int, int * string * string) Hashtbl.t * int * bool 30 let checkpoint () = Misc.clone_int_hashtbl mark_to_anchor, Misc.clone_int_hashtbl anchor_to_note, !anchor, !some 35 and hot_start (t1,t2,i,b) = Misc.copy_int_hashtbl t1 mark_to_anchor ; Misc.copy_int_hashtbl t2 anchor_to_note ; anchor := i ; some := b 40 let step_anchor mark = incr anchor ; Hashtbl.remove mark_to_anchor mark ; Hashtbl.add mark_to_anchor mark !anchor 45 ;; let get_anchor mark = let r = try Hashtbl.find mark_to_anchor mark 50 with Not_found -> begin step_anchor mark ; !anchor end in r 55 ;; let register mark themark text = some := true ; let anchor = get_anchor mark in 60 begin try let _ = Hashtbl.find anchor_to_note anchor in Misc.warning "erasing previous footnote" ; Hashtbl.remove anchor_to_note anchor with Not_found -> () 65 end ; Hashtbl.add anchor_to_note anchor (mark,themark,text) ;; 70 let flush lexer sec_notes sec_here = if !some && Section.value sec_here <= Section.value sec_notes then begin some := false ; lexer ("\\begin{thefootnotes}{"^sec_notes^"}") ; let all = ref [] in 75 Hashtbl.iter (fun anchor (mark,themark,text) -> all := ((mark,anchor),(themark,text)) :: !all) anchor_to_note ; all := Sort.list 80 (fun ((m1,a1),_) ((m2,a2),_) -> (a1 < a2) || ((a1 = a2) && (m1 <= m2))) !all ; List.iter (fun ((_,anchor),(themark,text)) -> 85 lexer ("\\item["^ "\\@noteref{text}{note}{"^ string_of_int anchor^ "}{\\@print{"^themark^"}}]") ; 90 lexer ("\\@print{"^text^"\n}")) !all ; lexer "\\end{thefootnotes}" ; Hashtbl.clear mark_to_anchor ; Hashtbl.clear anchor_to_note ; 95 end ;; <6>82 get.ml 12 "get.mll" open Misc open Parse_opts 5 open Lexing open Latexmacros open Lexstate open Stack 10 (* Compute functions *) let header = "$Id: get.mll,v 1.24 2001/02/12 10:05:29 maranget Exp $" exception Error of string 15 let sbool = function | true -> "true" | false -> "false" let get_this = ref (fun s -> assert false) 20 and get_fun = ref (fun f lexbuf -> assert false) and open_env = ref (fun _ -> ()) and close_env = ref (fun _ -> ()) and get_csname = ref (fun _ -> assert false) and main = ref (fun _ -> assert false) 25 ;; let bool_out = ref false and int_out = ref false 30 let int_stack = Stack.create "int_stack" and bool_stack = Stack.create "bool_stack" and group_stack = Stack.create "group_stack" and just_opened = ref false 35 type saved = bool * bool Stack.saved * bool * int Stack.saved * (unit -> unit) Stack.saved * bool 40 let check () = !bool_out, Stack.save bool_stack, !int_out, Stack.save int_stack, Stack.save group_stack, !just_opened 45 and hot (b,bs,i,is,gs,j) = bool_out := b ; Stack.restore bool_stack bs ; int_out := i ; Stack.restore int_stack is ; Stack.restore group_stack gs ; 50 just_opened := j let push_int x = if !verbose > 2 then prerr_endline ("PUSH INT: "^string_of_int x) ; 55 just_opened := false ; push int_stack x let open_ngroups n = let rec open_ngroups_rec = function 60 | 0 ->() | n -> push group_stack (fun () -> ()) ; open_ngroups_rec (n-1) in if !verbose > 2 then prerr_endline ("OPEN NGROUPS: "^string_of_int n) ; if n > 0 then begin 65 just_opened := true ; open_ngroups_rec n end let close_ngroups n = 70 let rec close_ngroups_rec = function | 0 -> () | n -> let f = pop group_stack in f() ; close_ngroups_rec (n-1) in 75 if !verbose > 2 then prerr_endline ("CLOSE NGROUPS: "^string_of_int n); close_ngroups_rec n let open_aftergroup f s = 80 if !verbose > 2 then prerr_endline ("OPEN AFTER: "^s) ; just_opened := true ; push group_stack f 85 let lex_tables = { Lexing.lex_base = "\000\000\001\000\002\000\061\000\003\000\254\255\255\255\240\255\ \001\000\020\000\054\000\004\000\136\000\244\255\243\255\246\255\ \247\255\144\000\245\255\164\000\250\255\000\000\000\000\239\255\ \007\000\000\000\249\255\004\000\000\000\012\000\248\255\241\255\ \254\000\154\000\164\000\034\000\242\255\073\001\006\000"; Lexing.lex_backtrk = "\255\255\002\000\255\255\255\255\255\255\255\255\255\255\255\255\ \001\000\015\000\015\000\015\000\015\000\255\255\255\255\255\255\ \255\255\002\000\255\255\015\000\255\255\015\000\015\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \014\000\002\000\003\000\255\255\255\255\004\000\001\000"; 90 Lexing.lex_default = "\007\000\002\000\255\255\004\000\255\255\000\000\000\000\000\000\ \255\255\255\255\255\255\035\000\255\255\000\000\000\000\000\000\ \000\000\255\255\000\000\031\000\000\000\255\255\255\255\000\000\ \255\255\255\255\000\000\255\255\255\255\255\255\000\000\000\000\ \255\255\255\255\255\255\035\000\000\000\255\255\255\255"; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\008\000\038\000\000\000\000\000\006\000\000\000\ \038\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \008\000\038\000\009\000\010\000\000\000\011\000\038\000\012\000\ \013\000\014\000\015\000\016\000\006\000\016\000\000\000\015\000\ \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\ \017\000\017\000\000\000\000\000\018\000\018\000\018\000\000\000\ \000\000\000\000\000\000\000\000\037\000\037\000\037\000\037\000\ \037\000\037\000\037\000\037\000\037\000\037\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\037\000\037\000\037\000\ \037\000\037\000\037\000\000\000\019\000\003\000\000\000\000\000\ \020\000\027\000\000\000\000\000\000\000\026\000\021\000\036\000\ \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ \028\000\030\000\024\000\029\000\022\000\037\000\037\000\037\000\ \037\000\037\000\037\000\013\000\025\000\014\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\000\000\000\000\000\000\000\000\000\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \034\000\034\000\034\000\034\000\034\000\034\000\034\000\034\000\ \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ \033\000\033\000\033\000\033\000\033\000\033\000\033\000\033\000\ \033\000\033\000\033\000\033\000\034\000\034\000\034\000\034\000\ \034\000\034\000\034\000\034\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\000\000\ \023\000\255\255\005\000\006\000\255\255\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\000\000\ \000\000\000\000\255\255\000\000\000\000\000\000\000\000\000\000\ \031\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\005\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\000\000\000\000\000\000\000\000\000\000\000\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\ \037\000\037\000\037\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\037\000\037\000\037\000\037\000\037\000\037\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\255\255\000\000\000\000\000\000\ \000\000\000\000\037\000\037\000\037\000\037\000\037\000\037\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000"; Lexing.lex_check = 95 "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\000\000\008\000\255\255\255\255\011\000\255\255\ \038\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\008\000\000\000\000\000\255\255\000\000\038\000\000\000\ \000\000\000\000\000\000\000\000\035\000\000\000\255\255\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\255\255\255\255\000\000\000\000\000\000\255\255\ \255\255\255\255\255\255\255\255\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\009\000\009\000\009\000\ \009\000\009\000\009\000\255\255\000\000\001\000\255\255\255\255\ \000\000\021\000\255\255\255\255\255\255\025\000\000\000\010\000\ \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\ \027\000\029\000\022\000\028\000\000\000\009\000\009\000\009\000\ \009\000\009\000\009\000\000\000\024\000\000\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \255\255\255\255\255\255\255\255\255\255\255\255\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \017\000\017\000\017\000\017\000\017\000\017\000\017\000\017\000\ \017\000\017\000\033\000\033\000\033\000\033\000\033\000\033\000\ \033\000\033\000\033\000\033\000\034\000\034\000\034\000\034\000\ \034\000\034\000\034\000\034\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\019\000\019\000\019\000\019\000\ \019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\ \019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\ \019\000\019\000\019\000\019\000\019\000\019\000\019\000\255\255\ \000\000\001\000\002\000\004\000\011\000\019\000\019\000\019\000\ \019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\ \019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\ \019\000\019\000\019\000\019\000\019\000\019\000\019\000\255\255\ \255\255\255\255\035\000\255\255\255\255\255\255\255\255\255\255\ \032\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\003\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\255\255\255\255\255\255\255\255\255\255\255\255\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\032\000\032\000\032\000\032\000\ \032\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\ \037\000\037\000\037\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\037\000\037\000\037\000\037\000\037\000\037\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\019\000\255\255\255\255\255\255\ \255\255\255\255\037\000\037\000\037\000\037\000\037\000\037\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255" } let rec result lexbuf = __ocaml_lex_result_rec lexbuf 0 and __ocaml_lex_result_rec lexbuf state = 100 match Lexing.engine lex_tables state lexbuf with 0 -> ( 101 "get.mll" result lexbuf) | 1 -> ( 105 102 "get.mll" result lexbuf) | 2 -> ( 105 "get.mll" let lxm = Lexing.lexeme lexbuf in 110 push_int (int_of_string lxm) ; result lexbuf) | 3 -> ( 109 "get.mll" let lxm = lexeme lexbuf in 115 push_int (int_of_string ("0o"^String.sub lxm 1 (String.length lxm-1))) ; result lexbuf) | 4 -> ( 114 "get.mll" 120 let lxm = lexeme lexbuf in push_int (int_of_string ("0x"^String.sub lxm 1 (String.length lxm-1))) ; result lexbuf) | 5 -> ( 125 119 "get.mll" let token = !get_csname lexbuf in after_quote (Lexing.from_string token) ; result lexbuf) | 6 -> ( 130 123 "get.mll" push bool_stack true ; result lexbuf) | 7 -> ( 126 "get.mll" 135 push bool_stack false ; result lexbuf) | 8 -> ( 130 "get.mll" let lxm = lexeme_char lexbuf 0 in 140 let unary = !just_opened in if unary then begin let f = pop group_stack in open_aftergroup (fun () -> 145 if !verbose > 2 then begin prerr_endline ("UNARY: "^String.make 1 lxm) ; Stack.pretty string_of_int int_stack end ; let x1 = pop int_stack in 150 let r = match lxm with | '+' -> x1 | '-' -> 0 - x1 | _ -> assert false in push_int r ; f()) "UNARY" 155 end else begin close_ngroups 2 ; open_aftergroup (fun () -> if !verbose > 2 then begin 160 prerr_endline ("OPPADD: "^String.make 1 lxm) ; Stack.pretty string_of_int int_stack end ; let x2 = pop int_stack in let x1 = pop int_stack in 165 let r = match lxm with | '+' -> x1 + x2 | '-' -> x1 - x2 | _ -> assert false in push_int r) "ADD"; 170 open_ngroups 1 ; end ; result lexbuf) | 9 -> ( 165 "get.mll" 175 let lxm = lexeme_char lexbuf 0 in close_ngroups 1 ; open_aftergroup (fun () -> if !verbose > 2 then begin 180 prerr_endline ("MULTOP"^String.make 1 lxm) ; Stack.pretty string_of_int int_stack end ; let x2 = pop int_stack in let x1 = pop int_stack in 185 let r = match lxm with | '*' -> x1 * x2 | '/' -> x1 / x2 | _ -> assert false in push_int r) "MULT"; 190 result lexbuf) | 10 -> ( 183 "get.mll" let lxm = Lexing.lexeme_char lexbuf 0 in close_ngroups 3 ; 195 open_aftergroup (fun () -> if !verbose > 2 then begin prerr_endline ("COMP: "^String.make 1 lxm) ; Stack.pretty string_of_int int_stack 200 end ; let x2 = pop int_stack in let x1 = pop int_stack in push bool_stack (match lxm with 205 | '<' -> x1 < x2 | '>' -> x1 > x2 | '=' -> x1 = x2 | _ -> assert false) ; if !verbose > 2 then 210 Stack.pretty sbool bool_stack) "COMP" ; open_ngroups 2 ; result lexbuf) | 11 -> ( 206 "get.mll" 215 open_ngroups 2 ; result lexbuf) | 12 -> ( 209 "get.mll" close_ngroups 2 ; 220 result lexbuf) | 13 -> ( 213 "get.mll" let lxm = lexeme lexbuf in let i = Char.code (lxm.[1]) - Char.code '1' in 225 scan_arg (scan_this_arg result) i ; result lexbuf) | 14 -> ( 218 "get.mll" let lxm = lexeme lexbuf in 230 let pat,body = Latexmacros.find lxm in let args = make_stack lxm pat lexbuf in scan_body (function | Subst body -> scan_this result body 235 | Toks l -> List.iter (scan_this result) (List.rev l) | CamlCode f -> 240 let rs = !get_fun f lexbuf in scan_this result rs) body args ; result lexbuf) | 15 -> ( 245 233 "get.mll" raise (Error ("Bad character in Get.result: ``"^lexeme lexbuf^"''"))) | 16 -> ( 234 "get.mll" ()) 250 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_result_rec lexbuf n and after_quote lexbuf = __ocaml_lex_after_quote_rec lexbuf 1 and __ocaml_lex_after_quote_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 255 0 -> ( 238 "get.mll" let lxm = lexeme lexbuf in push_int (Char.code lxm.[1]); result lexbuf) 260 | 1 -> ( 242 "get.mll" let lxm = lexeme lexbuf in push_int (Char.code lxm.[0]); result lexbuf) 265 | 2 -> ( 246 "get.mll" Misc.fatal "Cannot understand `-like numerical argument") | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_after_quote_rec lexbuf n 270 ;; 247 "get.mll" let init latexget latexgetfun latexopenenv latexcloseenv latexcsname 275 latexmain = get_this := latexget ; get_fun := latexgetfun ; open_env := latexopenenv ; close_env := latexcloseenv ; 280 get_csname := latexcsname ; main := latexmain ;; let def_loc name f = 285 Latexmacros.def name zero_pat (CamlCode f) ; ;; let def_commands l = List.map 290 (fun (name,f) -> name,Latexmacros.replace name (Some (zero_pat,CamlCode f))) l let def_commands_int () = 295 def_commands ["\\value", (fun lexbuf -> let name = !get_this (save_arg lexbuf) in push_int (Counter.value_counter name)) ; 300 "\\pushint", (fun lexbuf -> let s = !get_this (save_arg lexbuf) in scan_this result s)] 305 let def_commands_bool () = let old_ints = def_commands_int () in let old_commands = def_commands ["\\(", (fun _ -> open_ngroups 7) ; 310 "\\)", (fun _ -> close_ngroups 7) ; "\\@fileexists", (fun lexbuf -> let name = !get_this (save_arg lexbuf) in push bool_stack 315 (try let _ = Myfiles.open_tex name in true with Myfiles.Except | Myfiles.Error _ -> false)) ; "\\@commandexists", 320 (fun lexbuf -> let name = !get_csname lexbuf in push bool_stack (Latexmacros.exists name)) ; "\\or", (fun _ -> 325 close_ngroups 7 ; open_aftergroup (fun () -> if !verbose > 2 then begin prerr_endline "OR" ; 330 Stack.pretty sbool bool_stack end ; let b1 = pop bool_stack in let b2 = pop bool_stack in push bool_stack (b1 || b2)) "OR"; 335 open_ngroups 6) ; "\\and", (fun _ -> close_ngroups 6 ; open_aftergroup 340 (fun () -> if !verbose > 2 then begin prerr_endline "AND" ; Stack.pretty sbool bool_stack end ; 345 let b1 = pop bool_stack in let b2 = pop bool_stack in push bool_stack (b1 && b2)) "AND"; open_ngroups 5) ; "\\not", 350 (fun _ -> close_ngroups 4 ; open_aftergroup (fun () -> if !verbose > 2 then begin 355 prerr_endline "NOT" ; Stack.pretty sbool bool_stack end ; let b1 = pop bool_stack in push bool_stack (not b1)) "NOT"; 360 open_ngroups 3) ; "\\boolean", (fun lexbuf -> let name = !get_this (save_arg lexbuf) in let b = try 365 let r = !get_this (string_to_arg ("\\if"^name^" true\\else false\\fi")) in match r with | "true" -> true | "false" -> false 370 | _ -> raise (Misc.Fatal ("boolean value: "^r)) with Latexmacros.Failed -> true in push bool_stack b) ; "\\isodd", 375 (fun lexbuf -> close_ngroups 3 ; open_aftergroup (fun () -> if !verbose > 2 then begin 380 prerr_endline ("ISODD") ; Stack.pretty string_of_int int_stack end ; let x = pop int_stack in push bool_stack (x mod 2 = 1) ; 385 if !verbose > 2 then Stack.pretty sbool bool_stack) "ISODD" ; open_ngroups 2) ] in let old_equal = try Some (Latexmacros.find_fail "\\equal") with Failed -> None in 390 def_loc "\\equal" (fun lexbuf -> let arg1 = save_arg lexbuf in let arg2 = save_arg lexbuf in 395 scan_this !main "\\begin{@norefs}" ; let again = List.map (fun (name,x) -> name,Latexmacros.replace name x) ((("\\equal",old_equal)::old_ints)@old_commands) in push bool_stack (!get_this arg1 = !get_this arg2) ; let _ = 400 List.map (fun (name,x) -> Latexmacros.replace name x) again in scan_this !main "\\end{@norefs}") 405 let first_try s = let l = String.length s in if l <= 0 then raise (Failure "first_try") ; let rec try_rec r i = if i >= l then r 410 else match s.[i] with | '0'|'1'|'2'|'3'|'4'|'5'|'6'|'7'|'8'|'9' -> try_rec (10*r + Char.code s.[i] - Char.code '0') (i+1) | _ -> raise (Failure ("first_try")) in try_rec 0 0 415 ;; let get_int {arg=expr ; subst=subst} = if !verbose > 1 then prerr_endline ("get_int : "^expr) ; 420 let r = try first_try expr with Failure _ -> begin let old_int = !int_out in int_out := true ; start_normal subst ; 425 !open_env "*int*" ; let _ = def_commands_int () in open_ngroups 2 ; begin try scan_this result expr with | x -> 430 begin prerr_endline ("Error while scanning ``"^expr^"'' for integer result"); raise x end 435 end ; close_ngroups 2 ; !close_env "*int*" ; end_normal () ; if Stack.empty int_stack then 440 raise (Error ("``"^expr^"'' has no value as an integer")); let r = pop int_stack in int_out := old_int ; r end in if !verbose > 1 then 445 prerr_endline ("get_int: "^expr^" = "^string_of_int r) ; r let get_bool {arg=expr ; subst=subst} = 450 if !verbose > 1 then prerr_endline ("get_bool : "^expr) ; let old_bool = !bool_out in bool_out := true ; start_normal subst ; 455 !open_env "*bool*" ; def_commands_bool () ; open_ngroups 7 ; begin try scan_this result expr with | x -> 460 begin prerr_endline ("Error while scanning ``"^expr^"'' for boolean result"); raise x end 465 end ; close_ngroups 7 ; !close_env "*bool*" ; end_normal () ; if Stack.empty bool_stack then 470 raise (Error ("``"^expr^"'' has no value as a boolean")); let r = pop bool_stack in if !verbose > 1 then prerr_endline ("get_bool: "^expr^" = "^sbool r); bool_out := old_bool ; 475 r let get_length arg = if !verbose > 1 then prerr_endline ("get_length : "^arg) ; 480 let r = Length.main (Lexing.from_string arg) in if !verbose > 2 then begin prerr_string ("get_length : "^arg^" -> ") ; prerr_endline (Length.pretty r) end ; 485 r <6>83 hot.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: hot.ml,v 1.5 2001/05/25 12:37:22 maranget Exp $ *) (***********************************************************************) type saved = Lexstate.saved * Latexmacros.saved * Counter.saved * Color.saved * Foot.saved 15 let checkpoint () = Lexstate.checkpoint (), Latexmacros.checkpoint (), Counter.checkpoint (), 20 Color.checkpoint (), Foot.checkpoint () and start (lexstate, latexmacros, counter, color, foot) = Misc.hot_start () ; 25 Lexstate.hot_start lexstate ; Latexmacros.hot_start latexmacros ; Counter.hot_start counter ; Color.hot_start color ; Foot.hot_start foot ; 30 begin match !Parse_opts.destination with | Parse_opts.Info -> InfoRef.hot_start () | _ -> () end <6>84 htmlCommon.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: htmlCommon.ml,v 1.35 2001/04/23 16:04:27 maranget Exp $" (* Output function for a strange html model : 15 - Text elements can occur anywhere and are given as in latex - A new grouping construct is given (open_group () ; close_group ()) *) open Misc 20 open Element open Parse_opts open Latexmacros open Stack open Length 25 type block = | H1 | H2 | H3 | H4 | H5 | H6 30 | PRE | TABLE | TR | TD | DISPLAY | QUOTE | BLOCKQUOTE | DIV 35 | UL | OL | DL | GROUP | AFTER | DELAY | FORGET | INTERN | P | NADA 40 | OTHER of string ;; let string_of_block = function | H1 -> "H1" 45 | H2 -> "H2" | H3 -> "H3" | H4 -> "H4" | H5 -> "H5" | H6 -> "H6" 50 | PRE -> "PRE" | TABLE -> "TABLE" | TR -> "TR" | TD -> "TD" | DISPLAY -> "DISPLAY" 55 | QUOTE -> "QUOTE" | BLOCKQUOTE -> "BLOCKQUOTE" | DIV -> "DIV" | UL -> "UL" | OL -> "OL" 60 | DL -> "DL" | GROUP -> "" | AFTER -> "AFTER" | DELAY -> "DELAY" | FORGET -> "FORGET" 65 | P -> "P" | NADA -> "NADA" | INTERN -> "INTERN" | OTHER s -> s 70 let block_t = Hashtbl.create 17 ;; let no_opt = false ;; 75 let add b = Hashtbl.add block_t (string_of_block b) b ;; 80 add H1 ; add H2 ; add H3 ; add H4 ; 85 add H5 ; add H6 ; add PRE ; add TABLE ; add TR ; 90 add TD ; add DISPLAY ; add QUOTE ; add BLOCKQUOTE ; add DIV ; 95 add UL ; add OL ; add DL ; begin if no_opt then 100 Hashtbl.add block_t "" INTERN else add GROUP end ; add AFTER ; 105 add DELAY ; add FORGET ; add P ; add NADA ; () ;; 110 let failclose s b1 b2= raise (Misc.Close (s^": ``"^string_of_block b1^"'' closes ``"^ string_of_block b2^"''")) 115 ;; let find_block s = let s = String.uppercase s in try Hashtbl.find block_t s with 120 | Not_found -> OTHER s ;; let check_block_closed opentag closetag = if opentag <> closetag && not (opentag = AFTER && closetag = GROUP) then 125 failclose "html" closetag opentag ;; (* output globals *) type t_env = {here : bool ; env : text} 130 type t_top = {top_pending : text list ; top_active : t_env list ;} type style_info = 135 | Nothing of t_top | Activate of t_top | Closed of t_top * int | ActivateClosed of t_top | NotMe 140 | Insert of bool * text list let get_top_lists = function | Nothing x -> x | Activate x -> x | _ -> raise Not_found 145 let do_pretty_mods stderr f mods = let rec do_rec stderr = function [x] -> f stderr x | x::xs -> 150 Printf.fprintf stderr "%a; %a" f x do_rec xs | [] -> () in Printf.fprintf stderr "[%a]" do_rec mods 155 let tbool = function | true -> "+" | false -> "-" let pretty_mods stderr = do_pretty_mods stderr 160 (fun stderr text -> Printf.fprintf stderr "%s" (pretty_text text)) and pretty_tmods stderr = do_pretty_mods stderr (fun stderr {here=here ; env = env} -> 165 Printf.fprintf stderr "%s%s" (tbool here) (pretty_text env)) let pretty_top_styles stderr {top_pending = pending ; top_active = active} = Printf.fprintf stderr "{top_pending=%a, top_active=%a}" 170 pretty_mods pending pretty_tmods active let pretty_top stderr = function 175 | Nothing x -> Printf.fprintf stderr "Nothing %a" pretty_top_styles x | Activate x -> Printf.fprintf stderr "Activate %a" pretty_top_styles x | Closed _ -> Printf.fprintf stderr "Closed" | ActivateClosed _ -> Printf.fprintf stderr "ActivateClosed" | NotMe -> Printf.fprintf stderr "NotMe" 180 | Insert (b,active) -> Printf.fprintf stderr "Insert %b %a" b pretty_mods active type status = { mutable nostyle : bool ; 185 mutable pending : text list ; mutable active : t_env list ; mutable top : style_info ; mutable out : Out.t} ;; 190 let as_env {env=env} = env let as_envs tenvs r = List.fold_right (fun x r -> as_env x::r) tenvs r 195 let to_pending pending active = pending @ as_envs active [] let with_new_out out = {out with out = Out.create_buff ()} let free out = Out.free out.out 200 let cur_out = ref {nostyle=false ; pending = [] ; active = [] ; top = NotMe ; 205 out = Out.create_null ()} ;; type stack_item = Normal of block * string * status 210 | Freeze of (unit -> unit) ;; exception PopFreeze ;; 215 let push_out s (a,b,c) = push s (Normal (a,b,c)) ;; let pretty_stack s = Stack.pretty 220 (function Normal (s,args,_) -> "["^string_of_block s^"]-{"^args^"} " | Freeze _ -> "Freeze ") s ;; let rec pop_out s = match pop s with 225 | Normal (a,b,c) -> a,b,c | Freeze f -> raise PopFreeze (* begin if !verbose > 2 then begin prerr_string "unfreeze in pop_out" ; 230 pretty_stack !s end ; f () ; pop_out s end *) ;; 235 let out_stack = Stack.create_init "out_stack" (Normal (NADA,"",!cur_out)) ;; 240 type saved_out = status * stack_item Stack.saved let save_out () = !cur_out, Stack.save out_stack and restore_out (a,b) = 245 if !cur_out != a then begin free !cur_out ; Stack.finalize out_stack (function | Normal (_,_,x) -> x == a 250 | _ -> false) (function | Normal (_,_,out) -> free out | _ -> ()) end ; 255 cur_out := a ; Stack.restore out_stack b let pblock () = if Stack.empty out_stack then NADA 260 else match Stack.top out_stack with | Normal (s,_,_) -> s | _ -> NADA ;; 265 let do_put_char c = if !verbose > 3 then prerr_endline ("put_char: |"^String.escaped (String.make 1 c)^"|"); Out.put_char !cur_out.out c 270 and do_put s = if !verbose > 3 then prerr_endline ("put: |"^String.escaped s^"|"); Out.put !cur_out.out s 275 ;; (* Flags section *) (* Style information for caller *) 280 type flags_t = { mutable table_inside:bool; mutable in_math : bool; mutable ncols:int; 285 mutable empty:bool; mutable blank:bool; mutable pending_par: int option; mutable vsize:int; mutable nrows:int; 290 mutable table_vsize:int; mutable nitems:int; mutable dt:string; mutable dcount:string; mutable last_closed:block; 295 mutable in_pre:bool; mutable insert: (block * string) option; mutable insert_attr: (block * string) option; } ;; 300 let pretty_cur {pending = pending ; active = active ; top = top} = Printf.fprintf stderr "pending=%a, active=%a\n" pretty_mods pending pretty_tmods active ; 305 Printf.fprintf stderr "top = %a" pretty_top top ; prerr_endline "" ;; 310 let activate_top out = match out.top with | Nothing x -> out.top <- Activate x | _ -> () and close_top n out = match out.top with 315 | Nothing top -> out.top <- Closed (top, n+Out.get_pos out.out) | Activate top -> out.top <- ActivateClosed top | _ -> () let debug_attr stderr = function 320 | None -> Printf.fprintf stderr "None" | Some (tag,attr) -> Printf.fprintf stderr "``%s'' ``%s''" (string_of_block tag) attr 325 let debug_flags f = Printf.fprintf stderr "attr=%a\n" debug_attr f.insert_attr ; flush stderr 330 let flags = { table_inside = false; ncols = 0; in_math = false; empty = true; 335 blank = true; pending_par = None; vsize = 0; nrows = 0; table_vsize = 0; 340 nitems = 0; dt = ""; dcount = ""; last_closed = NADA; in_pre = false; 345 insert = None; insert_attr = None; } ;; let copy_flags { 350 table_inside = table_inside; ncols = ncols; in_math = in_math; empty = empty; blank = blank; 355 pending_par = pending_par; vsize = vsize; nrows = nrows; table_vsize = table_vsize; nitems = nitems; 360 dt = dt; dcount = dcount; last_closed = last_closed; in_pre = in_pre; insert = insert; 365 insert_attr = insert_attr; } = { table_inside = table_inside; ncols = ncols; in_math = in_math; 370 empty = empty; blank = blank; pending_par = pending_par; vsize = vsize; nrows = nrows; 375 table_vsize = table_vsize; nitems = nitems; dt = dt; dcount = dcount; last_closed = last_closed; 380 in_pre = in_pre; insert = insert; insert_attr = insert_attr; } and set_flags f { 385 table_inside = table_inside ; ncols = ncols; in_math = in_math; empty = empty; blank = blank; 390 pending_par = pending_par; vsize = vsize; nrows = nrows; table_vsize = table_vsize; nitems = nitems; 395 dt = dt; dcount = dcount; last_closed = last_closed; in_pre = in_pre; insert = insert; 400 insert_attr = insert_attr; } = f.table_inside <- table_inside; f.ncols <- ncols; f.in_math <- in_math; 405 f.empty <- empty; f.blank <- blank; f.pending_par <- pending_par; f.vsize <- vsize; f.nrows <- nrows; 410 f.table_vsize <- table_vsize; f.nitems <- nitems; f.dt <- dt; f.dcount <- dcount; f.last_closed <- last_closed; 415 f.in_pre <- in_pre; f.insert <- insert ; f.insert_attr <- insert_attr ; ;; 420 (* Independant stacks for flags *) type stack_t = { s_table_inside : bool Stack.t ; 425 s_saved_inside : bool Stack.t ; s_in_math : bool Stack.t ; s_ncols : int Stack.t ; s_empty : bool Stack.t ; s_blank : bool Stack.t ; 430 s_pending_par : int option Stack.t ; s_vsize : int Stack.t ; s_nrows : int Stack.t ; s_table_vsize : int Stack.t ; s_nitems : int Stack.t ; 435 s_dt : string Stack.t ; s_dcount : string Stack.t ; s_insert : (block * string) option Stack.t ; s_insert_attr : (block * string) option Stack.t ; (* Other stacks, not corresponding to flags *) 440 s_active : Out.t Stack.t ; s_after : (string -> string) Stack.t } let stacks = { 445 s_table_inside = Stack.create "inside" ; s_saved_inside = Stack.create "saved_inside" ; s_in_math = Stack.create_init "in_math" false ; s_ncols = Stack.create "ncols" ; s_empty = Stack.create_init "empty" false; 450 s_blank = Stack.create_init "blank" false ; s_pending_par = Stack.create "pending_par" ; s_vsize = Stack.create "vsize" ; s_nrows = Stack.create_init "nrows" 0 ; s_table_vsize = Stack.create_init "table_vsize" 0 ; 455 s_nitems = Stack.create_init "nitems" 0 ; s_dt = Stack.create_init "dt" "" ; s_dcount = Stack.create_init "dcount" "" ; s_insert = Stack.create_init "insert" None; s_insert_attr = Stack.create_init "insert_attr" None; 460 s_active = Stack.create "active" ; s_after = Stack.create "after" } type saved_stacks = { 465 ss_table_inside : bool Stack.saved ; ss_saved_inside : bool Stack.saved ; ss_in_math : bool Stack.saved ; ss_ncols : int Stack.saved ; ss_empty : bool Stack.saved ; 470 ss_blank : bool Stack.saved ; ss_pending_par : int option Stack.saved ; ss_vsize : int Stack.saved ; ss_nrows : int Stack.saved ; ss_table_vsize : int Stack.saved ; 475 ss_nitems : int Stack.saved ; ss_dt : string Stack.saved ; ss_dcount : string Stack.saved ; ss_insert : (block * string) option Stack.saved ; ss_insert_attr : (block * string) option Stack.saved ; 480 (* Other stacks, not corresponding to flags *) ss_active : Out.t Stack.saved ; ss_after : (string -> string) Stack.saved } 485 let save_stacks () = { ss_table_inside = Stack.save stacks.s_table_inside ; ss_saved_inside = Stack.save stacks.s_saved_inside ; ss_in_math = Stack.save stacks.s_in_math ; 490 ss_ncols = Stack.save stacks.s_ncols ; ss_empty = Stack.save stacks.s_empty ; ss_blank = Stack.save stacks.s_blank ; ss_pending_par = Stack.save stacks.s_pending_par ; ss_vsize = Stack.save stacks.s_vsize ; 495 ss_nrows = Stack.save stacks.s_nrows ; ss_table_vsize = Stack.save stacks.s_table_vsize ; ss_nitems = Stack.save stacks.s_nitems ; ss_dt = Stack.save stacks.s_dt ; ss_dcount = Stack.save stacks.s_dcount ; 500 ss_insert = Stack.save stacks.s_insert ; ss_insert_attr = Stack.save stacks.s_insert_attr ; ss_active = Stack.save stacks.s_active ; ss_after = Stack.save stacks.s_after } 505 and restore_stacks { ss_table_inside = saved_table_inside ; ss_saved_inside = saved_saved_inside ; 510 ss_in_math = saved_in_math ; ss_ncols = saved_ncols ; ss_empty = saved_empty ; ss_blank = saved_blank ; ss_pending_par = saved_pending_par ; 515 ss_vsize = saved_vsize ; ss_nrows = saved_nrows ; ss_table_vsize = saved_table_vsize ; ss_nitems = saved_nitems ; ss_dt = saved_dt ; 520 ss_dcount = saved_dcount ; ss_insert = saved_insert ; ss_insert_attr = saved_insert_attr ; ss_active = saved_active ; ss_after = saved_after 525 } = Stack.restore stacks.s_table_inside saved_table_inside ; Stack.restore stacks.s_saved_inside saved_saved_inside ; Stack.restore stacks.s_in_math saved_in_math ; Stack.restore stacks.s_ncols saved_ncols ; 530 Stack.restore stacks.s_empty saved_empty ; Stack.restore stacks.s_blank saved_blank ; Stack.restore stacks.s_pending_par saved_pending_par ; Stack.restore stacks.s_vsize saved_vsize ; Stack.restore stacks.s_nrows saved_nrows ; 535 Stack.restore stacks.s_table_vsize saved_table_vsize ; Stack.restore stacks.s_nitems saved_nitems ; Stack.restore stacks.s_dt saved_dt ; Stack.restore stacks.s_dcount saved_dcount ; Stack.restore stacks.s_insert saved_insert ; 540 Stack.restore stacks.s_insert_attr saved_insert_attr ; Stack.restore stacks.s_active saved_active ; Stack.restore stacks.s_after saved_after 545 let check_stack what = if not (Stack.empty what) && not !silent then begin prerr_endline ("Warning: stack "^Stack.name what^" is non-empty in Html.finalize") ; end 550 ;; let check_stacks () = match stacks with { s_table_inside = s_table_inside ; 555 s_saved_inside = s_saved_inside ; s_in_math = s_in_math ; s_ncols = s_ncols ; s_empty = s_empty ; s_blank = s_blank ; 560 s_pending_par = s_pending_par ; s_vsize = s_vsize ; s_nrows = s_nrows ; s_table_vsize = s_table_vsize ; s_nitems = s_nitems ; 565 s_dt = s_dt ; s_dcount = s_dcount ; s_insert = s_insert ; s_insert_attr = s_insert_attr ; s_active = s_active ; 570 s_after = s_after } -> check_stack s_table_inside ; check_stack s_saved_inside ; check_stack s_in_math ; 575 check_stack s_ncols ; check_stack s_empty ; check_stack s_blank ; check_stack s_pending_par ; check_stack s_vsize ; 580 check_stack s_nrows ; check_stack s_table_vsize ; check_stack s_nitems ; check_stack s_dt ; check_stack s_dcount ; 585 check_stack s_insert ; check_stack s_insert_attr ; check_stack s_active ; check_stack s_after 590 (* Full state saving *) type saved = flags_t * saved_stacks * saved_out 595 let check () = let saved_flags = copy_flags flags and saved_stacks = save_stacks () and saved_out = save_out () in 600 saved_flags, saved_stacks, saved_out and hot (f,s,o) = set_flags flags f ; 605 restore_stacks s ; restore_out o let sbool = function true -> "true" | _ -> "false" 610 ;; let prerr_flags s = prerr_endline ("<"^string_of_int (Stack.length stacks.s_empty)^"> "^s^ " empty="^sbool flags.empty^ 615 " blank="^sbool flags.blank^ " table="^sbool flags.table_inside) let is_header = function | H1 | H2 | H3 | H4 | H5 | H6 -> true 620 | _ -> false ;; let is_list = function UL | DL | OL -> true 625 | _ -> false ;; let string_of_par = function | Some i -> "+"^string_of_int i 630 | None -> "-" let par_val last now n = let r = if is_list last then begin 635 if is_list now then 1 else 0 end else if last = P then 0 else if 640 is_header last || last = PRE || last = BLOCKQUOTE then n-1 else if last = DIV || last = TABLE then n else n+1 in if !verbose > 2 then 645 Printf.fprintf stderr "par_val last=%s, now=%s, r=%d\n" (string_of_block last) (string_of_block now) r ; r 650 ;; let par = function | Some n as p -> flags.pending_par <- p ; 655 if !verbose > 2 then prerr_endline ("par: last_close="^ string_of_block flags.last_closed^ " r="^string_of_int n) | _ -> () 660 ;; let flush_par n = flags.pending_par <- None ; for i = 1 to n do 665 do_put "<BR>\n" done ; if n <= 0 then do_put_char '\n' ; if !verbose > 2 then prerr_endline 670 ("flush_par: last_closed="^ string_of_block flags.last_closed^ " p="^string_of_int n); flags.vsize <- flags.vsize + n; flags.last_closed <- NADA ;; 675 type t_try = Wait of block | Now let string_of_wait = function | Wait b -> "(Wait "^string_of_block b^")" | Now -> "Now" 680 let try_flush_par block = match block with | Wait GROUP -> () | _ -> match flags.pending_par with | Some n -> 685 flush_par (match block with | Wait b -> par_val b NADA n | _ -> par_val NADA NADA n) | _ -> () 690 let string_of_into = function | Some n -> "+"^string_of_int n | None -> "-" 695 let forget_par () = let r = flags.pending_par in if !verbose > 2 then prerr_endline 700 ("forget_par: last_close="^ string_of_block flags.last_closed^ " r="^string_of_into r) ; flags.pending_par <- None ; r ;; 705 (* styles *) 710 let do_close_mod = function Style m -> if flags.in_math && !Parse_opts.mathml then if m="mtext" then do_put ("</"^m^">") 715 else do_put "</mstyle>" else do_put ("</"^m^">") | (Color _ | Font _) -> if flags.in_math && !Parse_opts.mathml then do_put "</mstyle>" 720 else do_put "</FONT>" and do_open_mod e = if !verbose > 3 then prerr_endline ("do_open_mod: "^pretty_text e) ; 725 match e with Style m -> if flags.in_math && !Parse_opts.mathml then if m="mtext" then do_put ("<"^m^">") else do_put ("<mstyle style = \""^ 730 (match m with "B" -> "font-weight: bold " | "I" -> "font-style: italic " | "TT" -> "font-family: courier " | "EM" -> "font-style: italic " 735 | _ -> m)^ "\">") else do_put ("<"^m^">") | Font i -> if flags.in_math && !Parse_opts.mathml then 740 do_put ("<mstyle style = \"font-size: "^string_of_int i^"\">") else do_put ("<FONT SIZE="^string_of_int i^">") | Color s -> if flags.in_math && !Parse_opts.mathml then do_put ("<mstyle style = \"color: "^s^"\">") 745 else do_put ("<FONT COLOR="^s^">") ;; let do_close_tmod = function 750 | {here = true ; env = env} -> do_close_mod env | _ -> () let close_active_mods active = List.iter do_close_tmod active 755 let do_close_mods () = close_active_mods !cur_out.active ; !cur_out.active <- [] ; !cur_out.pending <- [] ;; 760 let do_close_mods_pred pred same_constr = let tpred {env=env} = pred env in 765 let rec split_again = function | [] -> [],None,[] | {here = false ; env=env} :: rest when same_constr env && not (pred env) -> [],Some env,rest 770 | m :: rest -> let to_close,to_open,to_keep = split_again rest in match to_open with | Some _ -> m::to_close,to_open,to_keep | None -> to_close,to_open,m::to_keep in 775 let rec split = function | [] -> [],None,[] | m :: rest -> let to_close,close,to_keep = split rest in 780 match close with | None -> if tpred m then if m.here then [],Some m.env,to_keep else 785 [],None,to_keep else [], None, m::to_keep | Some _ -> m::to_close,close,to_keep in 790 let rec filter_pred = function | [] -> [] | x :: rest -> if pred x then filter_pred rest else x::filter_pred rest in 795 let to_close,close,to_keep = split !cur_out.active in filter_pred 800 (match close with | None -> [] | Some env -> List.iter do_close_tmod to_close ; do_close_mod env ; 805 let (to_close_open,to_open,to_keep) = split_again to_keep in begin match to_open with | None -> !cur_out.active <- to_keep ; as_envs to_close [] 810 | Some env -> !cur_out.active <- to_keep ; List.iter do_close_tmod to_close_open ; as_envs to_close (as_envs to_close_open [env]) 815 end), close let close_mods () = do_close_mods () 820 ;; let is_style = function Style _ -> true 825 | _ -> false and is_font = function Font _ -> true | _ -> false 830 and is_color = function Color _ -> true | _ -> false ;; 835 let do_open_these_mods do_open_mod pending = let rec do_rec color size = function | [] -> [] | Color _ as e :: rest -> 840 if color then let rest = do_rec true size rest in {here=false ; env=e}::rest else begin let rest = do_rec true size rest in 845 do_open_mod e ; {here=true ; env=e}::rest end | Font _ as e :: rest -> if size then 850 let rest = do_rec color true rest in {here=false ; env=e}::rest else let rest = do_rec color true rest in do_open_mod e ; 855 {here=true ; env=e}::rest | e :: rest -> let rest = do_rec color size rest in do_open_mod e ; {here=true ; env=e} :: rest in 860 do_rec false false pending 865 let activate caller pending = let r = do_open_these_mods (fun _ -> ()) pending in if !verbose > 2 then begin prerr_string ("activate: ("^caller^")") ; pretty_mods stderr pending ; prerr_string " -> " ; 870 pretty_tmods stderr r ; prerr_endline "" end ; r 875 let get_top_active = function | Nothing {top_active = active} -> active | Activate {top_pending = pending ; top_active = active} -> activate "get_top_active" pending @ active | _ -> [] 880 let all_to_pending out = try let top = get_top_lists out.top in to_pending out.pending out.active @ 885 to_pending top.top_pending top.top_active with | Not_found -> to_pending out.pending out.active 890 let all_to_active out = activate "all_to_active" (all_to_pending out) (* Clear styles *) let clearstyle () = close_active_mods !cur_out.active ; 895 close_active_mods (get_top_active !cur_out.top) ; close_top 0 !cur_out ; !cur_out.pending <- [] ; !cur_out.active <- [] ;; 900 (* Avoid styles *) let nostyle () = clearstyle () ; !cur_out.nostyle <- true 905 ;; (* Create new statuses, with appropriate pending lists *) let create_status_from_top out = match out.top with 910 | NotMe|Closed _|ActivateClosed _|Insert (_,_) -> {nostyle=out.nostyle ; pending = [] ; active = [] ; top = Nothing {top_pending = out.pending ; top_active = out.active} ; 915 out = Out.create_buff ()} | Nothing {top_pending = top_pending ; top_active=top_active} -> assert (out.active=[]) ; {nostyle=out.nostyle ; pending = [] ; active = [] ; top = 920 Nothing {top_pending = out.pending @ top_pending ; top_active = top_active} ; out = Out.create_buff ()} | Activate {top_pending = top_pending ; top_active=top_active} -> 925 {nostyle=out.nostyle ; pending = [] ; active = [] ; top= Nothing {top_pending = out.pending ; top_active = out.active @ activate "top" top_pending @ top_active} ; 930 out=Out.create_buff ()} let create_status_from_scratch nostyle pending = {nostyle=nostyle ; 935 pending =pending ; active = [] ; top=NotMe ; out = Out.create_buff ()} let do_open_mods () = 940 if !verbose > 2 then begin prerr_string "=> do_open_mods: " ; pretty_cur !cur_out end ; 945 let now_active = do_open_these_mods do_open_mod !cur_out.pending in activate_top !cur_out ; !cur_out.active <- now_active @ !cur_out.active ; !cur_out.pending <- [] ; 950 if !verbose > 2 then begin prerr_string "<= do_open_mods: " ; pretty_cur !cur_out end 955 let do_pending () = 960 begin match flags.pending_par with | Some n -> flush_par (par_val flags.last_closed (pblock()) n) | _ -> () end ; 965 flags.last_closed <- NADA ; do_open_mods () ;; 970 let one_cur_size pending active = let rec cur_size_active = function | [] -> raise Not_found | {here=true ; env=Font i}::_ -> i | _::rest -> cur_size_active rest in 975 let rec cur_size_pending = function | [] -> cur_size_active active | Font i::_ -> i | _::rest -> cur_size_pending rest in 980 cur_size_pending pending ;; let cur_size out = try one_cur_size out.pending out.active 985 with Not_found -> try let top_out = get_top_lists out.top in one_cur_size top_out.top_pending top_out.top_active with Not_found -> 3 990 let one_first_same x same_constr pending active = let rec same_active = function | {here=true ; env=y} :: rest -> if same_constr y then x=y 995 else same_active rest | _::rest -> same_active rest | [] -> raise Not_found in let rec same_pending = function | [] -> same_active active 1000 | y::rest -> if same_constr y then x=y else same_pending rest in same_pending pending ;; 1005 let first_same x same_constr out = try one_first_same x same_constr out.pending out.active with Not_found -> 1010 try let top_out = get_top_lists out.top in one_first_same x same_constr top_out.top_pending top_out.top_active with | Not_found -> false 1015 let already_here = function | Font i -> i = cur_size !cur_out | x -> 1020 first_same x (match x with Style _ -> is_style | Font _ -> is_font | Color _ -> is_color) 1025 !cur_out ;; let ok_pre x = match x with | Color _ | Font _ | Style "SUB" | Style "SUP" -> not !Parse_opts.pedantic 1030 | _ -> true ;; let rec filter_pre = function [] -> [] 1035 | e::rest -> if ok_pre e then e::filter_pre rest else filter_pre rest ;; 1040 let ok_mod e = (not flags.in_pre || ok_pre e) && (not (already_here e)) ;; 1045 let get_fontsize () = cur_size !cur_out let rec erase_rec pred = function [] -> None 1050 | s::rest -> if pred s then Some rest else match erase_rec pred rest with 1055 | Some rest -> Some (s::rest) | None -> None ;; 1060 let erase_mod_pred pred same_constr = if not !cur_out.nostyle then begin match erase_rec pred !cur_out.pending with | Some pending -> !cur_out.pending <- pending 1065 | None -> let re_open,closed = do_close_mods_pred pred same_constr in match closed with | Some _ -> !cur_out.pending <- !cur_out.pending @ re_open 1070 | None -> activate_top !cur_out ; try let tops = get_top_lists !cur_out.top in !cur_out.active <- 1075 !cur_out.active @ activate "erase" tops.top_pending @ tops.top_active ; close_top 0 !cur_out ; let re_open,_ = do_close_mods_pred pred same_constr in 1080 !cur_out.pending <- !cur_out.pending @ re_open with | Not_found -> () end ;; 1085 let same_env = function | Style s1 -> (function | Style s2 -> s1 = s2 | _ -> false) | Font i1 -> (function | Font i2 -> i1 = i2 | _ -> false) 1090 | Color s1 -> (function | Color s2 -> s1 = s2 | _ -> false) and same_constr = function | Color _ -> is_color 1095 | Font _ -> is_font | Style _ -> is_style let erase_mods ms = let rec erase_rec = function 1100 | [] -> () | m :: ms -> erase_mod_pred (same_env m) (same_constr m) ; erase_rec ms in erase_rec ms 1105 ;; let open_mod m = if not !cur_out.nostyle then begin if !verbose > 3 then begin 1110 prerr_endline ("open_mod: "^pretty_text m^" ok="^sbool (ok_mod m)) ; pretty_cur !cur_out end ; begin match m with | Style "EM" -> 1115 if already_here m then erase_mods [m] else !cur_out.pending <- m :: !cur_out.pending | _ -> 1120 if ok_mod m then begin !cur_out.pending <- m :: !cur_out.pending end end end 1125 ;; let rec open_mods = function m::rest -> open_mods rest ; open_mod m | [] -> () 1130 ;; (* Blocks *) 1135 let pstart = function | H1 | H2 | H3 | H4 | H5 | H6 | PRE | DIV 1140 | BLOCKQUOTE | UL | OL | DL | TABLE -> true | _ -> false ;; 1145 let is_group = function | GROUP -> true | _ -> false 1150 and is_pre = function | PRE -> true | _ -> false let rec do_try_open_block s args = 1155 if !verbose > 2 then prerr_flags ("=> try open ``"^string_of_block s^"''"); if s = DISPLAY then begin do_try_open_block TABLE args ; do_try_open_block TR "VALIGN=middle" ; 1160 end else begin push stacks.s_empty flags.empty ; push stacks.s_blank flags.blank ; push stacks.s_insert flags.insert ; flags.empty <- true ; flags.blank <- true ; flags.insert <- None ; 1165 begin match s with | PRE -> flags.in_pre <- true (* No stack, cannot nest *) | TABLE -> push stacks.s_table_vsize flags.table_vsize ; push stacks.s_vsize flags.vsize ; 1170 push stacks.s_nrows flags.nrows ; flags.table_vsize <- 0 ; flags.vsize <- 0 ; flags.nrows <- 0 | TR -> 1175 flags.vsize <- 1 | TD -> push stacks.s_vsize flags.vsize ; flags.vsize <- 1 | _ -> 1180 if is_list s then begin push stacks.s_nitems flags.nitems; flags.nitems <- 0 ; if s = DL then begin push stacks.s_dt flags.dt ; 1185 push stacks.s_dcount flags.dcount; flags.dt <- ""; flags.dcount <- "" end end 1190 end end ; if !verbose > 2 then prerr_flags ("<= try open ``"^string_of_block s^"''") ;; 1195 let try_open_block s args = push stacks.s_insert_attr flags.insert_attr ; begin match flags.insert_attr with | Some (TR,_) when s <> TR -> () 1200 | _ -> flags.insert_attr <- None end ; do_try_open_block s args let do_do_open_block s args = 1205 if s = TR || is_header s then do_put "\n"; do_put_char '<' ; do_put (string_of_block s) ; if args <> "" then begin 1210 if args.[0] <> ' ' then do_put_char ' ' ; do_put args end ; do_put_char '>' 1215 let rec do_open_block insert s args = match s with | GROUP|DELAY|FORGET|AFTER|INTERN -> begin match insert with | Some (tag,iargs) -> do_do_open_block tag iargs | _ -> () 1220 end | DISPLAY -> do_open_block insert TABLE args ; do_open_block None TR "VALIGN=middle" | _ -> begin match insert with 1225 | Some (tag,iargs) -> if is_list s || s = TABLE then begin do_do_open_block tag iargs ; do_do_open_block s args end else begin 1230 do_do_open_block s args ; do_do_open_block tag iargs end | _ -> do_do_open_block s args end 1235 let rec do_try_close_block s = if !verbose > 2 then prerr_flags ("=> try close ``"^string_of_block s^"''") ; if s = DISPLAY then begin 1240 do_try_close_block TR ; do_try_close_block TABLE end else begin let ehere = flags.empty and ethere = pop stacks.s_empty in flags.empty <- (ehere && ethere) ; 1245 let bhere = flags.blank and bthere = pop stacks.s_blank in flags.blank <- (bhere && bthere) ; flags.insert <- pop stacks.s_insert ; begin match s with | PRE -> flags.in_pre <- false (* PRE cannot nest *) 1250 | TABLE -> let p_vsize = pop stacks.s_vsize in flags.vsize <- max (flags.table_vsize + (flags.nrows)/3) p_vsize ; flags.nrows <- pop stacks.s_nrows ; 1255 flags.table_vsize <- pop stacks.s_table_vsize | TR -> if ehere then begin flags.vsize <- 0 end ; 1260 flags.table_vsize <- flags.table_vsize + flags.vsize; if not ehere then flags.nrows <- flags.nrows + 1 | TD -> let p_vsize = pop stacks.s_vsize in flags.vsize <- max p_vsize flags.vsize 1265 | _ -> if is_list s then begin flags.nitems <- pop stacks.s_nitems ; if s = DL then begin flags.dt <- pop stacks.s_dt ; 1270 flags.dcount <- pop stacks.s_dcount end end end end ; 1275 if !verbose > 2 then prerr_flags ("<= try close ``"^string_of_block s^"''") let try_close_block s = begin match flags.insert_attr with 1280 | Some (tag,_) when tag = s -> flags.insert_attr <- pop stacks.s_insert_attr | _ -> match pop stacks.s_insert_attr with | None -> () | Some (_,_) as x -> flags.insert_attr <- x 1285 end ; do_try_close_block s let do_do_close_block s = do_put "</" ; 1290 do_put (string_of_block s) ; do_put_char '>' ; match s with TD -> do_put_char '\n' | _ -> () let rec do_close_block insert s = match s with 1295 | GROUP|DELAY|FORGET|AFTER|INTERN -> begin match insert with | Some (tag,_) -> do_do_close_block tag | _ -> () end 1300 | DISPLAY -> do_close_block None TR ; do_close_block insert TABLE | s -> begin match insert with | Some (tag,_) -> 1305 if is_list s || s = TABLE then begin do_do_close_block s; do_do_close_block tag end else begin do_do_close_block tag; 1310 do_do_close_block s end | _ -> do_do_close_block s end 1315 let check_empty () = flags.empty and make_empty () = flags.empty <- true ; flags.blank <- true ; !cur_out.top <- NotMe ; 1320 !cur_out.pending <- to_pending !cur_out.pending !cur_out.active ; !cur_out.active <- [] ;; let rec open_top_styles = function 1325 | NotMe|Insert (_,_) -> (* Real block, inserted block *) begin match !cur_out.top with | Nothing tops -> let mods = to_pending !cur_out.pending !cur_out.active @ 1330 to_pending tops.top_pending tops.top_active in assert (!cur_out.active=[]) ; close_active_mods tops.top_active ; !cur_out.top <- Closed (tops,Out.get_pos !cur_out.out); Some mods 1335 | Activate tops -> !cur_out.top <- ActivateClosed tops ; let mods = to_pending !cur_out.pending !cur_out.active @ to_pending tops.top_pending tops.top_active in 1340 close_active_mods !cur_out.active ; close_active_mods (activate "open_top_styles" tops.top_pending) ; close_active_mods tops.top_active ; Some mods | _ -> 1345 let mods = to_pending !cur_out.pending !cur_out.active in close_active_mods !cur_out.active ; Some mods end | Closed (_,n) -> (* Group that closed top_styles (all of them) *) 1350 let out = !cur_out in let mods = all_to_pending out in close_top n out ; Some mods | Nothing _ -> (* Group with nothing to do *) 1355 None | Activate _ -> (* Just activate styles *) do_open_mods () ; None | ActivateClosed tops -> 1360 do_open_mods () ; let r = open_top_styles (Closed (tops,Out.get_pos !cur_out.out)) in r 1365 let rec force_block s content = if !verbose > 2 then begin prerr_endline ("=> force_block: ["^string_of_block s^"]"); pretty_cur !cur_out end ; 1370 let was_empty = flags.empty in if s = FORGET then begin make_empty () ; end else if flags.empty then begin flags.empty <- false; flags.blank <- false ; 1375 do_open_mods () ; do_put content end ; if s = TABLE || s=DISPLAY then flags.table_inside <- true; (* if s = PRE then flags.in_pre <- false ; *) 1380 let true_s = if s = FORGET then pblock() else s in let insert = flags.insert and insert_attr = flags.insert_attr and was_nostyle = !cur_out.nostyle and was_top = !cur_out.top in 1385 do_close_mods () ; try_close_block true_s ; do_close_block insert true_s ; let ps,args,pout = pop_out out_stack in 1390 check_block_closed ps true_s ; let old_out = !cur_out in cur_out := pout ; if s = FORGET then free old_out else if ps <> DELAY then begin 1395 let mods = open_top_styles was_top in do_open_block insert s (match insert_attr with | Some (this_tag,attr) when this_tag = s -> args^" "^attr 1400 | _ -> args) ; begin match was_top with | Insert (_,mods) -> ignore (do_open_these_mods do_open_mod mods) 1405 | _ -> () end ; (* prerr_endline "****** NOW *******" ; pretty_cur !cur_out ; 1410 prerr_endline "\n**********" ; *) if ps = AFTER then begin let f = pop stacks.s_after in Out.copy_fun f old_out.out !cur_out.out 1415 end else begin Out.copy old_out.out !cur_out.out end ; free old_out ; begin match mods with 1420 | Some mods -> !cur_out.active <- [] ; !cur_out.pending <- mods | _ -> () end 1425 end else begin (* ps = DELAY *) raise (Misc.Fatal ("html: unflushed DELAY")) end ; if not was_empty && true_s <> GROUP && true_s <> AFTER then flags.last_closed <- true_s ; 1430 if !verbose > 2 then begin prerr_endline ("<= force_block: ["^string_of_block s^"]"); pretty_cur !cur_out end ; 1435 and close_block_loc pred s = if !verbose > 2 then prerr_string ("close_block_loc: ``"^string_of_block s^"'' = "); 1440 if not (pred ()) then begin if !verbose > 2 then prerr_endline "do it" ; force_block s ""; true end else begin 1445 if !verbose > 2 then prerr_endline "forget it" ; force_block FORGET ""; false end 1450 and open_block s args = if !verbose > 2 then begin prerr_endline ("=> open_block ``"^string_of_block s^"''"); pretty_cur !cur_out ; end ; 1455 try_flush_par (Wait s); push_out out_stack (s,args,!cur_out) ; cur_out := begin if is_group s then 1460 create_status_from_top !cur_out else create_status_from_scratch !cur_out.nostyle (let cur_mods = all_to_pending !cur_out in 1465 if flags.in_pre || is_pre s then filter_pre cur_mods else cur_mods) end ; try_open_block s args ; if !verbose > 2 then begin prerr_endline ("<= open_block ``"^string_of_block s^"''"); 1470 pretty_cur !cur_out ; end ; ;; 1475 let insert_block tag arg = begin match !cur_out.top with | Nothing {top_pending=pending ; top_active=active} -> !cur_out.pending <- !cur_out.pending @ to_pending pending active ; assert (!cur_out.active = []) ; 1480 !cur_out.top <- Insert (false,[]) | Activate {top_pending=pending ; top_active=active} -> let add_active = activate "insert_block" pending @ active in !cur_out.active <- !cur_out.active @ add_active ; !cur_out.top <- Insert (true,to_pending [] add_active) 1485 | Closed (_,n) -> Out.erase_start n !cur_out.out ; !cur_out.top <- Insert (false,[]) | ActivateClosed {top_active=active ; top_pending=pending}-> !cur_out.top <- Insert (false,to_pending pending active) 1490 | NotMe -> () | Insert _ -> () end ; flags.insert <- Some (tag,arg) 1495 let insert_attr tag attr = match tag,flags.insert_attr with | TD, Some (TR,_) -> () | _, _ -> flags.insert_attr <- Some (tag,attr) 1500 let close_block s = let _ = close_block_loc check_empty s in () ;; 1505 let erase_block s = if !verbose > 2 then begin Printf.fprintf stderr "erase_block: %s" (string_of_block s); prerr_newline () end ; 1510 try_close_block s ; let ts,_,tout = pop_out out_stack in if ts <> s && not (s = GROUP && ts = INTERN) then failclose "erase_block" s ts; free !cur_out ; 1515 cur_out := tout ;; let open_group ss = 1520 let e = Style ss in if no_opt || (ss <> "" && (not flags.in_pre || (ok_pre e))) then begin open_block INTERN "" ; if ss <> "" then !cur_out.pending <- !cur_out.pending @ [e] 1525 end else open_block GROUP "" and open_aftergroup f = open_block AFTER "" ; 1530 flags.empty <- false ; push stacks.s_after f and close_group () = match pblock () with 1535 | INTERN -> close_block INTERN | AFTER -> force_block AFTER "" | _ -> close_block GROUP ;; 1540 (* output requests *) let is_blank = function ' ' | '\n' -> true 1545 | _ -> false ;; let put s = let block = pblock () in 1550 match block with | TABLE|TR -> () | _ -> let s_blank = let r = ref true in 1555 for i = 0 to String.length s - 1 do r := !r && is_blank (String.unsafe_get s i) done ; !r in let save_last_closed = flags.last_closed in 1560 do_pending () ; flags.empty <- false; flags.blank <- s_blank && flags.blank ; do_put s ; if s_blank then flags.last_closed <- save_last_closed 1565 ;; let put_char c = let s = pblock () in match s with 1570 | TABLE|TR -> () | _ -> let save_last_closed = flags.last_closed in let c_blank = is_blank c in do_pending () ; 1575 flags.empty <- false; flags.blank <- c_blank && flags.blank ; do_put_char c ; if c_blank then flags.last_closed <- save_last_closed ;; 1580 let flush_out () = Out.flush !cur_out.out ;; 1585 let skip_line () = flags.vsize <- flags.vsize + 1 ; put "<BR>\n" ;; 1590 let put_length which = function | Pixel x -> put (which^string_of_int x) | Char x -> put (which^string_of_int (Length.font * x)) | Percent x -> put (which^"\""^string_of_int x^"%\"") 1595 | Default -> () | No s -> raise (Misc.Fatal ("No-length ``"^s^"'' in outManager")) let horizontal_line attr width height = open_block GROUP "" ; 1600 nostyle () ; put "<HR" ; begin match attr with "" -> () | _ -> put_char ' ' ; put attr end ; put_length " WIDTH=" width ; put_length " SIZE=" height ; 1605 put_char '>' ; close_block GROUP ;; let line_in_table h = 1610 let pad = (h-1)/2 in put "<TABLE BORDER=0 WIDTH=\"100%\" CELLSPACING=0 CELLPADDING=" ; put (string_of_int pad) ; put "><TR><TD></TD></TR></TABLE>" 1615 let freeze f = push out_stack (Freeze f) ; if !verbose > 2 then begin prerr_string "freeze: stack=" ; pretty_stack out_stack 1620 end ;; let flush_freeze () = match top out_stack with Freeze f -> 1625 let _ = pop out_stack in if !verbose > 2 then begin prerr_string "flush_freeze" ; pretty_stack out_stack end ; 1630 f () ; true | _ -> false ;; let pop_freeze () = match top out_stack with 1635 Freeze f -> let _ = pop out_stack in f,true | _ -> (fun () -> ()),false ;; 1640 let try_open_display () = push stacks.s_ncols flags.ncols ; push stacks.s_table_inside flags.table_inside ; 1645 push stacks.s_saved_inside false ; flags.table_inside <- false ; flags.ncols <- 0 and try_close_display () = 1650 flags.ncols <- pop stacks.s_ncols ; flags.table_inside <- pop stacks.s_saved_inside || flags.table_inside ; flags.table_inside <- pop stacks.s_table_inside || flags.table_inside ;; 1655 let close_flow_loc s = if !verbose > 2 then prerr_endline ("close_flow_loc: "^string_of_block s) ; 1660 let active = !cur_out.active and pending = !cur_out.pending in if close_block_loc check_empty s then begin !cur_out.pending <- to_pending pending active ; true 1665 end else begin !cur_out.pending <- to_pending pending active ; false end ;; 1670 let close_flow s = assert (s <> GROUP) ; if !verbose > 2 then prerr_flags ("=> close_flow ``"^string_of_block s^"''"); let _ = close_flow_loc s in 1675 if !verbose > 2 then prerr_flags ("<= close_flow ``"^string_of_block s^"''") ;; 1680 let get_block s args = if !verbose > 2 then begin prerr_flags "=> get_block"; end ; do_close_mods () ; 1685 let pempty = top stacks.s_empty and pblank = top stacks.s_blank and pinsert = top stacks.s_insert in try_close_block (pblock ()) ; flags.empty <- pempty ; flags.blank <- pblank ; flags.insert <- pinsert; 1690 do_close_block None s ; let _,_,pout = pop_out out_stack in let old_out = !cur_out in cur_out := with_new_out pout ; let mods = as_envs !cur_out.active !cur_out.pending in 1695 do_close_mods () ; do_open_block None s args ; Out.copy old_out.out !cur_out.out ; free old_out ; !cur_out.pending <- mods ; 1700 let r = !cur_out in cur_out := pout ; if !verbose > 2 then begin Out.debug stderr r.out ; prerr_endline ""; 1705 prerr_flags "<= get_block" end ; r let hidden_to_string f = 1710 (* prerr_string "to_string: " ; Out.debug stderr !cur_out.out ; prerr_endline "" ; *) 1715 let old_flags = copy_flags flags in let _ = forget_par () in open_block INTERN "" ; f () ; do_close_mods () ; 1720 let flags_now = copy_flags flags in let r = Out.to_string !cur_out.out in flags.empty <- true ; close_block INTERN ; set_flags flags old_flags ; 1725 r,flags_now ;; let to_string f = let r,_ = hidden_to_string f in 1730 r <6>85 htmllex.ml 12 "htmllex.mll" open Lexing open Lexeme 5 open Buff let txt_level = ref 0 and txt_stack = Stack.create "htmllex" 10 exception Error of string ;; let error msg lb = 15 raise (Error msg) let init table (s,t)= Hashtbl.add table s t ;; 20 let block = Hashtbl.create 17 ;; List.iter (init block) 25 ["CENTER", () ; "DIV", (); "BLOCKQUOTE", () ; "H1", () ; "H2", () ;"H3", () ;"H4", () ;"H5", () ;"H6", () ; "PRE", () ; "TABLE", () ; "TR",() ; "TD", () ; "TH",() ; "OL",() ; "UL",(); "P",() ; "LI",() ; "DL",() ; "DT", () ; "DD",() ; 30 ] ;; let ptop () = if not (Stack.empty txt_stack) then begin 35 let pos = Stack.top txt_stack in Location.print_this_fullpos pos ; prerr_endline "This opening tag is pending" end 40 let warnings = ref true let check_nesting lb name = try Hashtbl.find block (String.uppercase name) ; 45 if !txt_level <> 0 && !warnings then begin Location.print_fullpos () ; prerr_endline ("Warning, block level element: "^name^" nested inside text-level element") ; ptop () 50 end with | Not_found -> () let text = Hashtbl.create 17 55 ;; List.iter (init text) ["TT",TT ; "I",I ; "B",B ; "BIG",BIG ; "SMALL",SMALL ; 60 "STRIKE",STRIKE ; "S",S ; "U",U ; "FONT",FONT ; "EM",EM ; "STRONG",STRONG ; "DFN",DFN ; "CODE",CODE ; "SAMP",SAMP ; "KBD",KBD ; "VAR",VAR ; "CITE",CITE ; "ABBR",ABBR ; "ACRONYM",ACRONYM ; "Q",Q ; "SUB",SUB ; "SUP",SUP ; "A", A ; "SPAN", SPAN ; "SCRIPT", SCRIPT] ;; 65 let is_textlevel name = try let _ = Hashtbl.find text (String.uppercase name) in true 70 with | Not_found -> false let is_br name = "BR" = (String.uppercase name) let is_basefont name = "BASEFONT" = (String.uppercase name) 75 let set_basefont attrs lb = List.iter (fun (name,v,_) -> match String.uppercase name,v with | "SIZE",Some s -> 80 begin try Emisc.basefont := int_of_string s with | _ -> error "BASEFONT syntax" lb end 85 | _ -> ()) attrs let get_value lb = function | Some s -> s 90 | _ -> error "Bad attribute syntax" lb let norm_attrs lb attrs = List.map (fun (name,value,txt) -> 95 match String.uppercase name with | "SIZE" -> SIZE (get_value lb value),txt | "COLOR" -> COLOR (get_value lb value),txt | "FACE" -> FACE (get_value lb value),txt | _ -> OTHER, txt) 100 attrs let print_attrs s attrs = print_string s ; print_string ":" ; List.iter 105 (fun x -> match x with | name,Some value when name=s -> print_char ' ' ; print_string value | _ -> ()) 110 attrs ; print_char '\n' let ouvre lb name attrs txt = let uname = String.uppercase name in 115 try let tag = Hashtbl.find text uname in let attrs = norm_attrs lb attrs in incr txt_level ; Stack.push txt_stack (Location.get_pos ()) ; 120 Open (tag, attrs,txt) with | Not_found -> assert false and ferme lb name txt = 125 try let tag = Hashtbl.find text (String.uppercase name) in decr txt_level ; begin if not (Stack.empty txt_stack) then let _ = Stack.pop txt_stack in () 130 end ; Close (tag,txt) with | Not_found -> Text txt 135 let unquote s = 140 let l = String.length s in String.sub s 1 (l-2) ;; let buff = Buff.create () 145 and abuff = Buff.create () let put s = Buff.put buff s and putc c = Buff.put_char buff c 150 let aput s = Buff.put abuff s and aputc c = Buff.put_char abuff c 155 let lex_tables = { Lexing.lex_base = "\000\000\001\000\000\000\114\000\002\000\215\000\082\000\019\000\ \254\255\000\000\253\255\000\000\004\000\255\255\255\255\003\000\ \040\001\020\000\120\001\116\000\007\000\009\000\198\001\249\255\ \122\000\018\000\000\000\250\255\001\000\251\255\013\000\032\000\ \018\000\022\000\032\000\140\000\026\000\039\000\023\000\027\000\ \033\000"; Lexing.lex_backtrk = "\255\255\001\000\000\000\003\000\001\000\002\000\255\255\255\255\ \255\255\001\000\255\255\255\255\000\000\255\255\255\255\255\255\ \255\255\255\255\001\000\255\255\000\000\000\000\001\000\255\255\ \000\000\006\000\003\000\255\255\002\000\255\255\255\255\255\255\ \255\255\255\255\255\255\000\000\255\255\255\255\255\255\255\255\ \255\255"; 160 Lexing.lex_default = "\023\000\013\000\255\255\255\255\255\255\255\255\008\000\008\000\ \000\000\255\255\000\000\255\255\255\255\000\000\000\000\015\000\ \255\255\017\000\255\255\255\255\255\255\255\255\255\255\000\000\ \255\255\255\255\255\255\000\000\255\255\000\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255"; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\024\000\024\000\019\000\019\000\024\000\013\000\019\000\ \020\000\020\000\021\000\021\000\020\000\000\000\021\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \024\000\028\000\019\000\000\000\000\000\013\000\025\000\020\000\ \000\000\021\000\000\000\000\000\000\000\011\000\030\000\029\000\ \002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\008\000\013\000\026\000\255\255\012\000\020\000\ \009\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\035\000\035\000\000\000\000\000\000\000\ \000\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\021\000\021\000\019\000\019\000\021\000\ \031\000\019\000\032\000\035\000\035\000\033\000\034\000\035\000\ \037\000\038\000\039\000\040\000\000\000\000\000\000\000\000\000\ \014\000\000\000\021\000\000\000\019\000\035\000\035\000\000\000\ \000\000\035\000\035\000\000\000\000\000\000\000\000\000\022\000\ \036\000\000\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\035\000\000\000\000\000\000\000\ \010\000\020\000\036\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\000\000\000\000\000\000\ \000\000\000\000\000\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\015\000\016\000\000\000\000\000\000\000\017\000\000\000\ \027\000\255\255\018\000\255\255\018\000\018\000\000\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\000\000\010\000\255\255\000\000\000\000\000\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\000\000\000\000\000\000\000\000\018\000\000\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\010\000\018\000\000\000\018\000\018\000\000\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\000\000\000\000\000\000\000\000\000\000\ \000\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\000\000\000\000\000\000\000\000\018\000\ \000\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\000\000\018\000\018\000\000\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\000\000\000\000\000\000\000\000\000\000\ \000\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\000\000\000\000\000\000\000\000\018\000\ \000\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\022\000\000\000\000\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\000\000\000\000\000\000\000\000\000\000\000\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000"; Lexing.lex_check = 165 "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\000\000\000\000\004\000\004\000\000\000\012\000\004\000\ \020\000\020\000\021\000\021\000\020\000\255\255\021\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\026\000\004\000\255\255\255\255\015\000\000\000\020\000\ \255\255\021\000\255\255\255\255\255\255\009\000\028\000\026\000\ \002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\030\000\017\000\000\000\001\000\011\000\004\000\ \007\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\034\000\040\000\255\255\255\255\255\255\ \255\255\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\003\000\003\000\019\000\019\000\003\000\ \025\000\019\000\031\000\024\000\024\000\032\000\033\000\024\000\ \036\000\037\000\038\000\039\000\255\255\255\255\255\255\255\255\ \006\000\255\255\003\000\255\255\019\000\035\000\035\000\255\255\ \255\255\035\000\024\000\255\255\255\255\255\255\255\255\003\000\ \024\000\255\255\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\035\000\255\255\255\255\255\255\ \003\000\019\000\035\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\255\255\255\255\255\255\ \255\255\255\255\255\255\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\005\000\005\000\255\255\255\255\255\255\005\000\255\255\ \000\000\001\000\005\000\015\000\005\000\005\000\255\255\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\255\255\007\000\017\000\255\255\255\255\255\255\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\255\255\255\255\255\255\255\255\005\000\255\255\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\006\000\016\000\255\255\016\000\016\000\255\255\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\255\255\255\255\255\255\255\255\255\255\ \255\255\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\255\255\255\255\255\255\255\255\016\000\ \255\255\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\018\000\255\255\018\000\018\000\255\255\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\255\255\255\255\255\255\255\255\255\255\ \255\255\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\255\255\255\255\255\255\255\255\018\000\ \255\255\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\022\000\255\255\255\255\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\255\255\255\255\255\255\255\255\255\255\255\255\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ \022\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255" } let rec main lexbuf = __ocaml_lex_main_rec lexbuf 0 and __ocaml_lex_main_rec lexbuf state = 170 match Lexing.engine lex_tables state lexbuf with 0 -> ( 171 "htmllex.mll" Blanks (lexeme lexbuf)) | 1 -> ( 175 173 "htmllex.mll" put (lexeme lexbuf) ; in_comment lexbuf ; Text (Buff.to_string buff)) | 2 -> ( 180 177 "htmllex.mll" put (lexeme lexbuf) ; in_tag lexbuf ; Text (Buff.to_string buff)) | 3 -> ( 185 181 "htmllex.mll" putc '<' ; let tag = read_tag lexbuf in if is_textlevel tag then begin let attrs = read_attrs lexbuf in 190 ouvre lexbuf tag attrs (Buff.to_string buff) end else if is_basefont tag then begin let attrs = read_attrs lexbuf in set_basefont attrs lexbuf ; Text (Buff.to_string buff) 195 end else begin check_nesting lexbuf tag ; in_tag lexbuf ; let txt = Buff.to_string buff in if is_br tag then 200 Blanks txt else Text txt end) | 4 -> ( 205 200 "htmllex.mll" put "</" ; let tag = read_tag lexbuf in in_tag lexbuf ; ferme lexbuf tag (Buff.to_string buff)) 210 | 5 -> ( 204 "htmllex.mll" Eof) | 6 -> ( 206 "htmllex.mll" 215 putc (lexeme_char lexbuf 0) ; text lexbuf ; Text (Buff.to_string buff)) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_main_rec lexbuf n 220 and text lexbuf = __ocaml_lex_text_rec lexbuf 1 and __ocaml_lex_text_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 212 "htmllex.mll" 225 putc (lexeme_char lexbuf 0) ; text lexbuf) | 1 -> ( 213 "htmllex.mll" ()) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_text_rec lexbuf n 230 and read_tag lexbuf = __ocaml_lex_read_tag_rec lexbuf 2 and __ocaml_lex_read_tag_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 235 217 "htmllex.mll" let lxm = lexeme lexbuf in put lxm ; lxm) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_read_tag_rec lexbuf n 240 and read_attrs lexbuf = __ocaml_lex_read_attrs_rec lexbuf 3 and __ocaml_lex_read_attrs_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 222 "htmllex.mll" 245 aput (lexeme lexbuf) ; read_attrs lexbuf) | 1 -> ( 224 "htmllex.mll" let name = lexeme lexbuf in aput name ; 250 let v = read_avalue lexbuf in let atxt = Buff.to_string abuff in put atxt ; (name,v,atxt)::read_attrs lexbuf) | 2 -> ( 255 230 "htmllex.mll" put_char buff '>' ; []) | 3 -> ( 231 "htmllex.mll" error "Attribute syntax" lexbuf) 260 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_read_attrs_rec lexbuf n and read_avalue lexbuf = __ocaml_lex_read_avalue_rec lexbuf 4 and __ocaml_lex_read_avalue_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 265 0 -> ( 235 "htmllex.mll" let lxm = lexeme lexbuf in aput lxm ; Some (read_aavalue lexbuf)) 270 | 1 -> ( 238 "htmllex.mll" None) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_read_avalue_rec lexbuf n 275 and read_aavalue lexbuf = __ocaml_lex_read_aavalue_rec lexbuf 5 and __ocaml_lex_read_aavalue_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 243 "htmllex.mll" 280 let lxm = lexeme lexbuf in aput lxm ; unquote lxm) | 1 -> ( 247 "htmllex.mll" 285 let lxm = lexeme lexbuf in aput lxm ; lxm) | 2 -> ( 250 "htmllex.mll" 290 error "Attribute syntax" lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_read_aavalue_rec lexbuf n and in_tag lexbuf = __ocaml_lex_in_tag_rec lexbuf 6 and __ocaml_lex_in_tag_rec lexbuf state = 295 match Lexing.engine lex_tables state lexbuf with 0 -> ( 253 "htmllex.mll" putc (lexeme_char lexbuf 0)) | 1 -> ( 300 254 "htmllex.mll" putc (lexeme_char lexbuf 0) ; in_tag lexbuf) | 2 -> ( 255 "htmllex.mll" error "End of file in tag" lexbuf) 305 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_in_tag_rec lexbuf n and in_comment lexbuf = __ocaml_lex_in_comment_rec lexbuf 7 and __ocaml_lex_in_comment_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 310 0 -> ( 259 "htmllex.mll" put (lexeme lexbuf)) | 1 -> ( 261 "htmllex.mll" 315 putc (lexeme_char lexbuf 0) ; in_comment lexbuf) | 2 -> ( 263 "htmllex.mll" error "End of file in comment" lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_in_comment_rec lexbuf n 320 ;; 265 "htmllex.mll" 325 let to_string = function | Open (_,_,txt) | Close (_,txt) | Text txt | Blanks txt -> txt | Eof -> "Eof" 330 let rec cost = function | {tag=FONT ; attrs=attrs} -> (1,List.length attrs) | _ -> (1,0) let tok_buff = ref None 335 ;; let txt_buff = Buff.create () ;; 340 let rec read_tokens blanks lb = let t = main lb in match t with | Text txt -> Buff.put txt_buff txt ; read_tokens false lb | Blanks txt -> Buff.put txt_buff txt ; read_tokens blanks lb 345 | _ -> let txt = Buff.to_string txt_buff in match txt with | "" -> t | _ -> 350 tok_buff := Some t ; if blanks then Blanks txt else Text txt 355 let reset () = txt_level := 0 ; Stack.reset txt_stack ; Buff.reset txt_buff ; 360 Buff.reset buff ; Buff.reset abuff let next_token lb = try match !tok_buff with 365 | Some t -> tok_buff := None ; t | None -> read_tokens true lb with | e -> reset () ; 370 raise e <6>86 htmlMath.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: htmlMath.ml,v 1.21 2000/10/31 08:25:14 maranget Exp $" 15 open Misc open Parse_opts open Element open HtmlCommon open Stack 20 let delay_stack = Stack.create "delay_stack" ;; 25 (* delaying output .... *) let delay f = if !verbose > 2 then prerr_flags "=> delay" ; push stacks.s_vsize flags.vsize ; 30 flags.vsize <- 0; push delay_stack f ; open_block DELAY "" ; if !verbose > 2 then prerr_flags "<= delay" ;; 35 let flush x = if !verbose > 2 then prerr_flags ("=> flush arg is ``"^string_of_int x^"''"); try_close_block DELAY ; 40 let ps,_,pout = pop_out out_stack in if ps <> DELAY then raise (Misc.Fatal ("html: Flush attempt on: "^string_of_block ps)) ; let mods = as_envs !cur_out.active !cur_out.pending in do_close_mods () ; 45 let old_out = !cur_out in cur_out := pout ; let f = pop delay_stack in f x ; Out.copy old_out.out !cur_out.out ; 50 flags.empty <- false ; flags.blank <- false ; free old_out ; !cur_out.pending <- mods ; flags.vsize <- max (pop stacks.s_vsize) flags.vsize ; if !verbose > 2 then 55 prerr_flags "<= flush" ;; (* put functions *) 60 let put = HtmlCommon.put and put_char = HtmlCommon.put_char ;; let put_in_math s = 65 if flags.in_pre && !pedantic then put s else begin put "<I>"; put s; 70 put "</I>"; flags.empty <- false; flags.blank <- false; end ;; 75 (*----------*) (* DISPLAYS *) (*----------*) let open_center () = open_block DIV "ALIGN=center" 80 and close_center () = close_block DIV ;; let display_arg verbose = if verbose > 1 then 85 "BORDER=1 CELLSPACING=0 CELLPADDING=0" else "CELLSPACING=0 CELLPADDING=0" ;; 90 let begin_item_display f is_freeze = if !verbose > 2 then begin 95 Printf.fprintf stderr "begin_item_display: ncols=%d empty=%s" flags.ncols (sbool flags.empty) ; prerr_newline () end ; open_block TD "NOWRAP"; open_block INTERN "" ; 100 if is_freeze then(* push out_stack (Freeze f) ;*)freeze f; and end_item_display () = let f,is_freeze = pop_freeze () in 105 let _ = close_flow_loc INTERN in if close_flow_loc TD then flags.ncols <- flags.ncols + 1; if !verbose > 2 then begin Printf.fprintf stderr "end_item_display: ncols=%d stck: " flags.ncols; 110 pretty_stack out_stack end; flags.vsize,f,is_freeze ;; 115 let open_display () = if !verbose > 2 then begin Printf.fprintf stderr "open_display: " end ; try_open_display () ; 120 open_block DISPLAY (display_arg !verbose) ; open_block TD "NOWRAP" ; open_block INTERN "" ; if !verbose > 2 then begin pretty_cur !cur_out ; 125 prerr_endline "" end ;; let close_display () = 130 if !verbose > 2 then begin prerr_flags "=> close_display" end ; if not (flush_freeze ()) then begin close_flow INTERN ; 135 let n = flags.ncols in if !verbose > 2 then Printf.fprintf stderr "=> close_display, ncols=%d\n" n ; if (n = 0 && not flags.blank) then begin if !verbose > 2 then begin 140 prerr_string "No Display n=0" ; (Out.debug stderr !cur_out.out); prerr_endline "" end; let active = !cur_out.active and pending = !cur_out.pending in 145 do_close_mods () ; let ps,_,pout = pop_out out_stack in if ps <> TD then failclose "close_display" ps TD ; do_close_mods () ; 150 try_close_block TD ; let ps,_,ppout = pop_out out_stack in if ps <> DISPLAY then failclose "close_display" ps DISPLAY ; try_close_block DISPLAY ; 155 let old_out = !cur_out in cur_out := ppout ; do_close_mods () ; Out.copy old_out.out !cur_out.out ; flags.empty <- false ; flags.blank <- false ; 160 free old_out ; free pout ; !cur_out.pending <- as_envs active pending end else if (n=1 && flags.blank) then begin if !verbose > 2 then begin prerr_string "No display n=1"; 165 (Out.debug stderr !cur_out.out); prerr_endline "" ; end; close_flow FORGET ; let active = !cur_out.active and pending = !cur_out.pending in 170 let ps,_,pout = pop_out out_stack in if ps <> DISPLAY then failclose "close_display" ps DISPLAY ; try_close_block DISPLAY ; let old_out = !cur_out in 175 cur_out := pout ; do_close_mods () ; Out.copy_no_tag old_out.out !cur_out.out ; flags.empty <- false ; flags.blank <- false ; free old_out ; 180 !cur_out.pending <- as_envs active pending end else begin if !verbose > 2 then begin prerr_string ("One Display n="^string_of_int n) ; (Out.debug stderr !cur_out.out); 185 prerr_endline "" end; flags.empty <- flags.blank ; close_flow TD ; close_flow DISPLAY 190 end ; try_close_display () end ; if !verbose > 2 then prerr_flags ("<= close_display") 195 ;; let do_item_display force = if !verbose > 2 then begin 200 prerr_endline ("Item Display ncols="^string_of_int flags.ncols^" table_inside="^sbool flags.table_inside) end ; let f,is_freeze = pop_freeze () in if (force && not flags.empty) || flags.table_inside then begin push stacks.s_saved_inside 205 (pop stacks.s_saved_inside || flags.table_inside) ; flags.table_inside <- false ; let active = !cur_out.active and pending = !cur_out.pending in flags.ncols <- flags.ncols + 1 ; 210 let save = get_block TD "NOWRAP" in if !verbose > 2 then begin Out.debug stderr !cur_out.out ; prerr_endline "To be copied" end; 215 if close_flow_loc TD then flags.ncols <- flags.ncols + 1; if !verbose > 2 then begin Out.debug stderr !cur_out.out ; prerr_endline "Was copied" end; 220 Out.copy save.out !cur_out.out ; flags.empty <- false ; flags.blank <- false ; free save ; !cur_out.pending <- as_envs active pending ; !cur_out.active <- [] ; 225 if !verbose > 2 then begin Out.debug stderr !cur_out.out ; prerr_endline ("Some Item") end; open_block TD "NOWRAP" ; 230 open_block INTERN "" end else begin if !verbose > 2 then begin Out.debug stderr !cur_out.out ; prerr_endline "No Item" ; 235 prerr_endline ("flags: empty="^sbool flags.empty^" blank="^sbool flags.blank) end; close_flow INTERN ; if !verbose > 2 then begin Out.debug stderr !cur_out.out ; 240 prerr_endline "No Item" ; prerr_endline ("flags: empty="^sbool flags.empty^" blank="^sbool flags.blank) end; open_block INTERN "" end ; 245 if is_freeze then push out_stack (Freeze f) ; if !verbose > 2 then begin prerr_string ("out item_display -> ncols="^string_of_int flags.ncols) ; pretty_stack out_stack end ; 250 ;; let item_display () = do_item_display false and force_item_display () = do_item_display true ;; 255 let erase_display () = erase_block INTERN ; erase_block TD ; 260 erase_block DISPLAY ; try_close_display () ;; 265 let open_maths display = if display then open_center (); push stacks.s_in_math flags.in_math; flags.in_math <- true; if display then open_display () 270 else open_group ""; ;; let close_maths display = if display then close_display () 275 else close_group (); flags.in_math <- pop stacks.s_in_math ; if display then close_center () ;; 280 (* vertical display *) 285 let open_vdisplay display = if !verbose > 1 then prerr_endline "open_vdisplay"; if not display then raise (Misc.Fatal ("VDISPLAY in non-display mode")); 290 open_block TABLE (display_arg !verbose) and close_vdisplay () = if !verbose > 1 then prerr_endline "close_vdisplay"; 295 close_block TABLE and open_vdisplay_row s = if !verbose > 1 then prerr_endline "open_vdisplay_row"; 300 open_block TR "" ; open_block TD s ; open_display () and close_vdisplay_row () = 305 if !verbose > 1 then prerr_endline "close_vdisplay_row"; close_display () ; force_block TD "&nbsp;" ; close_block TR 310 ;; (* Sup/Sub stuff *) 315 let get_script_font () = let n = get_fontsize () in if n >= 3 then Some (n-1) else None ;; 320 let open_script_font () = if not !pedantic then match get_script_font () with | Some m -> open_mod (Font m) 325 | _ -> () ;; let put_sup_sub display scanner (arg : string Lexstate.arg) = 330 if display then open_display () else open_block INTERN "" ; open_script_font () ; scanner arg ; if display then close_display () else close_block INTERN ; ;; 335 let reput_sup_sub tag = function | "" -> () | s -> open_block INTERN "" ; 340 clearstyle () ; if not (flags.in_pre && !pedantic) then begin put_char '<' ; put tag ; put_char '>' 345 end ; put s ; if not (flags.in_pre && !pedantic) then begin put "</" ; put tag ; 350 put_char '>' end ; close_block INTERN 355 let standard_sup_sub scanner what sup sub display = let sup,fsup = hidden_to_string (fun () -> put_sup_sub display scanner sup) in let sub,fsub = 360 hidden_to_string (fun () -> put_sup_sub display scanner sub) in if display && (fsub.table_inside || fsup.table_inside) then begin force_item_display () ; open_vdisplay display ; 365 if sup <> "" then begin open_vdisplay_row "NOWRAP" ; clearstyle () ; put sup ; close_vdisplay_row () 370 end ; open_vdisplay_row "" ; what (); close_vdisplay_row () ; if sub <> "" then begin 375 open_vdisplay_row "NOWRAP" ; clearstyle () ; put sub ; close_vdisplay_row () end ; 380 close_vdisplay () ; force_item_display () end else begin what (); reput_sup_sub "SUB" sub ; 385 reput_sup_sub "SUP" sup end ;; 390 let limit_sup_sub scanner what sup sub display = let sup = to_string (fun () -> put_sup_sub display scanner sup) and sub = to_string (fun () -> put_sup_sub display scanner sub) in if sup = "" && sub = "" then what () 395 else begin force_item_display () ; open_vdisplay display ; open_vdisplay_row "ALIGN=center" ; put sup ; 400 close_vdisplay_row () ; open_vdisplay_row "ALIGN=left" ; what () ; close_vdisplay_row () ; open_vdisplay_row "ALIGN=center" ; 405 put sub ; close_vdisplay_row () ; close_vdisplay () ; force_item_display () end 410 ;; let int_sup_sub something vsize scanner what sup sub display = let sup = to_string (fun () -> put_sup_sub display scanner sup) and sub = to_string (fun () -> put_sup_sub display scanner sub) in 415 if something then begin force_item_display () ; what () ; force_item_display () end ; 420 if sup <> "" || sub <> "" then begin open_vdisplay display ; open_vdisplay_row "ALIGN=left NOWRAP" ; put sup ; close_vdisplay_row () ; 425 open_vdisplay_row "ALIGN=left" ; for i = 2 to vsize do skip_line () done ; close_vdisplay_row () ; 430 open_vdisplay_row "ALIGN=left NOWRAP" ; put sub ; close_vdisplay_row () ; close_vdisplay () ; force_item_display () 435 end ;; let insert_vdisplay open_fun = 440 if !verbose > 2 then begin prerr_flags "=> insert_vdisplay" ; end ; try let mods = to_pending !cur_out.pending !cur_out.active in 445 let bs,bargs,bout = pop_out out_stack in if bs <> INTERN then failclose "insert_vdisplay" bs INTERN ; let ps,pargs,pout = pop_out out_stack in if ps <> TD then 450 failclose "insert_vdisplay" ps TD ; let pps,ppargs,ppout = pop_out out_stack in if pps <> DISPLAY then failclose "insert_vdisplay" pps DISPLAY ; let new_out = create_status_from_scratch false [] in 455 push_out out_stack (pps,ppargs,new_out) ; push_out out_stack (ps,pargs,pout) ; push_out out_stack (bs,bargs,bout) ; close_display () ; cur_out := ppout ; 460 open_fun () ; do_put (Out.to_string new_out.out) ; flags.empty <- false ; flags.blank <- false ; free new_out ; if !verbose > 2 then begin 465 prerr_string "insert_vdisplay -> " ; pretty_mods stderr mods ; prerr_newline () end ; if !verbose > 2 then 470 prerr_flags "<= insert_vdisplay" ; mods with PopFreeze -> raise (UserError "\\over should be properly parenthesized") ;; 475 let over display lexbuf = if display then begin 480 let mods = insert_vdisplay (fun () -> open_vdisplay display ; open_vdisplay_row "NOWRAP ALIGN=center") in close_vdisplay_row () ; 485 (* open_vdisplay_row "" ; close_mods () ; horizontal_line "NOSHADE" Length.Default (Length.Pixel 2); *) 490 open_vdisplay_row "BGCOLOR=black" ; close_mods () ; line_in_table 3 ; close_vdisplay_row () ; open_vdisplay_row "NOWRAP ALIGN=center" ; 495 close_mods () ; open_mods mods ; freeze (fun () -> close_vdisplay_row () ; 500 close_vdisplay ();) end else begin put "/" end ;; 505 (* Gestion of left and right delimiters *) let put_delim delim i = 510 if !verbose > 1 then prerr_endline ("put_delim: ``"^delim^"'' ("^string_of_int i^")") ; if delim <> "." then begin begin_item_display (fun () -> ()) false ; 515 Symb.put_delim skip_line put delim i ; let _ = end_item_display () in () end ;; 520 let left delim k = let _,f,is_freeze = end_item_display () in delay (fun vsize -> put_delim delim vsize ; 525 begin_item_display (fun () -> ()) false ; k vsize ; let _ = end_item_display () in ()) ; begin_item_display f is_freeze 530 ;; let right delim = let vsize,f,is_freeze = end_item_display () in put_delim delim vsize; 535 flush vsize ; begin_item_display f is_freeze ; vsize ;; <6>87 html.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: html.ml,v 1.84 2001/04/02 18:06:15 maranget Exp $" 15 (* Output function for a strange html model : - Text elements can occur anywhere and are given as in latex - A new grouping construct is given (open_group () ; close_group ()) *) 20 open Misc open Parse_opts open Latexmacros open HtmlCommon 25 exception Error of string ;; type block = HtmlCommon.block ;; 30 let r_quote = String.create 1 ;; 35 let quote_char = function | '<' -> "&lt;" | '>' -> "&gt;" | '&' -> "&amp;" | c -> (r_quote.[0] <- c ; r_quote) 40 ;; let r_translate = String.create 1 ;; 45 let iso_translate = function | '<' -> "&lt;" | '>' -> "&gt;" | '&' -> "&amp;" | '' -> "&nbsp;" 50 | '' -> "&iexcl;" | '' -> "&cent;" | '' -> "&pound;" | '' -> "&curren;" | '' -> "&yen;" 55 | '' -> "&brvbar;" | '' -> "&sect;" | '' -> "&uml;" | '' -> "&copy;" | '' -> "&ordf;" 60 | '' -> "&laquo;" | '' -> "&not;" | '' -> "&shy;" | '' -> "&reg;" | '' -> "&macr;" 65 | '' -> "&deg;" | '' -> "&plusmn;" | '' -> "&sup2;" | '' -> "&sup3;" | '' -> "&acute;" 70 | '' -> "&micro;" | '' -> "&para;" | '' -> "&middot;" | '' -> "&cedil;" | '' -> "&sup1;" 75 | '' -> "&ordm;" | '' -> "&raquo;" | '' -> "&frac14;" | '' -> "&frac12;" | '' -> "&frac34;" 80 | '' -> "&iquest;" | 'A' -> "&Agrave;" | '' -> "&Aacute;" | 'A' -> "&Acirc;" | '' -> "&Atilde;" 85 | '' -> "&Auml;" | '' -> "&Aring;" | '' -> "&AElig;" | 'C' -> "&Ccedil;" | 'E' -> "&Egrave;" 90 | 'E' -> "&Eacute;" | 'E' -> "&Ecirc;" | 'E' -> "&Euml;" | '' -> "&Igrave;" | '' -> "&Iacute;" 95 | 'I' -> "&Icirc;" | 'I' -> "&Iuml;" | '' -> "&ETH;" | '' -> "&Ntilde;" | '' -> "&Ograve;" 100 | '' -> "&Oacute;" | 'O' -> "&Ocirc;" | '' -> "&Otilde;" | '' -> "&Ouml;" | '' -> "&times;" 105 | '' -> "&Oslash;" | '' -> "&Ugrave;" | '' -> "&Uacute;" | 'U' -> "&Ucirc;" | 'U' -> "&Uuml;" 110 | '' -> "&Yacute;" | '' -> "&THORN;" | '' -> "&szlig;" | 'a' -> "&agrave;" | '' -> "&aacute;" 115 | 'a' -> "&acirc;" | '' -> "&atilde;" | '' -> "&auml;" | '' -> "&aring;" | '' -> "&aelig;" 120 | 'c' -> "&ccedil;" | 'e' -> "&egrave;" | 'e' -> "&eacute;" | 'e' -> "&ecirc;" | 'e' -> "&euml;" 125 | '' -> "&igrave;" | '' -> "&iacute;" | 'i' -> "&icirc;" | 'i' -> "&iuml;" | '' -> "&eth;" 130 | '' -> "&ntilde;" | '' -> "&ograve;" | '' -> "&oacute;" | 'o' -> "&ocirc;" | '' -> "&otilde;" 135 | '' -> "&ouml;" | '' -> "&divide;" | '' -> "&oslash;" | '' -> "&ugrave;" | '' -> "&uacute;" 140 | 'u' -> "&ucirc;" | 'u' -> "&uuml;" | '' -> "&yacute;" | '' -> "&thorn;" | '' -> "&yuml;" 145 | c -> (r_translate.[0] <- c ; r_translate) ;; let iso c = 150 if !Lexstate.raw_chars then (r_translate.[0] <- c ; r_translate) else if !Parse_opts.iso then quote_char c else 155 iso_translate c ;; let iso_buff = Out.create_buff () 160 let iso_string s = if not !Parse_opts.iso then begin for i = 0 to String.length s - 1 do Out.put iso_buff (iso_translate s.[i]) done ; 165 Out.to_string iso_buff end else s (* Calls to other modules that are in the interface *) 170 let over, erase_display, begin_item_display, end_item_display, 175 force_item_display, item_display, close_display, open_display, close_maths, 180 open_maths, put_in_math, math_put, math_put_char, left, 185 right = if !Parse_opts.mathml then begin MathML.over, MathML.erase_display, 190 MathML.begin_item_display, MathML.end_item_display, MathML.force_item_display, MathML.item_display, MathML.close_display, 195 MathML.open_display, MathML.close_maths, MathML.open_maths, MathML.put_in_math, MathML.put, 200 MathML.put_char, MathML.left, MathML.right end else begin HtmlMath.over, 205 HtmlMath.erase_display, HtmlMath.begin_item_display, HtmlMath.end_item_display, HtmlMath.force_item_display, HtmlMath.item_display, 210 HtmlMath.close_display, HtmlMath.open_display, HtmlMath.close_maths, HtmlMath.open_maths, HtmlMath.put_in_math, 215 HtmlMath.put, HtmlMath.put_char, HtmlMath.left, HtmlMath.right end 220 ;; let int_sup_sub, limit_sup_sub, 225 standard_sup_sub = if !Parse_opts.mathml then MathML.int_sup_sub, MathML.limit_sup_sub, 230 MathML.standard_sup_sub else HtmlMath.int_sup_sub, HtmlMath.limit_sup_sub, HtmlMath.standard_sup_sub 235 ;; let set_out out = !cur_out.out <- out 240 and stop () = Stack.push stacks.s_active !cur_out.out ; Stack.push stacks.s_pending_par flags.pending_par ; !cur_out.out <- Out.create_null () ; flags.pending_par <- None 245 and restart () = !cur_out.out <- Stack.pop stacks.s_active ; flags.pending_par <- Stack.pop stacks.s_pending_par ;; 250 (* acces to flags *) let is_empty () = flags.empty and get_last_closed () = flags.last_closed 255 and set_last_closed s = flags.last_closed <- s ;; 260 let debug m = Printf.fprintf stderr "%s : table_vsize=%d vsize=%d" m flags.table_vsize flags.vsize ; prerr_newline () ;; 265 let debug_empty f = prerr_string (if f.empty then "empty=true" else "empty=false") ;; 270 let put s = 275 if flags.in_math then math_put s else HtmlCommon.put s ;; let put_char c = 280 if flags.in_math then math_put_char c else HtmlCommon.put_char c ;; let set_dt s = flags.dt <- s 285 and set_dcount s = flags.dcount <- s ;; let item () = if !verbose > 2 then begin 290 prerr_string "item: stack=" ; pretty_stack out_stack end ; let mods = all_to_pending !cur_out in clearstyle () ; 295 !cur_out.pending <- mods ; let saved = if flags.nitems = 0 then begin let _ = forget_par () in () ; Out.to_string !cur_out.out 300 end else "" in flags.nitems <- flags.nitems+1; try_flush_par Now ; do_put "<LI>" ; do_put saved 305 ;; let nitem = item ;; 310 let ditem scan arg = if !verbose > 2 then begin prerr_string "ditem: stack=" ; pretty_stack out_stack end ; 315 let mods = all_to_pending !cur_out in clearstyle () ; !cur_out.pending <- mods ; let true_scan = if flags.nitems = 0 then begin 320 let _ = forget_par () in () ; let saved = Out.to_string !cur_out.out in (fun arg -> do_put saved ; scan arg) end else scan in try_flush_par Now ; 325 do_put "<DT>" ; !cur_out.pending <- mods ; flags.nitems <- flags.nitems+1; open_block INTERN "" ; if flags.dcount <> "" then scan ("\\refstepcounter{"^ flags.dcount^"}") ; 330 true_scan ("\\makelabel{"^arg^"}") ; close_block INTERN ; do_put "<DD>" ;; 335 let loc_name _ = () (* freeze everyting and change output file *) 340 let open_chan chan = open_group "" ; free !cur_out ; !cur_out.out <- Out.create_chan chan ; 345 ;; let close_chan () = Out.close !cur_out.out ; !cur_out.out <- Out.create_buff () ; 350 close_group () ;; let to_style f = 355 let old_flags = copy_flags flags in let _ = forget_par () in open_block INTERN "" ; clearstyle () ; f () ; 360 let r = to_pending !cur_out.pending !cur_out.active in erase_block INTERN ; set_flags flags old_flags ; r ;; 365 let get_current_output () = Out.to_string !cur_out.out let finalize check = 370 if check then begin check_stacks () end else begin (* Flush output in case of fatal error *) let rec close_rec () = 375 if not (Stack.empty out_stack) then begin match Stack.pop out_stack with | Freeze _ -> close_rec () | Normal (_,_,pout) -> Out.copy !cur_out.out pout.out ; 380 cur_out := pout ; close_rec () end in close_rec () end ; 385 Out.close !cur_out.out ; !cur_out.out <- Out.create_null () ;; 390 let put_separator () = put "\n" ;; let unskip () = 395 Out.unskip !cur_out.out; if flags.blank then flags.empty <- true; ;; 400 let put_tag tag = put tag ;; let put_nbsp () = 405 if flags.in_math && !Parse_opts.mathml then put " " else put "&nbsp;" ;; 410 let put_open_group () = put_char '{' ;; 415 let put_close_group () = put_char '}' ;; 420 let open_table border htmlargs = let table,arg_b, arg = if flags.in_math && !Parse_opts.mathml then "mtable","frame = \"solid\"","" 425 else "TABLE","BORDER=1",htmlargs in if border then open_block TABLE (arg_b^" "^arg) else open_block TABLE arg ;; 430 let new_row () = if flags.in_math && !Parse_opts.mathml then open_block (OTHER "mtr") "" else open_block TR "" 435 ;; let attribut name = function | "" -> "" 440 | s -> " "^name^"="^s and as_colspan = function | 1 -> "" | n -> " COLSPAN="^string_of_int n and as_colspan_mathml = function 445 | 1 -> "" | n -> " columnspan= \""^string_of_int n^"\"" let as_align f span = match f with Tabular.Align {Tabular.vert=v ; Tabular.hor=h ; Tabular.wrap=w ; Tabular.width=size} -> 450 attribut "VALIGN" v^ attribut "ALIGN" h^ (if w then "" else " NOWRAP")^ as_colspan span | _ -> raise (Misc.Fatal ("as_align")) 455 ;; let as_align_mathml f span = match f with Tabular.Align {Tabular.vert=v ; Tabular.hor=h ; Tabular.wrap=w ; Tabular.width=size} -> attribut "rowalign" ("\""^v^"\"")^ 460 attribut "columnalign" ("\""^h^"\"")^ as_colspan_mathml span | _ -> raise (Misc.Fatal ("as_align_mathml")) ;; 465 let open_direct_cell attrs span = if flags.in_math && !Parse_opts.mathml then begin open_block (OTHER "mtd") (attrs^as_colspan_mathml span); open_display () end else open_block TD (attrs^as_colspan span) 470 let open_cell format span i= if flags.in_math && !Parse_opts.mathml then begin open_block (OTHER "mtd") (as_align_mathml format span); open_display () 475 end else open_block TD (as_align format span) ;; let erase_cell () = if flags.in_math && !Parse_opts.mathml then begin 480 erase_display (); erase_block (OTHER "mtd") end else erase_block TD and close_cell content = if flags.in_math && !Parse_opts.mathml then begin 485 close_display (); force_block (OTHER "mtd") "" end else force_block TD content and do_close_cell () = if flags.in_math && !Parse_opts.mathml then begin 490 close_display (); close_block (OTHER "mtd") end else close_block TD and open_cell_group () = open_group "" and close_cell_group () = close_group () 495 and erase_cell_group () = erase_block GROUP ;; let erase_row () = 500 if flags.in_math && !Parse_opts.mathml then erase_block (OTHER "mtr") else erase_block TR and close_row () = if flags.in_math && !Parse_opts.mathml then 505 close_block (OTHER "mtr") else close_block TR ;; let close_table () = 510 if flags.in_math && !Parse_opts.mathml then close_block (OTHER "mtable") else close_block TABLE ;; let make_border s = () 515 ;; let center_format = Tabular.Align {Tabular.hor="center" ; Tabular.vert = "top" ; 520 Tabular.wrap = false ; Tabular.pre = "" ; Tabular.post = "" ; Tabular.width = Length.Default} ;; let make_inside s multi = 525 if not (multi) then begin if pblock ()=TD || pblock() = (OTHER "mtd") then begin close_cell "&nbsp;"; open_cell center_format 1 0; put s; 530 end else begin open_cell center_format 1 0; put s; close_cell "&nbsp;" end; 535 end ;; let make_hline w noborder = 540 if noborder then begin new_row (); if not (flags.in_math && !Parse_opts.mathml) then begin open_direct_cell "BGCOLOR=black" w ; close_mods () ; 545 line_in_table 3 ; end else begin open_cell center_format w 0; close_mods () ; put "<mo stretchy=\"true\" > &horbar; </mo>"; 550 force_item_display (); end; close_cell "" ; close_row (); end 555 ;; let infomenu arg = () and infonode opt num arg = () and infoextranode num arg text = () 560 ;; let image arg n = if flags.in_pre && !Parse_opts.pedantic then begin 565 warning "Image tag inside preformatted block, ignored" end else begin put "<IMG " ; if arg <> "" then begin put arg; 570 put_char ' ' end ; put "SRC=\"" ; put n ; if !Parse_opts.pedantic then begin 575 put "\" ALT=\"" ; put n end ; put "\">" end 580 ;; type saved = HtmlCommon.saved let check = HtmlCommon.check 585 and hot = HtmlCommon.hot let skip_line = skip_line and flush_out = flush_out and close_group = close_group 590 and open_aftergroup = open_aftergroup and open_group = open_group and erase_block s = erase_block (find_block s) and insert_block s = insert_block (find_block s) and insert_attr s = insert_attr (find_block s) 595 and force_block s = force_block (find_block s) and close_block s = close_block (find_block s) and open_block s = open_block (find_block s) and forget_par = forget_par and par = par 600 and erase_mods = erase_mods and open_mod = open_mod and clearstyle = clearstyle and nostyle = nostyle and get_fontsize = get_fontsize 605 and horizontal_line = horizontal_line and to_string = to_string ;; <6>88 htmlparse.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: htmlparse.ml,v 1.5 2001/05/28 17:28:55 maranget Exp $ *) (***********************************************************************) open Lexeme open Htmllex open Tree 15 exception Error of string let error msg lb = raise (Error msg) 20 ;; let buff = ref None let next_token lexbuf = match !buff with 25 | Some tok -> buff := None ; tok | None -> Htmllex.next_token lexbuf and put_back lexbuf tok = match !buff with | None -> buff := Some tok 30 | _ -> error "Put back" lexbuf let txt_buff = Buff.create () let rec to_close tag lb = match next_token lb with 35 | Close (t,txt) when t=tag -> Buff.put txt_buff txt | Open (t,_,txt) when t=tag -> Buff.put txt_buff txt ; to_close tag lb ; 40 to_close tag lb | Eof -> error ("Eof in to_close") lb | tok -> Buff.put txt_buff (Htmllex.to_string tok); to_close tag lb 45 let rec tree lexbuf = match next_token lexbuf with | (Eof|Close (_,_)) as tok-> put_back lexbuf tok ; None | Open (SCRIPT,_,txt) -> 50 Buff.put txt_buff txt ; to_close SCRIPT lexbuf ; Some (Text (Buff.to_string txt_buff)) | Open (tag,attrs,txt) -> let fils = trees lexbuf in 55 begin match next_token lexbuf with | Close (ctag,ctxt) when tag=ctag -> Some (match tag with | A -> 60 ONode (txt,ctxt,fils) | _ -> Node ({tag=tag ; attrs=attrs ; txt=txt ; ctxt=ctxt},fils)) | tok -> 65 error (Htmllex.to_string tok ^ " closes "^txt) lexbuf end | Lexeme.Text txt -> Some (Text txt) | Lexeme.Blanks txt -> Some (Blanks txt) 70 and trees lexbuf = match tree lexbuf with | None -> [] | Some t -> t::trees lexbuf let rec do_main lexbuf = match tree lexbuf with 75 | None -> begin match next_token lexbuf with | Eof -> [] | tok -> error ("Unexpected " ^ to_string tok) lexbuf end 80 | Some (Text _ as last) -> [last] | Some t -> t :: do_main lexbuf let reset () = Buff.reset txt_buff 85 let main lexbuf = try do_main lexbuf with | e -> reset () ; raise e <6>89 htmltext.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: htmltext.ml,v 1.9 2001/06/06 16:52:41 maranget Exp $ *) (***********************************************************************) open Emisc open Lexeme 15 type tsize = Int of int | Big | Small type nat = | Style of tag | Size of tsize 20 | Color of string | Face of string | Other type t_style = {nat : nat ; txt : string ; ctxt : string} 25 type style = t_style list let rec do_cost seen_font r1 r2 = function | [] -> r1,r2 | {nat=(Size (Int _)|Color _|Face _)}::rem -> 30 do_cost true (if seen_font then r1 else 1+r1) (1+r2) rem | _::rem -> do_cost seen_font (1+r1) r2 rem let cost ss = do_cost false 0 0 ss 35 exception No let add_size d = match !basefont + d with | 1|2|3|4|5|6|7 as x -> x | _ -> raise No 40 let size_val = function | "+1" -> add_size 1 | "+2" -> add_size 2 | "+3" -> add_size 3 45 | "+4" -> add_size 4 | "+5" -> add_size 5 | "+6" -> add_size 6 | "-1" -> add_size (-1) | "-2" -> add_size (-2) 50 | "-3" -> add_size (-3) | "-4" -> add_size (-4) | "-5" -> add_size (-5) | "-6" -> add_size (-6) | "1" -> 1 55 | "2" -> 2 | "3" -> 3 | "4" -> 4 | "5" -> 5 | "6" -> 6 60 | "7" -> 7 | _ -> raise No let color_val s = match String.lowercase s with | "#000000" -> "black" 65 | "#c0c0c0" -> "silver" | "#808080" -> "gray" | "#ffffff" -> "white" | "#800000" -> "maroon" | "#ff0000" -> "red" 70 | "#800080" -> "purple" | "#ff00ff" -> "fuschia" | "#008000" -> "green" | "#00ff00" -> "lime" | "#808000" -> "olive" 75 | "#000080" -> "navy" | "#0000ff" -> "blue" | "#008080" -> "teal" | "#00ffff" -> "aqua" | s -> s 80 let same_style s1 s2 = match s1.nat, s2.nat with | Style t1, Style t2 -> t1=t2 | Other, Other -> s1.txt = s2.txt | Size s1, Size s2 -> s1=s2 85 | Color c1, Color c2 -> c1=c2 | Face f1, Face f2 -> f1=f2 | _,_ -> false let is_color = function 90 | Color _ -> true | _ -> false and is_size = function | Size _ -> true 95 | _ -> false and is_face = function | Face _ -> true | _ -> false 100 exception NoProp let get_prop = function | Size _ -> is_size 105 | Face _ -> is_face | Color _ -> is_color | _ -> raise NoProp let neutral_prop p = p (Color "") 110 let is_font = function | Size (Int _) | Face _ | Color _ -> true | _ -> false 115 let font_props = [is_size ; is_face ; is_color] exception Same let rec rem_prop p = function 120 | s::rem -> if p s.nat then rem else let rem = rem_prop p rem in s::rem 125 | [] -> raise Same let rec rem_style s = function | os::rem -> if same_style s os then rem 130 else let rem = rem_style s rem in os::rem | [] -> raise Same 135 let there s env = List.exists (fun t -> same_style s t) env type env = t_style list exception Split of t_style * env 140 let add s env = let new_env = try let p = get_prop s.nat in 145 try s::rem_prop p env with | Same -> match s.nat with 150 | Size (Int x) when x = !basefont -> env | _ -> s::env with | NoProp -> try 155 s::rem_style s env with | Same -> s::env in match s.nat with 160 | Other -> begin match new_env with | _::env -> raise (Split (s,env)) | _ -> assert false end 165 | _ -> new_env 170 let add_fontattr txt ctxt a env = let nat = match a with | SIZE s -> Size (Int (size_val s)) | COLOR s -> Color (color_val s) | FACE s -> Face s 175 | OTHER -> raise No in add {nat=nat ; txt=txt ; ctxt=ctxt} env let add_fontattrs txt ctxt attrs env = match attrs with | [] -> env 180 | _ -> let rec do_rec = function | [] -> env | (a,atxt)::rem -> add_fontattr 185 atxt ctxt a (do_rec rem) in try do_rec attrs with 190 | No -> add {nat=Other ; txt=txt ; ctxt=ctxt} env let add_style {Lexeme.tag=tag ; Lexeme.attrs=attrs ; Lexeme.txt=txt ; Lexeme.ctxt=ctxt} 195 env = match tag with | FONT -> add_fontattrs txt ctxt attrs env | A -> assert false 200 | BIG -> if attrs=[] then add {nat=Size Big ; txt=txt ; ctxt=ctxt} env else add {nat=Other ; txt=txt ; ctxt=ctxt} env 205 | SMALL -> if attrs=[] then add {nat=Size Small ; txt=txt ; ctxt=ctxt} env else add {nat=Other ; txt=txt ; ctxt=ctxt} env 210 | _ -> if attrs=[] then add {nat=Style tag ; txt=txt ; ctxt=ctxt} env else add {nat=Other ; txt=txt ; ctxt=ctxt} env 215 let blanksNeutral s = match s.nat with | Size _ | Style (U|TT|CODE|SUB|SUP) | Other -> false | _ -> true <6>90 image.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: image.ml,v 1.26 2001/05/25 09:07:11 maranget Exp $" open Misc 15 let base = Parse_opts.base_out ;; let count = ref 0 ;; 20 let buff = ref (Out.create_null ()) ;; let active = ref false 25 ;; let start () = active := true ; count := 0 ; 30 buff := Out.create_buff () ;; let active_stack = Stack.create "Image.active" 35 let stop () = Stack.push active_stack !active ; active := false and restart () = 40 if Stack.empty active_stack then active := true else active := Stack.pop active_stack 45 let put s = if !active then Out.put !buff s and put_char c = if !active then Out.put_char !buff c ;; let tmp_name = 50 if Parse_opts.filter then "" else base ^ ".image.tex.new" let open_chan () = let chan = open_out tmp_name in Out.to_chan chan !buff ; 55 buff := Out.create_chan chan and close_chan () = Out.close !buff ;; 60 let my_string_of_int n = Printf.sprintf "%03d" n ;; 65 let page () = let n = !count in if !verbose > 0 then begin Location.print_pos (); 70 Printf.fprintf stderr "dump image number %d" (n+1) ; prerr_endline "" end ; if n = 0 then open_chan () ; incr count ; 75 put ("\n\\clearpage% page: "^string_of_int n^"\n") ;; let dump s_open image lexbuf = Out.put !buff s_open ; 80 image lexbuf ;; let finalize check = active := false ; 85 if !count > 0 then begin close_chan() ; if check then begin let true_name = Filename.chop_suffix tmp_name ".new" in if Myfiles.changed tmp_name true_name then begin 90 Mysys.rename tmp_name true_name ; Misc.message ("HeVeA Warning: images may have changed, run ``imagen "^base^"''"); true end else begin 95 Mysys.remove tmp_name ; false end end else false 100 end else false <6>91 index.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: index.ml,v 1.40 2001/05/25 09:07:12 maranget Exp $" open Misc open Parse_opts 15 open Entry let missing_index tag = Misc.warning 20 ("Index structure not found, missing "^ (match tag with | "default" -> "\\makeindex" | _ -> "\\newindex{"^tag^"}..")) ;; 25 type entry_t = {key : key ; see : string option ; item : string} ;; 30 type entry = | Good of entry_t | Bad let first_key = function 35 | (x::_),_ -> x | _ -> raise (Misc.Fatal ("Empty key in first_key")) let pretty_key (l,p) = let rec p_rec l p = match l,p with 40 [],[] -> "" | [x],[""]-> x | [x],[y]-> x^"@"^y | x::xs,""::ys -> x^"!"^p_rec xs ys | x::xs,y::ys -> x^"@"^y^"!"^p_rec xs ys 45 | _,_ -> assert false in p_rec l p ;; let pretty_entry (k,_) = pretty_key k 50 ;; type t_index = {mutable name : string ; mutable onebad : bool ; 55 sufin : string ; sufout : string ; from_file : entry array option ; from_doc : entry Table.t ; out : Out.t} 60 let itable = Hashtbl.create 17 ;; let read_index_file name file = 65 let lexbuf = Lexing.from_channel file in let r = Table.create Bad in let rec do_rec () = try let arg1,arg2 = read_indexentry lexbuf in 70 let entry = try let k,see = read_key (Lexing.from_string arg1) in Good {key=k ; see=see ; item = arg2} with Entry.NoGood -> 75 Misc.warning ("Bad index arg syntax in file: "^name^ ", index entry is ``"^arg1^"''") ; Bad in Table.emit r entry ; 80 do_rec () with | Entry.Fini -> Table.trim r in let r = do_rec () in 85 if !verbose > 0 then prerr_endline ("Index file: "^name^" succesfully read"); Some r let find_index tag = Hashtbl.find itable tag 90 let changename tag name = try let idx = find_index tag in idx.name <- name 95 with Not_found -> missing_index tag let index_lbl tag i = "@"^tag^string_of_int i let index_filename suff = Parse_opts.base_out^".h"^suff 100 let treat tag arg refvalue = (* prerr_endline ("Index treat: "^tag^", "^arg^", "^refvalue) ; *) try if !verbose > 2 then prerr_endline ("Index.treat with arg: "^arg) ; let {from_doc = from_doc ; out = out} as idx = find_index tag in 105 let lbl = index_lbl tag (Table.get_size from_doc) in let refvalue = match refvalue with "" -> "??" | s -> s in let item = "\\@locref{"^lbl^"}{"^refvalue^"}" in Out.put out "\\indexentry{" ; Out.put out arg ; 110 Out.put out "}{" ; Out.put out item ; Out.put out "}\n" ; let lexbuf = Lexing.from_string arg in 115 let entry = try let key,see = read_key lexbuf in Good {key = key ; see = see ; item = item} with 120 | Entry.NoGood -> idx.onebad <- true ; Misc.warning ("Bad index syntax: ``"^arg^"''") ; Bad in Table.emit from_doc entry ; 125 lbl with | Not_found -> missing_index tag ; "" ;; 130 (* Compare function for keys *) let is_alpha c = ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z') 135 let compare_char c1 c2 = if is_alpha c1 && is_alpha c2 then let r = compare (Char.uppercase c1) (Char.uppercase c2) in if r <> 0 then r 140 else compare c1 c2 else if is_alpha c1 then 1 else if is_alpha c2 then -1 else compare c1 c2 145 exception Result of int let compare_string s1 s2 = let i = ref 0 and l1 = String.length s1 150 and l2 = String.length s2 in begin try while true do begin if !i >= l1 then if !i >= l2 then raise (Result 0) 155 else raise (Result (-1)) else if !i >= l2 then raise (Result 1) else let c = compare_char s1.[!i] s2.[!i] in if c <> 0 then raise (Result c) 160 end ; i := !i + 1 done ; 0 with Result x -> x 165 end let comp (l1,p1) (l2,p2) = let rec c_rec l1 l2 p1 p2 = match l1,l2 with 170 | [],[] -> 0 | [],_ -> -1 | _,[] -> 1 | x1::r1,x2::r2 -> let t = compare_string x1 x2 in 175 if t<> 0 then t else begin match p1,p2 with | y1::p1, y2::p2 -> let t = compare_string y1 y2 in 180 if t <> 0 then t else c_rec r1 r2 p1 p2 | _,_ -> assert false end in 185 c_rec l1 l2 p1 p2 ;; module OrderedKey = struct type t = key 190 let compare = comp end ;; module KeySet = Set.Make(OrderedKey) 195 ;; open KeySet 200 let rec common e1 e2 = match e1,e2 with ([],_),_ -> e1,e2 | _,([],_) -> e1,e2 | ([_],_),([_],_) -> e1,e2 | (_::_,_),([_],_) -> e1,e2 205 | (x1::r1,_::p1),(x2::r2,_::p2) -> if x1=x2 then common (r1,p1) (r2,p2) else e1,e2 210 | _ -> assert false ;; let rec close_prev out = function [],_ | [_],_ -> () 215 | _::r,_::p -> Out.put out "\\end{indexenv}\n" ; close_prev out (r,p) | _ -> assert false ;; 220 let rec open_this out k = match k with [],_ -> () | k::r,p::rp -> Out.put out "\\indexitem " ; 225 let tag = if p <> "" then p else k in Out.put out tag ; begin match r with [] -> () | _ -> Out.put out "\\begin{indexenv}\n" ; 230 end ; open_this out (r,rp) | _ -> assert false ;; 235 let start_change s1 s2 = match s1,s2 with | "",_ -> false | _,"" -> false | _,_ -> Char.uppercase s1.[0] <> Char.uppercase s2.[0] 240 let print_entry out tag entries bk k xs = let rp,rt = common bk k in close_prev out rp ; if fst rp = [] then Out.put out "\\begin{indexenv}\n" 245 else begin let top_prev = first_key bk and top_now = first_key k in if start_change top_prev top_now then Out.put out "\\indexspace\n" 250 end ; open_this out rt ; let rec prints = function [] -> Out.put_char out '\n' 255 | i::r -> Out.put out ", " ; begin match entries.(i) with | Good e -> begin match e.see with 260 | None -> Out.put out e.item | Some see -> Out.put out ("\\"^see^"{"^e.item^"}") end ; | Bad -> () end ; 265 prints r in prints (List.rev xs) ;; 270 let make_index t = let table = Hashtbl.create 17 and all = ref KeySet.empty in for i = 0 to Array.length t - 1 do 275 match t.(i) with | Good e -> all := KeySet.add e.key !all ; Hashtbl.add table e.key i | Bad -> () 280 done ; !all,table let output_index tag entries out = 285 if !verbose > 1 then prerr_endline ("Print index ``"^tag^"''") ; let all_keys,table = make_index entries in let prev = ref ([],[]) in KeySet.iter (fun k -> if !verbose > 2 then 290 prerr_endline ("Print_entry: "^pretty_key k); print_entry out tag entries !prev k (Hashtbl.find_all table k) ; prev := k) all_keys ; let pk,_ = !prev in 295 List.iter (fun _ -> Out.put out "\\end{indexenv}\n") pk let create_hind t tag sufout = let outname = index_filename sufout in 300 try let chan = open_out outname in output_index tag t (Out.create_chan chan) ; close_out chan with 305 | Sys_error s -> Misc.warning ("File error for "^outname^": "^s) let newindex tag sufin sufout name = (* prerr_endline ("New index: "^tag) ; *) 310 Hashtbl.remove itable tag ; let from_file = try let filename = index_filename sufin in let file = open_in filename in 315 read_index_file filename file with Sys_error _ -> None in begin match from_file with | None -> () | Some t -> create_hind t tag sufout 320 end ; Hashtbl.add itable tag {name = name ; onebad = false ; sufin = sufin ; sufout = sufout ; 325 from_file = from_file ; from_doc = Table.create Bad ; out = Out.create_buff ()} let print main tag = 330 try let idx = find_index tag in main ("\\@indexsection{"^idx.name^"}") ; let indname = index_filename idx.sufout in begin match idx.from_file with 335 | None -> create_hind (Table.trim idx.from_doc) tag idx.sufout | _ -> () end ; main ("\\input{"^indname^"}") 340 with | Not_found -> missing_index tag let diff_entries e1 e2 = let l1 = Array.length e1 and l2 = Array.length e2 in 345 if l1 <> l2 then true else let rec diff_rec i = if i >= l1 then false else 350 e1.(i) <> e2.(i) || diff_rec (i+1) in diff_rec 0 let finalize check = if check then begin 355 let top_changed = ref false in Hashtbl.iter (fun tag idx -> (* prerr_endline ("Check index changed: "^tag) ; *) let entries = Table.trim idx.from_doc in 360 let changed = match idx.from_file with | Some t -> diff_entries t entries | None -> Array.length entries <> 0 in if changed || idx.onebad then begin 365 top_changed := !top_changed || changed ; let idxname = index_filename idx.sufin in try if Array.length entries = 0 && not idx.onebad then Mysys.remove idxname 370 else begin let chan = open_out idxname in Out.to_chan chan idx.out ; close_out chan end 375 with | Sys_error s -> Misc.warning ("File error on "^idxname^": "^s) end) 380 itable ; if !top_changed then Misc.message "HeVeA Warning: Index(es) may have changed. Rerun me to get them right." ; !top_changed 385 end else false <6>92 info.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: info.ml,v 1.29 2001/05/25 09:07:14 maranget Exp $" 15 open Misc open Text open InfoRef exception Error of string 20 type block = Text.block let iso =Text.iso;; let iso_string =Text.iso_string;; 25 let set_out=Text.set_out;; let stop = Text.stop;; let restart = Text.restart;; let get_last_closed=Text.get_last_closed;; let set_last_closed=Text.set_last_closed;; 30 let is_empty=Text.is_empty;; let get_fontsize=Text.get_fontsize;; let nostyle=Text.nostyle;; let clearstyle=Text.clearstyle;; 35 let open_mod=open_mod;; let erase_mods=Text.erase_mods;; let par=Text.par;; let forget_par =Text.forget_par;; 40 let open_block =Text.open_block;; let close_block =Text.close_block;; let force_block =Text.force_block;; let insert_block =Text.insert_block;; 45 let insert_attr =Text.insert_attr;; let open_maths = Text.open_maths and close_maths = Text.close_maths ;; let open_display =Text.open_display;; 50 let close_display =Text.close_display;; let item_display =Text.item_display;; let force_item_display =Text.force_item_display;; let erase_display =Text.erase_display and standard_sup_sub = Text.standard_sup_sub 55 and limit_sup_sub = Text.limit_sup_sub and int_sup_sub = Text.int_sup_sub and over = Text.over and left = Text.left and right = Text.right 60 ;; let set_dcount =Text.set_dcount;; let item = Text.item;; let nitem = Text.nitem;; 65 let ditem = Text.ditem;; let erase_block =Text.erase_block;; let open_group =Text.open_group;; let open_aftergroup =Text.open_aftergroup;; let close_group =Text.close_group;; 70 let put s = Text.put s ;; let put_char c = Text.put_char c;; 75 let flush_out =Text.flush_out;; let skip_line =Text.skip_line;; (* Gestion des references *) 80 let loc_name=InfoRef.loc_name;; let open_chan=Text.open_chan;; 85 let close_chan=Text.close_chan;; let to_string=Text.to_string;; let to_style=Text.to_style;; let get_current_output =Text.get_current_output;; 90 (* Finalisation du fichier info *) let finalize check = if check then begin if !verbose>1 then prerr_endline "Beginning of second phase."; InfoRef.finalize_nodes (); 95 Text.finalize check ; let name,buf = if Parse_opts.filter then let texte = get_current_output () in "",Lexing.from_string texte 100 else (* changer de nom de fichier (renommer ?) *) let f = Parse_opts.name_out^".tmp" in f,Lexing.from_channel (open_in f) in 105 InfoRef.dump buf ; if not Parse_opts.filter && !verbose <= 0 then Mysys.remove name end else Text.finalize false ;; 110 let horizontal_line =Text.horizontal_line;; let put_separator =Text.put_separator;; let unskip = Text.unskip;; let put_tag =Text.put_tag;; 115 let put_nbsp =Text.put_nbsp;; let put_open_group =Text.put_open_group;; let put_close_group =Text.put_close_group;; let put_in_math =Text.put_in_math;; 120 let open_table =Text.open_table;; let new_row =Text.new_row;; let open_cell =Text.open_cell;; let erase_cell =Text.erase_cell;; 125 let close_cell =Text.close_cell;; let do_close_cell = Text.do_close_cell;; let open_cell_group = Text.open_cell_group;; let close_cell_group = Text.close_cell_group;; let erase_cell_group = Text.erase_cell_group;; 130 let close_row =Text.close_row;; let erase_row =Text.erase_row;; let close_table =Text.close_table;; let make_border = Text.make_border;; let make_inside = Text.make_inside;; 135 let make_hline = Text.make_hline;; let infonode = InfoRef.infonode;; let infoextranode = InfoRef.infoextranode;; let infomenu = InfoRef.infomenu;; 140 let image = Text.image;; type saved = Text.saved 145 let check = Text.check and hot = Text.hot <6>93 infoRef.ml 12 "infoRef.mll" let header = "$Id: infoRef.mll,v 1.22 2001/05/25 09:07:15 maranget Exp $" ;; 5 open Lexing open Misc 10 let compat_mem tbl key = try let _ = Hashtbl.find tbl key in true with Not_found -> false ;; 15 exception Error of string type node_t = { mutable name : string; mutable comment : string; 20 mutable previous : node_t option; mutable next : node_t option; mutable up : node_t option; mutable pos : int; } 25 ;; type menu_t = { mutable num : int; mutable nom : string; 30 mutable nod : node_t option; mutable nodes : node_t list; } ;; 35 let menu_list = ref [];; let nodes = Hashtbl.create 17;; let delayed = ref [];; 40 let current_node = ref None;; let menu_num = ref 0 ;; 45 let counter = ref 0 and pos_file = ref 0 ;; let abs_pos () = !counter + !pos_file 50 ;; let cur_file = ref (Parse_opts.name_out) ;; 55 let file_number = ref 1 ;; type label_t = { 60 mutable lab_name : string; mutable noeud : node_t option; };; let labels_list = ref [];; 65 let files = ref [];; let top_node = ref false;; let hot_start () = 70 menu_list := []; Hashtbl.clear nodes ; current_node := None ; menu_num := 0 ; counter := 0 ; 75 pos_file := 0 ; cur_file := Parse_opts.name_out ; files := [] ; top_node := false ; file_number := 1 ; 80 labels_list := [] ;; let infomenu arg = menu_num:=!menu_num+1; 85 menu_list := { num = !menu_num; nom = arg; nod = !current_node; nodes = []; 90 } ::!menu_list; Text.open_block "INFOLINE" ""; Text.put ("\\@menu"^string_of_int !menu_num^"\n"); Text.close_block "INFOLINE" ;; 95 let rec cherche_menu m = function | [] -> raise (Error ("Menu ``"^m^"'' not found")) | menu::r -> if menu.nom = m then menu 100 else cherche_menu m r ;; let rec cherche_menu_par_num n = function | [] -> raise (Error ("Menu not found")) 105 | menu::r -> if menu.num = n then menu else cherche_menu_par_num n r ;; 110 let ajoute_node_dans_menu n m = try let menu = cherche_menu m !menu_list in menu.nodes <- n :: menu.nodes; menu.nod 115 with _ -> None ;; let verifie name = 120 let nom = String.copy name in for i = 0 to String.length name -1 do match nom.[i] with | '\t' -> nom.[i] <- ' ' | ',' -> nom.[i] <- ' ' 125 | '.' -> nom.[i] <- '-' | '\n' -> nom.[i] <- ' ' | _ -> () done; nom 130 ;; 135 (* References *) let rec cherche_label s = function | [] -> raise Not_found | l::r -> if l.lab_name=s then l.noeud else cherche_label s r 140 ;; let rec change_label s = function | [] -> Misc.warning ("Cannot change label: ``"^s^"''") | l::r -> 145 if l.lab_name = s then l.noeud <- !current_node else change_label s r 150 let loc_name s1 = (* pose un label *) let _ = try let _ = cherche_label s1 !labels_list in Misc.warning ("Multiple use of label: "^s1) 155 with Not_found -> () in let l = { lab_name = s1; 160 noeud = !current_node ; } in labels_list := l:: !labels_list; Text.open_block "INFO" "" ; 165 Text.put "\\@name{" ; Text.put s1 ; Text.put "}" ; Text.close_block "INFO" ; if !verbose > 1 then prerr_endline ("InfoRef.loc_name, label="^s1); 170 ;; (* Sortie du fichier final *) 175 let out_cur = ref (Out.create_null ()) ;; let set_out chan = 180 if !verbose >3 then prerr_endline "Set_out"; out_cur := chan ;; let set_out_file s = 185 if !verbose >3 then prerr_endline ("Set_out_file :"^s); cur_file := s ;; let put s = 190 if !verbose >3 then prerr_endline ("put :"^s); counter:=!counter + String.length s; Out.put !out_cur s ;; 195 let put_char c = if !verbose >3 then prerr_endline ("put_char :"^String.make 1 c); counter:=!counter +1; 200 Out.put_char !out_cur c ;; let put_credits () = put "\n\n-------------------------------------\nThis file has been translated from LaTeX by HeVeA.\n\n"; 205 and put_header () = put "This file has been translated from LaTeX by HeVeA.\n" ;; 210 let next_file () = Out.close !out_cur ; file_number := !file_number +1; cur_file := Parse_opts.name_out ^ "-" ^ string_of_int !file_number ; if !verbose > 0 then 215 prerr_endline ("Change file to "^ !cur_file) ; set_out (Out.create_chan (open_out !cur_file)) ; files := (!cur_file,abs_pos ()) :: !files ; pos_file := abs_pos () ; put_header () ; 220 counter := 0 ;; 225 let noeud_name n = n.name ;; 230 let affiche_menu num = let menu = cherche_menu_par_num num !menu_list in if menu.nodes <> [] then begin put "* Menu:\n\n"; 235 let rec affiche_items = function | [] -> () | n::reste -> put ("* "^noeud_name n^"::\t"^n.comment^"\n"); affiche_items reste; 240 in affiche_items (List.rev menu.nodes); if !verbose >1 then prerr_endline ("Menu :"^menu.nom); end 245 ;; let do_affiche_tag_table s = put ("\n\nTag table:\n"^(if s<> "" then s^"\n" else "")) ; 250 Hashtbl.iter (fun nom n -> put ("Node: "^noeud_name n^""^string_of_int n.pos^"\n")) nodes; put "\nEnd tag table\n"; ;; 255 let affiche_tag_table ()= match !files with | [_] -> 260 do_affiche_tag_table "" | _ -> let rec do_indirect = function | [] -> () | (f,p)::reste -> 265 put (f^": "^string_of_int p^"\n"); do_indirect reste in Out.close !out_cur ; set_out (Out.create_chan (open_out Parse_opts.name_out)) ; 270 put_header () ; put "\nIndirect:\n"; do_indirect (List.rev !files); do_affiche_tag_table "(Indirect)" ;; 275 let affiche_node nom = if !top_node then begin put_credits () ; 280 top_node := false end ; let noeud = try Hashtbl.find nodes nom with Not_found -> raise (Error ("Node not found :"^nom)) 285 in if not Parse_opts.filter && !counter > 50000 then begin next_file () end; noeud.pos <- abs_pos (); 290 put "\n"; put ("Node: "^noeud_name noeud); (match noeud.next with | None -> () | Some n -> put (",\tNext: "^noeud_name n)); 295 (match noeud.previous with | None -> () | Some n -> put (",\tPrev: "^noeud_name n)); (match noeud.up with | None -> 300 if noeud.name = "Top" then begin put ",\tUp: (dir)." ; top_node := true end | Some n -> put (",\tUp: "^noeud_name n)); 305 put_char '\n'; if !verbose >1 then prerr_endline ("Node : "^noeud_name noeud); ;; 310 let affiche_ref key = try let l = cherche_label key !labels_list in match l with 315 | None -> () | Some node -> put ("*Note "^noeud_name node^"::") with | Not_found -> () (* A warning has already been given *) ;; 320 let footNote_label = ref "" ;; let lex_tables = { 325 Lexing.lex_base = "\000\000\001\000\002\000\003\000\004\000\254\255\000\000\253\255\ \000\000\000\000\000\000\000\000\000\000\255\255\005\000\006\000\ \007\000\008\000\017\000\027\000\250\255\021\000\251\255\002\000\ \001\000\002\000\002\000\002\000\004\000\000\000\005\000\005\000\ \001\000\006\000\001\000\008\000\008\000\017\000\018\000\002\000\ \252\255\010\000\004\000"; Lexing.lex_backtrk = "\255\255\255\255\255\255\255\255\255\255\255\255\001\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\001\000\255\255\ \001\000\255\255\000\000\000\000\255\255\005\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255"; Lexing.lex_default = 330 "\020\000\005\000\016\000\014\000\005\000\000\000\255\255\000\000\ \255\255\255\255\255\255\255\255\255\255\000\000\015\000\015\000\ \017\000\017\000\255\255\255\255\000\000\255\255\000\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\255\255\255\255"; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\ \000\000\013\000\013\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\000\000\000\000\000\000\000\000\000\000\ \008\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\ \019\000\019\000\019\000\019\000\019\000\019\000\019\000\019\000\ \019\000\019\000\019\000\019\000\019\000\023\000\000\000\000\000\ \000\000\000\000\000\000\000\000\021\000\000\000\000\000\000\000\ \006\000\010\000\000\000\035\000\033\000\012\000\041\000\027\000\ \028\000\029\000\031\000\034\000\037\000\011\000\009\000\024\000\ \025\000\036\000\030\000\032\000\026\000\038\000\005\000\039\000\ \042\000\013\000\000\000\013\000\007\000\040\000\000\000\000\000\ \005\000\000\000\013\000\013\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \022\000\255\255\255\255\255\255\007\000\255\255\255\255\255\255\ \255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000"; Lexing.lex_check = "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\002\000\255\255\255\255\255\255\ \255\255\016\000\017\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ \001\000\001\000\001\000\255\255\255\255\255\255\255\255\255\255\ \006\000\018\000\018\000\018\000\018\000\018\000\018\000\018\000\ \018\000\018\000\018\000\019\000\019\000\019\000\019\000\019\000\ \019\000\019\000\019\000\019\000\019\000\021\000\255\255\255\255\ \255\255\255\255\255\255\255\255\000\000\255\255\255\255\255\255\ \004\000\009\000\255\255\025\000\032\000\011\000\024\000\026\000\ \027\000\028\000\030\000\033\000\036\000\010\000\008\000\023\000\ \023\000\025\000\029\000\031\000\023\000\035\000\037\000\038\000\ \041\000\042\000\255\255\012\000\034\000\039\000\255\255\255\255\ \003\000\255\255\014\000\015\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\001\000\002\000\003\000\004\000\014\000\015\000\016\000\ \017\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255" 335 } let rec main lexbuf = __ocaml_lex_main_rec lexbuf 0 and __ocaml_lex_main_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 340 0 -> ( 339 "infoRef.mll" let num = numero lexbuf in affiche_menu num; 345 main lexbuf) | 1 -> ( 344 "infoRef.mll" let nom = finitLigne lexbuf in 350 affiche_node nom; main lexbuf) | 2 -> ( 349 "infoRef.mll" 355 let key = arg lexbuf in affiche_ref key; main lexbuf) | 3 -> ( 354 "infoRef.mll" 360 let _ = arg lexbuf in main lexbuf) | 4 -> ( 357 "infoRef.mll" affiche_tag_table ()) 365 | 5 -> ( 360 "infoRef.mll" let lxm = lexeme_char lexbuf 0 in put_char lxm; main lexbuf) 370 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_main_rec lexbuf n and numero lexbuf = __ocaml_lex_numero_rec lexbuf 1 and __ocaml_lex_numero_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 375 0 -> ( 366 "infoRef.mll" let lxm = lexeme lexbuf in int_of_string lxm) | 1 -> ( 380 368 "infoRef.mll" raise (Error "Syntax error in info temp file")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_numero_rec lexbuf n and finitLigne lexbuf = __ocaml_lex_finitLigne_rec lexbuf 2 385 and __ocaml_lex_finitLigne_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 372 "infoRef.mll" let lxm = lexeme lexbuf in 390 String.sub lxm 0 ((String.length lxm) -1)) | 1 -> ( 374 "infoRef.mll" raise ( Error "Syntax error in info temp file: no node name.")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_finitLigne_rec lexbuf n 395 and arg lexbuf = __ocaml_lex_arg_rec lexbuf 3 and __ocaml_lex_arg_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 400 378 "infoRef.mll" let lxm= lexeme lexbuf in String.sub lxm 0 ((String.length lxm) -1)) | 1 -> ( 380 "infoRef.mll" 405 raise (Error "Syntax error in info temporary file: invalid reference.")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_arg_rec lexbuf n and labels lexbuf = __ocaml_lex_labels_rec lexbuf 4 and __ocaml_lex_labels_rec lexbuf state = 410 match Lexing.engine lex_tables state lexbuf with 0 -> ( 384 "infoRef.mll" let key = arg lexbuf in key::labels lexbuf) 415 | 1 -> ( 386 "infoRef.mll" labels lexbuf) | 2 -> ( 387 "infoRef.mll" 420 []) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_labels_rec lexbuf n ;; 425 390 "infoRef.mll" let do_infonode opt num arg = let n = { 430 name = verifie num; comment = arg; previous = None; next = None; up = None; 435 pos = 0; } in if compat_mem nodes n.name then raise (Error ("Duplicate node name: "^n.name)); n.up <- (match opt with 440 "" -> None | m -> ajoute_node_dans_menu n m); Hashtbl.add nodes n.name n; Text.open_block "INFOLINE" ""; Text.put ("\\@node"^n.name^"\n"); 445 Text.close_block "INFOLINE"; current_node := Some n; if !verbose>1 then prerr_endline ("Node added :"^n.name^", "^n.comment) let infoextranode num nom text = 450 delayed := (num,nom,text) :: !delayed and flushextranodes () = let rec flush_rec = function | [] -> () 455 | (num,nom,text) :: rest -> do_infonode "" num nom ; Text.open_block "INFO" "" ; Text.put text ; Text.close_block "INFO" ; 460 let labs = labels (Lexing.from_string text) in List.iter (fun lab -> change_label lab !labels_list) labs ; flush_rec rest in flush_rec !delayed ; delayed := [] 465 ;; let infonode opt num arg = flushextranodes () ; do_infonode opt num arg 470 (* finalisation des liens entre les noeuds *) let rec do_finalize_nodes suivant = function | [] -> () 475 | n::reste -> if !verbose>2 then prerr_endline ("node :"^n.name); n.next <- suivant; (match suivant with | None -> () 480 | Some suiv -> suiv.previous <- Some n ); do_finalize_nodes (Some n) reste ;; let rec do_finalize_menus = function 485 | [] -> () | m::reste -> if m.nodes <> [] then begin do_finalize_nodes (match m.nod with 490 None -> None | Some n -> n.next) m.nodes; (match m.nod with None -> () 495 | Some n -> let first_node = List.hd (List.rev m.nodes) in n.next <- Some first_node; first_node.previous <- Some n; (* On descend dans l'arborescence des menus *) 500 let last_node = List.hd m.nodes in (match last_node.next with | None -> () | Some suiv -> suiv.previous <- Some n); (* On remonte les menus au meme niveau *) 505 ); do_finalize_menus reste; end ;; 510 let finalize_nodes () = if !verbose>2 then prerr_endline "finalizing nodes"; flushextranodes () ; do_finalize_menus (List.rev !menu_list); if !verbose>2 then prerr_endline "finalizing done."; 515 ;; let dump buff = let name,out_chan = match Parse_opts.name_out with | "" -> "", Out.create_chan stdout 520 | s -> let name = s^"-1" in name, Out.create_chan (open_out name) in if !verbose > 0 then prerr_endline ("Final dump in "^name) ; 525 set_out out_chan ; set_out_file name ; put_header () ; files := [name,abs_pos ()] ; main buff ; 530 Out.close !out_cur ; if !file_number = 1 then Mysys.rename !cur_file Parse_opts.name_out <6>94 latexmacros.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: latexmacros.ml,v 1.64 2000/06/02 15:23:26 maranget Exp $" open Misc open Parse_opts 15 open Symb open Lexstate exception Failed 20 module OString = struct type t = string let compare = Pervasives.compare end 25 module Strings = Set.Make (OString) (* Data structures for TeX macro model *) let local_table = Hashtbl.create 97 and global_table = Hashtbl.create 97 30 and prim_table = Hashtbl.create 5 let purge = ref Strings.empty and purge_stack = Stack.create "purge" and group_level = ref 0 35 (* Hot start *) type ctable = (string, pat * action) Hashtbl.t type ptable = (string, (unit -> unit)) Hashtbl.t type saved = 40 int * Strings.t * Strings.t Stack.saved * ptable * ctable * ctable let pretty_macro n acs = 45 pretty_pat n ; prerr_string " -> " ; pretty_action acs let hidden_pretty_table cmdtable = 50 let t = Hashtbl.create 97 and count = ref 0 in let incr k = incr count ; let r = 55 try Hashtbl.find t k with | Not_found -> let r = ref 0 in Hashtbl.add t k r ; r in 60 incr r in Hashtbl.iter (fun k (n,acc) -> Printf.fprintf stderr "%s -> " k ; pretty_macro n acc ; prerr_endline "" ; 65 incr k) cmdtable ; Printf.fprintf stderr "Table size: %d\n" !count ; Hashtbl.iter (fun k r -> 70 if !r > 1 then Printf.fprintf stderr "%s: %d\n" k !r) t ; flush stderr 75 let pretty_table () = Printf.fprintf stderr "Macro tables, level=%d\n" !group_level ; prerr_endline "Global table" ; hidden_pretty_table global_table ; prerr_endline "Local table" ; 80 hidden_pretty_table local_table let checkpoint () = !group_level, !purge, Stack.save purge_stack, clone_hashtbl prim_table, 85 clone_hashtbl global_table, clone_hashtbl local_table and hot_start (level_checked, purge_checked, purge_stack_checked, prim_checked, global_checked, local_checked) = 90 group_level := level_checked ; purge := purge_checked ; Stack.restore purge_stack purge_stack_checked ; Misc.copy_hashtbl prim_checked prim_table ; Misc.copy_hashtbl global_checked global_table ; 95 Misc.copy_hashtbl local_checked local_table (* Controlling scope *) let open_group () = incr group_level ; 100 Stack.push purge_stack !purge ; purge := Strings.empty and close_group () = if !group_level > 0 then (* Undo bindings created at the closed level *) 105 Strings.iter (fun name -> Hashtbl.remove local_table name) !purge ; decr group_level ; purge := Stack.pop purge_stack 110 let get_level () = !group_level (* Remove one local definition in advance ... *) let pre_purge name purge = 115 if Strings.mem name purge then begin Hashtbl.remove local_table name ; Strings.remove name purge end else purge 120 (* Definitions *) let hidden_global_def name x = if !group_level > 0 && Hashtbl.mem local_table name then begin (* 125 global definition of a localy defined macro, undo all local bindings *) purge := pre_purge name !purge ; Stack.map purge_stack (fun purge -> pre_purge name purge) 130 end ; Hashtbl.remove global_table name ; Hashtbl.add global_table name x let hidden_local_def name x = 135 if !group_level > 0 then begin (* indeed local *) if Strings.mem name !purge then (* redefinition *) Hashtbl.remove local_table name else (* creation (at the current level) *) purge := Strings.add name !purge ; 140 Hashtbl.add local_table name x end else begin (* same as global *) Hashtbl.remove global_table name ; Hashtbl.add global_table name x end 145 let hidden_find name = if !group_level > 0 then begin try Hashtbl.find local_table name with | Not_found -> Hashtbl.find global_table name 150 end else Hashtbl.find global_table name (* Primitives *) let register_init name f = 155 if !verbose > 1 then prerr_endline ("Registering primitives for package: "^name); try let _ = Hashtbl.find prim_table name in fatal 160 ("Attempt to initlialize primitives for package "^name^" twice") with | Not_found -> Hashtbl.add prim_table name f and exec_init name = 165 if !verbose > 1 then prerr_endline ("Initializing primitives for package: "^name) ; try let f = Hashtbl.find prim_table name in try f () with 170 Failed -> Misc.warning ("Bad trip while initializing primitives for package: "^name) with Not_found -> () ;; 175 (* Interface *) let exists name = 180 try let _ = hidden_find name in true with | Not_found -> false 185 let find name = try hidden_find name with | Not_found -> warning ("Command not found: "^name) ; 190 ([],[]),Subst "" and find_fail name = try hidden_find name with | Not_found -> raise Failed 195 let def name pat action = if !verbose > 1 then begin Printf.fprintf stderr "def %s = " name; pretty_macro pat action ; 200 prerr_endline "" end ; hidden_local_def name (pat,action) and global_def name pat action = 205 if !verbose > 1 then begin Printf.fprintf stderr "global def %s = " name; pretty_macro pat action ; prerr_endline "" end ; 210 hidden_global_def name (pat,action) ;; let def_init name f = 215 if exists name then fatal ("Command: "^name^" defined at initialisation") ; def name zero_pat (CamlCode f) let pretty_arg = function 220 | None -> prerr_string "<None>" | Some (n,acc) -> pretty_macro n acc let pretty_replace s name old new_def = Printf.fprintf stderr "%s: %s\n\told=" s name ; 225 pretty_arg old ; Printf.fprintf stderr "\n\tnew=" ; pretty_arg new_def ; prerr_endline "" 230 let replace name new_def = let old_def = try Some (hidden_find name) with | Not_found -> None in (* 235 pretty_replace "replace" name old_def new_def ; Printf.fprintf stderr "level=%d\n" !group_level ; *) begin match new_def with | Some d -> hidden_local_def name d 240 | None -> match old_def with | None -> () | Some _ -> (* what will happen if binging was global ??? *) if !group_level > 0 then purge := pre_purge name !purge 245 else Hashtbl.remove global_table name end ; old_def 250 (* macro static properties *) 255 let invisible = function "\\nofiles" | "\\pagebreak" | "\\nopagebreak" | "\linebreak" | "\\nolinebreak" | "\\label" | "\\index" | "\\vspace" | "\\glossary" | "\\marginpar" 260 | "\\figure" | "\\table" | "\\nostyle" | "\\rm" | "\\tt" | "\\bf" | "\\em" | "\\it" | "\\sl" | "\\tiny" | "\\footnotesize" | "\\scriptsize" | "\\small" | "\\normalsize" | "\\large" | "\\Large" | "\\LARGE" 265 | "\\huge" | "\\Huge" | "\\purple" | "\\silver" | "\\gray" | "\\white" | "\\maroon" | "\\red" | "\\fuchsia" | "\\green" | "\\lime" | "\\olive" | "\\yellow" | "\\navy" | "\\blue" | "\\teal" | "\\aqua" | "\\else" | "\\fi" 270 | "\\char" -> true | name -> (String.length name >= 3 && String.sub name 0 3 = "\\if") ;; <6>95 latexmain.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: latexmain.ml,v 1.69 2001/05/25 12:37:25 maranget Exp $" open Misc 15 open Parse_opts let scan_main, no_prelude, scan_print_env_pos, 20 dest_finalize,image_finalize = match !Parse_opts.destination with | Html when name_in <> "" -> let module Scan = Latexscan.Make (Html) (Image) in 25 let module MakeIt = Zyva.Make (Html) (Image) (Scan) in let module Rien = MakeIt (Videoc.Make) in let module RienBis = MakeIt (Package.Make) in let module RienTer = MakeIt (Verb.Make) in Scan.main, Scan.no_prelude, Scan.print_env_pos, 30 Html.finalize, Image.finalize | Html -> let module Scan = Latexscan.Make (Html) (Noimage) in let module Otherscan = Videoc.Make (Html) (Noimage) (Scan) in let module Verbscan = Verb.Make (Html) (Noimage) (Scan) in 35 let module OptScan = Package.Make (Html) (Image) (Scan) in Scan.main, Scan.no_prelude, Scan.print_env_pos, Html.finalize, Noimage.finalize | Text -> let module Scan = Latexscan.Make (Text) (Noimage) in 40 let module Verbscan = Verb.Make (Text) (Noimage) (Scan) in let module OptScan = Package.Make (Text) (Image) (Scan) in Scan.main, Scan.no_prelude, Scan.print_env_pos, Text.finalize,Noimage.finalize | Info -> 45 let module Scan = Latexscan.Make (Info) (Noimage) in let module Verbscan = Verb.Make (Info) (Noimage) (Scan) in let module OptScan = Package.Make (Info) (Image) (Scan) in Scan.main, Scan.no_prelude, Scan.print_env_pos, Info.finalize, Noimage.finalize 50 ;; let prerr_error msg = Location.print_pos () ; if msg <> "" then prerr_endline msg 55 ;; let prerr_bug msg = prerr_error msg ; prerr_endline 60 " (if input is plain LaTeX, please report to Luc.Maranget@inria.fr)" and prerr_not_supported msg = prerr_error msg ; prerr_endline "You ran into hevea limitations, sorrry" 65 ;; let finalize check = try 70 let changed = Auxx.finalize check in let changed = Index.finalize check || changed in let image_changed = image_finalize check in dest_finalize check ; if !verbose > 0 && Parse_opts.name_out <> "" then begin 75 prerr_endline ("Output is in file: "^Parse_opts.name_out) end ; changed,image_changed with e -> if check then raise e 80 else begin prerr_bug ("Uncaught exception in finalize: "^Printexc.to_string e) ; prerr_endline "Adios" ; exit 2 end 85 ;; let read_style name = let oldverb = !verbose in 90 if !verbose > 0 then verbose := 1; begin try let name,chan = Myfiles.open_tex name in if !verbose > 0 then begin prerr_endline ("read_style: "^name) 95 end ; let buf = Lexing.from_channel chan in Location.set name buf; begin try scan_main buf with Misc.EndInput -> () end ; close_in chan ; 100 Location.restore () with | Myfiles.Except-> () end ; verbose := oldverb 105 ;; let read_prog prog = try let real_prog = Myfiles.find prog 110 and name = Filename.temp_file "hevea" ".hva" in begin match Sys.command (real_prog^" >"^name) with | 0 -> read_style name | _ -> warning ("Could not exec program file: "^real_prog) 115 end ; Mysys.remove name with | Not_found -> warning ("Could not find program file: "^prog) 120 let read_tex name_in = Save.set_verbose !silent !verbose ; begin try match name_in with 125 | "" -> Lexstate.real_input_file !verbose scan_main "" stdin | _ -> Lexstate.input_file !verbose scan_main name_in with | Misc.EndDocument -> () end 130 let main () = verbose := !readverb ; read_style "hevea.hva" ; 135 let rec do_rec = function [] -> () | File x::rest -> do_rec rest ; 140 read_style x | Prog x::rest -> do_rec rest ; read_prog x in 145 let styles = Parse_opts.styles in do_rec styles ; if Parse_opts.filter then no_prelude () ; 150 if !Parse_opts.fixpoint then begin let image_changed = ref false in let saved = Hot.checkpoint () in let rec do_rec i = 155 read_tex name_in ; let changed,image_changed_now = finalize true in image_changed := !image_changed || image_changed_now ; if changed then begin Hot.start saved ; 160 Auxx.hot_start () ; Misc.message ("Run, run, again...") ; do_rec (i+1) end else begin Misc.message 165 ("Fixpoint reached in "^string_of_int i^" step(s)") ; if !image_changed then begin Misc.message ("Now, I am running imagen for you") ; let _ = Sys.command("imagen "^base_out) in () 170 end end in do_rec 1 end else begin read_tex name_in ; 175 let _ = finalize true in () end ; (* Optimisation *) if !optimize then begin 180 match !destination with | Html when name_in <> "" -> Ultra.verbose := !Misc.verbose ; if not (Esponja.file name_out) then warning "Esponja failed, optimisation not performed" 185 | _ -> () end ; exit 0 ;; (* 190 let _ = Dynlink.init () ; begin try Dynlink.add_interfaces ["Pervasives"] ["/usr/local/lib/ocaml"] ; Dynlink.loadfile "a.cmo" ; 195 with Dynlink.Error e -> prerr_endline (Dynlink.error_message e) end *) let _ = begin try 200 main () ; exit 0 with | Misc.Close s -> prerr_error s ; 205 scan_print_env_pos () | Html.Error s -> prerr_error ("Error while writing HTML:\n\t"^s) | Text.Error s -> prerr_error ("Error while writing Text:\n\t"^s) 210 | Info.Error s -> prerr_error ("Error while writing Info:\n\t"^s) | InfoRef.Error s -> prerr_error ("Error while writing Info:\n\t"^s) | Misc.ScanError s -> 215 prerr_error ("Error while reading LaTeX:\n\t"^s) | Lexstate.Error s -> prerr_error ("Error while reading LaTeX:\n\t"^s) | Verb.VError s -> prerr_error ("Error while reading verbatim LaTeX:\n\t"^s) 220 | Colscan.Error s -> prerr_error ("Error while reading LaTeX style colors:\n\t"^s) | Save.Error s -> prerr_error ("Error while reading LaTeX macros arguments:\n\t"^s) | Tabular.Error s -> 225 prerr_error ("Error while reading table format:\n\t"^s) | Get.Error s -> prerr_error ("Error while getting a value:\n\t"^s) | Misc.UserError s -> prerr_error ("User error:\n\t"^s) 230 | Myfiles.Error s -> prerr_error ("File error:\n\t"^s) | Misc.NoSupport s -> prerr_not_supported s | Misc.Fatal s -> 235 prerr_bug ("Fatal error: "^s) | Stack.Fatal s -> prerr_bug ("Fatal stack error, "^s) (* | x -> 240 prerr_bug ("Fatal error, spurious exception:\n\t"^Printexc.to_string x) *) end ; let _ = finalize false in 245 prerr_endline "Adios" ; exit 2 ;; <6>96 latexscan.ml 15 "latexscan.mll" module type S = sig 5 (* external entry points *) val no_prelude : unit -> unit val main : Lexing.lexbuf -> unit val print_env_pos : unit -> unit 10 (* additional resources needed for extension modules. *) val cur_env : string ref val new_env : string -> unit val close_env : string -> unit val echo_toimage : unit -> bool 15 val echo_global_toimage : unit -> bool val fun_register : (unit -> unit) -> unit val newif_ref : string -> bool ref -> unit val top_open_block : string -> string -> unit 20 val top_close_block : string -> unit val check_alltt_skip : Lexing.lexbuf -> unit val skip_pop : Lexing.lexbuf -> unit (* ``def'' functions for initialisation only *) val def_code : string -> (Lexing.lexbuf -> unit) -> unit 25 val def_name_code : string -> (string -> Lexing.lexbuf -> unit) -> unit val def_fun : string -> (string -> string) -> unit val get_this_main : string -> string val check_this_main : string -> bool val get_prim : string -> string 30 val get_prim_arg : Lexing.lexbuf -> string val get_prim_opt : string -> Lexing.lexbuf -> string val get_csname : Lexing.lexbuf -> string end 35 module Make (Dest : OutManager.S) (Image : ImageManager.S) = struct open Misc open Parse_opts 40 open Element open Lexing open Myfiles open Latexmacros open Save 45 open Tabular open Lexstate open Stack open Subst 50 let sbool = function | false -> "false" | true -> "true" 55 let last_letter name = let c = String.get name (String.length name-1) in ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') ;; 60 let top_par n = if not (!display || !in_math) then Dest.par n ;; 65 let if_level = ref 0 ;; let cur_env = ref "" and after = ref [] 70 and stack_env = Stack.create "stack_env" ;; let echo_toimage () = get_level () = 0 && top_level () and echo_global_toimage () = top_level () 75 let stack_env_pretty () = Stack.pretty (fun (x,_,_) -> x) stack_env let fun_register f = if get_level () > 0 then after := f :: !after 80 ;; let inc_size i = let n = Dest.get_fontsize () in 85 let new_size = if n+i <= 1 then 1 else if n+i >= 7 then 7 else n+i in Dest.open_mod (Font new_size) 90 ;; let big_size () = Dest.open_mod (Font 7) ;; 95 (* Horizontal display *) let top_open_display () = if !display then begin if !verbose > 1 then 100 prerr_endline "open display" ; Dest.open_display () end and top_item_display () = 105 if !display then begin Dest.item_display () end ;; 110 let top_close_display () = if !display then begin Dest.close_display () end 115 (* Latex environment stuff *) let print_env_pos () = let _,_,pos = Stack.pop stack_env in 120 Location.print_this_pos pos ; prerr_endline ("Latex environment ``"^ !cur_env^"'' is pending") ;; let new_env env = 125 Latexmacros.open_group () ; push stack_env (!cur_env, !after, Location.get_pos ()) ; cur_env := env ; after := [] ; if !verbose > 1 then begin 130 Location.print_pos () ; Printf.fprintf stderr "Begin : %s <%d>" env (get_level ()); prerr_endline "" end 135 let error_env close_e open_e = raise (Misc.Close ("Latex env error: ``"^close_e^"'' closes ``"^open_e^"''")) 140 let close_env env = if !verbose > 1 then begin Printf.fprintf stderr "End: %s <%d>" env (get_level ()); prerr_endline "" end ; 145 if env = !cur_env then begin let e,a,_ = pop stack_env in List.iter (fun f -> f ()) !after ; cur_env := e ; after := a ; 150 Latexmacros.close_group () end else error_env env !cur_env ;; 155 let env_check () = !cur_env, !after, Stack.save stack_env and env_hot (e,a,s) = cur_env := e ; after := a ; Stack.restore stack_env s 160 (* Top functions for blocks *) type array_type = {math : bool ; border : bool} 165 type in_table = Table of array_type | NoTable | Tabbing ;; let cur_format = ref [||] and stack_format = Stack.create "stack_format" 170 and cur_col = ref 0 and stack_col = Stack.create "stack_col" and in_table = ref NoTable and stack_table = Stack.create_init "stack_table" NoTable and first_col = ref false 175 and first_border = ref false and stack_first = Stack.create "stack_first" and stack_first_b = Stack.create "stack_first_b" and in_multi = ref false and stack_multi_flag = Stack.create "stack_multi_flag" 180 and stack_multi = Stack.create "stack_multi" ;; let pretty_array_type = function 185 | Table {math = m ; border = b} -> "Table math="^(if m then "+" else "-")^ " border="^(if b then "+" else "-") | NoTable -> "NoTable" | Tabbing -> "Tabbing" 190 let prerr_array_state () = prerr_endline (pretty_array_type !in_table) ; prerr_string " format:"; pretty_formats !cur_format ; 195 prerr_endline "" ; prerr_endline (" cur_col="^string_of_int !cur_col) ; prerr_endline (" first_col="^ (if !first_col then "true" else "false")) ;; 200 let save_array_state () = push stack_format !cur_format ; push stack_col !cur_col ; push stack_table !in_table ; 205 push stack_first !first_col; push stack_first_b !first_border; push stack_multi_flag !in_multi ; in_multi := false ; if !verbose > 1 then begin 210 prerr_endline "Save array state:" ; prerr_array_state () end and restore_array_state () = 215 in_table := pop stack_table ; cur_col := pop stack_col ; cur_format := pop stack_format ; first_col := pop stack_first ; first_border := pop stack_first_b; 220 in_multi := pop stack_multi_flag ; if !verbose > 1 then begin prerr_endline "Restore array state:" ; prerr_array_state () end 225 ;; let top_open_block block args = if !verbose > 2 then prerr_endline ("Top open: "^block); push stack_table !in_table ; 230 in_table := NoTable ; begin match block with | "PRE" -> push stack_display !display ; if !display then begin 235 Dest.item_display () ; display := false end ; Dest.open_block "PRE" args | "DISPLAY" -> 240 push stack_display !display ; display := true ; Dest.open_display () | "TABLE" -> save_array_state () ; 245 in_table := NoTable ; top_item_display () ; Dest.open_block "TABLE" args | "TR" -> Dest.open_block "TR" args 250 | "TD" -> Dest.open_block "TD" args ; top_open_display () | _ -> if !display then begin 255 Dest.item_display () ; Dest.open_block block args ; Dest.open_display () end else Dest.open_block block args end 260 and top_close_block_aux close_fun block = if !verbose > 2 then prerr_endline ("Top close: "^block) ; in_table := pop stack_table ; begin match block with 265 | "PRE" -> display := pop stack_display ; close_fun block ; top_item_display () | "DISPLAY" -> 270 Dest.close_display () ; display := pop stack_display | "TABLE" -> close_fun "TABLE" ; top_item_display () ; 275 restore_array_state () | "TR" -> close_fun "TR" | "TD" -> top_close_display () ; 280 close_fun "TD" | _ -> if !display then begin Dest.close_display () ; close_fun block ; Dest.item_display () end else 285 close_fun block end ;; let top_close_block block = top_close_block_aux Dest.close_block block 290 and top_erase_block block = top_close_block_aux Dest.erase_block block let top_open_group () = top_open_block "" "" ; new_env "" 295 and top_close_group () = if !cur_env = "*mbox" then begin top_close_block "" ; in_math := pop stack_in_math ; display := pop stack_display ; if !display then Dest.item_display () ; 300 close_env "*mbox" end else begin top_close_block "" ; close_env "" end 305 ;; let start_mbox () = push stack_table !in_table ; in_table := NoTable ; push stack_in_math !in_math ; in_math := false ; 310 if !display then Dest.item_display () ; push stack_display !display ; display := false ; Dest.open_block "" "" ; new_env "*mbox" ;; 315 let get_fun_result f lexbuf = if !verbose > 1 then prerr_endline ("get_fun") ; let r = Dest.to_string (fun () -> 320 top_open_group () ; Dest.nostyle () ; f lexbuf ; top_close_group ()) in if !verbose > 1 then begin 325 prerr_endline ("get_fun -> ``"^r^"''") end ; r 330 let do_get_this start_lexstate restore_lexstate make_style lexfun {arg=s ; subst=subst} = let par_val = Dest.forget_par () in start_lexstate subst; if !verbose > 1 then 335 prerr_endline ("get_this : ``"^s^"''") ; verbose := !verbose - 1; let lexer = Lexing.from_string s in let r = Dest.to_string (fun () -> if !display then Dest.open_display () ; 340 top_open_group () ; make_style () ; lexfun lexer ; top_close_group () ; if !display then Dest.close_display ()) in 345 let _ = Dest.forget_par () in verbose := !verbose + 1 ; if !verbose > 1 then begin prerr_endline ("get_this ``"^s^"'' -> ``"^r^"''") 350 end ; restore_lexstate () ; Dest.par par_val ; r 355 let get_this_arg = do_get_this start_lexstate_subst restore_lexstate (fun () -> ()) and get_this_string main s = do_get_this start_lexstate_subst restore_lexstate (fun () -> ()) 360 main (string_to_arg s) let more_buff = Out.create_buff () ;; 365 let default_format = Tabular.Align {hor="left" ; vert = "" ; wrap = false ; pre = "" ; post = "" ; width = Length.Default} 370 and center_format = Tabular.Align {hor="center" ; vert = "top" ; wrap = false ; pre = "" ; post = "" ; width = Length.Default} ;; 375 let is_table = function | Table _ -> true | _ -> false 380 and is_noborder_table = function | Table {border = b} -> not b | _ -> false 385 and is_tabbing = function | Tabbing -> true | _ -> false and math_table = function 390 | Table {math = m} -> m | _ -> raise (Misc.Fatal "Array construct outside an array") ;; 395 exception EndInside ;; exception NoMulti ;; 400 let attribut name = function | "" -> "" | s -> " "^name^"="^s and as_colspan = function 405 | 1 -> "" | n -> " COLSPAN="^string_of_int n let is_inside = function Tabular.Inside _ -> true 410 | _ -> false let is_border = function | Tabular.Border _ -> true | _ -> false 415 and as_wrap = function | Tabular.Align {wrap = w} -> w | _ -> false 420 and as_pre = function | Tabular.Align {pre=s} -> s | _ -> raise (Misc.Fatal "as_pre") and as_post = function 425 | Tabular.Align {post=s} -> s | f -> raise (Misc.Fatal ("as_post "^pretty_format f)) ;; let get_col format i = 430 let r = if i >= Array.length format+1 then raise (Misc.ScanError ("This array/tabular column has no specification")) else if i = Array.length format then default_format else format.(i) in 435 if !verbose > 2 then begin Printf.fprintf stderr "get_col : %d: " i ; prerr_endline (pretty_format r) ; prerr_string " <- " ; pretty_formats format ; 440 prerr_newline () end ; r ;; 445 (* Paragraph breaks are different in tables *) let par_val t = if is_table t then match get_col !cur_format !cur_col with | Tabular.Align {wrap=false} -> None 450 | _ -> Some 0 else Some 1 let show_inside main format i closing = 455 (* if !verbose > -1 then begin prerr_string ("show_inside: "^string_of_int i) end ; *) 460 let t = ref i in begin try while true do begin match get_col format !t with Tabular.Inside s -> let saved_table = !in_table in 465 if math_table saved_table then scan_this main "$" else scan_this main "{" ; let s = get_this_string main s in 470 if math_table saved_table then scan_this main "$" else scan_this main "}" ; Dest.make_inside s !in_multi; 475 | Tabular.Border s -> Dest.make_border s; if !first_border then first_border := false; | _ -> raise EndInside end ; 480 t := !t+1 done with EndInside -> if (!t = i) && (closing || !first_border) then Dest.make_border " "; end ; 485 (* if !verbose > -1 then prerr_endline (" -> "^string_of_int !t) ; *) !t 490 ;; let rec eat_inside format i b insides = if i >= Array.length format then (i , b , insides) else begin 495 let f = get_col format i in if is_inside f then eat_inside format (i+1) b (insides+1) else if is_border f then eat_inside format (i+1) (b+1) insides 500 else i, b, insides end ;; let rec find_end n format i b insides = match n with 505 0 -> eat_inside format i b insides | _ -> let f = get_col format i in if is_inside f then find_end n format (i+1) b (insides +1) 510 else if is_border f then find_end n format (i+1) (b+1) insides else find_end (n-1) format (i+1) b insides ;; 515 let find_start i = if !first_border then 0 else i let find_align format = 520 let t = ref 0 in while (is_inside (get_col format !t)) || (is_border (get_col format !t)) do t := !t+1 done ; !t 525 ;; let next_no_border format n = let t = ref n in while is_border (get_col format !t) do 530 t:= !t+1 done; !t ;; 535 let do_open_col main format span insides = let save_table = !in_table in Dest.open_cell format span insides; if not (as_wrap format) && math_table !in_table then begin display := true ; 540 Dest.open_display () end ; if math_table !in_table && not (as_wrap format) then begin scan_this main "$" end else 545 scan_this main "{" ; scan_this main (as_pre format) ; in_table := save_table let open_col main = 550 let _ = Dest.forget_par () in Dest.open_cell_group () ; cur_col := show_inside main !cur_format !cur_col false; let format = (get_col !cur_format !cur_col) in do_open_col main format 1 0 555 ;; let open_first_col main = first_col := true ; first_border := true; 560 open_col main ;; let erase_col main = let old_format = get_col !cur_format !cur_col in 565 scan_this main (as_post old_format) ; if math_table !in_table && not (as_wrap old_format) then scan_this main "$" else scan_this main "}" ; 570 if !display then begin Dest.close_display () ; display := false end ; Dest.erase_cell () ; 575 Dest.erase_cell_group () ;; let open_row () = 580 cur_col := 0 ; Dest.new_row () and close_row () = Dest.close_row () ;; 585 let do_hline main = if !verbose > 2 then begin Printf.fprintf stderr "hline: %d %d" !cur_col (Array.length !cur_format) ; 590 prerr_newline () end ; erase_col main ; Dest.erase_row () ; Dest.make_hline (Array.length !cur_format) (is_noborder_table !in_table); 595 open_row () ; open_first_col main ;; let do_multi n format main = 600 if !verbose > 2 then begin prerr_string ("multicolumn: n="^string_of_int n^" format:") ; pretty_formats format ; prerr_endline "" 605 end ; erase_col main ; let start_span = find_start !cur_col 610 and k,b,insides = find_end n !cur_format !cur_col 0 0 in let end_span = k - b in in_multi := true; 615 let i = show_inside main format 0 true in Dest.open_cell_group () ; do_open_col main (get_col format i) (end_span - start_span) insides; push stack_multi (!cur_format,k) ; 620 cur_format := format ; cur_col := i ; ;; 625 let close_col_aux main content is_last = let old_format = get_col !cur_format !cur_col in scan_this main (as_post old_format) ; if math_table !in_table && not (as_wrap old_format) then scan_this main "$" 630 else scan_this main "}" ; if !display then begin Dest.close_display () ; display := false 635 end ; if is_last && Dest.is_empty () then Dest.erase_cell () else begin if !in_multi then begin let _ = show_inside main !cur_format (!cur_col+1) true in 640 in_multi := false ; let f,n = pop stack_multi in cur_format := f ; cur_col := next_no_border f n; cur_col := show_inside main !cur_format !cur_col false; 645 end else begin cur_col := !cur_col + 1; cur_col := show_inside main !cur_format !cur_col true; end; Dest.close_cell content; 650 if !first_col then begin first_col := false; first_border := false; end end ; 655 Dest.close_cell_group () ;; let close_col main content = close_col_aux main content false and close_last_col main content = close_col_aux main content true 660 and close_last_row () = if !first_col then Dest.erase_row () else 665 Dest.close_row () ;; (* Compute functions *) 670 let get_style lexfun {arg=s ; subst=env} = start_normal env ; let lexer = Lexing.from_string s in let r = Dest.to_style (fun () -> lexfun lexer) in end_normal () ; 675 r (* Image stuff *) let iput_newpage () = Image.page () 680 ;; let stack_entry = Stack.create "stack_entry" and stack_out = Stack.create "stack_out" ;; 685 let start_other_scan env lexfun lexbuf = if !verbose > 1 then begin prerr_endline ("Start other scan ("^env^")") ; stack_env_pretty () ; 690 prerr_endline ("Current env is: ``"^ !cur_env^"''") ; pretty (fun x -> x) stack_entry end; save_lexstate () ; push stack_entry env ; 695 rev stack_entry ; lexfun lexbuf ;; let start_image_scan s image lexbuf = 700 start_other_scan "toimage" (fun b -> Image.dump s image b) lexbuf ;; let complete_scan main lexbuf = main lexbuf ; 705 close_env (pop stack_out) ; top_close_block "" ; if !verbose > 1 then begin prerr_endline "Complete scan" ; stack_env_pretty () ; 710 prerr_endline ("Current env is: ``"^ !cur_env^"''") end ;; 715 let stop_other_scan comment main lexbuf = if !verbose > 1 then begin prerr_endline "Stop image: env stack is" ; stack_env_pretty () ; prerr_endline ("Current env is: ``"^ !cur_env^"''") 720 end; let _ = pop stack_entry in if not comment then close_env !cur_env ; if not (Stack.empty stack_out) then begin complete_scan main lexbuf ; 725 while not (Stack.empty stack_out) do let lexbuf = previous_lexbuf () in complete_scan main lexbuf done end ; 730 restore_lexstate () ;; let includes_table = Hashtbl.create 17 and check_includes = ref false 735 ;; let add_includes l = check_includes := true ; List.iter (fun x -> Hashtbl.add includes_table x ()) l 740 ;; let check_include s = not !check_includes || 745 begin try Hashtbl.find includes_table s ; true with Not_found -> false end ;; 750 let mk_out_file () = match Parse_opts.name_out,!Parse_opts.destination with | "", Parse_opts.Info -> Out.create_buff () | "", _ -> Out.create_chan stdout 755 | x , Parse_opts.Info -> Out.create_chan (open_out (x^".tmp")) | x , _ -> Out.create_chan (open_out x) ;; let no_prelude () = 760 if !verbose > 1 then prerr_endline "Filter mode" ; flushing := true ; let _ = Dest.forget_par () in () ; Dest.set_out (mk_out_file ()) ;; 765 let macro_depth = ref 0 ;; let debug = function 770 | Not -> "Not" | Macro -> "Macro" | Inside -> "Inside" ;; 775 let rec expand_toks main = function | [] -> () | s::rem -> expand_toks main rem ; 780 scan_this main s let expand_command main skip_blanks name lexbuf = if !verbose > 2 then begin Printf.fprintf stderr "expand_command: %s\n" name 785 end ; let cur_subst = get_subst () in let exec = if !alltt_loaded then function 790 | Subst body -> if !verbose > 2 then prerr_endline ("user macro: "^body) ; let old_alltt = !alltt in Stack.push stack_alltt old_alltt ; 795 alltt := (match old_alltt with | Not -> Not | _ -> Macro) ; (* 800 Printf.fprintf stderr "Enter: %s, %s -> %s\n" name (debug old_alltt) (debug !alltt) ; *) scan_this_may_cont main lexbuf cur_subst (string_to_arg body) ; let _ = Stack.pop stack_alltt in 805 alltt := (match old_alltt, !alltt with | Not, Inside -> Inside | (Macro|Inside), Not -> Not | _, _ -> old_alltt) 810 (* Printf.fprintf stderr "After: %s, %s -> %s\n" name (debug old_alltt) (debug !alltt) *) | Toks l -> expand_toks main l 815 | CamlCode f -> f lexbuf else function | Subst body -> if !verbose > 2 then 820 prerr_endline ("user macro: "^body) ; scan_this_may_cont main lexbuf cur_subst (string_to_arg body) | Toks l -> expand_toks main l | CamlCode f -> f lexbuf in 825 let pat,body = Latexmacros.find name in let par_before = Dest.forget_par () in if (if !in_math then Latexmacros.invisible name else 830 not (effective !alltt) && is_subst body && last_letter name) then begin if !verbose > 2 then prerr_endline ("skipping blanks ("^name^")"); 835 skip_blanks lexbuf end else begin if !verbose > 2 then begin prerr_endline ("not skipping blanks ("^name^")") end 840 end ; let par_after = Dest.forget_par () in Dest.par par_before ; let args = make_stack name pat lexbuf in let saw_par = !Save.seen_par in 845 if (!verbose > 1) then begin prerr_endline ("Expanding macro "^name^" {"^(string_of_int !macro_depth)^"}") ; macro_depth := !macro_depth + 1 end ; 850 scan_body exec body args ; if (!verbose > 1) then begin prerr_endline ("Cont after macro "^name^": ") ; macro_depth := !macro_depth - 1 end ; 855 Dest.par par_after ; if saw_par then begin top_par (par_val !in_table) end ;; 860 let count_newlines s = let l = String.length s in let rec c_rec i = if i >= l then 0 865 else match s.[i] with | '\n' -> 1 + c_rec (i+1) | _ -> c_rec (i+1) in c_rec 0 ;; 870 let check_case s = match !case with | Lower -> String.lowercase s | Upper -> String.uppercase s | Neutral -> s 875 and check_case_char c = match !case with | Lower -> Char.lowercase c | Upper -> Char.uppercase c | Neutral -> c 880 let lex_tables = { Lexing.lex_base = "\000\000\001\000\002\000\002\000\004\000\003\000\056\000\005\000\ \032\000\255\255\008\000\006\000\007\000\011\000\001\000\012\000\ \090\000\119\000\009\000\010\000\254\255\097\000\253\255\098\000\ \053\000\022\000\033\000\013\000\104\000\072\000\041\000\023\000\ \039\000\021\000\058\000\074\000\056\000\077\000\013\000\137\000\ \138\000\117\000\081\000\083\000\055\000\056\000\057\000\041\000\ \059\000\064\000\014\000\059\000\058\000\054\000\026\000\133\000\ \091\000\106\000\063\000\076\000\058\000\075\000\057\000\252\255\ \081\000\076\000\080\000\100\000\117\000\099\000\123\000\119\000\ \123\000\092\000\091\000\090\000\086\000\074\000\092\000\104\000\ \086\000\102\000\085\000\096\000\098\000\105\000\093\000\091\000\ \132\000\150\000\155\000\151\000\151\000\147\000\248\255\255\255\ \126\000\118\000\127\000\131\000\250\000\053\001\112\001\171\001\ \230\001\033\002\092\002\151\002\210\002\013\003\071\003\129\003\ \119\000\134\000\188\003\247\003\027\000\004\000\028\000\255\255\ \010\000\029\000\030\000\139\000\136\000\126\000\132\000\127\000\ \133\000\238\000\214\000\015\000\249\255\223\000\050\004\059\004\ \250\255\140\004\221\004\046\005\127\005\083\004\163\004\169\000\ \180\000\140\000\150\000\134\000\152\000\157\000\223\000\167\000\ \249\000\160\004\205\000\174\000\187\000\182\000\185\000\153\003\ \222\000\218\000\221\000\205\000\223\000\228\000\226\000\013\004\ \251\255\244\004\186\005\011\006\092\006\173\006\254\006\245\004\ \069\005\217\000\227\000\187\000\197\000\181\000\199\000\204\000\ \014\001\203\000\016\001\158\004\240\000\209\000\191\000\207\000\ \189\000\014\004\226\000\242\000\225\000\255\000\017\001\022\001\ \020\001\112\007\113\007\114\007\244\000\034\001\045\001\023\001\ \039\001\051\001\033\001\102\001\084\001\094\001\096\001\099\001\ \087\001\137\001\015\004\115\007\238\255\116\007\118\007\239\255\ \125\005\227\001\255\255\250\255\006\006\240\255\110\007\169\007\ \252\255\253\255\247\255\246\255\241\255\245\255\250\007\073\008\ \016\006\120\007\121\007"; Lexing.lex_backtrk = "\255\255\001\000\000\000\255\255\255\255\255\255\255\255\255\255\ \003\000\255\255\002\000\001\000\255\255\002\000\001\000\000\000\ \008\000\004\000\001\000\255\255\255\255\001\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\002\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \007\000\255\255\255\255\255\255\255\255\002\000\002\000\002\000\ \002\000\002\000\002\000\002\000\002\000\001\000\006\000\005\000\ \255\255\255\255\004\000\003\000\000\000\000\000\000\000\255\255\ \000\000\000\000\000\000\255\255\255\255\255\255\255\255\255\255\ \255\255\002\000\002\000\002\000\255\255\006\000\002\000\006\000\ \255\255\005\000\005\000\005\000\004\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\001\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\001\000\ \255\255\002\000\004\000\004\000\004\000\004\000\003\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \001\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\001\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\001\000\011\000\255\255\ \017\000\004\000\255\255\255\255\013\000\255\255\012\000\017\000\ \255\255\255\255\255\255\255\255\255\255\255\255\007\000\012\000\ \013\000\255\255\011\000"; 885 Lexing.lex_default = "\220\000\009\000\255\255\020\000\168\000\167\000\132\000\131\000\ \255\255\000\000\255\255\255\255\020\000\255\255\255\255\255\255\ \094\000\255\255\038\000\020\000\000\000\255\255\000\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\038\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\000\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\000\000\000\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\000\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\131\000\000\000\255\255\255\255\136\000\ \000\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\159\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\167\000\ \000\000\255\255\168\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\193\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\218\000\255\255\000\000\255\255\255\255\000\000\ \255\255\255\255\000\000\000\000\255\255\000\000\255\255\094\000\ \000\000\000\000\000\000\000\000\000\000\000\000\255\255\255\255\ \255\255\255\255\255\255"; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\221\000\117\000\002\000\009\000\117\000\009\000\ \120\000\119\000\020\000\009\000\120\000\020\000\000\000\009\000\ \000\000\255\255\000\000\000\000\000\000\000\000\000\000\000\000\ \222\000\223\000\219\000\224\000\225\000\226\000\227\000\201\000\ \121\000\169\000\009\000\118\000\116\000\028\000\050\000\021\000\ \228\000\228\000\228\000\228\000\228\000\228\000\228\000\228\000\ \228\000\228\000\055\000\116\000\118\000\121\000\122\000\229\000\ \122\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\230\000\230\000\133\000\231\000\134\000\232\000\233\000\ \170\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\230\000\230\000\234\000\123\000\235\000\236\000\095\000\ \039\000\023\000\023\000\037\000\026\000\027\000\023\000\023\000\ \028\000\034\000\031\000\032\000\033\000\009\000\035\000\036\000\ \009\000\027\000\039\000\039\000\135\000\041\000\091\000\040\000\ \088\000\073\000\041\000\022\000\041\000\051\000\047\000\048\000\ \049\000\050\000\052\000\053\000\054\000\055\000\024\000\024\000\ \070\000\039\000\040\000\067\000\064\000\060\000\061\000\041\000\ \062\000\063\000\065\000\066\000\029\000\009\000\096\000\042\000\ \068\000\042\000\069\000\063\000\071\000\043\000\072\000\043\000\ \009\000\074\000\075\000\076\000\077\000\078\000\025\000\025\000\ \079\000\080\000\081\000\082\000\042\000\083\000\056\000\084\000\ \085\000\057\000\043\000\044\000\030\000\086\000\087\000\045\000\ \020\000\045\000\089\000\090\000\050\000\046\000\092\000\046\000\ \093\000\054\000\112\000\097\000\098\000\044\000\044\000\099\000\ \110\000\100\000\113\000\114\000\045\000\124\000\058\000\125\000\ \126\000\059\000\046\000\127\000\128\000\129\000\130\000\166\000\ \130\000\163\000\151\000\147\000\148\000\149\000\150\000\150\000\ \237\000\255\255\022\000\009\000\136\000\020\000\022\000\022\000\ \063\000\255\255\022\000\152\000\020\000\255\255\129\000\255\255\ \063\000\063\000\063\000\063\000\063\000\063\000\063\000\063\000\ \063\000\153\000\160\000\156\000\157\000\158\000\159\000\161\000\ \020\000\162\000\159\000\164\000\165\000\150\000\152\000\200\000\ \197\000\185\000\181\000\182\000\183\000\184\000\184\000\186\000\ \187\000\194\000\190\000\191\000\192\000\193\000\195\000\196\000\ \094\000\193\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\198\000\199\000\184\000\ \186\000\205\000\255\255\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\102\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \206\000\207\000\208\000\209\000\210\000\211\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\212\000\213\000\214\000\215\000\216\000\ \217\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \103\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\218\000\168\000\ \000\000\000\000\000\000\000\000\101\000\101\000\101\000\101\000\ \104\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\000\000\000\000\000\000\000\000\000\000\000\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\105\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\000\000\000\000\000\000\000\000\ \000\000\000\000\101\000\101\000\101\000\101\000\106\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\000\000\ \000\000\000\000\000\000\000\000\000\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \107\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\000\000\000\000\000\000\000\000\000\000\000\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\108\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\000\000\000\000\000\000\ \000\000\000\000\000\000\101\000\101\000\101\000\101\000\109\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \000\000\000\000\000\000\000\000\000\000\000\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\000\000\009\000\000\000\000\000\000\000\000\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\000\000\000\000\000\000\000\000\ \000\000\000\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\255\255\ \009\000\009\000\000\000\000\000\000\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\141\000\000\000\000\000\000\000\000\000\142\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\000\000\141\000\000\000\000\000\000\000\143\000\ \000\000\000\000\144\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\000\000\145\000\ \143\000\255\255\146\000\144\000\137\000\137\000\137\000\137\000\ \138\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\136\000\000\000\ \145\000\000\000\000\000\146\000\000\000\000\000\187\000\000\000\ \153\000\000\000\000\000\141\000\000\000\000\000\000\000\000\000\ \142\000\000\000\000\000\000\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\000\000\ \143\000\154\000\188\000\144\000\000\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\136\000\ \145\000\155\000\189\000\146\000\000\000\255\255\255\255\255\255\ \000\000\000\000\000\000\000\000\175\000\175\000\000\000\000\000\ \000\000\176\000\000\000\000\000\000\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \000\000\177\000\177\000\255\255\178\000\178\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\139\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \136\000\179\000\179\000\000\000\180\000\180\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\175\000\000\000\000\000\ \000\000\000\000\176\000\000\000\000\000\000\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\000\000\177\000\000\000\000\000\178\000\000\000\137\000\ \137\000\137\000\140\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\136\000\179\000\000\000\000\000\180\000\132\000\132\000\ \132\000\132\000\132\000\132\000\132\000\132\000\132\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\000\000\000\000\000\000\000\000\000\000\000\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\000\000\000\000\000\000\ \000\000\000\000\000\000\171\000\171\000\171\000\171\000\172\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\168\000\240\000\240\000\ \240\000\240\000\240\000\240\000\240\000\240\000\240\000\240\000\ \240\000\240\000\240\000\240\000\240\000\240\000\240\000\240\000\ \240\000\240\000\000\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\000\000\000\000\ \000\000\000\000\000\000\000\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\168\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\000\000\ \000\000\000\000\255\255\000\000\000\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\173\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\168\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \000\000\000\000\000\000\000\000\000\000\000\000\171\000\171\000\ \171\000\174\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \168\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\000\000\000\000\000\000\000\000\000\000\000\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\202\000\202\000\202\000\000\000\002\000\241\000\000\000\ \241\000\000\000\241\000\241\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \202\000\202\000\202\000\219\000\241\000\203\000\242\000\203\000\ \241\000\242\000\136\000\000\000\136\000\000\000\136\000\136\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\000\000\000\000\000\000\204\000\204\000\204\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\000\000\000\000\000\000\000\000\ \000\000\000\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\094\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\000\000\000\000\000\000\ \000\000\000\000\000\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\000\000\000\000\000\000\000\000\ \000\000\255\255\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000"; Lexing.lex_check = 890 "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\000\000\014\000\002\000\005\000\117\000\007\000\ \011\000\012\000\010\000\018\000\120\000\013\000\255\255\038\000\ \255\255\131\000\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\000\000\002\000\000\000\000\000\000\000\000\000\003\000\ \010\000\004\000\008\000\013\000\015\000\027\000\050\000\019\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\054\000\116\000\118\000\121\000\122\000\000\000\ \008\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\006\000\000\000\006\000\000\000\000\000\ \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\008\000\000\000\000\000\016\000\ \017\000\021\000\023\000\024\000\025\000\026\000\021\000\023\000\ \028\000\029\000\030\000\031\000\032\000\033\000\034\000\035\000\ \036\000\037\000\039\000\040\000\006\000\041\000\042\000\017\000\ \043\000\044\000\041\000\008\000\017\000\045\000\046\000\047\000\ \048\000\049\000\051\000\052\000\053\000\055\000\021\000\023\000\ \056\000\039\000\040\000\057\000\058\000\059\000\060\000\040\000\ \061\000\062\000\064\000\065\000\028\000\066\000\016\000\041\000\ \067\000\017\000\068\000\069\000\070\000\041\000\071\000\017\000\ \072\000\073\000\074\000\075\000\076\000\077\000\021\000\023\000\ \078\000\079\000\080\000\081\000\040\000\082\000\055\000\083\000\ \084\000\055\000\040\000\017\000\028\000\085\000\086\000\041\000\ \087\000\017\000\088\000\089\000\090\000\041\000\091\000\017\000\ \092\000\093\000\097\000\096\000\096\000\039\000\040\000\096\000\ \098\000\099\000\112\000\113\000\040\000\123\000\055\000\124\000\ \125\000\055\000\040\000\126\000\127\000\128\000\130\000\143\000\ \129\000\144\000\145\000\146\000\147\000\148\000\149\000\150\000\ \000\000\001\000\003\000\005\000\004\000\007\000\011\000\012\000\ \010\000\018\000\019\000\151\000\015\000\038\000\129\000\131\000\ \133\000\133\000\133\000\133\000\133\000\133\000\133\000\133\000\ \133\000\152\000\154\000\155\000\156\000\157\000\158\000\160\000\ \008\000\161\000\162\000\163\000\164\000\165\000\166\000\177\000\ \178\000\179\000\180\000\181\000\182\000\183\000\184\000\185\000\ \186\000\188\000\189\000\190\000\191\000\192\000\194\000\195\000\ \006\000\196\000\100\000\100\000\100\000\100\000\100\000\100\000\ \100\000\100\000\100\000\100\000\100\000\100\000\100\000\100\000\ \100\000\100\000\100\000\100\000\100\000\100\000\100\000\100\000\ \100\000\100\000\100\000\100\000\100\000\197\000\198\000\199\000\ \200\000\204\000\016\000\100\000\100\000\100\000\100\000\100\000\ \100\000\100\000\100\000\100\000\100\000\100\000\100\000\100\000\ \100\000\100\000\100\000\100\000\100\000\100\000\100\000\100\000\ \100\000\100\000\100\000\100\000\100\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \205\000\206\000\207\000\208\000\209\000\210\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \101\000\101\000\101\000\101\000\101\000\101\000\101\000\101\000\ \102\000\102\000\102\000\102\000\102\000\102\000\102\000\102\000\ \102\000\102\000\102\000\102\000\102\000\102\000\102\000\102\000\ \102\000\102\000\102\000\102\000\102\000\102\000\102\000\102\000\ \102\000\102\000\102\000\211\000\212\000\213\000\214\000\215\000\ \216\000\102\000\102\000\102\000\102\000\102\000\102\000\102\000\ \102\000\102\000\102\000\102\000\102\000\102\000\102\000\102\000\ \102\000\102\000\102\000\102\000\102\000\102\000\102\000\102\000\ \102\000\102\000\102\000\103\000\103\000\103\000\103\000\103\000\ \103\000\103\000\103\000\103\000\103\000\103\000\103\000\103\000\ \103\000\103\000\103\000\103\000\103\000\103\000\103\000\103\000\ \103\000\103\000\103\000\103\000\103\000\103\000\217\000\225\000\ \255\255\255\255\255\255\255\255\103\000\103\000\103\000\103\000\ \103\000\103\000\103\000\103\000\103\000\103\000\103\000\103\000\ \103\000\103\000\103\000\103\000\103\000\103\000\103\000\103\000\ \103\000\103\000\103\000\103\000\103\000\103\000\104\000\104\000\ \104\000\104\000\104\000\104\000\104\000\104\000\104\000\104\000\ \104\000\104\000\104\000\104\000\104\000\104\000\104\000\104\000\ \104\000\104\000\104\000\104\000\104\000\104\000\104\000\104\000\ \104\000\255\255\255\255\255\255\255\255\255\255\255\255\104\000\ \104\000\104\000\104\000\104\000\104\000\104\000\104\000\104\000\ \104\000\104\000\104\000\104\000\104\000\104\000\104\000\104\000\ \104\000\104\000\104\000\104\000\104\000\104\000\104\000\104\000\ \104\000\105\000\105\000\105\000\105\000\105\000\105\000\105\000\ \105\000\105\000\105\000\105\000\105\000\105\000\105\000\105\000\ \105\000\105\000\105\000\105\000\105\000\105\000\105\000\105\000\ \105\000\105\000\105\000\105\000\255\255\255\255\255\255\255\255\ \255\255\255\255\105\000\105\000\105\000\105\000\105\000\105\000\ \105\000\105\000\105\000\105\000\105\000\105\000\105\000\105\000\ \105\000\105\000\105\000\105\000\105\000\105\000\105\000\105\000\ \105\000\105\000\105\000\105\000\106\000\106\000\106\000\106\000\ \106\000\106\000\106\000\106\000\106\000\106\000\106\000\106\000\ \106\000\106\000\106\000\106\000\106\000\106\000\106\000\106\000\ \106\000\106\000\106\000\106\000\106\000\106\000\106\000\255\255\ \255\255\255\255\255\255\255\255\255\255\106\000\106\000\106\000\ \106\000\106\000\106\000\106\000\106\000\106\000\106\000\106\000\ \106\000\106\000\106\000\106\000\106\000\106\000\106\000\106\000\ \106\000\106\000\106\000\106\000\106\000\106\000\106\000\107\000\ \107\000\107\000\107\000\107\000\107\000\107\000\107\000\107\000\ \107\000\107\000\107\000\107\000\107\000\107\000\107\000\107\000\ \107\000\107\000\107\000\107\000\107\000\107\000\107\000\107\000\ \107\000\107\000\255\255\255\255\255\255\255\255\255\255\255\255\ \107\000\107\000\107\000\107\000\107\000\107\000\107\000\107\000\ \107\000\107\000\107\000\107\000\107\000\107\000\107\000\107\000\ \107\000\107\000\107\000\107\000\107\000\107\000\107\000\107\000\ \107\000\107\000\108\000\108\000\108\000\108\000\108\000\108\000\ \108\000\108\000\108\000\108\000\108\000\108\000\108\000\108\000\ \108\000\108\000\108\000\108\000\108\000\108\000\108\000\108\000\ \108\000\108\000\108\000\108\000\108\000\255\255\255\255\255\255\ \255\255\255\255\255\255\108\000\108\000\108\000\108\000\108\000\ \108\000\108\000\108\000\108\000\108\000\108\000\108\000\108\000\ \108\000\108\000\108\000\108\000\108\000\108\000\108\000\108\000\ \108\000\108\000\108\000\108\000\108\000\109\000\109\000\109\000\ \109\000\109\000\109\000\109\000\109\000\109\000\109\000\109\000\ \109\000\109\000\109\000\109\000\109\000\109\000\109\000\109\000\ \109\000\109\000\109\000\109\000\109\000\109\000\109\000\109\000\ \255\255\255\255\255\255\255\255\255\255\255\255\109\000\109\000\ \109\000\109\000\109\000\109\000\109\000\109\000\109\000\109\000\ \109\000\109\000\109\000\109\000\109\000\109\000\109\000\109\000\ \109\000\109\000\109\000\109\000\109\000\109\000\109\000\109\000\ \110\000\110\000\110\000\110\000\110\000\110\000\110\000\110\000\ \110\000\110\000\110\000\110\000\110\000\110\000\110\000\110\000\ \110\000\110\000\110\000\110\000\110\000\110\000\110\000\110\000\ \110\000\110\000\255\255\159\000\255\255\255\255\255\255\255\255\ \110\000\110\000\110\000\110\000\110\000\110\000\110\000\110\000\ \110\000\110\000\110\000\110\000\110\000\110\000\110\000\110\000\ \110\000\110\000\110\000\110\000\110\000\110\000\110\000\110\000\ \110\000\110\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\255\255\255\255\255\255\255\255\ \255\255\255\255\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\111\000\111\000\111\000\111\000\ \111\000\111\000\111\000\111\000\114\000\114\000\114\000\114\000\ \114\000\114\000\114\000\114\000\114\000\114\000\114\000\114\000\ \114\000\114\000\114\000\114\000\114\000\114\000\114\000\114\000\ \114\000\114\000\114\000\114\000\114\000\114\000\114\000\167\000\ \193\000\218\000\255\255\255\255\255\255\114\000\114\000\114\000\ \114\000\114\000\114\000\114\000\114\000\114\000\114\000\114\000\ \114\000\114\000\114\000\114\000\114\000\114\000\114\000\114\000\ \114\000\114\000\114\000\114\000\114\000\114\000\114\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\134\000\255\255\255\255\255\255\255\255\134\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ \115\000\115\000\255\255\141\000\255\255\255\255\255\255\134\000\ \255\255\255\255\134\000\135\000\135\000\135\000\135\000\135\000\ \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ \135\000\135\000\135\000\135\000\135\000\135\000\255\255\134\000\ \141\000\159\000\134\000\141\000\135\000\135\000\135\000\135\000\ \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ \135\000\135\000\135\000\135\000\135\000\135\000\137\000\255\255\ \141\000\255\255\255\255\141\000\255\255\255\255\187\000\255\255\ \153\000\255\255\255\255\142\000\255\255\255\255\255\255\255\255\ \142\000\255\255\255\255\255\255\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\255\255\ \142\000\153\000\187\000\142\000\255\255\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ \137\000\137\000\137\000\137\000\137\000\137\000\137\000\138\000\ \142\000\153\000\187\000\142\000\255\255\167\000\193\000\218\000\ \255\255\255\255\255\255\255\255\169\000\175\000\255\255\255\255\ \255\255\169\000\255\255\255\255\255\255\138\000\138\000\138\000\ \138\000\138\000\138\000\138\000\138\000\138\000\138\000\138\000\ \138\000\138\000\138\000\138\000\138\000\138\000\138\000\138\000\ \138\000\138\000\138\000\138\000\138\000\138\000\138\000\138\000\ \255\255\169\000\175\000\135\000\169\000\175\000\138\000\138\000\ \138\000\138\000\138\000\138\000\138\000\138\000\138\000\138\000\ \138\000\138\000\138\000\138\000\138\000\138\000\138\000\138\000\ \138\000\138\000\138\000\138\000\138\000\138\000\138\000\138\000\ \139\000\169\000\175\000\255\255\169\000\175\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\176\000\255\255\255\255\ \255\255\255\255\176\000\255\255\255\255\255\255\139\000\139\000\ \139\000\139\000\139\000\139\000\139\000\139\000\139\000\139\000\ \139\000\139\000\139\000\139\000\139\000\139\000\139\000\139\000\ \139\000\139\000\139\000\139\000\139\000\139\000\139\000\139\000\ \139\000\255\255\176\000\255\255\255\255\176\000\255\255\139\000\ \139\000\139\000\139\000\139\000\139\000\139\000\139\000\139\000\ \139\000\139\000\139\000\139\000\139\000\139\000\139\000\139\000\ \139\000\139\000\139\000\139\000\139\000\139\000\139\000\139\000\ \139\000\140\000\176\000\255\255\255\255\176\000\224\000\224\000\ \224\000\224\000\224\000\224\000\224\000\224\000\224\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\140\000\ \140\000\140\000\140\000\140\000\140\000\140\000\140\000\140\000\ \140\000\140\000\140\000\140\000\140\000\140\000\140\000\140\000\ \140\000\140\000\140\000\140\000\140\000\140\000\140\000\140\000\ \140\000\140\000\255\255\255\255\255\255\255\255\255\255\255\255\ \140\000\140\000\140\000\140\000\140\000\140\000\140\000\140\000\ \140\000\140\000\140\000\140\000\140\000\140\000\140\000\140\000\ \140\000\140\000\140\000\140\000\140\000\140\000\140\000\140\000\ \140\000\140\000\170\000\170\000\170\000\170\000\170\000\170\000\ \170\000\170\000\170\000\170\000\170\000\170\000\170\000\170\000\ \170\000\170\000\170\000\170\000\170\000\170\000\170\000\170\000\ \170\000\170\000\170\000\170\000\170\000\255\255\255\255\255\255\ \255\255\255\255\255\255\170\000\170\000\170\000\170\000\170\000\ \170\000\170\000\170\000\170\000\170\000\170\000\170\000\170\000\ \170\000\170\000\170\000\170\000\170\000\170\000\170\000\170\000\ \170\000\170\000\170\000\170\000\170\000\171\000\228\000\228\000\ \228\000\228\000\228\000\228\000\228\000\228\000\228\000\228\000\ \240\000\240\000\240\000\240\000\240\000\240\000\240\000\240\000\ \240\000\240\000\255\255\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\255\255\255\255\ \255\255\255\255\255\255\255\255\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\171\000\171\000\ \171\000\171\000\171\000\171\000\171\000\171\000\172\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\172\000\172\000\172\000\172\000\ \172\000\172\000\172\000\172\000\172\000\172\000\172\000\172\000\ \172\000\172\000\172\000\172\000\172\000\172\000\172\000\172\000\ \172\000\172\000\172\000\172\000\172\000\172\000\172\000\255\255\ \255\255\255\255\170\000\255\255\255\255\172\000\172\000\172\000\ \172\000\172\000\172\000\172\000\172\000\172\000\172\000\172\000\ \172\000\172\000\172\000\172\000\172\000\172\000\172\000\172\000\ \172\000\172\000\172\000\172\000\172\000\172\000\172\000\173\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\173\000\173\000\173\000\ \173\000\173\000\173\000\173\000\173\000\173\000\173\000\173\000\ \173\000\173\000\173\000\173\000\173\000\173\000\173\000\173\000\ \173\000\173\000\173\000\173\000\173\000\173\000\173\000\173\000\ \255\255\255\255\255\255\255\255\255\255\255\255\173\000\173\000\ \173\000\173\000\173\000\173\000\173\000\173\000\173\000\173\000\ \173\000\173\000\173\000\173\000\173\000\173\000\173\000\173\000\ \173\000\173\000\173\000\173\000\173\000\173\000\173\000\173\000\ \174\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\174\000\174\000\ \174\000\174\000\174\000\174\000\174\000\174\000\174\000\174\000\ \174\000\174\000\174\000\174\000\174\000\174\000\174\000\174\000\ \174\000\174\000\174\000\174\000\174\000\174\000\174\000\174\000\ \174\000\255\255\255\255\255\255\255\255\255\255\255\255\174\000\ \174\000\174\000\174\000\174\000\174\000\174\000\174\000\174\000\ \174\000\174\000\174\000\174\000\174\000\174\000\174\000\174\000\ \174\000\174\000\174\000\174\000\174\000\174\000\174\000\174\000\ \174\000\201\000\202\000\203\000\255\255\219\000\221\000\255\255\ \222\000\255\255\241\000\242\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \201\000\202\000\203\000\219\000\221\000\201\000\222\000\203\000\ \241\000\242\000\221\000\255\255\222\000\255\255\241\000\242\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\230\000\ \230\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\255\255\255\255\255\255\201\000\202\000\203\000\230\000\ \230\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\230\000\230\000\230\000\230\000\230\000\230\000\230\000\ \230\000\231\000\231\000\231\000\231\000\231\000\231\000\231\000\ \231\000\231\000\231\000\231\000\231\000\231\000\231\000\231\000\ \231\000\231\000\231\000\231\000\231\000\231\000\231\000\231\000\ \231\000\231\000\231\000\231\000\255\255\255\255\255\255\255\255\ \255\255\255\255\231\000\231\000\231\000\231\000\231\000\231\000\ \231\000\231\000\231\000\231\000\231\000\231\000\231\000\231\000\ \231\000\231\000\231\000\231\000\231\000\231\000\231\000\231\000\ \231\000\231\000\231\000\231\000\238\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\255\255\255\255\255\255\ \255\255\255\255\255\255\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\238\000\238\000\238\000\ \238\000\238\000\238\000\238\000\238\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\255\255\255\255\255\255\255\255\ \255\255\231\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\239\000\239\000\239\000\239\000\ \239\000\239\000\239\000\239\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255" } let rec main lexbuf = __ocaml_lex_main_rec lexbuf 0 and __ocaml_lex_main_rec lexbuf state = 895 match Lexing.engine lex_tables state lexbuf with 0 -> ( 900 "latexscan.mll" expand_command main skip_blanks "\\@hevea@percent" lexbuf ; main lexbuf) 900 | 1 -> ( 905 "latexscan.mll" expand_command main skip_blanks "\\@hevea@newline" lexbuf ; main lexbuf) | 2 -> ( 905 909 "latexscan.mll" expand_command main skip_blanks "\\@hevea@underscore" lexbuf ; main lexbuf) | 3 -> ( 912 "latexscan.mll" 910 expand_command main skip_blanks "\\@hevea@circ" lexbuf ; main lexbuf) | 4 -> ( 916 "latexscan.mll" let lxm = lexeme lexbuf in 915 (* ``$'' has nothing special *) let dodo = lxm <> "$" in if effective !alltt || not (is_plain '$') then begin Dest.put lxm ; main lexbuf (* vicious case ``$x$$y$'' *) 920 end else if dodo && not !display && !in_math then begin scan_this main "${}$" ; main lexbuf end else begin (* General case *) let math_env = if dodo then "*display" else "*math" in 925 if !in_math then begin in_math := pop stack_in_math ; if dodo then begin Dest.close_maths dodo end else begin 930 top_close_display () ; Dest.close_maths dodo end ; display := pop stack_display ; if !display then begin 935 Dest.item_display () end ; close_env math_env ; main lexbuf end else begin 940 push stack_in_math !in_math ; in_math := true ; let lexfun lb = if !display then Dest.item_display () ; push stack_display !display ; 945 if dodo then begin display := true ; Dest.open_maths dodo; end else begin Dest.open_maths dodo; 950 top_open_display () ; end; skip_blanks lb ; main lb in new_env math_env ; lexfun lexbuf 955 end end) | 5 -> ( 962 "latexscan.mll" expand_command main skip_blanks "\\@hevea@amper" lexbuf ; main lexbuf) 960 | 6 -> ( 966 "latexscan.mll" let lxm = lexeme lexbuf in begin if effective !alltt || not (is_plain '#') then Dest.put lxm 965 else let i = Char.code lxm.[1] - Char.code '1' in scan_arg (if !alltt_loaded then (fun arg -> 970 let old_alltt = !alltt in alltt := Stack.pop stack_alltt ; scan_this_may_cont main lexbuf (get_subst ()) arg ; alltt := old_alltt ; Stack.push stack_alltt old_alltt) 975 else (fun arg -> scan_this_may_cont main lexbuf (get_subst ()) arg)) i end ; main lexbuf) 980 | 7 -> ( 986 "latexscan.mll" let name = lexeme lexbuf in expand_command main skip_blanks name lexbuf ; main lexbuf) 985 | 8 -> ( 991 "latexscan.mll" expand_command main skip_blanks "\\@hevea@obrace" lexbuf ; main lexbuf) | 9 -> ( 990 994 "latexscan.mll" expand_command main skip_blanks "\\@hevea@cbrace" lexbuf ; main lexbuf) | 10 -> ( 996 "latexscan.mll" 995 ()) | 11 -> ( 998 "latexscan.mll" if effective !alltt then let lxm = lexeme lexbuf in Dest.put lxm 1000 else Dest.put_char ' '; main lexbuf) | 12 -> ( 1005 "latexscan.mll" 1005 let lxm = lexeme lexbuf in let lxm = check_case lxm in if !in_math then begin Dest.put_in_math lxm; end else 1010 Dest.put lxm ; main lexbuf) | 13 -> ( 1014 "latexscan.mll" let lxm = lexeme lexbuf in 1015 Dest.put lxm; main lexbuf) | 14 -> ( 1019 "latexscan.mll" expand_command main skip_blanks "\\@hevea@tilde" lexbuf ; 1020 main lexbuf ) | 15 -> ( 1023 "latexscan.mll" expand_command main skip_blanks "\\@hevea@question" lexbuf ; main lexbuf) 1025 | 16 -> ( 1026 "latexscan.mll" expand_command main skip_blanks "\\@hevea@excl" lexbuf ; main lexbuf) | 17 -> ( 1030 1030 "latexscan.mll" let lxm = lexeme_char lexbuf 0 in let lxm = check_case_char lxm in Dest.put (Dest.iso lxm) ; main lexbuf) 1035 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_main_rec lexbuf n and gobble_one_char lexbuf = __ocaml_lex_gobble_one_char_rec lexbuf 1 and __ocaml_lex_gobble_one_char_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 1040 0 -> ( 1036 "latexscan.mll" ()) | 1 -> ( 1037 "latexscan.mll" 1045 fatal ("Gobble at end of file")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_gobble_one_char_rec lexbuf n and complete_newline lexbuf = __ocaml_lex_complete_newline_rec lexbuf 2 and __ocaml_lex_complete_newline_rec lexbuf state = 1050 match Lexing.engine lex_tables state lexbuf with 0 -> ( 1040 "latexscan.mll" lexeme lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_complete_newline_rec lexbuf n 1055 and latex2html_latexonly lexbuf = __ocaml_lex_latex2html_latexonly_rec lexbuf 3 and __ocaml_lex_latex2html_latexonly_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 1060 1044 "latexscan.mll" () ) | 1 -> ( 1046 "latexscan.mll" latex2html_latexonly lexbuf) 1065 | 2 -> ( 1048 "latexscan.mll" fatal "End of file in latex2html_latexonly") | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_latex2html_latexonly_rec lexbuf n 1070 and latexonly lexbuf = __ocaml_lex_latexonly_rec lexbuf 4 and __ocaml_lex_latexonly_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 1052 "latexscan.mll" 1075 stop_other_scan true main lexbuf) | 1 -> ( 1054 "latexscan.mll" latexonly lexbuf) | 2 -> ( 1080 1056 "latexscan.mll" latex_comment lexbuf ; latexonly lexbuf) | 3 -> ( 1058 "latexscan.mll" let {arg=arg} = save_arg lexbuf in 1085 if arg = "latexonly" then begin top_close_block "" ; stop_other_scan false main lexbuf end else if arg = top stack_entry then begin let _ = pop stack_entry in 1090 push stack_out arg ; begin match Latexmacros.find (end_env arg) with _,(Subst body) -> scan_this_may_cont latexonly lexbuf (get_subst ()) (string_to_arg body) 1095 | _,_ -> raise (Misc.ScanError ("Bad closing macro in latexonly: ``"^arg^"''")) end end else latexonly lexbuf) 1100 | 4 -> ( 1074 "latexscan.mll" latexonly lexbuf) | 5 -> ( 1076 "latexscan.mll" 1105 if empty stack_lexbuf then () else begin let lexbuf = previous_lexbuf () in latexonly lexbuf end) 1110 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_latexonly_rec lexbuf n and latex_comment lexbuf = __ocaml_lex_latex_comment_rec lexbuf 5 and __ocaml_lex_latex_comment_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 1115 0 -> ( 1084 "latexscan.mll" ()) | 1 -> ( 1085 "latexscan.mll" 1120 latex_comment lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_latex_comment_rec lexbuf n and image lexbuf = __ocaml_lex_image_rec lexbuf 6 and __ocaml_lex_image_rec lexbuf state = 1125 match Lexing.engine lex_tables state lexbuf with 0 -> ( 1091 "latexscan.mll" stop_other_scan true main lexbuf) | 1 -> ( 1130 1093 "latexscan.mll" image lexbuf) | 2 -> ( 1095 "latexscan.mll" let lxm = lexeme lexbuf in 1135 Image.put lxm ; image_comment lexbuf ; image lexbuf) | 3 -> ( 1101 "latexscan.mll" 1140 let lxm = lexeme lexbuf in let i = Char.code (lxm.[1]) - Char.code '1' in scan_arg (scan_this_arg image) i ; image lexbuf) | 4 -> ( 1145 1106 "latexscan.mll" let lxm = lexeme lexbuf in Save.start_echo () ; let {arg=arg} = save_arg lexbuf in let true_arg = Save.get_echo () in 1150 if arg = "toimage" then begin top_close_block "" ; stop_other_scan false main lexbuf end else if arg = top stack_entry then begin let _ = pop stack_entry in 1155 push stack_out arg ; begin match Latexmacros.find (end_env arg) with _,(Subst body) -> scan_this_may_cont image lexbuf (get_subst ()) (string_to_arg body) 1160 | _,_ -> raise (Misc.ScanError ("Bad closing macro in image: ``"^arg^"''")) end end else begin Image.put lxm ; Image.put true_arg ; image lexbuf 1165 end) | 5 -> ( 1127 "latexscan.mll" let lxm = lexeme lexbuf in begin match lxm with 1170 (* Definitions of simple macros, bodies are not substituted *) | "\\def" | "\\gdef" -> Save.start_echo () ; skip_csname lexbuf ; skip_blanks lexbuf ; 1175 let _ = Save.defargs lexbuf in let _ = save_arg lexbuf in Image.put lxm ; let saved = Save.get_echo () in Image.put saved 1180 | "\\renewcommand" | "\\newcommand" | "\\providecommand" | "\\renewcommand*" | "\\newcommand*" | "\\providecommand*" -> Save.start_echo () ; let _ = save_arg lexbuf in let _ = save_opts ["0" ; ""] lexbuf in 1185 let _ = save_arg lexbuf in Image.put lxm ; let saved = Save.get_echo () in Image.put saved | "\\newenvironment" | "\\renewenvironment" 1190 | "\\newenvironment*" | "\\renewenvironment*" -> Save.start_echo () ; let _ = save_arg lexbuf in let _ = save_opts ["0" ; ""] lexbuf in let _ = save_arg lexbuf in 1195 let _ = save_arg lexbuf in Image.put lxm ; Image.put (Save.get_echo ()) | _ -> Image.put lxm end ; image lexbuf) 1200 | 6 -> ( 1160 "latexscan.mll" let s = lexeme lexbuf in Image.put s ; image lexbuf) 1205 | 7 -> ( 1164 "latexscan.mll" if empty stack_lexbuf then begin if not filter && top_lexstate () then raise (Misc.ScanError ("No \\end{document} found")) 1210 end else begin let lexbuf = previous_lexbuf () in image lexbuf end) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_image_rec lexbuf n 1215 and image_comment lexbuf = __ocaml_lex_image_comment_rec lexbuf 7 and __ocaml_lex_image_comment_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 1220 1174 "latexscan.mll" Image.put_char '\n') | 1 -> ( 1175 "latexscan.mll" ()) 1225 | 2 -> ( 1177 "latexscan.mll" let lxm = lexeme lexbuf in Image.put lxm ; image_comment lexbuf) 1230 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_image_comment_rec lexbuf n and mbox_arg lexbuf = __ocaml_lex_mbox_arg_rec lexbuf 8 and __ocaml_lex_mbox_arg_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 1235 0 -> ( 1182 "latexscan.mll" mbox_arg lexbuf) | 1 -> ( 1184 "latexscan.mll" 1240 if not (empty stack_lexbuf) then begin let lexbuf = previous_lexbuf () in if !verbose > 2 then begin prerr_endline "Poping lexbuf in mbox_arg" ; pretty_lexbuf lexbuf 1245 end ; mbox_arg lexbuf end else raise (Misc.ScanError "End of file in \\mbox argument")) | 2 -> ( 1193 "latexscan.mll" 1250 start_mbox ()) | 3 -> ( 1195 "latexscan.mll" raise (Misc.ScanError "Cannot find a \\mbox argument here, use braces")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_mbox_arg_rec lexbuf n 1255 and no_skip lexbuf = __ocaml_lex_no_skip_rec lexbuf 9 and __ocaml_lex_no_skip_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 1260 1198 "latexscan.mll" ()) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_no_skip_rec lexbuf n and skip_blanks_pop lexbuf = __ocaml_lex_skip_blanks_pop_rec lexbuf 10 1265 and __ocaml_lex_skip_blanks_pop_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 1201 "latexscan.mll" skip_blanks_pop lexbuf) 1270 | 1 -> ( 1202 "latexscan.mll" more_skip_pop lexbuf) | 2 -> ( 1203 "latexscan.mll" 1275 ()) | 3 -> ( 1205 "latexscan.mll" if not (empty stack_lexbuf) then begin let lexbuf = previous_lexbuf () in 1280 if !verbose > 2 then begin prerr_endline "Poping lexbuf in skip_blanks" ; pretty_lexbuf lexbuf end ; skip_blanks_pop lexbuf 1285 end else ()) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_blanks_pop_rec lexbuf n and more_skip_pop lexbuf = __ocaml_lex_more_skip_pop_rec lexbuf 11 and __ocaml_lex_more_skip_pop_rec lexbuf state = 1290 match Lexing.engine lex_tables state lexbuf with 0 -> ( 1215 "latexscan.mll" top_par (par_val !in_table)) | 1 -> ( 1295 1216 "latexscan.mll" skip_blanks_pop lexbuf) | 2 -> ( 1218 "latexscan.mll" if not (empty stack_lexbuf) then begin 1300 let lexbuf = previous_lexbuf () in if !verbose > 2 then begin prerr_endline "Poping lexbuf in skip_blanks" ; pretty_lexbuf lexbuf end ; 1305 more_skip_pop lexbuf end else ()) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_more_skip_pop_rec lexbuf n and to_newline lexbuf = __ocaml_lex_to_newline_rec lexbuf 12 1310 and __ocaml_lex_to_newline_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 1228 "latexscan.mll" ()) 1315 | 1 -> ( 1229 "latexscan.mll" Out.put_char more_buff (Lexing.lexeme_char lexbuf 0) ; to_newline lexbuf) | 2 -> ( 1320 1232 "latexscan.mll" if not (empty stack_lexbuf) then let lexbuf = previous_lexbuf () in to_newline lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_to_newline_rec lexbuf n 1325 and skip_blanks lexbuf = __ocaml_lex_skip_blanks_rec lexbuf 13 and __ocaml_lex_skip_blanks_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 1330 1237 "latexscan.mll" skip_blanks lexbuf) | 1 -> ( 1238 "latexscan.mll" more_skip lexbuf) 1335 | 2 -> ( 1239 "latexscan.mll" ()) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_blanks_rec lexbuf n 1340 and more_skip lexbuf = __ocaml_lex_more_skip_rec lexbuf 14 and __ocaml_lex_more_skip_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 1242 "latexscan.mll" 1345 top_par (par_val !in_table)) | 1 -> ( 1243 "latexscan.mll" skip_blanks lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_more_skip_rec lexbuf n 1350 and skip_spaces lexbuf = __ocaml_lex_skip_spaces_rec lexbuf 15 and __ocaml_lex_skip_spaces_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 1355 1246 "latexscan.mll" ()) | 1 -> ( 1247 "latexscan.mll" ()) 1360 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_spaces_rec lexbuf n and skip_false lexbuf = __ocaml_lex_skip_false_rec lexbuf 16 and __ocaml_lex_skip_false_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 1365 0 -> ( 1252 "latexscan.mll" if is_plain '%' then skip_comment lexbuf ; skip_false lexbuf) | 1 -> ( 1370 1255 "latexscan.mll" skip_false lexbuf) | 2 -> ( 1257 "latexscan.mll" if_level := !if_level + 1 ; 1375 skip_false lexbuf) | 3 -> ( 1260 "latexscan.mll" skip_false lexbuf) | 4 -> ( 1380 1262 "latexscan.mll" if !if_level = 0 then skip_blanks lexbuf else skip_false lexbuf) | 5 -> ( 1265 "latexscan.mll" 1385 skip_false lexbuf) | 6 -> ( 1267 "latexscan.mll" if !if_level = 0 then begin skip_blanks lexbuf 1390 end else begin if_level := !if_level -1 ; skip_false lexbuf end) | 7 -> ( 1395 1273 "latexscan.mll" skip_false lexbuf) | 8 -> ( 1274 "latexscan.mll" raise (Error "End of entry while skipping TeX conditional macro")) 1400 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_false_rec lexbuf n and comment lexbuf = __ocaml_lex_comment_rec lexbuf 17 and __ocaml_lex_comment_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 1405 0 -> ( 1278 "latexscan.mll" skip_comment lexbuf ; start_image_scan "" image lexbuf) | 1 -> ( 1281 "latexscan.mll" 1410 latex2html_latexonly lexbuf) | 2 -> ( 1283 "latexscan.mll" ()) | 3 -> ( 1415 1285 "latexscan.mll" skip_to_end_latex lexbuf) | 4 -> ( 1287 "latexscan.mll" skip_comment lexbuf ; more_skip lexbuf) 1420 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_comment_rec lexbuf n and skip_comment lexbuf = __ocaml_lex_skip_comment_rec lexbuf 18 and __ocaml_lex_skip_comment_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 1425 0 -> ( 1291 "latexscan.mll" if !verbose > 1 then prerr_endline ("Comment:"^lexeme lexbuf) ; if !flushing then Dest.flush_out () ) 1430 | 1 -> ( 1294 "latexscan.mll" raise (Misc.ScanError "Latex comment is not terminated")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_comment_rec lexbuf n 1435 and skip_to_end_latex lexbuf = __ocaml_lex_skip_to_end_latex_rec lexbuf 19 and __ocaml_lex_skip_to_end_latex_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 1298 "latexscan.mll" 1440 skip_comment lexbuf ; skip_spaces lexbuf) | 1 -> ( 1300 "latexscan.mll" skip_to_end_latex lexbuf) | 2 -> ( 1445 1301 "latexscan.mll" fatal ("End of file in %BEGIN LATEX ... %END LATEX")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_to_end_latex_rec lexbuf n ;; 1450 1302 "latexscan.mll" let _ = () ;; 1455 (* A few subst definitions, with 2 optional arguments *) def "\\makebox" (latex_pat ["" ; ""] 3) (Subst "\\warning{makebox}\\mbox{#3}") ; def "\\framebox" (latex_pat ["" ; ""] 3) 1460 (Subst "\\warning{framebox}\\fbox{#3}") ;; let check_alltt_skip lexbuf = 1465 if not (effective !alltt) then skip_blanks lexbuf and skip_pop lexbuf = save_lexstate () ; skip_blanks_pop lexbuf ; 1470 restore_lexstate () ;; let def_code name f = def_init name f let def_name_code name f = def_init name (f name) 1475 ;; def_code "\\@hevea@percent" (fun lexbuf -> 1480 if effective !alltt || not (is_plain '%') then begin let lxm = lexeme lexbuf in Dest.put lxm ; main lexbuf end else begin 1485 comment lexbuf end) ;; def_code "\\@hevea@newline" 1490 (fun lexbuf -> let lxm = complete_newline lexbuf in let nlnum = count_newlines lxm in if !Lexstate.withinLispComment then begin 1495 if !verbose > 2 then prerr_endline "NL caught after LispComment" ; raise (Misc.EndOfLispComment nlnum) (* QNC *) end else begin if effective !alltt then begin Dest.put_char '\n' ; 1500 Dest.put lxm end else if nlnum >= 1 then expand_command main skip_blanks "\\par" lexbuf else Dest.put_separator () 1505 end) ;; let sub_sup lxm lexbuf = if effective !alltt || not (is_plain lxm) then Dest.put_char lxm 1510 else if not !in_math then begin warning ("``"^Char.escaped lxm^"''occuring outside math mode") ; Dest.put_char lxm end else begin let sup,sub = match lxm with 1515 '^' -> let sup = save_arg lexbuf in let sub = save_sub lexbuf in sup,unoption sub | '_' -> 1520 let sub = save_arg lexbuf in let sup = save_sup lexbuf in unoption sup,sub | _ -> assert false in Dest.standard_sup_sub (scan_this_arg main) (fun () -> ()) sup sub !display 1525 end ;; def_code "\\@hevea@underscore" (fun lexbuf -> sub_sup '_' lexbuf) ; def_code "\\@hevea@circ" (fun lexbuf -> sub_sup '^' lexbuf) 1530 ;; def_code "\\mathop" (fun lexbuf -> let symbol = save_arg lexbuf in 1535 let {limits=limits ; sup=sup ; sub=sub} = save_sup_sub lexbuf in begin match limits with | (Some Limits|None) when !display -> Dest.limit_sup_sub (scan_this_arg main) 1540 (fun _ -> scan_this_arg main symbol) sup sub !display | (Some IntLimits) when !display -> Dest.int_sup_sub true 3 (scan_this_arg main) (fun () -> scan_this_arg main symbol) 1545 sup sub !display | _ -> scan_this_arg main symbol ; Dest.standard_sup_sub (scan_this_arg main) 1550 (fun _ -> ()) sup sub !display end) ;; 1555 def_code "\\@hevea@obrace" (fun _ -> if !activebrace && is_plain '{' then top_open_group () else begin 1560 Dest.put_char '{' end) ; def_code "\\bgroup" (fun lexbuf -> 1565 top_open_group () ; check_alltt_skip lexbuf) ;; def_code "\\@hevea@cbrace" 1570 (fun _ -> if !activebrace && is_plain '}' then begin top_close_group () end else begin Dest.put_char '}' 1575 end) ; def_code "\\egroup" (fun lexbuf -> top_close_group () ; check_alltt_skip lexbuf) 1580 ;; def_code "\\@hevea@tilde" (fun lexbuf -> 1585 if effective !alltt || not (is_plain '~') then Dest.put_char '~' else Dest.put_nbsp ()) ;; 1590 def_code "\\@hevea@question" (fun lexbuf -> if if_next_char '`' lexbuf then begin gobble_one_char lexbuf ; if effective !alltt then Dest.put "?`" 1595 else Dest.put (Dest.iso '') end else Dest.put_char '?') ;; 1600 def_code "\\@hevea@excl" (fun lexbuf -> if if_next_char '`' lexbuf then begin gobble_one_char lexbuf ; if effective !alltt then Dest.put "!`" 1605 else Dest.put (Dest.iso '') end else Dest.put_char '!') ;; 1610 let get_this_main arg = get_this_string main arg let check_this_main s = if !verbose > 1 then prerr_endline ("check_this: ``"^s^"''"); 1615 start_normal (get_subst ()) ; let save_par = Dest.forget_par () in Dest.open_block "TEMP" ""; let r = try 1620 scan_this main s ; true with | x -> false in Dest.erase_block "TEMP" ; 1625 Dest.par save_par ; end_normal () ; if !verbose > 1 then prerr_endline ("check_this: ``"^s^"'' = "^sbool r); r 1630 let get_prim_onarg arg = let plain_sub = is_plain '_' and plain_sup = is_plain '^' and plain_dollar = is_plain '$' 1635 and plain_amper = is_plain '&' in unset_plain '_' ; unset_plain '^' ; unset_plain '$' ; unset_plain '&' ; let r = do_get_this start_normal end_normal Dest.nostyle 1640 main arg in plain_back plain_sub '_' ; plain_back plain_sup '^' ; plain_back plain_dollar '$' ; plain_back plain_amper '&' ; r 1645 let get_prim s = get_prim_onarg (string_to_arg s) let get_prim_arg lexbuf = let arg = save_arg lexbuf in get_prim_onarg arg 1650 and get_prim_opt def lexbuf = let arg = save_opt def lexbuf in get_prim_onarg arg 1655 let get_csname lexbuf = protect_save_string (fun lexbuf -> Save.csname lexbuf get_prim Subst.subst_this) lexbuf 1660 let def_fun name f = def_code name (fun lexbuf -> 1665 let arg = subst_arg lexbuf in scan_this main (f arg)) ;; (* Paragraphs *) 1670 let do_unskip () = let _ = Dest.forget_par () in Dest.unskip () ;; 1675 def_code "\\unskip" (fun lexbuf -> do_unskip () ; check_alltt_skip lexbuf) ;; 1680 def_code "\\par" (fun lexbuf -> match par_val !in_table with | None -> 1685 Dest.put_char ' ' ; check_alltt_skip lexbuf | pval -> top_par pval ; check_alltt_skip lexbuf) 1690 ;; (* Styles and packages *) let do_documentclass command lexbuf = 1695 Save.start_echo () ; let {arg=opt_arg} = save_opt "" lexbuf in let {arg=arg} = save_arg lexbuf in let real_args = Save.get_echo () in begin try if not !styleloaded then 1700 input_file 0 main (arg^".hva") with Myfiles.Except | Myfiles.Error _ -> raise (Misc.ScanError ("No base style")) end ; 1705 if command = "\\documentstyle" then begin let rec read_packages = function | [] -> () | pack :: rest -> scan_this main ("\\usepackage{"^pack^"}") ; 1710 read_packages rest in read_packages (Save.cite_arg (Lexing.from_string ("{"^opt_arg^"}"))) end ; Image.start () ; 1715 Image.put command ; Image.put real_args ; Image.put_char '\n' ; Dest.set_out (mk_out_file ()) ; Dest.stop () 1720 ;; def_name_code "\\documentstyle" do_documentclass ; def_name_code "\\documentclass" do_documentclass ;; 1725 let do_input lxm lexbuf = Save.start_echo () ; let arg = get_prim_arg lexbuf in 1730 let echo_arg = Save.get_echo () in if lxm <> "\\include" || check_include arg then begin let filename = if lxm = "\\bibliography" then Parse_opts.base_in^".bbl" else arg in 1735 begin try input_file !verbose main filename with Myfiles.Except -> Image.put lxm ; Image.put echo_arg ; 1740 Image.put "\n" ; | Myfiles.Error _ -> () end end ;; 1745 def_code "\\input" (do_input "\\input") ; def_code "\\include" (do_input "\\include") ; def_code "\\bibliography" (do_input "\\bibliography") ;; 1750 (* Command definitions *) let do_newcommand lxm lexbuf = Save.start_echo () ; 1755 let name = get_csname lexbuf in let nargs = save_opts ["0" ; ""] lexbuf in let body = subst_body lexbuf in let echo () = if echo_toimage () && lxm <> "\\@forcecommand" then begin 1760 Image.put lxm ; Image.put (Save.get_echo ()) ; Image.put_char '\n' end in let nargs,(def,defval) = match nargs with 1765 [a1 ; a2] -> Get.get_int (from_ok a1), (match a2 with | {arg=No s ; subst=env} -> false,mkarg s env | {arg=Yes s ; subst=env} -> true,mkarg s env) 1770 | _ -> assert false in let pat = latex_pat (if def then [do_subst_this defval] else []) nargs in match lxm with | "\\@forcecommand" -> Latexmacros.def name pat (Subst body) 1775 | "\\newcommand"|"\\newcommand*" -> echo () ; if Latexmacros.exists name then warning ("Ignoring (re-)definition of ``"^name^"'' by \\newcommand") else begin 1780 Latexmacros.def name pat (Subst body) end | "\\renewcommand"|"\\renewcommand*" -> if not (Latexmacros.exists name) then begin warning ("Defining ``"^name^"'' by \\renewcommand") 1785 end else echo () ; Latexmacros.def name pat (Subst body) | _ -> echo () ; 1790 if not (Latexmacros.exists name) then Latexmacros.def name pat (Subst body) ;; def_name_code "\\renewcommand" do_newcommand ; 1795 def_name_code "\\renewcommand*" do_newcommand ; def_name_code "\\newcommand" do_newcommand ; def_name_code "\\newcommand*" do_newcommand ; def_name_code "\\providecommand" do_newcommand ; def_name_code "\\providecommand*" do_newcommand ; 1800 def_name_code "\\@forcecommand" do_newcommand ;; def_name_code "\\newcolumntype" (fun lxm lexbuf -> 1805 Save.start_echo () ; let old_raw = !raw_chars in raw_chars := true ; let name = get_prim_arg lexbuf in raw_chars := old_raw ; 1810 let nargs = save_opt "0" lexbuf in let body = subst_body lexbuf in let rest = Save.get_echo () in if echo_toimage () then Image.put (lxm^rest^"\n") ; 1815 let col_cmd = Misc.column_to_command name in if Latexmacros.exists col_cmd then warning ("Not (re)-defining column type ``"^name^"'' with \\newcolumntype") else 1820 Latexmacros.def col_cmd (latex_pat [] (Get.get_int nargs)) (Subst body)) ;; 1825 let do_newenvironment lxm lexbuf = Save.start_echo () ; let name = get_prim_arg lexbuf in let nargs,optdef = match save_opts ["0" ; ""] lexbuf with 1830 | [x ; y ] -> x,y | _ -> assert false in let body1 = subst_body lexbuf in let body2 = subst_body lexbuf in if echo_toimage () then 1835 Image.put (lxm^Save.get_echo ()^"\n") ; let do_defs () = Latexmacros.def (start_env name) 1840 (latex_pat (match optdef with | {arg=No _} -> [] | {arg=Yes s ; subst=env} -> [do_subst_this (mkarg s env)]) (match nargs with 1845 | {arg=No _} -> 0 | {arg=Yes s ; subst=env} -> Get.get_int (mkarg s env))) (Subst body1) ; Latexmacros.def (end_env name) zero_pat (Subst body2) in 1850 if lxm = "\\newenvironment" || lxm = "\\newenvironment*" then if Latexmacros.exists (start_env name) || Latexmacros.exists (start_env name) then 1855 warning ("Not (re)-defining environment ``"^name^"'' with "^lxm) else do_defs () else begin 1860 if not (Latexmacros.exists (start_env name) && Latexmacros.exists (start_env name)) then warning 1865 ("Defining environment ``"^name^"'' with "^lxm) ; do_defs () end ;; 1870 def_name_code "\\newenvironment" do_newenvironment ; def_name_code "\\newenvironment*" do_newenvironment ; def_name_code "\\renewenvironment" do_newenvironment ; def_name_code "\\renewenvironment*" do_newenvironment ;; 1875 let do_newcounter name within = try Counter.def_counter name within ; Latexmacros.global_def 1880 ("\\the"^name) zero_pat (Subst ("\\arabic{"^name^"}")) with | Failed -> () let do_newtheorem lxm lexbuf = 1885 Save.start_echo () ; let name = get_prim_arg lexbuf in let numbered_like = match save_opts [""] lexbuf with | [x] -> x | _ -> assert false in 1890 let caption = subst_arg lexbuf in let within = match save_opts [""] lexbuf with | [x] -> x | _ -> assert false in if echo_global_toimage () then 1895 Image.put (lxm^Save.get_echo ()^"\n") ; let cname = match numbered_like,within with {arg=No _},{arg=No _} -> do_newcounter name "" ; name | _,{arg=Yes _} -> 1900 let within = get_prim_onarg (from_ok within) in do_newcounter name within ; name | {arg=Yes _},_ -> get_prim_onarg (from_ok numbered_like) in Latexmacros.global_def 1905 (start_env name) (latex_pat [""] 1) (Subst ("\\begin{flushleft}\\refstepcounter{"^cname^"}{\\bf "^caption^"~"^ "\\the"^cname^"}\\quad\\ifoptarg{\\purple[#1]\\quad}\\fi\\em")) ; Latexmacros.global_def 1910 (end_env name) zero_pat (Subst "\\end{flushleft}") ;; def_name_code "\\newtheorem" do_newtheorem ; 1915 def_name_code "\\renewtheorem" do_newtheorem ;; (* Command definitions, TeX style *) 1920 let do_def global lxm lexbuf = Save.start_echo () ; let name = get_csname lexbuf in Save.skip_blanks_init lexbuf ; let name,args_pat,body = 1925 if top_level () then let args_pat = Save.defargs lexbuf in let {arg=body} = save_arg lexbuf in name,args_pat,body else 1930 let args_pat = Save.defargs (Lexing.from_string (subst_this (Save.get_defargs lexbuf))) in let body = subst_body lexbuf in 1935 name,args_pat,body in let real_args = Save.get_echo () in if echo_toimage () || (global && echo_global_toimage ()) then begin Image.put (lxm^real_args) ; Image.put_char '\n' 1940 end ; (if global then global_def else def) name ([],args_pat) (Subst body) ;; 1945 def_name_code "\\def" (do_def false) ; def_name_code "\\gdef" (do_def true) ;; let do_let global lxm lexbuf = 1950 Save.start_echo () ; let name = get_csname lexbuf in Save.skip_equal lexbuf ; let alt = get_csname lexbuf in let real_args = Save.get_echo () in 1955 try let nargs,body = Latexmacros.find_fail alt in (if global then global_def else def) name nargs body ; if echo_toimage () || (global && echo_global_toimage ()) then begin 1960 Image.put lxm ; Image.put real_args ; Image.put "\n" end with 1965 | Failed -> warning ("Not binding "^name^" with "^lxm^", command "^alt^" does not exist") ;; def_name_code "\\let" (do_let false) ; 1970 ;; let do_global lxm lexbuf = let next = subst_arg lexbuf in begin match next with 1975 | "\\def" -> do_def true (lxm^next) lexbuf | "\\let" -> do_let true (lxm^next) lexbuf | _ -> warning "Ignored \\global" end ;; 1980 def_name_code "\\global" do_global ;; 1985 (* TeXisms *) def_code "\\noexpand" (fun lexbuf -> let arg = subst_arg lexbuf in 1990 Dest.put arg) ;; def_code "\\execafter" (fun lexbuf -> 1995 let arg = save_arg lexbuf in let next_arg = save_arg lexbuf in let cur_subst = get_subst () in scan_this_may_cont main lexbuf cur_subst next_arg ; scan_this_may_cont main lexbuf cur_subst arg) 2000 ;; def_code "\\csname" (fun lexbuf -> 2005 skip_blanks lexbuf ; let name = "\\"^get_prim (Save.incsname lexbuf) in check_alltt_skip lexbuf ; expand_command main skip_blanks name lexbuf) ;; 2010 def_code "\\string" (fun lexbuf -> let arg = subst_arg lexbuf in Dest.put arg) 2015 ;; let get_num_arg lexbuf = Save.num_arg lexbuf (fun s -> Get.get_int (string_to_arg s)) ;; 2020 let top_plain c = if not (is_plain c) then begin set_plain c ; 2025 fun_register (fun () -> unset_plain c) end and top_unplain c = if is_plain c then begin 2030 unset_plain c ; fun_register (fun () -> set_plain c) end ;; 2035 def_code "\\catcode" (fun lexbuf -> let char = Char.chr (Get.get_int (save_arg_with_delim "=" lexbuf)) in let code = get_num_arg lexbuf in 2040 begin match char,code with | ('\\',0) | ('{',1) | ('}',2) | ('$',3) | ('&' ,4) | ('#',6) | ('^',7) | ('_',8) | ('~',13) | ('%',14) -> top_plain char | ('{',(11|12)) | ('}',(11|12)) | ('$',(11|12)) | ('&' ,(11|12)) | 2045 ('#',(11|12)) | ('^',(11|12)) | ('_',(11|12)) | ('~',(11|12)) | ('%',(11|12)) | ('\\',(11|12)) -> top_unplain char | _ -> warning "This \\catcode operation is not permitted" end ; 2050 main lexbuf) ;; def_code "\\chardef" (fun lexbuf -> 2055 let csname = get_csname lexbuf in Save.skip_equal lexbuf ; let i = get_num_arg lexbuf in Latexmacros.def csname zero_pat (Subst (string_of_int i))) ;; 2060 (* Complicated use of output blocks *) def_code "\\left" (fun lexbuf -> let dprev = !display in 2065 Stack.push stack_display dprev ; display := true ; if not dprev then top_open_display () ; let delim = subst_arg lexbuf in 2070 let {sub=sub ; sup=sup} = save_sup_sub lexbuf in Dest.left delim (fun vsize -> Dest.int_sup_sub false vsize (scan_this_arg main) (fun () -> ()) sup sub true)) 2075 ;; (* Display is true *) def_code "\\right" (fun lexbuf -> 2080 let delim = subst_arg lexbuf in let vsize = Dest.right delim in let {sup=sup ; sub=sub} = save_sup_sub lexbuf in let do_what = (fun () -> ()) in Dest.int_sup_sub false vsize 2085 (scan_this_arg main) do_what sup sub !display ; let dprev = Stack.pop stack_display in if not dprev then top_close_display () ; display := dprev) ;; 2090 def_code "\\over" (fun lexbuf -> Dest.over !display lexbuf; skip_blanks lexbuf) 2095 ;; let check_not = function | "\\in" -> "\\notin" | "=" -> "\\neq" 2100 | "\\subset" -> "\\notsubset" | s -> "\\neg\\:"^s ;; def_fun "\\not" check_not 2105 ;; def_code "\\uppercase" (fun lexbuf -> let arg = save_arg lexbuf in 2110 let old_case = !case in case := Upper ; scan_this_arg main arg ; case := old_case) ; def_code "\\lowercase" 2115 (fun lexbuf -> let arg = save_arg lexbuf in let old_case = !case in case := Lower ; scan_this_arg main arg ; 2120 case := old_case) ;; (* list items *) def_code "\\@li" (fun _ -> Dest.item ()) ; 2125 def_code "\\@linum" (fun _ -> Dest.nitem ()) ; def_code "\\@dt" (fun lexbuf -> let arg = subst_arg lexbuf in Dest.ditem (scan_this main) arg ; 2130 check_alltt_skip lexbuf) ;; (* Html primitives *) 2135 def_code "\\@open" (fun lexbuf -> let tag = get_prim_arg lexbuf in let arg = get_prim_arg lexbuf in top_open_block tag arg) 2140 ;; def_code "\\@insert" (fun lexbuf -> let tag = get_prim_arg lexbuf in 2145 let arg = get_prim_arg lexbuf in Dest.insert_block tag arg ) ;; def_code "\\@close" 2150 (fun lexbuf -> let tag = get_prim_arg lexbuf in top_close_block tag) ;; 2155 def_code "\\@print" (fun lexbuf -> let {arg=arg} = save_arg lexbuf in Dest.put arg) ; ;; 2160 def_code "\\@printnostyle" (fun lexbuf -> let {arg=arg} = save_arg lexbuf in top_open_group () ; 2165 Dest.nostyle () ; Dest.put arg ; top_close_group ()) ;; 2170 def_code "\\@getprintnostyle" (fun lexbuf -> top_open_group () ; Dest.nostyle () ; let arg = get_prim_arg lexbuf in 2175 Dest.put arg ; top_close_group ()) ;; def_code "\\@getprint" 2180 (fun lexbuf -> let arg = get_prim_arg lexbuf in let buff = Lexing.from_string arg in Dest.put (Save.tagout buff)) ; ;; 2185 def_code "\\@subst" (fun lexbuf -> let arg = subst_arg lexbuf in Dest.put arg) 2190 ;; def_code "\\@notags" (fun lexbuf -> let arg = save_arg lexbuf in 2195 let arg = get_this_arg main arg in let r = let buff = Lexing.from_string arg in Save.tagout buff in Dest.put r) 2200 ;; def_code "\\@anti" (fun lexbuf -> let arg = save_arg lexbuf in let envs = get_style main arg in 2205 if !verbose > 2 then begin prerr_string ("Anti result: ") ; List.iter (fun s -> prerr_string (Element.pretty_text s^", ")) envs ; 2210 prerr_endline "" end ; Dest.erase_mods envs) ;; def_code "\\@style" 2215 (fun lexbuf -> let arg = get_prim_arg lexbuf in Dest.open_mod (Style arg) ) ;; def_code "\\@fontcolor" 2220 (fun lexbuf -> let arg = get_prim_arg lexbuf in Dest.open_mod (Color arg)) ;; def_code "\\@fontsize" 2225 (fun lexbuf -> let arg = save_arg lexbuf in Dest.open_mod (Font (Get.get_int arg)) ) ;; def_code "\\@nostyle" 2230 (fun lexbuf -> Dest.nostyle () ; check_alltt_skip lexbuf) ;; def_code "\\@clearstyle" (fun lexbuf -> Dest.clearstyle () ; check_alltt_skip lexbuf) ;; 2235 def_code "\\@incsize" (fun lexbuf -> let arg = save_arg lexbuf in inc_size (Get.get_int arg) ) ;; 2240 def_code "\\htmlcolor" (fun lexbuf -> let arg = get_prim_arg lexbuf in Dest.open_mod (Color ("\"#"^arg^"\"")) ) ;; 2245 def_code "\\usecounter" (fun lexbuf -> let arg = get_prim_arg lexbuf in Counter.set_counter arg 0 ; 2250 scan_this main ("\\let\\@currentlabel\\the"^arg) ; Dest.set_dcount arg ) ;; def_code "\\@fromlib" (fun lexbuf -> 2255 let arg = get_prim_arg lexbuf in start_lexstate (); Mysys.put_from_file (Filename.concat Mylib.libdir arg) Dest.put; restore_lexstate ()) ;; 2260 def_code "\\@imageflush" (fun lexbuf -> iput_newpage () ; check_alltt_skip lexbuf) ;; 2265 def_code "\\textalltt" (fun lexbuf -> let opt = get_prim_opt "CODE" lexbuf in let arg = save_arg lexbuf in let old = !alltt in 2270 scan_this main "\\mbox{" ; alltt := Inside ; Dest.open_group opt ; scan_this_arg main arg ; Dest.close_group () ; 2275 scan_this main "}" ; alltt := old ) ;; def_code "\\@itemdisplay" (fun lexbuf -> Dest.force_item_display ()) 2280 ;; def_code "\\@br" (fun lexbuf -> Dest.skip_line ()) ;; 2285 (* TeX conditionals *) let testif cell lexbuf = if !cell then check_alltt_skip lexbuf else skip_false lexbuf 2290 let setif cell b lexbuf = let old = !cell in fun_register (fun () -> cell := old) ; cell := b ; 2295 check_alltt_skip lexbuf ;; let extract_if name = let l = String.length name in 2300 if l <= 3 || String.sub name 0 3 <> "\\if" then raise (Error ("Bad newif: "^name)) ; String.sub name 3 (l-3) ;; 2305 let def_and_register name f = def name zero_pat (CamlCode f) ;; let tverb name cell lexbuf = 2310 if !verbose > 1 then Printf.fprintf stderr "Testing %s -> %b\n" name !cell ; testif cell lexbuf ;; 2315 let newif_ref name cell = def_and_register ("\\if"^name) (tverb name cell) ; def_and_register ("\\"^name^"true") (setif cell true) ; def_and_register ("\\"^name^"false") (setif cell false) ; 2320 register_cell name cell ; fun_register (fun () -> unregister_cell name) ;; let newif lexbuf = 2325 let arg = get_csname lexbuf in let saw_par = !Save.seen_par in begin try let name = extract_if arg in let cell = ref false in 2330 newif_ref name cell ; with Latexmacros.Failed -> () end ; if saw_par then begin top_par (par_val !in_table) 2335 end ;; exception FailedFirst ;; 2340 def_code "\\ifx" (fun lexbuf -> let arg1 = get_csname lexbuf in let arg2 = get_csname lexbuf in 2345 let r = try let m1 = try Latexmacros.find_fail arg1 with | Failed -> raise FailedFirst in 2350 let m2 = Latexmacros.find_fail arg2 in m1 = m2 with | FailedFirst -> begin 2355 try let _ = Latexmacros.find_fail arg2 in false with Failed -> true end | Failed -> false in if r then 2360 check_alltt_skip lexbuf else skip_false lexbuf) ;; def_code "\\ifu" 2365 (fun lexbuf -> let arg1 = get_csname lexbuf in try let _ = Latexmacros.find_fail arg1 in skip_false lexbuf 2370 with | Failed -> check_alltt_skip lexbuf) ;; def_code "\\newif" newif 2375 ;; def_code "\\else" (fun lexbuf -> skip_false lexbuf) ;; 2380 def_code "\\fi" (fun lexbuf -> check_alltt_skip lexbuf) ;; let sawdocument = ref false 2385 ;; newif_ref "symb" symbols ; newif_ref "iso" iso ; newif_ref "raw" raw_chars ; 2390 newif_ref "silent" silent; newif_ref "math" in_math ; newif_ref "mmode" in_math ; newif_ref "display" display ; newif_ref "french" french ; 2395 newif_ref "html" html; newif_ref "text" text; newif_ref "info" text; newif_ref "mathml" Parse_opts.mathml; newif_ref "entities" Parse_opts.entities; 2400 newif_ref "optarg" optarg; newif_ref "styleloaded" styleloaded; newif_ref "activebrace" activebrace; newif_ref "pedantic" pedantic ; newif_ref "fixpoint" fixpoint ; 2405 newif_ref "alltt@loaded" alltt_loaded ; newif_ref "filter" (ref filter) ; newif_ref "@sawdocument" sawdocument ; def_code "\\iftrue" (testif (ref true)) ; def_code "\\iffalse" (testif (ref false)) 2410 ;; def_code "\\if@toplevel" (fun lexbuf -> if echo_global_toimage () then check_alltt_skip lexbuf 2415 else skip_false lexbuf) ;; 2420 (* Bibliographies *) let bib_ref s1 s2 = scan_this main ("\\@bibref{"^s1^"}{"^s2^"}") ;; 2425 def_code "\\cite" (fun lexbuf -> let opt = save_opt "" lexbuf in check_alltt_skip lexbuf ; let args = List.map subst_this (Save.cite_arg lexbuf) in 2430 Dest.put_char '[' ; Dest.open_group "CITE" ; let rec do_rec = function [] -> () | [x] -> bib_ref x (Auxx.bget true x) 2435 | x::rest -> bib_ref x (Auxx.bget true x) ; Dest.put ", " ; do_rec rest in do_rec args ; 2440 if opt.arg <> "" then begin Dest.put ", " ; scan_this_arg main opt ; end ; Dest.close_group () ; 2445 Dest.put_char ']' ) ;; (* Includes *) def_code "\\includeonly" 2450 (fun lexbuf -> let arg = Save.cite_arg lexbuf in add_includes arg ) ;; 2455 (* Foot notes *) def_code "\\@stepanchor" (fun lexbuf -> let mark = Get.get_int (save_arg lexbuf) in 2460 Foot.step_anchor mark) ; def_code "\\@anchorval" (fun lexbuf -> let mark = Get.get_int (save_arg lexbuf) in Dest.put (string_of_int (Foot.get_anchor mark))) 2465 ;; def_code "\\@footnotetext" (fun lexbuf -> start_lexstate () ; 2470 let mark = Get.get_int (save_arg lexbuf) in let text = save_arg lexbuf in let text = do_get_this start_normal end_normal Dest.clearstyle 2475 main text in Foot.register mark (get_this_string main ("\\@fnmarknote{"^string_of_int mark^"}")) text ; 2480 restore_lexstate ()) ;; def_code "\\@footnoteflush" (fun lexbuf -> 2485 let sec_here = get_prim_arg lexbuf and sec_notes = get_prim "\\@footnotelevel" in start_lexstate () ; Foot.flush (scan_this main) sec_notes sec_here ; restore_lexstate ()) 2490 ;; (* Opening and closing environments *) 2495 def_code "\\begin" (fun lexbuf -> let cur_subst = get_subst () in let env = get_prim_arg lexbuf in new_env env ; 2500 top_open_block "" "" ; let macro = start_env env in let old_envi = save stack_entry in push stack_entry env ; begin try 2505 expand_command main no_skip macro lexbuf with | e -> restore stack_entry old_envi ; raise e 2510 end ; restore stack_entry old_envi) ;; 2515 def_code "\\@begin" (fun lexbuf -> let env = get_prim_arg lexbuf in new_env env ; top_open_block "" "") 2520 ;; def_code "\\end" (fun lexbuf -> let env = get_prim_arg lexbuf in 2525 expand_command main no_skip ("\\end"^env) lexbuf ; close_env env ; top_close_block "") ;; 2530 def_code "\\@raise@enddocument" (fun _ -> if not !sawdocument then fatal ("\\end{document} with no \\begin{document}") else if not (Stack.empty stack_env) then 2535 error_env "document" !cur_env else raise Misc.EndDocument) ;; 2540 def_code "\\@end" (fun lexbuf -> let env = get_prim_arg lexbuf in top_close_block "" ; close_env env) 2545 ;; let little_more lexbuf = to_newline lexbuf ; Out.to_string more_buff 2550 ;; def_code "\\endinput" (fun lexbuf -> let reste = little_more lexbuf in scan_this main reste ; 2555 raise Misc.EndInput) ;; (* Boxes *) 2560 def_code "\\mbox" (fun lexbuf -> mbox_arg lexbuf) ;; 2565 def_code "\\newsavebox" (fun lexbuf -> let name = get_csname lexbuf in try let _ = find_fail name in 2570 warning ("Not (re-)defining ``"^name^"'' with \\newsavebox") with | Failed -> global_def name zero_pat (CamlCode (fun _ -> ()))) ;; 2575 def_code "\\providesavebox" (fun lexbuf -> let name = get_csname lexbuf in try 2580 let _ = find_fail name in () with | Failed -> global_def name zero_pat (CamlCode (fun _ -> ()))) ;; 2585 let caml_print s = CamlCode (fun _ -> Dest.put s) let do_sbox global name body = if not (Latexmacros.exists name) then 2590 warning ("\\sbox on undefined bin ``"^name^"''") ; start_mbox () ; let to_print = get_this_arg main body in top_close_group () ; (if global then global_def else def) name zero_pat (caml_print to_print) 2595 ;; def_code "\\savebox" (fun lexbuf -> let name = get_csname lexbuf in 2600 warning "savebox"; skip_opt lexbuf ; skip_opt lexbuf ; let body = save_arg lexbuf in do_sbox false name body) 2605 ;; def_code "\\sbox" (fun lexbuf -> let name = get_csname lexbuf in 2610 let body = save_arg lexbuf in do_sbox false name body) ; def_code "\\gsbox" (fun lexbuf -> 2615 let name = get_csname lexbuf in let body = save_arg lexbuf in do_sbox true name body) ; ;; 2620 def_code "\\usebox" (fun lexbuf -> let name = get_csname lexbuf in top_open_group () ; Dest.nostyle () ; 2625 expand_command main skip_blanks name lexbuf ; top_close_group ()) ;; def_code "\\lrbox" 2630 (fun lexbuf -> close_env "lrbox" ; push stack_display !display ; display := false ; let name = get_csname lexbuf in 2635 Dest.open_aftergroup (fun s -> def name zero_pat (caml_print s) ; "") ; start_mbox ()) 2640 ;; def_code "\\endlrbox" (fun _ -> top_close_group () ; (* close mbox *) 2645 Dest.close_group () ; (* close after group *) display := pop stack_display ; new_env "lrbox") ;; 2650 (* chars *) def_code "\\char" (fun lexbuf -> let arg = get_num_arg lexbuf in 2655 if not !silent && (arg < 32 || (arg > 127 && arg < 161)) then begin Location.print_pos () ; prerr_endline ("Warning: \\char, check output"); end ; Dest.put (Dest.iso (Char.chr arg)) ; 2660 if not (effective !alltt) then check_alltt_skip lexbuf) ;; def_code "\\symbol" (fun lexbuf -> 2665 let arg = get_prim_arg lexbuf in scan_this main ("\\char"^arg)) ;; (* labels *) 2670 (* Counters *) let alpha_of_int i = String.make 1 (Char.chr (i-1+Char.code 'a')) and upalpha_of_int i = String.make 1 (Char.chr (i-1+Char.code 'A')) ;; 2675 let rec roman_of_int = function 0 -> "" | 1 -> "i" | 2 -> "ii" 2680 | 3 -> "iii" | 4 -> "iv" | 9 -> "ix" | i -> if i < 9 then "v"^roman_of_int (i-5) 2685 else let d = i / 10 and u = i mod 10 in String.make d 'x'^roman_of_int u ;; 2690 let uproman_of_int i = String.uppercase (roman_of_int i) ;; let fnsymbol_of_int = function 0 -> " " 2695 | 1 -> "*" | 2 -> "#" | 3 -> "%" | 4 -> "\167" | 5 -> "\182" 2700 | 6 -> "||" | 7 -> "**" | 8 -> "##" | 9 -> "%%" | i -> alpha_of_int (i-9) 2705 ;; let def_printcount name f = def_code name (fun lexbuf -> 2710 let cname = get_prim_arg lexbuf in let cval = Counter.value_counter cname in Dest.put (f cval)) ;; 2715 def_printcount "\\arabic" string_of_int ; def_printcount "\\alph" alpha_of_int ; def_printcount "\\Alph" upalpha_of_int ; def_printcount "\\roman" roman_of_int; def_printcount "\\Roman" uproman_of_int; 2720 def_printcount "\\fnsymbol" fnsymbol_of_int ;; let pad p l s = for i = l-String.length s downto 1 do 2725 Dest.put (Dest.iso_string p) done ;; def_code "\\@pad" 2730 (fun lexbuf -> let p = get_prim_arg lexbuf in let l = Get.get_int (save_arg lexbuf) in let arg = get_prim_arg lexbuf in pad p l arg ; 2735 Dest.put (Dest.iso_string arg)) ;; def_code "\\newcounter" (fun lexbuf -> 2740 Save.start_echo () ; let name = get_prim_arg lexbuf in let within = get_prim_opt "" lexbuf in let real_args = Save.get_echo () in if echo_global_toimage () then begin 2745 Image.put "\\newcounter" ; Image.put real_args ; Image.put_char '\n' end ; do_newcounter name within) 2750 ;; def_code "\\addtocounter" (fun lexbuf -> Save.start_echo () ; 2755 let name = get_prim_arg lexbuf in let arg = save_arg lexbuf in let real_args = Save.get_echo () in if echo_global_toimage () then begin Image.put "\\addtocounter" ; 2760 Image.put real_args ; Image.put_char '\n' end ; Counter.add_counter name (Get.get_int arg)) ;; 2765 def_code "\\setcounter" (fun lexbuf -> Save.start_echo () ; let name = get_prim_arg lexbuf in 2770 let arg = save_arg lexbuf in let real_args = Save.get_echo () in if echo_global_toimage () then begin Image.put "\\setcounter" ; Image.put real_args ; 2775 Image.put_char '\n' end ; Counter.set_counter name (Get.get_int arg) ) ;; 2780 def_code "\\stepcounter" (fun lexbuf -> Save.start_echo () ; let name = get_prim_arg lexbuf in let real_args = Save.get_echo () in 2785 if echo_global_toimage () then begin Image.put "\\stepcounter" ; Image.put real_args ; Image.put_char '\n' end ; 2790 Counter.step_counter name) ;; (* terminal output *) def_code "\\typeout" 2795 (fun lexbuf -> let what = get_prim_arg lexbuf in prerr_endline what ) ;; 2800 def_code "\\warning" (fun lexbuf -> let what = subst_arg lexbuf in warning what ) ;; 2805 (* spacing *) let stack_closed = Stack.create "stack_closed" ;; 2810 def_code "\\@saveclosed" (fun lexbuf -> push stack_closed (Dest.get_last_closed ()) ; check_alltt_skip lexbuf) 2815 ;; def_code "\\@restoreclosed" (fun lexbuf -> Dest.set_last_closed (pop stack_closed) ; 2820 check_alltt_skip lexbuf) ;; exception Cannot ;; 2825 def_code "\\@getlength" (fun lexbuf -> let arg = get_prim_arg lexbuf in let pxls = 2830 match Get.get_length arg with | Length.Pixel n -> n | Length.Char n -> Length.char_to_pixel n | _ -> 0 in Dest.put (string_of_int (pxls/2))) 2835 ;; let do_space vert lexbuf = let arg = subst_arg lexbuf in begin try 2840 let n = match Length.main (Lexing.from_string arg) with | Length.Char n -> n | Length.Pixel n -> Length.pixel_to_char n | _ -> raise Cannot in if vert then 2845 for i=1 to n do Dest.skip_line () done else for i=1 to n do 2850 Dest.put_nbsp (); (* "&nbsp;"*) done with Cannot -> warning ((if vert then "\\vspace" else "\\hspace")^ " with arg ``"^arg^"''") 2855 end ;; def_code "\\hspace" (fun lexbuf -> do_space false lexbuf) ; def_code "\\vspace" (fun lexbuf -> do_space true lexbuf) 2860 ;; (* Explicit groups *) def_code "\\begingroup" (fun lexbuf -> 2865 new_env "command-group" ; top_open_block "" "" ; check_alltt_skip lexbuf) ;; def_code "\\endgroup" 2870 (fun lexbuf -> top_close_block "" ; close_env !cur_env ; check_alltt_skip lexbuf) ;; 2875 (* alltt *) register_init "alltt" (fun () -> def_code "\\alltt" 2880 (fun _ -> if !verbose > 1 then prerr_endline "begin alltt" ; alltt := Inside ; fun_register (fun () -> alltt := Not) ; Dest.close_block "" ; Dest.open_block "PRE" "") ; 2885 def_code "\\endalltt" (fun _ -> if !verbose > 1 then prerr_endline "end alltt" ; Dest.close_block "PRE" ; Dest.open_block "" "")) 2890 ;; (* Multicolumn *) def_code "\\multicolumn" 2895 (fun lexbuf -> if not (is_table !in_table) then raise (ScanError "\\multicolumn should occur in some array") ; let n = Get.get_int (save_arg lexbuf) in let format = Tabular.main (save_arg lexbuf) in 2900 do_multi n format main) ;; def_code "\\hline" (fun lexbuf -> 2905 if not (is_table !in_table) then raise (ScanError "\\hline should occur in some array") ; do_hline main ; skip_blanks_pop lexbuf ; let _ = Dest.forget_par () in 2910 ()) ;; (* inside tabbing *) let do_tabul lexbuf = 2915 if is_tabbing !in_table then begin do_unskip () ; Dest.close_cell ""; Dest.open_cell default_format 1 0 end ; skip_blanks_pop lexbuf 2920 ;; def_code "\\>" do_tabul ; def_code "\\=" do_tabul ;; 2925 def_code "\\kill" (fun lexbuf -> if is_tabbing !in_table then begin do_unskip () ; 2930 Dest.close_cell ""; Dest.erase_row () ; Dest.new_row () ; Dest.open_cell default_format 1 0 end ; 2935 skip_blanks_pop lexbuf) ;; (* Tabular and arrays *) 2940 let check_width = function | Length.Char x -> " WIDTH="^string_of_int (Length.char_to_pixel x) 2945 | Length.Pixel x -> " WIDTH="^string_of_int x | Length.Percent x -> " WIDTH=\""^string_of_int x^"%\"" | _ -> "" 2950 ;; let get_table_attributes border len = let attrs = get_prim (if border then 2955 "\\@table@attributes@border" else "\\@table@attributes") in attrs^check_width len 2960 let open_tabbing lexbuf = let lexbuf = Lexstate.previous_lexbuf in let lexfun lb = Dest.open_table false "border=0 cellspacing=0 cellpadding=0" ; 2965 Dest.new_row (); Dest.open_cell default_format 1 0 in push stack_table !in_table ; in_table := Tabbing ; new_env "tabbing" ; 2970 def "\\a" zero_pat (CamlCode (fun lexbuf -> let acc = subst_arg lexbuf in let arg = subst_arg lexbuf in 2975 scan_this main ("\\"^acc^arg))) ; lexfun lexbuf ;; def_code "\\tabbing" open_tabbing 2980 ;; let close_tabbing _ = Dest.do_close_cell (); Dest.close_row (); 2985 Dest.close_table (); in_table := pop stack_table ; close_env "tabbing" ; ;; 2990 def_code "\\endtabbing" close_tabbing ;; let open_array env lexbuf = save_array_state (); 2995 Tabular.border := false ; let len = match env with | "tabular*"|"Tabular*" -> let arg = save_arg lexbuf in begin match Get.get_length (get_prim_onarg arg) with 3000 | Length.No s -> warning ("``tabular*'' with length argument: "^ do_subst_this arg) ; Length.Default | width -> width 3005 end | _ -> Length.Default in let attributes = match env with | "Tabular*" | "Array" | "Tabular" -> get_prim_opt "" lexbuf | _ -> skip_opt lexbuf ; "" in 3010 skip_opt lexbuf ; let format = save_arg lexbuf in let format = Tabular.main format in cur_format := format ; push stack_in_math !in_math ; 3015 in_table := Table {math = (env = "array") ; border = !Tabular.border} ; if !display then Dest.item_display () ; in_math := false ; 3020 push stack_display !display ; display := false ; begin match attributes with | "" -> if !Tabular.border then 3025 Dest.open_table true (get_table_attributes true len) else Dest.open_table false (get_table_attributes false len); | _ -> Dest.open_table !Tabular.border (attributes^check_width len) 3030 end ; open_row() ; open_first_col main ; skip_blanks_pop lexbuf ; ;; 3035 def_code "\\@array" (open_array "array") ; def_code "\\@tabular" (open_array "tabular") ; def_code "\\@tabular*" (open_array "tabular*") ;; 3040 def_code "\\@Array" (open_array "Array") ; def_code "\\@Tabular" (open_array "Tabular") ; def_code "\\@Tabular*" (open_array "Tabular*") ;; 3045 let close_array _ = do_unskip () ; close_last_col main "" ; close_last_row () ; 3050 Dest.close_table () ; restore_array_state () ; in_math := pop stack_in_math ; display := pop stack_display; if !display then Dest.item_display () ; 3055 ;; def_code "\\end@array" close_array ; def_code "\\end@tabular" close_array ; def_code "\\end@tabular*" close_array ; 3060 def_code "\\end@Array" close_array ; def_code "\\end@Tabular" close_array ; def_code "\\end@Tabular*" close_array ; ;; 3065 let do_amper lexbuf = if effective !alltt || not (is_plain '&') then begin let lxm = lexeme lexbuf in for i = 0 to String.length lxm -1 do 3070 Dest.put (Dest.iso lxm.[i]) done end else if is_table !in_table then begin close_col main "&nbsp;"; open_col main 3075 end ; if not (effective !alltt) && is_plain '&' then skip_blanks_pop lexbuf and do_bsbs lexbuf = do_unskip () ; 3080 skip_opt lexbuf ; if is_table !in_table then begin close_col main "&nbsp;" ; close_row () ; open_row () ; open_first_col main end else if is_tabbing !in_table then begin 3085 Dest.close_cell ""; Dest.close_row () ; Dest.new_row () ; Dest.open_cell default_format 1 0 end else begin 3090 if !display then warning "\\\\ in display mode, ignored" else Dest.skip_line () end ; 3095 skip_blanks_pop lexbuf ; let _ = Dest.forget_par () in () ;; def_code "\\@hevea@amper" do_amper ; 3100 def_code "\\\\" do_bsbs ; def_code "\\@HEVEA@amper" do_amper ; def_code "\\@HEVEA@bsbs" do_bsbs ; () ;; 3105 (* Other scanners *) def_code "\\latexonly" (fun lexbuf -> 3110 start_other_scan "latexonly" latexonly lexbuf) ;; def_code "\\toimage" (fun lexbuf -> 3115 start_image_scan "" image lexbuf) ;; def_code "\\@stopimage" (fun lexbuf -> 3120 Image.stop () ; check_alltt_skip lexbuf) ;; def_code "\\@restartimage" 3125 (fun lexbuf -> Image.restart () ; check_alltt_skip lexbuf) ;; 3130 def_code "\\@stopoutput" (fun lexbuf -> Dest.stop () ; 3135 check_alltt_skip lexbuf) ;; def_code "\\@restartoutput" (fun lexbuf -> 3140 Dest.restart () ; check_alltt_skip lexbuf) ;; 3145 (* Info format specific *) def_code "\\@infomenu" (fun lexbuf -> let arg = get_prim_arg lexbuf in 3150 Dest.infomenu arg) ;; def_code "\\@infonode" (fun lexbuf -> 3155 let opt = get_prim_opt "" lexbuf in let num = get_prim_arg lexbuf in let nom = get_prim_arg lexbuf in Dest.infonode opt num nom) ;; 3160 def_code "\\@infoextranode" (fun lexbuf -> let num = get_prim_arg lexbuf in let nom = get_prim_arg lexbuf in 3165 let text = get_prim_arg lexbuf in Dest.infoextranode num nom text) ;; def_code "\\@infoname" 3170 (fun lexbuf -> let arg = get_prim_arg lexbuf in Dest.loc_name arg) ;; 3175 let safe_len = function | Length.No _ -> Length.Default | l -> l ;; 3180 def_code "\\@printHR" (fun lexbuf -> let arg = get_prim_arg lexbuf in let taille = safe_len (Get.get_length (get_prim_arg lexbuf)) in Dest.horizontal_line arg taille (Length.Pixel 2)) 3185 ;; def_code"\\@hr" (fun lexbuf -> let attr = subst_opt "" lexbuf in 3190 let width = safe_len (Get.get_length (get_prim_arg lexbuf)) in let height = safe_len (Get.get_length (get_prim_arg lexbuf)) in Dest.horizontal_line attr width height) ;; 3195 (* Accents *) let aigu = function "a" -> "" | "e" -> "e" | "i" | "\\i" | "\\i " -> "" | "o" -> "" | "u" -> "" | "A" -> "" | "E" -> "E" | "I" | "\\I" | "\\I " -> "" 3200 | "O" -> "" | "U" -> "" | "y" -> "" | "Y" -> "" | "" | " " -> "'" | s -> s 3205 and grave = function "a" -> "a" | "e" -> "e" | "i" -> "" | "o" -> "" | "u" -> "" | "\\i" | "\\i " -> "" | "A" -> "A" | "E" -> "E" | "I" -> "" | "O" -> "" | "U" -> "" | "\\I" | "\\I " -> "" 3210 | "" | " " -> "`" | s -> s and circonflexe = function "a" -> "a" | "e" -> "e" | "i" -> "i" | "o" -> "o" | "u" -> "u" | "\\i" | "\\i " -> "i" 3215 | "A" -> "A" | "E" -> "E" | "I" -> "I" | "O" -> "O" | "U" -> "U" | "\\I" | "\\I " -> "I" | "" | " " -> "\\@print{^}" | s -> s 3220 and trema = function "a" -> "" | "e" -> "e" | "i" -> "i" | "o" -> "" | "u" -> "u" | "\\i" | "\\i " -> "i" | "A" -> "" | "E" -> "E" | "I" -> "I" | "O" -> "" | "U" -> "U" | "\\I" | "\\I " -> "I" 3225 | "" | " " -> "" | s -> s and cedille = function "c" -> "c" 3230 | "C" -> "C" | s -> s and tilde = function "a" -> "" | "A" -> "" 3235 | "o" -> "" | "O" -> "" | "n" -> "" | "N" -> "" | "" | " " -> "\\@print{~}" | s -> s ;; 3240 def_fun "\\'" aigu ; def_fun "\\`" grave ; 3245 def_fun "\\^" circonflexe ; def_fun "\\\"" trema ; def_fun "\\c" cedille ; def_fun "\\~" tilde ;; 3250 Get.init get_prim_onarg get_fun_result new_env close_env 3255 get_csname main ;; def_code "\\@primitives" 3260 (fun lexbuf -> let pkg = get_prim_arg lexbuf in exec_init pkg) ;; 3265 (* try e1 with _ -> e2 *) def_code "\\@try" (fun lexbuf -> let saved_location = Location.check () 3270 and env_saved = env_check () and saved = Hot.checkpoint () and saved_lexstate = Lexstate.check_lexstate () and saved_out = Dest.check () and saved_get = Get.check () 3275 and saved_aux = Auxx.check () in let e1 = save_arg lexbuf in let e2 = save_arg lexbuf in try top_open_block "TEMP" "" ; 3280 scan_this_arg main e1 ; top_close_block "TEMP" with e -> begin Location.hot saved_location ; env_hot env_saved ; 3285 Misc.print_verb 0 ("\\@try caught exception : "^Printexc.to_string e) ; Lexstate.hot_lexstate saved_lexstate ; Dest.hot saved_out ; Get.hot saved_get ; 3290 Auxx.hot saved_aux ; Hot.start saved ; scan_this_arg main e2 end) ;; 3295 def_code "\\@heveafail" (fun lexbuf -> let s = get_prim_arg lexbuf in raise (Misc.Purposly s)) 3300 ;; (* (* A la TeX ouput (more or less...) *) 3305 def_code "\\newwrite" (fun lexbuf -> let cmd = save_arg lexbuf in let file = ref stderr in def_code cmd 3310 (fun lexbuf -> let op = save_arg lexbuf in try match op with | "\\write" -> 3315 let what = subst_arg subst lexbuf in output_string !file what ; output_char !file '\n' | "\\closeout" -> close_out !file 3320 | "\\openout" -> let name = get_this_nostyle main (save_filename lexbuf) in file := open_out name | _ -> warning ("Unkown file operation: "^op) 3325 with Sys_error s -> warning ("TeX file error : "^s))) ;; let def_fileop me = 3330 def_code me (fun lexbuf -> let cmd = subst_arg lexbuf in scan_this_may_cont main lexbuf (cmd^me)) ;; 3335 def_fileop "\\write" ; def_fileop "\\openout" ; def_fileop "\\closeout" ;; 3340 *) <6>97 length.ml # end13 "length.mll" open Lexing let header = "$Id: length.mll,v 1.13 2001/06/06 16:52:52 maranget Exp $" 5 exception Cannot ;; let font = 10 10 ;; let font_float = float font ;; type t = 15 Char of int | Pixel of int | Percent of int | No of string | Default let pretty = function | Char x -> string_of_int x^" chars" | Pixel x -> string_of_int x^" pxls" 20 | Percent x -> string_of_int x^"%" | Default -> "default" | No s -> "*"^s^"*" let pixel_to_char x = (100 * x + 50)/(100 * font) 25 and char_to_pixel x = font * x let mk_char x = Char (truncate (0.5 +. x)) let mk_pixel x = Pixel (truncate (0.5 +. x)) and mk_percent x = Percent (truncate x) 30 ;; let convert unit x = match unit with | "ex"|"em" -> mk_char x | "pt" -> mk_pixel x 35 | "in" -> mk_char ((x *. 72.27) /. font_float) | "cm" -> mk_char ((x *. 28.47) /. font_float) | "mm" -> mk_char ((x *. 2.847) /. font_float) | "pc" -> mk_char ((x *. 12.0) /. font_float) | "@percent" -> mk_percent (100.0 *. x) 40 | _ -> No unit ;; let lex_tables = { Lexing.lex_base = 45 "\000\000\000\000\000\000\002\000\007\000\017\000\029\000\000\000\ \000\000\000\000\000\000\001\000\000\000\000\000\254\255\039\000\ \255\255"; Lexing.lex_backtrk = "\001\000\002\000\001\000\001\000\000\000\255\255\000\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\000\000\ \255\255"; Lexing.lex_default = "\255\255\255\255\003\000\003\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\000\000\255\255\ \000\000"; 50 Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\004\000\004\000\255\255\255\255\004\000\000\000\255\255\ \004\000\004\000\000\000\000\000\004\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \004\000\000\000\255\255\000\000\000\000\000\000\000\000\004\000\ \000\000\000\000\000\000\000\000\000\000\016\000\005\000\000\000\ \006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\ \006\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\ \007\000\015\000\015\000\015\000\015\000\015\000\015\000\015\000\ \015\000\015\000\015\000\005\000\000\000\006\000\006\000\006\000\ \006\000\006\000\006\000\006\000\006\000\006\000\006\000\015\000\ \015\000\015\000\015\000\015\000\015\000\015\000\015\000\015\000\ \015\000\000\000\000\000\011\000\000\000\009\000\012\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\013\000\000\000\ \008\000\000\000\010\000\000\000\014\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \255\255\000\000\255\255\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ "; Lexing.lex_check = "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\002\000\002\000\003\000\003\000\002\000\255\255\003\000\ \004\000\004\000\255\255\255\255\004\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \002\000\255\255\003\000\255\255\255\255\255\255\255\255\004\000\ \255\255\255\255\255\255\255\255\255\255\000\000\001\000\255\255\ \001\000\001\000\001\000\001\000\001\000\001\000\001\000\001\000\ \001\000\001\000\255\255\255\255\255\255\255\255\255\255\255\255\ \001\000\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\005\000\006\000\255\255\006\000\006\000\006\000\ \006\000\006\000\006\000\006\000\006\000\006\000\006\000\015\000\ \015\000\015\000\015\000\015\000\015\000\015\000\015\000\015\000\ \015\000\255\255\255\255\010\000\255\255\008\000\011\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\012\000\255\255\ \007\000\255\255\009\000\255\255\013\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \002\000\255\255\003\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ " } 55 let rec main_rule lexbuf = __ocaml_lex_main_rule_rec lexbuf 0 and __ocaml_lex_main_rule_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 60 57 "length.mll" let x,unit = positif lexbuf in convert unit (0.0 -. x)) | 1 -> ( 58 "length.mll" let x,unit = positif lexbuf in convert unit x) 65 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_main_rule_rec lexbuf n and positif lexbuf = __ocaml_lex_positif_rec lexbuf 1 and __ocaml_lex_positif_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 70 0 -> ( 62 "length.mll" let lxm = lexeme lexbuf in float_of_string lxm,unit lexbuf) | 1 -> ( 75 64 "length.mll" 1.0, "@percent") | 2 -> ( 65 "length.mll" raise Cannot) 80 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_positif_rec lexbuf n and unit lexbuf = __ocaml_lex_unit_rec lexbuf 2 and __ocaml_lex_unit_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 85 0 -> ( 67 "length.mll" unit lexbuf) | 1 -> ( 68 "length.mll" 90 lexeme lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_unit_rec lexbuf n ;; 95 70 "length.mll" open Lexing let main lexbuf = 100 try main_rule lexbuf with | Cannot -> let sbuf = lexbuf.lex_buffer in No (String.sub sbuf 0 lexbuf.lex_buffer_len) <6>98 lexstate.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: lexstate.ml,v 1.57 2001/02/12 10:05:37 maranget Exp $" open Misc 15 open Lexing open Stack 20 (* Commands nature *) type action = | Subst of string | Toks of string list | CamlCode of (Lexing.lexbuf -> unit) 25 let pretty_action acs = match acs with | Subst s -> Printf.fprintf stderr "{%s}" s 30 | Toks l -> List.iter (fun s -> Printf.fprintf stderr "{%s}, " s) l | CamlCode _ -> prerr_string "*code*" 35 type pat = string list * string list let pretty_pat (_,args) = 40 List.iter (fun s -> prerr_string s ; prerr_char ',') args let is_subst body = match body with | CamlCode _ -> false | _ -> true 45 let latex_pat opts n = let n_opts = List.length opts in let rec do_rec r i = if i <= n_opts then r 50 else do_rec (("#"^string_of_int i)::r) (i-1) in opts,do_rec [] n let zero_pat = latex_pat [] 0 and one_pat = latex_pat [] 1 55 (* Environments *) type subst = Top | Env of string arg array and 'a arg = {arg : 'a ; subst : subst } 60 let mkarg arg subst = {arg=arg ; subst=subst } type alltt = Not | Inside | Macro 65 let effective = function | Inside -> true | _ -> false 70 let subst = ref Top and alltt = ref Not let stack_subst = Stack.create "stack_subst" and stack_alltt = Stack.create_init "stack_alltt" Not 75 let get_subst () = !subst let set_subst s = subst := s let top_subst = Top 80 let pretty_subst = function | Top -> prerr_endline "Top level" | Env args -> 85 if Array.length args <> 0 then begin prerr_endline "Env: " ; for i = 0 to Array.length args - 1 do prerr_string "\t``" ; prerr_string args.(i).arg ; 90 prerr_endline "''" done end let rec pretty_subst_rec indent = function 95 | Top -> prerr_string indent ; prerr_endline "Top level" | Env args -> if Array.length args <> 0 then begin prerr_string indent ; prerr_endline "Env: " ; 100 for i = 0 to Array.length args - 1 do prerr_string indent ; prerr_string (" #"^string_of_int (i+1)^" ``"); prerr_string args.(i).arg ; prerr_endline "''" ; 105 pretty_subst_rec (" "^indent) args.(i).subst done end let full_pretty_subst s = pretty_subst_rec " " s 110 exception Error of string (* Status flags *) let display = ref false 115 and raw_chars = ref false and in_math = ref false and french = ref (match !Parse_opts.language with 120 | Parse_opts.Francais -> true | _ -> false) and optarg = ref false and styleloaded = ref false and activebrace = ref true and html = 125 ref (match !Parse_opts.destination with | Parse_opts.Html -> true | Parse_opts.Info | Parse_opts.Text -> false) and text = 130 ref (match !Parse_opts.destination with | Parse_opts.Html -> false | Parse_opts.Info | Parse_opts.Text -> true) and alltt_loaded = ref false 135 (* Additional variables for videoc *) and withinLispComment = ref false and afterLispCommentNewlines = ref 0 (* Additional flags for transformations *) ;; 140 type case = Upper | Lower | Neutral let case = ref Neutral ;; 145 let string_to_arg arg = {arg=arg ; subst= !subst } (* Stacks for flags *) let stack_in_math = Stack.create "stack_in_math" and stack_display = Stack.create "stack_display" 150 (* Stacks for entry stream *) let stack_lexbuf = Stack.create "stack_lexbuf" ;; 155 let pretty_lexbuf lb = let pos = lb.lex_curr_pos and len = String.length lb.lex_buffer in prerr_endline "Buff contents:" ; let size = if !verbose > 3 then len-pos else min (len-pos) 80 in if size <> len-pos then begin 160 prerr_string "<<" ; prerr_string (String.sub lb.lex_buffer pos (size/2)) ; prerr_string "... (omitted) ..." ; prerr_string (String.sub lb.lex_buffer (len-size/2-1) (size/2)) ; prerr_endline ">>" 165 end else prerr_endline ("<<"^String.sub lb.lex_buffer pos size^">>"); prerr_endline ("curr_pos="^string_of_int lb.lex_curr_pos); prerr_endline "End of buff" ;; 170 (* arguments inside macros*) type env = string array ref type closenv = string array t 175 (* catcodes *) 180 let plain_of_char = function | '{' -> 0 | '}' -> 1 | '$' -> 2 185 | '&' -> 3 | '#' -> 4 | '^' -> 5 | '_' -> 6 | '~' -> 7 190 | '\\' -> 8 | '%' -> 9 | c -> raise (Fatal ("Internal catcode table error: '"^String.make 1 c^"'")) 195 and plain = Array.create 10 true let is_plain c = plain.(plain_of_char c) and set_plain c = plain.(plain_of_char c) <- true 200 and unset_plain c = plain.(plain_of_char c) <- false and plain_back b c = plain.(plain_of_char c) <- b let top_level () = match !subst with Top -> true | _ -> false 205 and is_top = function | Top -> true | _ -> false 210 let prerr_args () = pretty_subst !subst let scan_arg lexfun i = let args = match !subst with 215 | Top -> [||] | Env args -> args in if i >= Array.length args then begin if !verbose > 1 then begin prerr_string ("Subst arg #"^string_of_int (i+1)^" -> not found") ; 220 pretty_subst !subst end ; raise (Error "Macro argument not found") end; let arg = args.(i) in 225 if !verbose > 1 then begin prerr_string ("Subst arg #"^string_of_int (i+1)^" -> ``"^arg.arg^"''") end ; let r = lexfun arg in 230 r and scan_body exec body args = match body with | CamlCode _|Toks _ -> exec body | Subst _ -> 235 let old_subst = !subst in subst := args ; let r = exec body in subst := old_subst ; r 240 (* Recoding and restoring lexbufs *) let record_lexbuf lexbuf subst = Stack.push stack_subst subst ; 245 Stack.push stack_lexbuf lexbuf ; and previous_lexbuf () = let lexbuf = Stack.pop stack_lexbuf in subst := Stack.pop stack_subst ; 250 lexbuf ;; (* Saving and restoring lexing status *) 255 let stack_lexstate = Stack.create "stack_lexstate" let top_lexstate () = Stack.empty stack_lexstate let save_lexstate () = 260 let old_stack = Stack.save stack_subst in Stack.push stack_subst !subst ; push stack_lexstate (Stack.save stack_lexbuf, Stack.save stack_subst) ; 265 Stack.restore stack_subst old_stack and restore_lexstate () = let lexbufs,substs = pop stack_lexstate in Stack.restore stack_lexbuf lexbufs ; 270 Stack.restore stack_subst substs ; subst := Stack.pop stack_subst (* Flags save and restore *) let save_flags () = 275 push stack_display !display ; push stack_in_math !in_math and restore_flags () = in_math := pop stack_in_math ; 280 display := pop stack_display (* Total ckeckpoint of lexstate *) type saved_lexstate = (Lexing.lexbuf Stack.saved * subst Stack.saved) Stack.saved * 285 bool Stack.saved * bool Stack.saved let check_lexstate () = save_lexstate () ; save_flags () ; 290 let r = Stack.save stack_lexstate, Stack.save stack_display, Stack.save stack_in_math in restore_lexstate () ; 295 restore_flags () ; r and hot_lexstate (l,d,m) = Stack.restore stack_lexstate l ; 300 Stack.restore stack_display d ; Stack.restore stack_in_math m ; restore_lexstate () ; restore_flags () ;; 305 (* Blank lexing status *) let start_lexstate () = save_lexstate () ; Stack.restore stack_lexbuf (Stack.empty_saved) ; 310 Stack.restore stack_subst (Stack.empty_saved) let start_lexstate_subst this_subst = start_lexstate () ; subst := this_subst 315 ;; let flushing = ref false ;; 320 let start_normal this_subst = start_lexstate () ; save_flags () ; display := false ; 325 in_math := false ; subst := this_subst and end_normal () = restore_flags () ; 330 restore_lexstate () ;; let full_save_arg eoferror mkarg parg lexfun lexbuf = let rec save_rec lexbuf = 335 try let arg = lexfun lexbuf in mkarg arg !subst with Save.Eof -> begin if Stack.empty stack_lexbuf then 340 eoferror () else begin let lexbuf = previous_lexbuf () in if !verbose > 1 then begin prerr_endline "popping stack_lexbuf in full_save_arg"; 345 pretty_lexbuf lexbuf ; prerr_args () end; save_rec lexbuf end 350 end in let start_pos = Location.get_pos () in try Save.seen_par := false ; 355 save_lexstate () ; let r = save_rec lexbuf in restore_lexstate () ; if !verbose > 2 then prerr_endline ("Arg parsed: ``"^parg r^"''") ; 360 r with | (Save.Error _ | Error _) as e -> restore_lexstate () ; Save.seen_par := false ; 365 Location.print_this_pos start_pos ; prerr_endline "Parsing of argument failed" ; raise e | e -> restore_lexstate () ; 370 raise e ;; type ok = No of string | Yes of string ;; 375 let parg {arg=arg} = arg and pok = function | {arg=Yes s} -> s | {arg=No s} -> "* default arg: ["^s^"] *" 380 let eof_arg () = Save.empty_buffs () ; raise (Error "Eof while looking for argument") 385 let save_arg lexbuf = let r = full_save_arg eof_arg mkarg parg Save.arg lexbuf in r 390 and save_arg_with_delim delim lexbuf = full_save_arg eof_arg mkarg parg (Save.with_delim delim) lexbuf and save_filename lexbuf = full_save_arg eof_arg mkarg parg Save.filename lexbuf and save_verbatim lexbuf = 395 full_save_arg eof_arg mkarg parg Save.arg_verbatim lexbuf type sup_sub = { limits : Misc.limits option ; sup : string arg ; 400 sub : string arg ; } let mklimits x _ = x 405 let plimits = function | Some Limits -> "\\limits" | Some NoLimits -> "\\nolimits" | Some IntLimits -> "\\intlimits" | None -> "*no limit info*" 410 exception Over let eof_over () = raise Over let save_limits lexbuf = 415 let rec do_rec res = try let r = full_save_arg eof_over mklimits plimits Save.get_limits lexbuf in match r with 420 | None -> res | Some _ -> do_rec r with | Over -> res in do_rec None 425 let mkoptionarg opt subst = match opt with | None -> None | Some s -> Some (mkarg s subst) 430 and poptionarg = function | None -> "*None*" | Some a -> a.arg let save_sup lexbuf = 435 try full_save_arg eof_over mkoptionarg poptionarg Save.get_sup lexbuf with | Over -> None 440 and save_sub lexbuf = try full_save_arg eof_over mkoptionarg poptionarg Save.get_sub lexbuf with | Over -> None 445 let unoption = function | None -> {arg="" ; subst=top_subst } | Some a -> a 450 let save_sup_sub lexbuf = let limits = save_limits lexbuf in match save_sup lexbuf with | None -> let sub = save_sub lexbuf in 455 let sup = save_sup lexbuf in {limits=limits ; sup = unoption sup ; sub = unoption sub} | Some sup -> let sub = save_sub lexbuf in {limits=limits ; sup = sup ; sub = unoption sub} 460 let protect_save_string lexfun lexbuf = full_save_arg eof_arg (fun s _ -> s) (fun s -> s) 465 lexfun lexbuf let eof_opt def () = {arg=No def ; subst=Top } let save_arg_opt def lexbuf = 470 let r = full_save_arg (eof_opt def) mkarg pok 475 (fun lexbuf -> try Yes (Save.opt lexbuf) with | Save.NoOpt -> No def) lexbuf in match r.arg with 480 | Yes _ -> r | No _ -> mkarg (No def) !subst ;; 485 let from_ok okarg = match okarg.arg with | Yes s -> optarg := true ; 490 mkarg s okarg.subst | No s -> optarg := false ; mkarg s okarg.subst 495 let pretty_ok = function Yes s -> "+"^s^"+" | No s -> "-"^s^"-" ;; 500 let norm_arg s = String.length s = 2 && s.[0] = '#' && ('0' <= s.[1] && s.[1] <= '9') 505 let rec parse_args_norm pat lexbuf = match pat with | [] -> [] | s :: (ss :: _ as pat) when norm_arg s && norm_arg ss -> let arg = save_arg lexbuf in let r = parse_args_norm pat lexbuf in 510 arg :: r | s :: ss :: pat when norm_arg s && not (norm_arg ss) -> let arg = save_arg_with_delim ss lexbuf in arg :: parse_args_norm pat lexbuf | s :: pat when not (norm_arg s) -> 515 Save.skip_delim s lexbuf ; parse_args_norm pat lexbuf | s :: pat -> let arg = save_arg lexbuf in let r = parse_args_norm pat lexbuf in 520 arg :: r ;; let skip_csname lexbuf = 525 let _ = Save.csname lexbuf (fun x -> x) in () let skip_opt lexbuf = let _ = save_arg_opt "" lexbuf in 530 () and save_opt def lexbuf = from_ok (save_arg_opt def lexbuf) ;; 535 let rec save_opts pat lexbuf = match pat with [] -> [] | def::rest -> let arg = save_arg_opt def lexbuf in let r = save_opts rest lexbuf in 540 arg :: r ;; let parse_args (popt,pat) lexbuf = 545 Save.seen_par := false ; let opts = save_opts popt lexbuf in begin match pat with | s :: ss :: _ when norm_arg s && not (norm_arg ss) -> Save.skip_blanks_init lexbuf 550 | _ -> () end ; let args = parse_args_norm pat lexbuf in (opts,args) ;; 555 let make_stack name pat lexbuf = try let (opts,args) = parse_args pat lexbuf in let args = Array.of_list (List.map from_ok opts@args) in 560 if !verbose > 1 then begin Printf.fprintf stderr "make_stack for macro: %s " name ; pretty_pat pat ; prerr_endline ""; for i = 0 to Array.length args-1 do 565 Printf.fprintf stderr "\t#%d = %s\n" (i+1) (args.(i).arg) ; pretty_subst (args.(i).subst) done end ; Env args 570 with Save.Delim delim -> raise (Error ("Use of "^name^ " does not match its definition (delimiter: "^delim^")")) 575 ;; let scan_this lexfun s = start_lexstate (); 580 if !verbose > 1 then begin Printf.fprintf stderr "scan_this : [%s]" s ; prerr_endline "" end ; let lexer = Lexing.from_string s in 585 let r = lexfun lexer in if !verbose > 1 then begin Printf.fprintf stderr "scan_this : over" ; prerr_endline "" end ; 590 restore_lexstate (); r and scan_this_arg lexfun {arg=s ; subst=this_subst } = start_lexstate () ; 595 subst := this_subst ; if !verbose > 1 then begin Printf.fprintf stderr "scan_this_arg : [%s]" s ; prerr_endline "" end ; 600 let lexer = Lexing.from_string s in let r = lexfun lexer in if !verbose > 1 then begin Printf.fprintf stderr "scan_this_arg : over" ; prerr_endline "" 605 end ; restore_lexstate (); r ;; 610 let scan_this_may_cont lexfun lexbuf cur_subst {arg=s ; subst=env } = if !verbose > 1 then begin Printf.fprintf stderr "scan_this_may_cont : [%s]" s ; prerr_endline "" ; 615 if !verbose > 1 then begin prerr_endline "Pushing lexbuf and env" ; pretty_lexbuf lexbuf ; pretty_subst !subst end 620 end ; save_lexstate (); record_lexbuf lexbuf cur_subst ; subst := env ; let lexer = Lexing.from_string s in 625 let r = lexfun lexer in restore_lexstate (); if !verbose > 1 then begin Printf.fprintf stderr "scan_this_may_cont : over" ; 630 prerr_endline "" end ; r let real_input_file loc_verb main filename input = 635 if !verbose > 0 then prerr_endline ("Input file: "^filename) ; let buf = Lexing.from_channel input in Location.set filename buf ; let old_verb = !verbose in 640 verbose := loc_verb ; if !verbose > 1 then prerr_endline ("scanning: "^filename) ; start_lexstate () ; let old_lexstate = Stack.save stack_lexstate in subst := Top ; 645 begin try main buf with | Misc.EndInput -> Stack.restore stack_lexstate old_lexstate | e -> Stack.restore stack_lexstate old_lexstate ; 650 restore_lexstate (); close_in input ; verbose := old_verb ; (* NO Location.restore () ; for proper error messages *) raise e 655 end ; restore_lexstate (); if !verbose > 1 then prerr_endline ("scanning over: "^filename) ; close_in input ; verbose := old_verb ; 660 Location.restore () let input_file loc_verb main filename = try let filename,input = Myfiles.open_tex filename in 665 real_input_file loc_verb main filename input with Myfiles.Except -> begin if !verbose > 0 then prerr_endline ("Not opening file: "^filename) ; raise Myfiles.Except 670 end | Myfiles.Error m as x -> begin Misc.warning m ; raise x end 675 (* Hot start *) type saved = (string * bool ref) list * bool list 680 let cell_list = ref [] let checkpoint () = !cell_list, List.map (fun (_,cell) -> !cell) !cell_list ; 685 and hot_start (cells, values) = let rec start_rec cells values = match cells, values with | [],[] -> () | (name,cell)::rcells, value :: rvalues -> if !verbose > 1 then begin 690 prerr_endline ("Restoring "^name^" as "^if value then "true" else "false") end ; cell := value ; start_rec rcells rvalues 695 | _,_ -> Misc.fatal ("Trouble in Lexstate.hot_start") in start_rec cells values ; cell_list := cells 700 let register_cell name cell = cell_list := (name,cell) :: !cell_list and unregister_cell name = 705 let rec un_rec = function | [] -> Misc.warning ("Cannot unregister cell: "^name) ; [] | (xname,cell) :: rest -> 710 if xname = name then rest else (xname,cell) :: un_rec rest in cell_list := un_rec !cell_list <6>99 location.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) open Stack let header = "$Id: location.ml,v 1.19 2001/05/28 17:28:56 maranget Exp $" 15 type fileOption = No | Yes of in_channel ;; let stack = Stack.create "location" ;; 20 let curlexbuf = ref (Lexing.from_string "") and curlexname = ref "" 25 and curline = ref (0,1) and curfile = ref No ;; let save_state () = 30 push stack (!curlexname,!curlexbuf,!curline,!curfile) and restore_state () = let name,lexbuf,line,file = pop stack in curlexname := name ; 35 curlexbuf := lexbuf; curline := line; curfile := file type saved = (string * Lexing.lexbuf * (int * int) * fileOption) Stack.saved 40 let close_file = function | Yes f -> close_in f | _ -> () 45 let close_curfile () = close_file !curfile let check () = save_state () ; let r = Stack.save stack in 50 restore_state () ; r and hot saved = let to_finalize = stack in 55 Stack.restore stack saved ; let _,_,_,file_now = Stack.top stack in Stack.finalize to_finalize (fun (_,_,_,file) -> file == file_now) (fun (_,_,_,file) -> close_file file) ; 60 restore_state () let get () = !curlexname ;; 65 let set name lexbuf = save_state () ; curlexname := name ; curlexbuf := lexbuf; curfile := 70 begin match name with "" -> No | _ -> try Yes (open_in name) with Sys_error _ -> No end ; curline := (0,1) 75 ;; let restore () = close_curfile () ; restore_state () 80 ;; let rec do_find_line file lp r c = function 0 -> lp,r,c 85 | n -> let cur = input_char file in do_find_line file (match cur with '\n' -> lp+c+1 | _ -> lp) (match cur with '\n' -> r+1 | _ -> r) 90 (match cur with '\n' -> 0 | _ -> c+1) (n-1) ;; let find_line file lp nline nchars = do_find_line file lp nline 0 nchars 95 type t = string * int * int let do_get_pos () = match !curfile with No -> -1,-1 100 | Yes file -> try let char_pos = Lexing.lexeme_start !curlexbuf and last_pos,last_line = !curline in let last_pos,last_line = 105 if char_pos < last_pos then 0,1 else last_pos,last_line in seek_in file last_pos ; (* prerr_endline ("char_pos="^string_of_int char_pos) ; *) let line_pos,nline,nchar = find_line file last_pos last_line (char_pos-last_pos) in 110 curline := (line_pos,nline); nline,nchar with Sys_error _ -> -1,-1 ;; 115 let get_pos () = let nline,nchars = do_get_pos () in !curlexname,nline,nchars ;; 120 let do_print_pos full (s,nline,nchars) = if nline >= 0 then prerr_string (s^":"^string_of_int nline^ (if full then ":"^string_of_int (nchars+1)^": " else ": ")) 125 else match s with | "" -> () | _ -> prerr_string (s^": ") 130 let print_pos () = let nlines,nchars = do_get_pos () in do_print_pos false (!curlexname,nlines,nchars) and print_fullpos () = 135 let nlines,nchars = do_get_pos () in do_print_pos true (!curlexname,nlines,nchars) and print_this_pos p = do_print_pos false p and print_this_fullpos p = do_print_pos true p <6>100 mathML.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: mathML.ml,v 1.15 2000/10/13 19:17:41 maranget Exp $" 15 open Misc open Parse_opts open Element open HtmlCommon open Latexmacros 20 open Stack (*----------*) (* DISPLAYS *) (*----------*) 25 let begin_item_display f is_freeze = if !verbose > 2 then begin Printf.fprintf stderr "begin_item_display: ncols=%d empty=%s" flags.ncols (sbool flags.empty) ; prerr_newline () 30 end ; open_block (OTHER "mrow") ""; open_block GROUP "" ; if is_freeze then(* push out_stack (Freeze f) ;*)freeze f; 35 and end_item_display () = let f,is_freeze = pop_freeze () in let _ = close_flow_loc GROUP in if close_flow_loc (OTHER "mrow") then 40 flags.ncols <- flags.ncols + 1; if !verbose > 2 then begin Printf.fprintf stderr "end_item_display: ncols=%d stck: " flags.ncols; pretty_stack out_stack end; 45 flags.vsize,f,is_freeze and open_display () = if !verbose > 2 then begin 50 Printf.fprintf stderr "open_display: " end ; try_open_display () ; open_block (OTHER "mrow") ""; do_put_char '\n'; 55 open_block GROUP "" ; if !verbose > 2 then begin pretty_cur !cur_out ; prerr_endline "" end 60 and close_display () = if !verbose > 2 then begin prerr_flags "=> close_display" 65 end ; if not (flush_freeze ()) then begin close_flow GROUP ; let n = flags.ncols in if (n = 0 && not flags.blank) then begin 70 if !verbose > 2 then begin prerr_string "No Display n=0" ; (Out.debug stderr !cur_out.out); prerr_endline "" end; 75 let active = !cur_out.active and pending = !cur_out.pending in do_close_mods () ; let ps,_,ppout = pop_out out_stack in if ps <> (OTHER "mrow") then failclose "close_display" ps (OTHER "mrow") ; 80 try_close_block (OTHER "mrow"); let old_out = !cur_out in cur_out := ppout ; do_close_mods () ; Out.copy old_out.out !cur_out.out ; 85 flags.empty <- false ; flags.blank <- false ; free old_out ; !cur_out.pending <- to_pending pending active end else if (n=1 (*&& flags.blank*)) then begin if !verbose > 2 then begin 90 prerr_string "No display n=1"; (Out.debug stderr !cur_out.out); prerr_endline "" ; end; let active = !cur_out.active and pending = !cur_out.pending in 95 let ps,_,pout = pop_out out_stack in if ps<> (OTHER "mrow") then failclose "close_display" ps (OTHER "mrow"); try_close_block (OTHER "mrow") ; let old_out = !cur_out in 100 cur_out := pout ; do_close_mods () ; if flags.blank then Out.copy_no_tag old_out.out !cur_out.out else Out.copy old_out.out !cur_out.out; flags.empty <- false ; flags.blank <- false ; 105 free old_out ; !cur_out.pending <- to_pending pending active end else begin if !verbose > 2 then begin prerr_string ("One Display n="^string_of_int n) ; 110 (Out.debug stderr !cur_out.out); prerr_endline "" end; flags.empty <- flags.blank ; close_flow (OTHER "mrow") ; 115 do_put_char '\n'; end ; try_close_display () end ; if !verbose > 2 then 120 prerr_flags ("<= close_display") ;; let do_item_display force = 125 if !verbose > 2 then begin prerr_endline ("Item Display ncols="^string_of_int flags.ncols^" table_inside="^sbool flags.table_inside) end ; let f,is_freeze = pop_freeze () in if ((*force && *)not flags.empty) || flags.table_inside then 130 flags.ncols <- flags.ncols + 1 ; let active = !cur_out.active and pending = !cur_out.pending in close_flow GROUP ; open_block GROUP ""; 135 !cur_out.pending <- to_pending pending active; !cur_out.active <- [] ; if is_freeze then freeze f; if !verbose > 2 then begin prerr_string ("out item_display -> ncols="^string_of_int flags.ncols) ; 140 pretty_stack out_stack end ; ;; let item_display () = do_item_display false 145 and force_item_display () = do_item_display true ;; 150 let erase_display () = erase_block GROUP ; erase_block (OTHER "mrow"); try_close_display () ;; 155 let open_maths display = if !verbose > 1 then prerr_endline "=> open_maths"; push stacks.s_in_math flags.in_math; if display then do_put "<BR>\n"; 160 if not flags.in_math then open_block (OTHER "math") "align=\"center\"" else erase_mods [Style "mtext"]; do_put_char '\n'; flags.in_math <- true; open_display (); 165 open_display (); ;; let close_maths display = if !verbose >1 then prerr_endline "=> close_maths"; 170 close_display (); close_display (); flags.in_math <- pop stacks.s_in_math ; do_put_char '\n'; if not flags.in_math then begin 175 close_block (OTHER "math") end else open_mod (Style "mtext"); ;; 180 let insert_vdisplay open_fun = if !verbose > 2 then begin prerr_flags "=> insert_vdisplay" ; 185 end ; try let mods = to_pending !cur_out.pending !cur_out.active in let bs,bargs,bout = pop_out out_stack in if bs <> GROUP then 190 failclose "insert_vdisplay" bs GROUP ; let ps,pargs,pout = pop_out out_stack in if ps <> (OTHER "mrow") then failclose "insert_vdisplay" ps (OTHER "mrow"); let new_out = create_status_from_scratch false [] in 195 push_out out_stack (ps,pargs,new_out) ; push_out out_stack (bs,bargs,bout) ; close_display () ; cur_out := pout ; open_fun () ; 200 do_put (Out.to_string new_out.out) ; flags.empty <- false ; flags.blank <- false ; free new_out ; if !verbose > 2 then begin prerr_string "insert_vdisplay -> " ; 205 pretty_mods stderr mods ; prerr_newline () end ; if !verbose > 2 then prerr_flags "<= insert_vdisplay" ; 210 mods with PopFreeze -> raise (UserError "wrong parenthesization"); ;; 215 (* delaying output .... *) (* let delay f = if !verbose > 2 then 220 prerr_flags "=> delay" ; push vsize_stack flags.vsize ; flags.vsize <- 0; push delay_stack f ; open_block "DELAY" "" ; 225 if !verbose > 2 then prerr_flags "<= delay" ;; let flush x = 230 if !verbose > 2 then prerr_flags ("=> flush arg is ``"^string_of_int x^"''"); try_close_block "DELAY" ; let ps,_,pout = pop_out out_stack in if ps <> "DELAY" then 235 raise (Misc.Fatal ("html: Flush attempt on: "^ps)) ; let mods = !cur_out.active @ !cur_out.pending in do_close_mods () ; let old_out = !cur_out in cur_out := pout ; 240 let f = pop "delay" delay_stack in f x ; Out.copy old_out.out !cur_out.out ; flags.empty <- false ; flags.blank <- false ; free old_out ; 245 !cur_out.pending <- mods ; flags.vsize <- max (pop "vsive" vsize_stack) flags.vsize ; if !verbose > 2 then prerr_flags "<= flush" ;; 250 *) (* put functions *) let is_digit = function 255 '1'|'2'|'3'|'4'|'5'|'6'|'7'|'8'|'9'|'0'|'.'|',' -> true | _ -> false ;; let is_number s = 260 let r = ref true in for i = 0 to String.length s -1 do r := !r && is_digit s.[i] done; !r 265 ;; let is_op = function "+" | "-"|"/"|"*"|"%"|"<"|">"|"="|"("|")"|"{"|"}"|"["|"]"|","|";"|":"|"|"|"&"|"#"|"!"|"~"|"$" -> true 270 | _ -> false ;; let is_open_delim = function | "(" | "[" | "{" | "<" -> true 275 | _ -> false and is_close_delim = function | ")" | "]" | "}" | ">" -> true | _ -> false ;; 280 let open_delim () = open_display (); freeze ( fun () -> 285 close_display (); close_display ();); and is_close () = let f, is_freeze = pop_freeze () in if is_freeze then begin 290 freeze f; false end else true; and close_delim () = 295 let f, is_freeze = pop_freeze () in if is_freeze then begin close_display (); end else begin close_display (); 300 open_display (); warning "Math expression improperly parenthesized"; end ;; 305 let put s = let s_blank = let r = ref true in 310 for i = 0 to String.length s - 1 do r := !r && is_blank (String.get s i) done ; !r in let s_blanc = 315 let r = ref true in for i = 0 to String.length s - 1 do r := !r && ((String.get s i)=' ') done ; !r in 320 if not s_blanc then begin let s_op = is_op s and s_number = is_number s in let save_last_closed = flags.last_closed in if is_open_delim s then open_delim (); 325 let s_text = if is_close_delim s then is_close () else false in if s_op || s_number then force_item_display (); do_pending () ; flags.empty <- false; flags.blank <- s_blank && flags.blank ; 330 if s_number then begin do_put ("<mn> "^s^" </mn>\n") end else if s_text then begin do_put ("<mtext>"^s^"</mtext>") end else if s_op then begin 335 do_put ("<mo> "^s^" </mo>\n"); end else begin do_put s end; if s_blank then flags.last_closed <- save_last_closed; 340 if is_close_delim s then close_delim (); end ;; let put_char c = 345 let save_last_closed = flags.last_closed in let c_blank = is_blank c in if c <> ' ' then begin let s = String.make 1 c in let c_op = is_op s in 350 let c_digit = is_digit c in if is_open_delim s then open_delim (); let c_text = if is_close_delim s then is_close () else false in if c_op || c_digit then force_item_display (); do_pending () ; 355 flags.empty <- false; flags.blank <- c_blank && flags.blank ; if c_digit then begin do_put ("<mn> "^s^" </mn>\n") end else if c_text then begin 360 do_put ("<mtext>"^s^"</mtext>") end else if c_op then begin do_put ("<mo> "^s^" </mo>\n"); end else begin do_put_char c; 365 end; if c_blank then flags.last_closed <- save_last_closed; if is_close_delim s then close_delim (); end ;; 370 let put_in_math s = if flags.in_pre && !pedantic then put s else begin 375 force_item_display (); do_pending () ; do_put "<mi> "; do_put s; do_put " </mi>\n"; 380 flags.empty <- false; flags.blank <- false; end ;; 385 (* Sup/Sub stuff *) let put_sub_sup s = 390 open_display (); put s; item_display (); close_display (); ;; 395 let insert_sub_sup tag s t = let f, is_freeze = pop_freeze () in let ps,pargs,pout = pop_out out_stack in if ps <> GROUP then failclose "sup_sub" ps GROUP ; 400 let new_out = create_status_from_scratch false [] in push_out out_stack (ps,pargs,new_out); close_block GROUP; cur_out := pout; open_block tag ""; 405 open_display (); let texte = Out.to_string new_out.out in do_put (if texte = "" then "<mo> &InvisibleTimes; </mo>" else texte); flags.empty <- false; flags.blank <- false; free new_out; 410 close_display (); put_sub_sup s; if t<>"" then put_sub_sup t; close_block tag; open_block GROUP ""; 415 if is_freeze then freeze f ;; let get_sup_sub (scanner : string Lexstate.arg -> unit) 420 (s : string Lexstate.arg) = to_string (fun () -> scanner s) let standard_sup_sub scanner what sup sub display = let sup = get_sup_sub scanner sup 425 and sub = get_sup_sub scanner sub in match sub,sup with | "","" -> what () | a,"" -> open_block (OTHER "msub") ""; 430 open_display (); what (); if flags.empty then begin erase_display (); erase_block (OTHER "msub") ; 435 insert_sub_sup (OTHER "msub") a ""; end else begin close_display (); put_sub_sup a; close_block (OTHER "msub") ; 440 end; | "",b -> open_block (OTHER "msup") ""; open_display (); what (); 445 if flags.empty then begin erase_display (); erase_block (OTHER "msup") ; insert_sub_sup (OTHER "msup") b ""; end else begin 450 close_display (); put_sub_sup b; close_block (OTHER "msup"); end; | a,b -> 455 open_block (OTHER "msubsup") ""; open_display (); what (); if flags.empty then begin erase_display (); 460 erase_block (OTHER "msubsup") ; insert_sub_sup (OTHER "msubsup") a b; end else begin close_display (); put_sub_sup a; 465 put_sub_sup b; close_block (OTHER "msubsup") ; end; ;; 470 let limit_sup_sub scanner what sup sub display = let sup = get_sup_sub scanner sup and sub = get_sup_sub scanner sub in 475 match sub,sup with | "","" -> what () | a,"" -> open_block (OTHER "munder") ""; open_display (); 480 what (); if flags.empty then begin erase_display (); erase_block (OTHER "munder"); insert_sub_sup (OTHER "munder") a ""; 485 end else begin close_display (); put_sub_sup a; close_block (OTHER "munder"); end; 490 | "",b -> open_block (OTHER "mover") ""; open_display (); what (); if flags.empty then begin 495 erase_display (); erase_block (OTHER "mover"); insert_sub_sup (OTHER "mover") b ""; end else begin close_display (); 500 put_sub_sup b; close_block (OTHER "mover"); end; | a,b -> open_block (OTHER "munderover") ""; 505 open_display (); what (); if flags.empty then begin erase_display (); erase_block (OTHER "munderover"); 510 insert_sub_sup (OTHER "munderover") a b; end else begin close_display (); put_sub_sup a; put_sub_sup b; 515 close_block (OTHER "munderover"); end; ;; let int_sup_sub something vsize scanner what sup sub display = 520 standard_sup_sub scanner what sup sub display ;; let over display lexbuf = 525 if display then begin force_item_display (); let mods = insert_vdisplay (fun () -> open_block (OTHER "mfrac") ""; 530 open_display ()) in force_item_display (); flags.ncols <- flags.ncols +1; close_display () ; open_display () ; 535 freeze (fun () -> force_item_display (); flags.ncols <- flags.ncols +1; close_display () ; 540 close_block (OTHER "mfrac")) end else begin put "/" end ;; 545 let tr = function "<" -> "<" | ">" -> ">" 550 | "\\{" -> "{" | "\\}" -> "}" | s -> s ;; 555 let left delim k = force_item_display (); open_display (); if delim <>"." then put ("<mo> "^ tr delim^" </mo>"); k 0 ; 560 force_item_display (); freeze ( fun () -> force_item_display (); close_display (); 565 warning "Left delimitor not matched with a right one."; force_item_display (); close_display ();) ;; 570 let right delim = force_item_display (); if delim <> "." then put ("<mo> "^tr delim^" </mo>"); force_item_display (); let f,is_freeze = pop_freeze () in 575 if not is_freeze then begin warning "Right delimitor alone"; close_display (); open_display (); end else begin 580 try let ps,parg,pout = pop_out out_stack in let pps,pparg,ppout = pop_out out_stack in if pblock() = (OTHER "mfrac") then begin warning "Right delimitor not matched with a left one."; 585 push_out out_stack (pps,pparg,ppout); push_out out_stack (ps,parg,pout); freeze f; close_display (); open_display (); 590 end else begin push_out out_stack (pps,pparg,ppout); push_out out_stack (ps,parg,pout); close_display (); end; 595 with PopFreeze -> raise (UserError ("Bad placement of right delimitor")); end; 3 ;; <6>101 misc.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1999 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: misc.ml,v 1.19 2001/02/20 14:10:09 maranget Exp $" exception Fatal of string 15 exception NoSupport of string exception Purposly of string exception ScanError of string exception UserError of string exception EndInput 20 exception EndDocument exception Close of string exception EndOfLispComment of int (* QNC *) let verbose = ref 0 25 and readverb = ref 0 let silent = ref false let column_to_command s = "\\@"^s^"@" 30 let hot_start () = () let warning s = 35 if not !silent || !verbose > 0 then begin Location.print_pos () ; prerr_string "Warning: " ; prerr_endline s end 40 let print_verb level s = if !verbose > level then begin Location.print_pos () ; prerr_endline s 45 end let message s = if not !silent || !verbose > 0 then prerr_endline s 50 let fatal s = raise (Fatal s) let not_supported s = raise (NoSupport s) let rec rev_iter f = function 55 | [] -> () | x::rem -> rev_iter f rem ; f x let copy_hashtbl from_table to_table = Hashtbl.clear to_table ; 60 let module OString = struct type t = string let compare = Pervasives.compare end in 65 let module Strings = Set.Make (OString) in let keys = ref Strings.empty in Hashtbl.iter (fun key _ -> keys := Strings.add key !keys) from_table ; 70 Strings.iter (fun key -> let vals = Hashtbl.find_all from_table key in rev_iter (Hashtbl.add to_table key) vals) !keys 75 let clone_hashtbl from_table = let to_table = Hashtbl.create 17 in copy_hashtbl from_table to_table ; to_table 80 let copy_int_hashtbl from_table to_table = Hashtbl.clear to_table ; let module OInt = struct 85 type t = int let compare x y = x-y end in let module Ints = Set.Make (OInt) in let keys = ref Ints.empty in 90 Hashtbl.iter (fun key _ -> keys := Ints.add key !keys) from_table ; Ints.iter (fun key -> 95 let vals = Hashtbl.find_all from_table key in rev_iter (Hashtbl.add to_table key) vals) !keys let clone_int_hashtbl from_table = 100 let to_table = Hashtbl.create 17 in copy_int_hashtbl from_table to_table ; to_table let start_env env = "\\"^ env 105 and end_env env = "\\end"^env type limits = Limits | NoLimits | IntLimits <6>102 myfiles.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: myfiles.ml,v 1.22 2001/05/25 09:07:25 maranget Exp $" open Misc 15 exception Error of string ;; exception Except ;; 20 let etable = Hashtbl.create 17 ;; List.iter (fun name -> Hashtbl.add etable name ()) !Parse_opts.except 25 ;; let is_except name = try Hashtbl.find etable name ; true with Not_found -> false ;; 30 let tex_path = "." :: !Parse_opts.path @ [Mylib.libdir ; Filename.concat Mylib.libdir 35 (match !Parse_opts.destination with | Parse_opts.Html -> "html" | Parse_opts.Text -> "text" | Parse_opts.Info -> "info")] ;; 40 exception Found of (string * in_channel) ;; let do_open_tex filename = 45 try List.iter (fun dir -> try let full_name = Filename.concat dir filename in if !verbose > 1 then prerr_endline ("Trying: "^full_name) ; 50 let r = open_in full_name in if !verbose > 1 then prerr_endline ("Opening: "^full_name) ; raise (Found (full_name,r)) with Sys_error s -> if !verbose > 1 then prerr_endline ("Failed: "^s)) 55 tex_path ; raise (Error ("Cannot open file: "^filename)) with Found r -> r ;; 60 let open_tex filename = if !verbose > 1 then prerr_endline ("Searching file: "^filename) ; 65 if is_except filename then raise Except ; if Filename.is_implicit filename then if Filename.check_suffix filename ".tex" || Filename.check_suffix filename ".hva" 70 then do_open_tex filename else try let name = filename^".tex" in if is_except name then raise Except ; 75 do_open_tex name with Error _ -> do_open_tex filename else try if Filename.check_suffix filename ".tex" then filename,open_in filename 80 else try (filename^".tex"),open_in (filename^".tex") with Sys_error _ -> filename,open_in filename with Sys_error _ -> raise (Error ("Cannot open: "^filename)) 85 exception FoundBis of string let do_find name = try 90 List.iter (fun dir -> let full_name = Filename.concat dir name in if Sys.file_exists full_name then raise (FoundBis full_name)) tex_path ; 95 raise Not_found with FoundBis r -> r ;; let find_one name = 100 if Sys.file_exists name then name else raise Not_found 105 let find name = if Filename.is_implicit name then if Filename.check_suffix name ".tex" || Filename.check_suffix name ".hva" 110 then do_find name else try let name = name^".tex" in do_find name 115 with Not_found -> do_find name else if Filename.check_suffix name ".tex" then find_one name else 120 try find_one (name^".tex") with | Not_found -> find_one name 125 exception Return of bool let diff_chan chan1 chan2 = try while true do 130 let c1 = try input_char chan1 with End_of_file -> begin try let _ = input_char chan2 in raise (Return true) 135 with End_of_file -> raise (Return false) end in let c2 = try input_char chan2 with End_of_file -> raise (Return true) in if c1 <> c2 then 140 raise (Return true) done ; assert false with Return r -> r 145 let changed tmp_name name = try let true_chan = open_in name in let tmp_chan = try open_in tmp_name 150 with Sys_error _ -> begin close_in true_chan ; raise (Misc.Fatal ("Cannot reopen temporary image file: "^tmp_name)) 155 end in let r = diff_chan true_chan tmp_chan in close_in true_chan ; close_in tmp_chan ; r 160 with Sys_error _ -> true <6>103 mylib.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: mylib.ml,v 1.7 2001/05/25 09:07:26 maranget Exp $" exception Error of string ;; 15 let static_libdir = LIBDIR ;; let libdir = 20 try Sys.getenv "HEVEADIR" with Not_found -> LIBDIR ;; <6>104 mysys.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: mysys.ml,v 1.1 2001/05/25 09:07:26 maranget Exp $" exception Error of string 15 let put_from_file name put = try let size = 1024 in let buff = String.create size in 20 let chan_in = open_in_bin name in let rec do_rec () = let i = input chan_in buff 0 size in if i > 0 then begin put (String.sub buff 0 i) ; 25 do_rec () end in do_rec () ; close_in chan_in with Sys_error _ -> 30 raise (Error ("Cannot read file "^name)) ;; let copy_from_lib dir name = let chan_out = 35 try open_out_bin name with Sys_error _ -> raise (Error ("Cannot open file: "^name)) in try put_from_file (Filename.concat dir name) 40 (fun s -> output_string chan_out s) ; close_out chan_out with | e -> close_out chan_out ; raise e ;; 45 (* handle windows/Unix dialectic => no error when s2 exists *) let rename s1 s2 = if Sys.file_exists s2 then 50 Sys.remove s2 ; Sys.rename s1 s2 let remove s = if Sys.file_exists s then 55 Sys.remove s <6>105 noimage.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: noimage.ml,v 1.7 1999/12/01 19:04:50 maranget Exp $" let start () = () and stop () = () 15 and restart () = () ;; let put _ = () and put_char _ = () 20 ;; let dump _ image lexbuf = image lexbuf let page () = () ;; 25 let finalize _ = false ;; <6>106 out.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) open Lexing let header = "$Id: out.ml,v 1.20 2000/10/27 11:26:58 maranget Exp $" 15 let verbose = ref 0 ;; type buff = { mutable buff : string; 20 mutable bp : int; mutable len : int } ;; 25 type t = Buff of buff | Chan of out_channel | Null ;; let debug chan out = match out with Buff out -> 30 output_char chan '*' ; output chan out.buff 0 out.bp ; output_char chan '*' | Chan _ -> output_string chan "*CHAN*" 35 | Null -> output_string chan "*NULL*" ;; let free_list = ref [] 40 let free = function | Buff b -> b.bp <- 0 ; free_list := b :: !free_list | _ -> () 45 let create_buff () = Buff (match !free_list with | [] -> {buff = String.create 128 ; bp = 0 ; len = 128} | b::rem -> 50 free_list := rem ; b) and create_chan chan = Chan chan and create_null () = Null 55 and is_null = function | Null -> true | _ -> false and is_empty = function 60 | Buff {bp=0} -> true | _ -> false ;; let reset = function 65 Buff b -> b.bp <- 0 | _ -> raise (Misc.Fatal "Out.reset") let get_pos = function | Buff b -> b.bp 70 | _ -> 0 let erase_start n = function | Buff b -> String.blit b.buff n b.buff 0 (b.bp-n) ; 75 b.bp <- b.bp-n | _ -> raise (Misc.Fatal "Out.erase_start") let realloc out = 80 let new_len = 2 * out.len in let new_b = String.create new_len in String.unsafe_blit out.buff 0 new_b 0 out.bp ; out.buff <- new_b ; out.len <- new_len 85 ;; let rec put out s = match out with (Buff out) as b -> let l = String.length s in 90 if out.bp + l < out.len then begin String.unsafe_blit s 0 out.buff out.bp l ; out.bp <- out.bp + l end else begin realloc out ; 95 put b s end | Chan chan -> output_string chan s | Null -> () ;; 100 let rec blit out lexbuf = match out with (Buff out) as b -> let l = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in if out.bp + l < out.len then begin 105 String.blit lexbuf.lex_buffer lexbuf.lex_start_pos out.buff out.bp l ; out.bp <- out.bp + l end else begin realloc out ; 110 blit b lexbuf end | Chan chan -> output_string chan (lexeme lexbuf) | Null -> () ;; 115 let rec put_char out c = match out with Buff out as b -> if out.bp + 1 < out.len then begin String.unsafe_set out.buff out.bp c ; 120 out.bp <- out.bp + 1 end else begin realloc out ; put_char b c end 125 | Chan chan -> Pervasives.output_char chan c | Null -> () ;; let flush = function 130 Chan chan -> flush chan | _ -> () ;; let iter f = function 135 | Buff {buff=buff ; bp=bp} -> for i = 0 to bp-1 do f (buff.[i]) done | Null -> () 140 | _ -> Misc.fatal "Out.iter" let to_string out = match out with Buff out -> let r = String.sub out.buff 0 out.bp in 145 out.bp <- 0 ; r | _ -> raise (Misc.Fatal "Out.to_string") ;; let to_chan chan out = match out with 150 Buff out -> output chan out.buff 0 out.bp ; out.bp <- 0 | _ -> raise (Misc.Fatal "to_chan") ;; 155 let hidden_copy from to_buf i l = match to_buf with Chan chan -> output chan from.buff i l | Buff out -> 160 while out.bp + l >= out.len do realloc out done ; String.unsafe_blit from.buff i out.buff out.bp l ; out.bp <- out.bp + l 165 | Null -> () ;; let copy from_buff to_buff = match from_buff with Buff from -> hidden_copy from to_buff 0 from.bp 170 | _ -> raise (Misc.Fatal "Out.copy") let copy_fun f from_buff to_buff = match from_buff with Buff from -> put to_buff (f (String.sub from.buff 0 from.bp)) 175 | _ -> raise (Misc.Fatal "Out.copy_fun") let copy_no_tag from_buff to_buff = if !verbose > 2 then begin prerr_string "copy no tag from_buff"; 180 debug stderr from_buff ; prerr_endline "" end ; match from_buff with Buff from -> begin 185 try let i = String.index from.buff '>' in let j = if from.bp=0 then i+1 else String.rindex_from from.buff (from.bp-1) '<' in 190 hidden_copy from to_buff (i+1) (j-i-1) ; if !verbose > 2 then begin prerr_string "copy no tag to_buff"; debug stderr to_buff ; prerr_endline "" 195 end with Not_found -> raise (Misc.Fatal "Out.copy_no_tag, no tag found") end | _ -> raise (Misc.Fatal "Out.copy_no_tag") ;; 200 let close = function | Chan c -> close_out c | _ -> () ;; 205 let is_space = function | ' ' | '\n' -> true | _ -> false 210 let unskip = function | Buff b -> while b.bp > 0 && is_space b.buff.[b.bp-1] do b.bp <- b.bp - 1 done 215 | _ -> () <6>107 package.ml (***********************************************************************) (* *) (* HEVEA *) (* Luc Maranget, projet PARA, INRIA Rocquencourt *) 5 (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* en Automatique. Distributed only by permission. *) (* *) (* *) 10 (***********************************************************************) (* $Id: package.ml,v 1.30 2001/02/12 10:05:39 maranget Exp $ *) module type S = sig end 15 module Make (Dest : OutManager.S) (Image : ImageManager.S) (Scan : Latexscan.S) : S = struct 20 open Misc open Lexing open Lexstate open Latexmacros open Subst 25 open Stack open Scan ;; (* Various outworld information *) 30 let def_print name s = def_code name (fun _ -> Dest.put (Dest.iso_string s)) ;; def_code "\\@lexbuf" 35 (fun lexbuf -> prerr_endline ("LEXBUF: "^string_of_int (Stack.length stack_lexbuf))) ;; def_code "\\@macros" 40 (fun _ -> Latexmacros.pretty_table ()) ;; def_print "\\@basein" Parse_opts.base_in ; def_print "\\jobname" Parse_opts.base_out ; 45 def_print "\\@heveacomline" (Array.fold_right (fun arg r -> arg^" "^r) Sys.argv "") ; def_print "\@heveaversion" Version.version ; 50 def_print "\@hevealibdir" Mylib.libdir ;; (* ``Token'' registers *) def_code "\\newtokens" 55 (fun lexbuf -> let toks = Scan.get_csname lexbuf in if Latexmacros.exists toks then Misc.warning ("\\newtokens redefines command ``"^toks^"''") ; Latexmacros.def toks zero_pat (Toks [])) 60 ;; def_code "\\resettokens" (fun lexbuf -> let toks = Scan.get_csname lexbuf in 65 begin try match Latexmacros.find_fail toks with | _,Toks _ -> Latexmacros.def toks zero_pat (Toks []) | _ -> raise Failed with Failed -> 70 Misc.warning ("\\resettokens for "^toks^" failed") end) ;; def_code "\\addtokens" 75 (fun lexbuf -> let toks = Scan.get_csname lexbuf in let arg = Subst.subst_arg lexbuf in begin try match Latexmacros.find_fail toks with | _,Toks l -> 80 Latexmacros.def toks zero_pat (Toks (arg::l)) | _ -> raise Failed with Failed -> Misc.warning ("\\addtokens for "^toks^" failed") end) 85 ;; let call_subst lexbuf = let csname = get_csname lexbuf in let arg = subst_arg lexbuf in 90 let exec = csname^" "^arg in if !verbose > 1 then begin prerr_string "\\@callsubst: " ; prerr_endline exec ; end ; 95 scan_this main exec and call_prim lexbuf = let csname = get_csname lexbuf in 100 let arg = get_prim_arg lexbuf in let exec = csname^" "^arg in if !verbose > 1 then begin prerr_string "\\@callprim: " ; prerr_endline exec ; 105 end ; scan_this main exec ;; 110 def_code "\\@funcall" call_subst ; def_code "\\@callsubst" call_subst ; def_code "\\@callprim" call_prim ; ;; 115 (* Aux files parsing *) def_code "\\@hauxinit" (fun lexbuf -> Auxx.init Parse_opts.base_out ; 120 check_alltt_skip lexbuf) ;; let get_raw lexbuf = let saved = !raw_chars in 125 raw_chars := true ; let r = get_prim_arg lexbuf in raw_chars := saved ; r ;; 130 def_code "\\@newlabel" (fun lexbuf -> let name = get_raw lexbuf in let arg = get_raw lexbuf in 135 Auxx.rset name arg) ;; def_code "\\@auxwrite" 140 (fun lexbuf -> let lab = get_raw lexbuf in let theref = get_prim_arg lexbuf in Auxx.rwrite lab theref) ;; 145 def_code "\\@auxread" (fun lexbuf -> let lab = get_raw lexbuf in scan_this main (Auxx.rget lab)) 150 ;; def_code "\\@bibread" (fun lexbuf -> let key = get_raw lexbuf in 155 scan_this main (Auxx.bget false key)) ;; def_code "\\@bibwrite" (fun lexbuf -> 160 let pretty = match Subst.subst_arg lexbuf with | "\\theheveabib" as s -> get_prim s | s -> s in let key = get_raw lexbuf in Auxx.bwrite key pretty) 165 ;; def_code "\\bibcite" (fun lexbuf -> 170 let name = get_raw lexbuf in let arg = Subst.subst_arg lexbuf in Auxx.bset name arg) ;; 175 (* Index primitives *) register_init "index" (fun () -> def_code "\\@indexwrite" 180 (fun lexbuf -> let tag = get_prim_opt "default" lexbuf in let arg = Subst.subst_arg lexbuf in let theref = get_prim_arg lexbuf in let lbl = Index.treat tag arg theref in 185 Dest.put lbl) ; def_code "\\@printindex" (fun lexbuf -> let tag = get_prim_opt "default" lexbuf in 190 Index.print (scan_this main) tag) ; def_code "\\@indexname" (fun lexbuf -> let tag = get_prim_opt "default" lexbuf in 195 let name = get_prim_arg lexbuf in Index.changename tag name) ; let new_index lexbuf = let tag = get_prim_arg lexbuf in let sufin = get_prim_arg lexbuf in 200 let sufout = get_prim_arg lexbuf in let name = get_prim_arg lexbuf in Index.newindex tag sufin sufout name in def_code "\\newindex" new_index ; def_code "\\renewindex" new_index) 205 ;; (* ifthen package *) register_init "ifthen" (fun () -> 210 def_code "\\ifthenelse" (fun lexbuf -> let cond = save_arg lexbuf in let arg_true = save_arg lexbuf in let arg_false = save_arg lexbuf in 215 scan_this_arg main (if Get.get_bool cond then arg_true else arg_false)) ; def_code "\\whiledo" (fun lexbuf -> 220 let test = save_arg lexbuf in let body = save_arg lexbuf in let btest = ref (Get.get_bool test) in while !btest do scan_this_arg main body ; 225 btest := Get.get_bool test done) ; def_fun "\\newboolean" (fun s -> "\\newif\\if"^s) ; 230 def_code "\\setboolean" (fun lexbuf -> let name = get_prim_arg lexbuf in let arg = save_arg lexbuf in let b = Get.get_bool arg in 235 scan_this main ("\\"^name^(if b then "true" else "false"))) ; ()) ;; 240 (* color package *) register_init "color" (fun () -> def_code "\\definecolor" (fun lexbuf -> 245 Save.start_echo () ; let clr = get_prim_arg lexbuf in let mdl = get_prim_arg lexbuf in let value = get_prim_arg lexbuf in Image.put "\\definecolor" ; 250 Image.put (Save.get_echo ()) ; fun_register (fun () -> Color.remove clr) ; Color.define clr mdl value ) ; def_code "\\DefineNamedColor" 255 (fun lexbuf -> let _ = get_prim_arg lexbuf in let clr = get_prim_arg lexbuf in let mdl = get_prim_arg lexbuf in let value = get_prim_arg lexbuf in 260 fun_register (fun () -> Color.remove clr) ; Color.define clr mdl value ; Color.define_named clr mdl value) ; def_code "\\@getcolor" 265 (fun lexbuf -> let mdl = get_prim_opt "!*!" lexbuf in let clr = get_prim_arg lexbuf in let htmlval = match mdl with | "!*!"|"" -> Color.retrieve clr 270 | _ -> Color.compute mdl clr in Dest.put_char '"' ; Dest.put_char '#' ; Dest.put htmlval ; Dest.put_char '"')) 275 ;; register_init "colortbl" (fun () -> def_code "\\columncolor" 280 (fun lexbuf -> let mdl = get_prim_opt "!*!" lexbuf in let clr = get_prim_arg lexbuf in let htmlval = match mdl with | "!*!" -> Color.retrieve clr 285 | _ -> Color.compute mdl clr in skip_opt lexbuf ; skip_opt lexbuf ; Dest.insert_attr "TD" ("bgcolor=\"#"^htmlval^"\"")) ; def_code "\\rowcolor" 290 (fun lexbuf -> let mdl = get_prim_opt "!*!" lexbuf in let clr = get_prim_arg lexbuf in let htmlval = match mdl with | "!*!" -> Color.retrieve clr 295 | _ -> Color.compute mdl clr in skip_opt lexbuf ; skip_opt lexbuf ; Dest.insert_attr "TR" ("bgcolor=\"#"^htmlval^"\""))) ;; 300 (* sword package *) register_init "sword" (fun () -> 305 def_code "\\FRAME" (fun lexbuf -> let lxm = lexeme lexbuf in (* discard the first 7 arguments *) let _ = save_arg lexbuf in 310 let _ = save_arg lexbuf in let _ = save_arg lexbuf in let _ = save_arg lexbuf in let _ = save_arg lexbuf in let _ = save_arg lexbuf in 315 let _ = save_arg lexbuf in (* keep argument 8 *) let t = Subst.subst_arg lexbuf in (* try to find rightmost material in single quotes *) let i = try String.rindex t '\'' with Not_found-> (-1) in 320 if i>=0 then begin (* we found something, so extract the filename *) let j = String.rindex_from t (i - 1) '\'' in let s = String.sub t (j + 1) (i - j - 1) in let t = Filename.basename (s) in 325 let s = Filename.chop_extension (t) in (* now form the macro swFRAME whose arg is just the base file name *) let cmd = "\\swFRAME{"^s^"}" in (* put it back into the input stream *) 330 scan_this main cmd end ; if i<0 then begin (* no filename found: we use a default name and give a warning *) warning ("\\FRAME: no filename (missing snapshot?) - using 335 fallback name"); let s = "FRAME-graphic-not-found" in let cmd = "\\swFRAME{"^s^"}" in scan_this main cmd end) ; 340 def_code "\\UNICODE" (fun lexbuf -> (* input: \UNICODE{arg} where arg is a hex number, eg 0x23ab *) (* output: call to \swUNICODE{arg1}{arg2} where: *) (* arg1 = hex number w/o leading 0, eg x23ab *) 345 (* arg2 = decimal equivalent, eg 9131 *) (* it is up to \swUNICODE (in sword.hva) to do final formatting *) let lxm = lexeme lexbuf in let t = Subst.subst_arg lexbuf in let s = string_of_int (int_of_string (t)) in 350 let tt = String.sub t (String.index t 'x') (-1+String.length t) in let cmd = "\\swUNICODE{" ^tt^"}{"^s^"}" in scan_this main cmd) ) ;; 355 (* url package *) let verb_arg lexbuf = let {arg=url} = save_verbatim lexbuf in for i = 0 to String.length url - 1 do 360 Dest.put (Dest.iso url.[i]) done ;; def_code "\\@verbarg" verb_arg ; 365 ;; register_init "url" (fun () -> def_code "\\@Url" verb_arg ; 370 def_code "\\Url" (fun lexbuf -> Save.start_echo () ; let _ = save_verbatim lexbuf in 375 let arg = Save.get_echo () in scan_this main ("\\UrlFont\\UrlLeft\\@Url"^arg^"\\UrlRight\\endgroup")) ; let do_urldef lexbuf = 380 Save.start_echo () ; let name = Scan.get_csname lexbuf in let url_macro = Scan.get_csname lexbuf in let true_args = Save.get_echo () in Save.start_echo () ; 385 let _ = save_verbatim lexbuf in let arg = Save.get_echo () in let what = get_this_main (url_macro^arg) in if Scan.echo_toimage () then begin Image.put "\\urldef" ; 390 Image.put true_args ; Image.put arg end ; Latexmacros.def name zero_pat (CamlCode (fun _ -> Dest.put what)) in 395 def_code "\\urldef" do_urldef ; ()) ;; 400 (* hyperref (not implemented in fact) *) register_init "hyperref" (fun () -> def_code "\\href" (fun lexbuf -> 405 Save.start_echo () ; let _ = save_arg lexbuf in let url = Save.get_echo () in let {arg=arg ; subst=subst} = save_arg lexbuf in scan_this_arg main 410 (mkarg ("\\ahref{\\textalltt[]"^url^"}{"^arg^"}") subst)) ; def_code "\\hyperimage" (fun lexbuf -> Save.start_echo () ; let _ = save_arg lexbuf in 415 let url = Save.get_echo () in let _ = save_arg lexbuf in scan_this main ("\\imgsrc{\\textalltt[]"^url^"}")) ; def_code "\\hyperref" 420 (fun lexbuf -> Save.start_echo () ; let url = save_arg lexbuf in let url = Save.get_echo () in let category = get_prim_arg lexbuf in 425 let name = get_prim_arg lexbuf in let {arg=text ; subst=subst} = save_arg lexbuf in scan_this_arg main (mkarg ("\\ahref{\\textalltt[]"^url^ 430 "\\#"^category^"."^name^"}{"^text^"}") subst))) ;; (* (extended) keyval package *) 435 let keyval_name f k = "\\KV@"^f^"@"^k let keyval_extra f k = keyval_name f k^"@extra" 440 let do_definekey lexbuf = let argdef = save_opts ["1" ; ""] lexbuf in let family = get_prim_arg lexbuf in let key = get_prim_arg lexbuf in let opt = save_opts [""] lexbuf in 445 let body = subst_body lexbuf in begin match argdef with | {arg=No _}:: _ -> begin match opt with | [{arg=No _}] -> 450 Latexmacros.def (keyval_name family key) one_pat (Subst body) | [{arg=Yes opt ; subst=subst}] -> Latexmacros.def (keyval_name family key) one_pat (Subst body) ; Latexmacros.def (keyval_name family key^"@default") zero_pat 455 (Subst ((keyval_name family key^ "{"^do_subst_this (mkarg opt subst))^"}")) | _ -> assert false end 460 | [{arg=Yes nargs ; subst=subst} ; opt] -> let nargs = Get.get_int (mkarg nargs subst) in let extra = keyval_extra key family in Latexmacros.def (keyval_name family key) one_pat (Subst 465 ("\\@funcall{"^extra^"}{#1}")) ; begin match opt with | {arg=No _} -> Latexmacros.def extra (latex_pat [] nargs) (Subst body) | {arg=Yes opt ; subst=o_subst} -> 470 Latexmacros.def extra (latex_pat [do_subst_this (mkarg opt o_subst)] nargs) (Subst body) end 475 | _ -> assert false end ;; let do_definekeyopt lexbuf = 480 let familly = get_prim_arg lexbuf in let key = get_prim_arg lexbuf in let opt = subst_arg lexbuf in let body = subst_body lexbuf in let name = keyval_name familly key in 485 let extra = keyval_extra key familly in Latexmacros.def name one_pat (Subst ("\\@funcall{"^extra^"}{"^opt^"}")) ; Latexmacros.def extra one_pat (Subst body) 490 let do_setkey lexbuf = let family = get_prim_arg lexbuf in let arg = subst_arg lexbuf^",," in 495 let abuff = Lexing.from_string arg in let rec do_rec () = let {arg=x} = save_arg_with_delim "," abuff in if x <> "" then begin let xbuff = Lexing.from_string (x^"==") in 500 check_alltt_skip xbuff ; let {arg=key} = save_arg_with_delim "=" xbuff in let {arg=value} = save_arg_with_delim "=" xbuff in if !verbose > 1 then Printf.fprintf stderr "SETKEY, key=%s, value=%s\n" key value ; 505 let csname = keyval_name family key in if Latexmacros.exists csname then begin if value <> "" then scan_this main (csname^"{"^value^"}") else 510 scan_this main (csname^"@default") end else warning ("keyval, uknown key: ``"^key^"''") ; do_rec () end in 515 do_rec () ;; register_init "keyval" (fun () -> 520 def_code "\\define@key" do_definekey ; def_code "\\@setkeys" do_setkey ) ;; 525 register_init "amsmath" (fun () -> def_code "\\numberwithin" (fun lexbuf -> let name = get_prim_arg lexbuf in 530 let within = get_prim_arg lexbuf in Counter.number_within name within) ) ;; 535 end <6>108 parse_opts.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) open Misc let header = "$Id: parse_opts.ml,v 1.25 2001/05/25 12:37:27 maranget Exp $" 15 type input = File of string | Prog of string let files = ref [] ;; 20 let add_input s = files := File s :: !files and add_program s = files := Prog s :: !files 25 ;; type language = Francais | English ;; 30 type destination = Html | Text | Info ;; let mathml = ref false and entities = ref false ;; 35 let language = ref English and symbols = ref true and iso = ref true and pedantic = ref false 40 and destination = ref Html and fixpoint = ref false and optimize = ref false ;; 45 let width = ref 72 ;; let except = ref [] 50 ;; let path = ref [] ;; 55 let outname = ref "" ;; let _ = Arg.parse [ 60 ("-version", Arg.Unit (fun () -> print_endline ("hevea "^Version.version) ; print_endline ("library directory: "^Mylib.static_libdir) ; exit 0), 65 "show hevea version and library directory") ; ("-v", Arg.Unit (fun () -> readverb := !readverb + 1), "verbose flag, can be repeated to increase verbosity") ; ("-s", Arg.Unit (fun () -> silent := true), "suppress warnings") ; 70 ("-e", Arg.String (fun s -> except := s :: !except), "filename, prevent file ``filename'' from being read") ; ("-fix", Arg.Unit (fun () -> fixpoint := true), "iterate Hevea until fixpoint") ; ("-O", Arg.Unit (fun () -> optimize := true), 75 "call esponja to optimize HTML output") ; ("-exec", Arg.String add_program, "prog , execute external program ``prog'', then read its result") ; ("-francais",Arg.Unit (fun () -> language := Francais), "french mode") ; 80 ("-nosymb",Arg.Unit (fun () -> symbols := false), "do not output symbol fonts") ; ("-noiso",Arg.Unit (fun () -> iso := false), "use HTML entities in place of isolatin1 non-ascii characters") ; ("-pedantic",Arg.Unit (fun () -> pedantic := true), 85 "be pedantic in interpreting HTML 4.0 transitional definition") ; ("-I", Arg.String (fun s -> path := s :: !path), "dir, add directory ``dir'' to search path") ; ("-mathml",Arg.Unit (fun() -> mathml := true), "produces MathML output for equations, very experimental"); 90 ("-entities",Arg.Unit (fun() -> entities := true), "produces HTML 4.0 entities and unicode characters references for symbols, very experimental"); ("-text",Arg.Unit (fun () -> symbols := false; destination := Text), "output plain text"); ("-info",Arg.Unit (fun () -> symbols := false; destination := Info), 95 "output info file(s)"); ("-w", Arg.String (fun s -> width := int_of_string s), "width, set the output width for text or info output"); ("-o", Arg.String (fun s -> outname := s), "filename, make hevea output go into file ``filename''") 100 ] (add_input) ("hevea "^Version.version) ;; 105 let warning s = if not !silent || !verbose > 0 then begin Location.print_pos () ; prerr_string "Warning: " ; prerr_endline s 110 end ;; (* For correcting strange user (-exec prog en dernier) *) let rec ffirst = function 115 | [] -> None,[] | Prog _ as arg::rem -> let file, rest = ffirst rem in file, arg::rest | File _ as arg::rem -> 120 Some arg,rem ;; files := match ffirst !files with 125 | None,rem -> rem | Some arg,rem -> arg::rem 130 let base_in,name_in,styles = match !files with | File x :: rest -> if Filename.check_suffix x ".hva" then "","", !files else 135 let base_file = Filename.basename x in begin try let base = if Filename.check_suffix base_file ".tex" then Filename.chop_extension base_file 140 else base_file in base,x,rest with Invalid_argument _ -> base_file, x,rest end 145 | _ -> "","",!files let filter = match base_in with "" -> true | _ -> false ;; 150 if filter then begin if !fixpoint then Misc.warning ("No fixpoint in filter mode"); fixpoint := false end 155 ;; let base_out = match !outname with | "" -> begin match base_in with | "" -> "" 160 | _ -> Filename.basename base_in end | name -> let suff = match !destination with | Html -> ".html" 165 | Text -> ".txt" | Info -> ".info" in if Filename.check_suffix name suff then Filename.chop_suffix name suff 170 else try Filename.chop_extension name with Invalid_argument _ -> name 175 let name_out = match !outname with | "" -> begin match base_in with | "" -> "" | x -> begin match !destination with 180 | Html ->x^".html" | Text ->x^".txt" | Info ->x^".info" end end 185 | x -> x <6>109 pp.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: pp.ml,v 1.4 2001/05/28 17:28:56 maranget Exp $ *) (***********************************************************************) open Printf open Lexeme open Tree 15 let potag chan ({txt=txt} as s)= output_string chan txt ; s let rec pctag chan {ctxt=txt} = output_string chan txt 20 let rec tree po pc chan = function | Text txt -> output_string chan txt | Blanks txt -> output_string chan txt 25 | Node (styles, ts) -> let styles = po chan styles in trees po pc chan ts ; pc chan styles | ONode (so,sc,ts) -> 30 output_string chan so ; trees po pc chan ts ; output_string chan sc and trees po pc chan = function 35 | [] -> () | t::rem -> tree po pc chan t ; trees po pc chan rem let ptree chan t = tree potag pctag chan t and ptrees chan ts = trees potag pctag chan ts 40 open Htmltext let rec sep_font = function | [] -> [],[] 45 | {nat=(Size (Int _)|Face _|Color _)} as s::rem -> let fs,os = sep_font rem in s::fs,os | s::rem -> let fs,os = sep_font rem in 50 fs,s::os let rec do_potags chan = function | [] -> () 55 | {txt=txt}::rem -> output_string chan txt ; do_potags chan rem let rec do_pctags chan = function 60 | [] -> () | {ctxt=txt}::rem -> do_pctags chan rem ; output_string chan txt 65 let potags chan x = let fs,os = sep_font x in let styles = match fs with | [] -> os | {ctxt=ctxt}::_ -> 70 let txt = "<" ^ String.sub ctxt 2 4 ^ List.fold_right (fun {txt=atxt} r -> atxt ^ r) fs ">" in 75 {nat=Other ; txt=txt ; ctxt=ctxt}::os in (* output_char chan '[' ; *) do_potags chan styles ; (* output_char chan ']' ; *) styles 80 and pctags chan x = do_pctags chan x let tree chan t = tree potags pctags chan t and trees chan ts = trees potags pctags chan ts <6>110 save.ml 12 "save.mll" open Lexing open Misc 5 let header = "$Id: save.mll,v 1.60 2001/02/12 10:05:39 maranget Exp $" let rec if_next_char c lb = if lb.lex_eof_reached then 10 false else let pos = lb.lex_curr_pos and len = lb.lex_buffer_len in if pos >= len then begin 15 warning "Refilling buffer" ; lb.refill_buff lb ; if_next_char c lb end else lb.lex_buffer.[pos] = c 20 let rec if_next_string s lb = if s = "" then true else 25 let pos = lb.lex_curr_pos and len = lb.lex_buffer_len and slen = String.length s in if pos + slen - 1 >= len then begin if lb.lex_eof_reached then begin 30 false end else begin lb.refill_buff lb ; if_next_string s lb end 35 end else String.sub lb.lex_buffer pos slen = s let verbose = ref 0 and silent = ref false ;; 40 let set_verbose s v = silent := s ; verbose := v ;; 45 exception Error of string ;; exception Delim of string ;; 50 let seen_par = ref false ;; let brace_nesting = ref 0 55 and arg_buff = Out.create_buff () and echo_buff = Out.create_buff () and tag_buff = Out.create_buff () ;; 60 let echo = ref false ;; let get_echo () = echo := false ; Out.to_string echo_buff 65 and start_echo () = echo := true ; Out.reset echo_buff and stop_echo () = echo := false ; Out.reset echo_buff ;; let empty_buffs () = 70 brace_nesting := 0 ; Out.reset arg_buff ; echo := false ; Out.reset echo_buff ; Out.reset tag_buff ;; 75 let error s = empty_buffs () ; raise (Error s) ;; 80 let my_int_of_string s = try int_of_string s with Failure "int_of_string" -> error ("Integer argument expected: ``"^s^"''") 85 exception Eof ;; exception NoOpt ;; 90 let put_echo s = if !echo then Out.put echo_buff s and put_echo_char c = if !echo then Out.put_char echo_buff c and blit_echo lb = 95 if !echo then Out.blit echo_buff lb ;; let put_both s = put_echo s ; Out.put arg_buff s 100 ;; let blit_both lexbuf = blit_echo lexbuf ; Out.blit arg_buff lexbuf let put_both_char c = 105 put_echo_char c ; Out.put_char arg_buff c ;; type kmp_t = Continue of int | Stop of string 110 let rec kmp_char delim next i c = if i < 0 then begin Out.put_char arg_buff c ; Continue 0 end else if c = delim.[i] then begin 115 if i >= String.length delim - 1 then Stop (Out.to_string arg_buff) else Continue (i+1) end else begin 120 if next.(i) >= 0 then Out.put arg_buff (String.sub delim 0 (i-next.(i))) ; kmp_char delim next next.(i) c end let lex_tables = { 125 Lexing.lex_base = "\000\000\001\000\002\000\000\000\006\000\003\000\004\000\008\000\ \013\000\015\000\005\000\020\000\007\000\018\000\026\000\105\000\ \010\000\035\000\040\000\047\000\024\000\027\000\009\000\008\000\ \020\000\017\000\000\000\012\000\013\000\056\000\011\000\000\000\ \255\255\254\255\253\255\000\000\254\255\252\255\000\000\001\000\ \000\000\005\000\002\000\008\000\015\000\005\000\007\000\016\000\ \033\000\024\000\030\000\255\255\000\000\250\255\060\000\005\000\ \249\255\001\000\002\000\030\000\032\000\002\000\034\000\040\000\ \014\000\015\000\251\255\016\000\042\000\122\000\041\000\071\000\ \176\000\072\000\076\000\057\000\064\000\069\000\074\000\078\000\ \078\000\083\000\074\000\076\000\083\000\088\000\078\000\080\000\ \080\000\089\000\093\000\090\000\095\000\086\000\088\000\194\000\ \195\000\197\000\000\001\163\000\182\000\185\000\191\000\015\000\ \023\001\038\001\241\000\109\001\240\000\045\000\010\001\000\000\ \099\000\002\000\120\000\106\000\112\000\126\000\115\000\124\000\ \103\000\028\001\153\000\001\000\139\000\145\000\177\000\172\000\ \183\000\030\001\244\000\245\000\255\255\254\255\248\000\050\001\ \111\001\116\001\118\001\136\001\001\000\105\001\253\255\185\001\ \254\255\248\255\013\002\094\002\175\002\000\003\058\003\139\003\ \004\000\138\001\154\001\156\001\253\255\255\255\254\255\186\001\ \188\001"; Lexing.lex_backtrk = "\002\000\255\255\255\255\001\000\008\000\255\255\255\255\001\000\ \001\000\000\000\255\255\002\000\255\255\001\000\000\000\007\000\ \002\000\005\000\002\000\002\000\002\000\002\000\000\000\255\255\ \255\255\255\255\002\000\002\000\255\255\001\000\255\255\001\000\ \255\255\255\255\255\255\002\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\002\000\255\255\005\000\001\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\001\000\001\000\001\000\255\255\ \255\255\000\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\001\000\ \000\000\000\000\255\255\255\255\001\000\255\255\006\000\006\000\ \002\000\003\000\000\000\000\000\003\000\255\255\255\255\001\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\000\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\001\000\004\000\005\000\255\255\255\255\004\000\000\000\ \255\255\000\000\000\000\000\000\000\000\006\000\255\255\006\000\ \255\255\255\255\004\000\004\000\004\000\004\000\255\255\003\000\ \000\000\000\000\001\000\001\000\255\255\255\255\255\255\255\255\ \255\255"; Lexing.lex_default = 130 "\255\255\037\000\034\000\255\255\056\000\032\000\006\000\255\255\ \255\255\255\255\130\000\255\255\033\000\255\255\106\000\255\255\ \095\000\255\255\255\255\255\255\033\000\033\000\022\000\053\000\ \034\000\034\000\255\255\255\255\034\000\255\255\032\000\255\255\ \000\000\000\000\000\000\255\255\000\000\000\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\000\000\255\255\000\000\255\255\255\255\ \000\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\000\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\095\000\ \255\255\255\255\255\255\255\255\255\255\056\000\255\255\066\000\ \255\255\255\255\106\000\106\000\255\255\109\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\134\000\255\255\000\000\000\000\134\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\000\000\066\000\ \000\000\000\000\255\255\255\255\255\255\255\255\037\000\255\255\ \255\255\255\255\255\255\255\255\000\000\000\000\000\000\255\255\ \255\255"; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\159\000\160\000\152\000\154\000\159\000\152\000\139\000\ \140\000\007\000\032\000\139\000\096\000\007\000\136\000\137\000\ \009\000\000\000\136\000\110\000\009\000\121\000\121\000\110\000\ \159\000\121\000\033\000\107\000\108\000\032\000\139\000\107\000\ \007\000\141\000\096\000\142\000\073\000\136\000\054\000\009\000\ \073\000\072\000\110\000\051\000\121\000\072\000\036\000\033\000\ \071\000\000\000\107\000\069\000\071\000\032\000\255\255\109\000\ \032\000\032\000\032\000\073\000\055\000\032\000\034\000\057\000\ \072\000\034\000\066\000\037\000\135\000\032\000\000\000\071\000\ \071\000\073\000\051\000\058\000\071\000\073\000\000\000\000\000\ \032\000\000\000\000\000\032\000\038\000\122\000\156\000\000\000\ \000\000\131\000\143\000\111\000\062\000\112\000\114\000\071\000\ \073\000\035\000\047\000\043\000\039\000\052\000\040\000\041\000\ \122\000\042\000\097\000\097\000\070\000\044\000\097\000\068\000\ \045\000\046\000\033\000\032\000\157\000\048\000\158\000\074\000\ \132\000\144\000\133\000\255\255\255\255\255\255\032\000\033\000\ \036\000\097\000\049\000\098\000\050\000\032\000\032\000\123\000\ \099\000\032\000\067\000\255\255\065\000\063\000\255\255\066\000\ \064\000\100\000\100\000\100\000\100\000\100\000\100\000\100\000\ \100\000\100\000\100\000\059\000\033\000\032\000\032\000\088\000\ \060\000\084\000\061\000\032\000\032\000\032\000\032\000\032\000\ \032\000\032\000\032\000\032\000\078\000\075\000\079\000\080\000\ \076\000\072\000\077\000\081\000\082\000\072\000\083\000\034\000\ \085\000\086\000\087\000\033\000\089\000\090\000\091\000\092\000\ \093\000\101\000\094\000\037\000\255\255\096\000\097\000\097\000\ \072\000\113\000\097\000\104\000\104\000\104\000\104\000\104\000\ \104\000\104\000\104\000\115\000\102\000\116\000\117\000\118\000\ \119\000\120\000\255\255\096\000\032\000\097\000\100\000\100\000\ \100\000\100\000\100\000\100\000\100\000\100\000\100\000\100\000\ \053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\ \053\000\108\000\108\000\255\255\124\000\108\000\125\000\126\000\ \033\000\255\255\032\000\033\000\032\000\037\000\145\000\034\000\ \056\000\255\255\255\255\033\000\032\000\037\000\032\000\255\255\ \108\000\037\000\127\000\110\000\037\000\103\000\255\255\110\000\ \255\255\128\000\255\255\255\255\129\000\255\255\000\000\000\000\ \000\000\000\000\000\000\066\000\000\000\121\000\121\000\129\000\ \033\000\121\000\110\000\129\000\000\000\255\255\000\000\033\000\ \105\000\105\000\105\000\105\000\105\000\105\000\105\000\105\000\ \105\000\105\000\000\000\135\000\121\000\255\255\129\000\135\000\ \000\000\105\000\105\000\105\000\105\000\105\000\105\000\104\000\ \104\000\104\000\104\000\104\000\104\000\104\000\104\000\000\000\ \255\255\034\000\135\000\000\000\255\255\000\000\105\000\105\000\ \105\000\105\000\105\000\105\000\105\000\105\000\105\000\105\000\ \000\000\105\000\105\000\105\000\105\000\105\000\105\000\105\000\ \105\000\105\000\105\000\105\000\105\000\000\000\255\255\255\255\ \034\000\255\255\034\000\255\255\000\000\255\255\107\000\108\000\ \136\000\137\000\107\000\000\000\136\000\137\000\138\000\138\000\ \138\000\137\000\000\000\138\000\000\000\032\000\000\000\105\000\ \105\000\105\000\105\000\105\000\105\000\107\000\000\000\136\000\ \000\000\153\000\255\255\153\000\137\000\153\000\138\000\153\000\ \000\000\255\255\053\000\053\000\053\000\053\000\053\000\053\000\ \053\000\053\000\053\000\155\000\000\000\155\000\000\000\155\000\ \153\000\155\000\153\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\255\255\155\000\000\000\155\000\000\000\000\000\000\000\ \000\000\000\000\255\255\159\000\160\000\160\000\000\000\159\000\ \000\000\160\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\159\000\000\000\160\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\255\255\000\000\000\000\000\000\000\000\000\000\ \000\000\255\255\000\000\000\000\255\255\000\000\000\000\000\000\ \255\255\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\000\000\032\000\000\000\032\000\ \000\000\000\000\146\000\147\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\000\000\000\000\000\000\066\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \000\000\000\000\000\000\000\000\000\000\255\255\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \066\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\255\255\000\000\000\000\000\000\000\000\000\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\148\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\066\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\000\000\000\000\000\000\000\000\000\000\000\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\149\000\ \146\000\146\000\066\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\000\000\150\000\000\000\000\000\000\000\ \000\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\000\000\000\000\000\000\ \000\000\000\000\000\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\037\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\000\000\000\000\ \000\000\000\000\000\000\000\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\255\255\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000"; Lexing.lex_check = "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\000\000\000\000\140\000\002\000\000\000\152\000\004\000\ \004\000\007\000\007\000\004\000\016\000\007\000\008\000\008\000\ \009\000\255\255\008\000\013\000\009\000\011\000\011\000\013\000\ \000\000\011\000\052\000\014\000\014\000\003\000\004\000\014\000\ \007\000\004\000\016\000\004\000\017\000\008\000\023\000\009\000\ \017\000\018\000\013\000\025\000\011\000\018\000\024\000\109\000\ \019\000\255\255\014\000\020\000\019\000\031\000\021\000\014\000\ \058\000\029\000\029\000\017\000\023\000\029\000\014\000\055\000\ \018\000\064\000\065\000\067\000\009\000\068\000\255\255\019\000\ \071\000\073\000\024\000\057\000\071\000\073\000\255\255\255\255\ \029\000\255\255\255\255\000\000\026\000\123\000\001\000\255\255\ \255\255\010\000\004\000\012\000\061\000\111\000\113\000\071\000\ \073\000\028\000\039\000\042\000\038\000\025\000\038\000\040\000\ \011\000\041\000\015\000\015\000\020\000\043\000\015\000\021\000\ \044\000\045\000\046\000\035\000\001\000\047\000\001\000\017\000\ \010\000\004\000\010\000\004\000\022\000\016\000\018\000\027\000\ \028\000\015\000\048\000\015\000\049\000\013\000\019\000\011\000\ \015\000\050\000\059\000\020\000\060\000\062\000\021\000\014\000\ \063\000\015\000\015\000\015\000\015\000\015\000\015\000\015\000\ \015\000\015\000\015\000\054\000\070\000\068\000\071\000\075\000\ \054\000\076\000\054\000\069\000\069\000\069\000\069\000\069\000\ \069\000\069\000\069\000\069\000\077\000\074\000\078\000\079\000\ \074\000\072\000\074\000\080\000\081\000\072\000\082\000\083\000\ \084\000\085\000\086\000\087\000\088\000\089\000\090\000\091\000\ \092\000\015\000\093\000\094\000\095\000\096\000\097\000\097\000\ \072\000\112\000\097\000\099\000\099\000\099\000\099\000\099\000\ \099\000\099\000\099\000\114\000\101\000\115\000\116\000\117\000\ \118\000\119\000\095\000\096\000\120\000\097\000\100\000\100\000\ \100\000\100\000\100\000\100\000\100\000\100\000\100\000\100\000\ \102\000\102\000\102\000\102\000\102\000\102\000\102\000\102\000\ \102\000\108\000\108\000\106\000\122\000\108\000\124\000\125\000\ \000\000\001\000\002\000\005\000\006\000\010\000\004\000\012\000\ \023\000\022\000\016\000\030\000\027\000\028\000\072\000\103\000\ \108\000\025\000\126\000\110\000\024\000\101\000\106\000\110\000\ \020\000\127\000\014\000\021\000\128\000\106\000\255\255\255\255\ \255\255\255\255\255\255\017\000\255\255\121\000\121\000\129\000\ \018\000\121\000\110\000\129\000\255\255\109\000\255\255\019\000\ \098\000\098\000\098\000\098\000\098\000\098\000\098\000\098\000\ \098\000\098\000\255\255\135\000\121\000\095\000\129\000\135\000\ \255\255\098\000\098\000\098\000\098\000\098\000\098\000\104\000\ \104\000\104\000\104\000\104\000\104\000\104\000\104\000\255\255\ \130\000\131\000\135\000\255\255\134\000\255\255\105\000\105\000\ \105\000\105\000\105\000\105\000\105\000\105\000\105\000\105\000\ \255\255\098\000\098\000\098\000\098\000\098\000\098\000\105\000\ \105\000\105\000\105\000\105\000\105\000\255\255\106\000\130\000\ \131\000\130\000\131\000\134\000\255\255\134\000\107\000\107\000\ \136\000\136\000\107\000\255\255\136\000\137\000\137\000\138\000\ \138\000\137\000\255\255\138\000\255\255\110\000\255\255\105\000\ \105\000\105\000\105\000\105\000\105\000\107\000\255\255\136\000\ \255\255\139\000\107\000\153\000\137\000\139\000\138\000\153\000\ \255\255\107\000\141\000\141\000\141\000\141\000\141\000\141\000\ \141\000\141\000\141\000\154\000\255\255\155\000\255\255\154\000\ \139\000\155\000\153\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\101\000\154\000\255\255\155\000\255\255\255\255\255\255\ \255\255\255\255\095\000\159\000\159\000\160\000\255\255\159\000\ \255\255\160\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\159\000\255\255\160\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\107\000\255\255\255\255\255\255\255\255\255\255\ \255\255\106\000\255\255\255\255\130\000\255\255\255\255\255\255\ \134\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ \143\000\143\000\143\000\143\000\255\255\159\000\255\255\160\000\ \255\255\255\255\143\000\143\000\143\000\143\000\143\000\143\000\ \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ \143\000\143\000\143\000\143\000\255\255\255\255\255\255\146\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \255\255\255\255\255\255\255\255\255\255\107\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \146\000\146\000\146\000\146\000\146\000\146\000\146\000\146\000\ \147\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\147\000\147\000\ \147\000\147\000\147\000\147\000\147\000\147\000\147\000\147\000\ \147\000\147\000\147\000\147\000\147\000\147\000\147\000\147\000\ \147\000\147\000\147\000\147\000\147\000\147\000\147\000\147\000\ \147\000\143\000\255\255\255\255\255\255\255\255\255\255\147\000\ \147\000\147\000\147\000\147\000\147\000\147\000\147\000\147\000\ \147\000\147\000\147\000\147\000\147\000\147\000\147\000\147\000\ \147\000\147\000\147\000\147\000\147\000\147\000\147\000\147\000\ \147\000\148\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\148\000\ \148\000\148\000\148\000\148\000\148\000\148\000\148\000\148\000\ \148\000\148\000\148\000\148\000\148\000\148\000\148\000\148\000\ \148\000\148\000\148\000\148\000\148\000\148\000\148\000\148\000\ \148\000\148\000\255\255\255\255\255\255\255\255\255\255\255\255\ \148\000\148\000\148\000\148\000\148\000\148\000\148\000\148\000\ \148\000\148\000\148\000\148\000\148\000\148\000\148\000\148\000\ \148\000\148\000\148\000\148\000\148\000\148\000\148\000\148\000\ \148\000\148\000\149\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \149\000\149\000\149\000\149\000\149\000\149\000\149\000\149\000\ \149\000\149\000\149\000\149\000\149\000\149\000\149\000\149\000\ \149\000\149\000\149\000\149\000\149\000\149\000\149\000\149\000\ \149\000\149\000\149\000\255\255\149\000\255\255\255\255\255\255\ \255\255\149\000\149\000\149\000\149\000\149\000\149\000\149\000\ \149\000\149\000\149\000\149\000\149\000\149\000\149\000\149\000\ \149\000\149\000\149\000\149\000\149\000\149\000\149\000\149\000\ \149\000\149\000\149\000\150\000\150\000\150\000\150\000\150\000\ \150\000\150\000\150\000\150\000\150\000\150\000\150\000\150\000\ \150\000\150\000\150\000\150\000\150\000\150\000\150\000\150\000\ \150\000\150\000\150\000\150\000\150\000\255\255\255\255\255\255\ \255\255\255\255\255\255\150\000\150\000\150\000\150\000\150\000\ \150\000\150\000\150\000\150\000\150\000\150\000\150\000\150\000\ \150\000\150\000\150\000\150\000\150\000\150\000\150\000\150\000\ \150\000\150\000\150\000\150\000\150\000\151\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\255\255\255\255\ \255\255\255\255\255\255\255\255\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\151\000\151\000\ \151\000\151\000\151\000\151\000\151\000\151\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\150\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255" 135 } let rec opt lexbuf = __ocaml_lex_opt_rec lexbuf 0 and __ocaml_lex_opt_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 140 0 -> ( 140 "save.mll" put_echo (lexeme lexbuf) ; opt2 lexbuf) | 1 -> ( 145 142 "save.mll" raise Eof) | 2 -> ( 143 "save.mll" raise NoOpt) 150 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_opt_rec lexbuf n and opt2 lexbuf = __ocaml_lex_opt2_rec lexbuf 1 and __ocaml_lex_opt2_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 155 0 -> ( 147 "save.mll" incr brace_nesting; put_both_char '{' ; opt2 lexbuf) | 1 -> ( 160 149 "save.mll" decr brace_nesting; if !brace_nesting >= 0 then begin put_both_char '}' ; opt2 lexbuf end else begin 165 error "Bad brace nesting in optional argument" end) | 2 -> ( 156 "save.mll" if !brace_nesting > 0 then begin 170 put_both_char ']' ; opt2 lexbuf end else begin put_echo_char ']' ; Out.to_string arg_buff end) 175 | 3 -> ( 163 "save.mll" let s = lexeme_char lexbuf 0 in put_both_char s ; opt2 lexbuf ) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_opt2_rec lexbuf n 180 and skip_comment lexbuf = __ocaml_lex_skip_comment_rec lexbuf 2 and __ocaml_lex_skip_comment_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 185 167 "save.mll" ()) | 1 -> ( 168 "save.mll" ()) 190 | 2 -> ( 169 "save.mll" skip_comment lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_comment_rec lexbuf n 195 and check_comment lexbuf = __ocaml_lex_check_comment_rec lexbuf 3 and __ocaml_lex_check_comment_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 172 "save.mll" 200 skip_comment lexbuf) | 1 -> ( 173 "save.mll" ()) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_check_comment_rec lexbuf n 205 and arg lexbuf = __ocaml_lex_arg_rec lexbuf 4 and __ocaml_lex_arg_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 210 176 "save.mll" put_echo (lexeme lexbuf) ; arg lexbuf) | 1 -> ( 178 "save.mll" incr brace_nesting; 215 put_echo_char '{' ; arg2 lexbuf) | 2 -> ( 182 "save.mll" skip_comment lexbuf ; arg lexbuf) 220 | 3 -> ( 184 "save.mll" let lxm = lexeme lexbuf in put_echo lxm ; lxm) 225 | 4 -> ( 188 "save.mll" blit_both lexbuf ; skip_blanks lexbuf) | 5 -> ( 230 191 "save.mll" let lxm = lexeme lexbuf in put_echo lxm ; lxm) | 6 -> ( 194 "save.mll" 235 let c = lexeme_char lexbuf 0 in put_both_char c ; Out.to_string arg_buff) | 7 -> ( 197 "save.mll" 240 raise Eof) | 8 -> ( 198 "save.mll" error "Argument expected") | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_arg_rec lexbuf n 245 and first_char lexbuf = __ocaml_lex_first_char_rec lexbuf 5 and __ocaml_lex_first_char_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 250 203 "save.mll" let lxm = lexeme_char lexbuf 0 in put_echo_char lxm ; lxm) | 1 -> ( 255 206 "save.mll" raise Eof) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_first_char_rec lexbuf n and rest lexbuf = __ocaml_lex_rest_rec lexbuf 6 260 and __ocaml_lex_rest_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 210 "save.mll" let lxm = lexeme lexbuf in 265 put_echo lxm ; lxm) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_rest_rec lexbuf n and skip_blanks lexbuf = __ocaml_lex_skip_blanks_rec lexbuf 7 270 and __ocaml_lex_skip_blanks_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 216 "save.mll" seen_par := false ; 275 put_echo (lexeme lexbuf) ; more_skip lexbuf) | 1 -> ( 220 "save.mll" put_echo (lexeme lexbuf) ; Out.to_string arg_buff) 280 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_blanks_rec lexbuf n and more_skip lexbuf = __ocaml_lex_more_skip_rec lexbuf 8 and __ocaml_lex_more_skip_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 285 0 -> ( 224 "save.mll" seen_par := true ; put_echo (lexeme lexbuf) ; more_skip lexbuf) 290 | 1 -> ( 228 "save.mll" Out.to_string arg_buff) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_more_skip_rec lexbuf n 295 and skip_equal lexbuf = __ocaml_lex_skip_equal_rec lexbuf 9 and __ocaml_lex_skip_equal_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 231 "save.mll" 300 ()) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_equal_rec lexbuf n and arg2 lexbuf = __ocaml_lex_arg2_rec lexbuf 10 and __ocaml_lex_arg2_rec lexbuf state = 305 match Lexing.engine lex_tables state lexbuf with 0 -> ( 235 "save.mll" incr brace_nesting; put_both_char '{' ; 310 arg2 lexbuf) | 1 -> ( 239 "save.mll" decr brace_nesting; if !brace_nesting > 0 then begin 315 put_both_char '}' ; arg2 lexbuf end else begin put_echo_char '}' ; Out.to_string arg_buff end) 320 | 2 -> ( 247 "save.mll" blit_both lexbuf ; arg2 lexbuf ) | 3 -> ( 249 "save.mll" 325 error "End of file in argument") | 4 -> ( 252 "save.mll" blit_both lexbuf ; arg2 lexbuf ) | 5 -> ( 330 255 "save.mll" let c = lexeme_char lexbuf 0 in put_both_char c ; arg2 lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_arg2_rec lexbuf n 335 and csname lexbuf = __ocaml_lex_csname_rec lexbuf 11 and __ocaml_lex_csname_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 260 "save.mll" 340 (fun get_prim subst -> blit_echo lexbuf ; csname lexbuf get_prim subst)) | 1 -> ( 263 "save.mll" (fun get_prim subst_fun -> 345 blit_echo lexbuf ; let r = incsname lexbuf in "\\"^get_prim r)) | 2 -> ( 267 "save.mll" 350 fun get_prim subst -> let r = arg lexbuf in subst r) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_csname_rec lexbuf n and incsname lexbuf = __ocaml_lex_incsname_rec lexbuf 12 and __ocaml_lex_incsname_rec lexbuf state = 355 match Lexing.engine lex_tables state lexbuf with 0 -> ( 271 "save.mll" let lxm = lexeme lexbuf in put_echo lxm ; Out.to_string arg_buff) 360 | 1 -> ( 274 "save.mll" put_both_char (lexeme_char lexbuf 0) ; incsname lexbuf) | 2 -> ( 365 276 "save.mll" error "End of file in command name") | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_incsname_rec lexbuf n and cite_arg lexbuf = __ocaml_lex_cite_arg_rec lexbuf 13 370 and __ocaml_lex_cite_arg_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 279 "save.mll" cite_args_bis lexbuf) 375 | 1 -> ( 280 "save.mll" error "No opening ``{'' in citation argument") | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_cite_arg_rec lexbuf n 380 and cite_args_bis lexbuf = __ocaml_lex_cite_args_bis_rec lexbuf 14 and __ocaml_lex_cite_args_bis_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 283 "save.mll" 385 let lxm = lexeme lexbuf in lxm::cite_args_bis lexbuf) | 1 -> ( 284 "save.mll" cite_args_bis lexbuf) | 2 -> ( 390 285 "save.mll" cite_args_bis lexbuf) | 3 -> ( 286 "save.mll" cite_args_bis lexbuf) 395 | 4 -> ( 287 "save.mll" []) | 5 -> ( 288 "save.mll" 400 error "Bad syntax for \\cite argument") | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_cite_args_bis_rec lexbuf n and num_arg lexbuf = __ocaml_lex_num_arg_rec lexbuf 15 and __ocaml_lex_num_arg_rec lexbuf state = 405 match Lexing.engine lex_tables state lexbuf with 0 -> ( 291 "save.mll" (fun get_int -> num_arg lexbuf get_int)) | 1 -> ( 410 293 "save.mll" fun get_int -> let lxm = lexeme lexbuf in my_int_of_string lxm) | 2 -> ( 415 297 "save.mll" fun get_int ->let lxm = lexeme lexbuf in my_int_of_string ("0o"^String.sub lxm 1 (String.length lxm-1))) | 3 -> ( 300 "save.mll" 420 fun get_int ->let lxm = lexeme lexbuf in my_int_of_string ("0x"^String.sub lxm 1 (String.length lxm-1))) | 4 -> ( 303 "save.mll" fun get_int ->let c = lexeme_char lexbuf 2 in 425 Char.code c) | 5 -> ( 306 "save.mll" fun get_int -> let lxm = lexeme lexbuf in 430 get_int (String.sub lxm 1 2)) | 6 -> ( 310 "save.mll" fun get_int ->let c = lexeme_char lexbuf 1 in Char.code c) 435 | 7 -> ( 313 "save.mll" fun get_int -> let s = arg lexbuf in get_int s) 440 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_num_arg_rec lexbuf n and filename lexbuf = __ocaml_lex_filename_rec lexbuf 16 and __ocaml_lex_filename_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 445 0 -> ( 319 "save.mll" put_echo (lexeme lexbuf) ; filename lexbuf) | 1 -> ( 320 "save.mll" 450 let lxm = lexeme lexbuf in put_echo lxm ; lxm) | 2 -> ( 321 "save.mll" arg lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_filename_rec lexbuf n 455 and get_limits lexbuf = __ocaml_lex_get_limits_rec lexbuf 17 and __ocaml_lex_get_limits_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 460 324 "save.mll" get_limits lexbuf) | 1 -> ( 325 "save.mll" Some Limits) 465 | 2 -> ( 326 "save.mll" Some NoLimits) | 3 -> ( 327 "save.mll" 470 Some IntLimits) | 4 -> ( 328 "save.mll" raise Eof) | 5 -> ( 475 329 "save.mll" None) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_get_limits_rec lexbuf n and get_sup lexbuf = __ocaml_lex_get_sup_rec lexbuf 18 480 and __ocaml_lex_get_sup_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 332 "save.mll" try Some (arg lexbuf) with Eof -> error "End of file after ^") 485 | 1 -> ( 333 "save.mll" raise Eof) | 2 -> ( 334 "save.mll" 490 None) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_get_sup_rec lexbuf n and get_sub lexbuf = __ocaml_lex_get_sub_rec lexbuf 19 and __ocaml_lex_get_sub_rec lexbuf state = 495 match Lexing.engine lex_tables state lexbuf with 0 -> ( 338 "save.mll" try Some (arg lexbuf) with Eof -> error "End of file after _") | 1 -> ( 500 339 "save.mll" raise Eof) | 2 -> ( 340 "save.mll" None) 505 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_get_sub_rec lexbuf n and defargs lexbuf = __ocaml_lex_defargs_rec lexbuf 20 and __ocaml_lex_defargs_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 510 0 -> ( 344 "save.mll" let lxm = lexeme lexbuf in put_echo lxm ; lxm::defargs lexbuf) 515 | 1 -> ( 348 "save.mll" blit_both lexbuf ; let r = in_defargs lexbuf in r :: defargs lexbuf) 520 | 2 -> ( 351 "save.mll" []) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_defargs_rec lexbuf n 525 and in_defargs lexbuf = __ocaml_lex_in_defargs_rec lexbuf 21 and __ocaml_lex_in_defargs_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 354 "save.mll" 530 blit_both lexbuf ; in_defargs lexbuf) | 1 -> ( 355 "save.mll" put_both_char (lexeme_char lexbuf 0) ; in_defargs lexbuf) | 2 -> ( 535 356 "save.mll" Out.to_string arg_buff) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_in_defargs_rec lexbuf n and get_defargs lexbuf = __ocaml_lex_get_defargs_rec lexbuf 22 540 and __ocaml_lex_get_defargs_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 359 "save.mll" let r = lexeme lexbuf in r) 545 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_get_defargs_rec lexbuf n and tagout lexbuf = __ocaml_lex_tagout_rec lexbuf 23 and __ocaml_lex_tagout_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 550 0 -> ( 362 "save.mll" Out.put_char tag_buff ' ' ; tagout lexbuf) | 1 -> ( 363 "save.mll" 555 intag lexbuf) | 2 -> ( 364 "save.mll" Out.put tag_buff " " ; tagout lexbuf) | 3 -> ( 560 365 "save.mll" Out.put tag_buff ">" ; tagout lexbuf) | 4 -> ( 366 "save.mll" Out.put tag_buff "<" ; tagout lexbuf) 565 | 5 -> ( 367 "save.mll" Out.blit tag_buff lexbuf ; tagout lexbuf) | 6 -> ( 368 "save.mll" 570 Out.to_string tag_buff) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_tagout_rec lexbuf n and intag lexbuf = __ocaml_lex_intag_rec lexbuf 24 and __ocaml_lex_intag_rec lexbuf state = 575 match Lexing.engine lex_tables state lexbuf with 0 -> ( 371 "save.mll" tagout lexbuf) | 1 -> ( 580 372 "save.mll" instring lexbuf) | 2 -> ( 373 "save.mll" intag lexbuf) 585 | 3 -> ( 374 "save.mll" Out.to_string tag_buff) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_intag_rec lexbuf n 590 and instring lexbuf = __ocaml_lex_instring_rec lexbuf 25 and __ocaml_lex_instring_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 377 "save.mll" 595 intag lexbuf) | 1 -> ( 378 "save.mll" instring lexbuf) | 2 -> ( 600 379 "save.mll" instring lexbuf) | 3 -> ( 380 "save.mll" Out.to_string tag_buff) 605 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_instring_rec lexbuf n and checklimits lexbuf = __ocaml_lex_checklimits_rec lexbuf 26 and __ocaml_lex_checklimits_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 610 0 -> ( 384 "save.mll" true) | 1 -> ( 385 "save.mll" 615 false) | 2 -> ( 386 "save.mll" false) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_checklimits_rec lexbuf n 620 and eat_delim_init lexbuf = __ocaml_lex_eat_delim_init_rec lexbuf 27 and __ocaml_lex_eat_delim_init_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 625 389 "save.mll" raise Eof) | 1 -> ( 391 "save.mll" fun delim next _ -> 630 put_echo_char '{' ; incr brace_nesting ; let r = arg2 lexbuf in check_comment lexbuf ; if if_next_string delim lexbuf then begin 635 skip_delim_rec lexbuf delim 0 ; r end else begin Out.put_char arg_buff '{' ; Out.put arg_buff r ; 640 Out.put_char arg_buff '}' ; eat_delim_rec lexbuf delim next 0 end) | 2 -> ( 405 "save.mll" 645 eat_delim_rec lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_eat_delim_init_rec lexbuf n and eat_delim_rec lexbuf = __ocaml_lex_eat_delim_rec_rec lexbuf 28 and __ocaml_lex_eat_delim_rec_rec lexbuf state = 650 match Lexing.engine lex_tables state lexbuf with 0 -> ( 409 "save.mll" fun delim next i -> put_echo "\\{" ; 655 match kmp_char delim next i '\\' with | Stop _ -> error "Delimitors cannot end with ``\\''" | Continue i -> match kmp_char delim next i '{' with | Stop s -> s 660 | Continue i -> eat_delim_rec lexbuf delim next i) | 1 -> ( 419 "save.mll" fun delim next i -> put_echo_char '{' ; 665 Out.put arg_buff (if i > 0 then String.sub delim 0 i else "") ; Out.put_char arg_buff '{' ; incr brace_nesting ; let r = arg2 lexbuf in Out.put arg_buff r ; 670 Out.put_char arg_buff '}' ; eat_delim_rec lexbuf delim next 0) | 2 -> ( 429 "save.mll" fun delim next i -> 675 let c = lexeme_char lexbuf 0 in put_echo_char c ; match kmp_char delim next i c with | Stop s -> s | Continue i -> eat_delim_rec lexbuf delim next i) 680 | 3 -> ( 436 "save.mll" error ("End of file in delimited argument, read: "^ Out.to_string echo_buff)) 685 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_eat_delim_rec_rec lexbuf n and skip_delim_init lexbuf = __ocaml_lex_skip_delim_init_rec lexbuf 29 and __ocaml_lex_skip_delim_init_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 690 0 -> ( 441 "save.mll" skip_delim_init lexbuf) | 1 -> ( 442 "save.mll" 695 skip_delim_rec lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_delim_init_rec lexbuf n and skip_delim_rec lexbuf = __ocaml_lex_skip_delim_rec_rec lexbuf 30 and __ocaml_lex_skip_delim_rec_rec lexbuf state = 700 match Lexing.engine lex_tables state lexbuf with 0 -> ( 446 "save.mll" fun delim i -> let c = lexeme_char lexbuf 0 in 705 put_echo_char c ; if c <> delim.[i] then raise (Delim delim) ; if i+1 < String.length delim then skip_delim_rec lexbuf delim (i+1)) 710 | 1 -> ( 454 "save.mll" fun delim i -> error ("End of file checking delimiter ``"^delim^"''")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_delim_rec_rec lexbuf n 715 and check_equal lexbuf = __ocaml_lex_check_equal_rec lexbuf 31 and __ocaml_lex_check_equal_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 720 457 "save.mll" true) | 1 -> ( 458 "save.mll" false) 725 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_check_equal_rec lexbuf n ;; 460 "save.mll" 730 let init_kmp s = let l = String.length s in let r = Array.create l (-1) in 735 let rec init_rec i j = if i+1 < l then begin if j = -1 || s.[i]=s.[j] then begin r.(i+1) <- j+1 ; 740 init_rec (i+1) (j+1) end else init_rec i r.(j) end in init_rec 0 (-1) ; 745 r let with_delim delim lexbuf = let next = init_kmp delim in check_comment lexbuf ; 750 let r = eat_delim_init lexbuf delim next 0 in r and skip_delim delim lexbuf = check_comment lexbuf ; 755 skip_delim_init lexbuf delim 0 let skip_blanks_init lexbuf = let _ = skip_blanks lexbuf in () 760 let arg_verbatim lexbuf = match first_char lexbuf with | '{' -> incr brace_nesting ; arg2 lexbuf 765 | c -> let delim = String.make 1 c in with_delim delim lexbuf <6>111 section.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: section.ml,v 1.3 1999/10/05 17:02:31 maranget Exp $" let value s = match String.uppercase s with "DOCUMENT"|"" -> 0 15 | "PART" -> 1 | "CHAPTER" -> 2 | "SECTION" -> 3 | "SUBSECTION" -> 4 | "SUBSUBSECTION" -> 5 20 | "PARAGRAPH" -> 6 | "SUBPARAGRAPH" -> 7 | _ -> 8 ;; <6>112 stack.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: stack.ml,v 1.8 2001/05/28 17:28:56 maranget Exp $ *) (***********************************************************************) exception Fatal of string type 'a t = {mutable l : 'a list ; name : string ; bottom : 'a option} 15 let create name = {l = [] ; name=name ; bottom = None} let create_init name x = {l = [] ; name=name ; bottom = Some x} 20 let reset s = s.l <- [] let bottom msg s = match s.bottom with | None -> raise (Fatal (msg^": "^s.name)) | Some x -> x 25 let name {name=name} = name and push s x = s.l <- x :: s.l 30 and pop s = match s.l with | [] -> bottom "pop" s | x :: r -> s.l <- r ; x 35 and top s = match s.l with | [] -> bottom "top" s | x :: _ -> x 40 and length s = List.length s.l and empty s = match s.l with | [] -> true | _ -> false 45 let pretty f stack = prerr_string stack.name ; prerr_string ": <<" ; let rec do_rec = function 50 | [] -> prerr_endline ">>" | [x] -> prerr_string ("``"^f x^"''") ; prerr_endline ">>" | x :: r -> 55 prerr_string "``" ; prerr_string (f x) ; prerr_string "'' " ; do_rec r in do_rec stack.l 60 let rev s = s.l <- List.rev s.l let map s f = s.l <- List.map f s.l type 'a saved = 'a list 65 let empty_saved = [] and save {l=l} = l and restore s x = s.l <- x 70 let finalize {l=now ; name=name} p f = let rec f_rec = function | [] -> () | nx::n -> if p nx then () 75 else begin f nx ; f_rec n end in f_rec now <6>113 subst.ml 12 "subst.mll" open Misc open Lexstate 5 open Lexing let subst_buff = Out.create_buff () ;; 10 let lex_tables = { Lexing.lex_base = "\000\000\001\000\002\000\030\000\250\255\251\255\253\255\111\000\ \194\000\019\001\100\001\181\001\006\002\087\002\254\255\255\255\ "; Lexing.lex_backtrk = "\006\000\002\000\255\255\002\000\255\255\255\255\255\255\004\000\ \004\000\004\000\004\000\004\000\004\000\003\000\255\255\255\255\ "; 15 Lexing.lex_default = "\001\000\001\000\255\255\005\000\000\000\000\000\000\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\000\000\000\000\ "; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\002\000\255\255\014\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\015\000\015\000\015\000\015\000\015\000\ \015\000\015\000\015\000\015\000\000\000\000\000\000\000\000\000\ \000\000\006\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\003\000\255\255\007\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\009\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\000\000\000\000\005\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \004\000\255\255\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\000\000\255\255\000\000\ \000\000\000\000\000\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\005\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\000\000\000\000\ \000\000\000\000\000\000\000\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\010\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\005\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\000\000\ \000\000\000\000\000\000\000\000\000\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\011\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\005\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \000\000\000\000\000\000\000\000\000\000\000\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\012\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\013\000\008\000\008\000\008\000\008\000\008\000\ \008\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ "; Lexing.lex_check = 20 "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\000\000\001\000\002\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\002\000\002\000\002\000\002\000\002\000\ \002\000\002\000\002\000\002\000\255\255\255\255\255\255\255\255\ \255\255\003\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\000\000\001\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\255\255\255\255\255\255\255\255\255\255\255\255\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ \003\000\007\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\007\000\ \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\ \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\ \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\ \007\000\007\000\255\255\255\255\255\255\255\255\255\255\255\255\ \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\ \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\ \007\000\007\000\007\000\007\000\007\000\007\000\007\000\007\000\ \007\000\007\000\255\255\255\255\008\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\001\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\255\255\003\000\255\255\ \255\255\255\255\255\255\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\009\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\255\255\255\255\ \255\255\255\255\255\255\255\255\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\010\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\010\000\010\000\010\000\010\000\ \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\ \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\ \010\000\010\000\010\000\010\000\010\000\010\000\010\000\255\255\ \255\255\255\255\255\255\255\255\255\255\010\000\010\000\010\000\ \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\ \010\000\010\000\010\000\010\000\010\000\010\000\010\000\010\000\ \010\000\010\000\010\000\010\000\010\000\010\000\010\000\011\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\011\000\011\000\011\000\ \011\000\011\000\011\000\011\000\011\000\011\000\011\000\011\000\ \011\000\011\000\011\000\011\000\011\000\011\000\011\000\011\000\ \011\000\011\000\011\000\011\000\011\000\011\000\011\000\011\000\ \255\255\255\255\255\255\255\255\255\255\255\255\011\000\011\000\ \011\000\011\000\011\000\011\000\011\000\011\000\011\000\011\000\ \011\000\011\000\011\000\011\000\011\000\011\000\011\000\011\000\ \011\000\011\000\011\000\011\000\011\000\011\000\011\000\011\000\ \012\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \012\000\255\255\255\255\255\255\255\255\255\255\255\255\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \012\000\012\000\012\000\012\000\012\000\012\000\012\000\012\000\ \012\000\013\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\013\000\ \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\ \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\ \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\ \013\000\013\000\255\255\255\255\255\255\255\255\255\255\255\255\ \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\ \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\ \013\000\013\000\013\000\013\000\013\000\013\000\013\000\013\000\ \013\000\013\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ " } let rec subst lexbuf = __ocaml_lex_subst_rec lexbuf 0 and __ocaml_lex_subst_rec lexbuf state = 25 match Lexing.engine lex_tables state lexbuf with 0 -> ( 25 "subst.mll" let lxm = lexeme lexbuf in if is_plain '#' then begin 30 let i = Char.code (lxm.[1]) - Char.code '1' in scan_arg (fun arg -> scan_this_arg subst arg) i end else Out.put subst_buff lxm ; 35 subst lexbuf) | 1 -> ( 34 "subst.mll" let lxm = lexeme lexbuf in if is_plain '#' then 40 Out.put_char subst_buff '#' else Out.put subst_buff lxm ; subst lexbuf) | 2 -> ( 45 41 "subst.mll" Out.blit subst_buff lexbuf ; subst lexbuf) | 3 -> ( 43 "subst.mll" let lxm = lexeme lexbuf in 50 Save.start_echo () ; let _ = Save.arg lexbuf in let real_arg = Save.get_echo () in Out.put subst_buff lxm ; Out.put subst_buff real_arg ; 55 subst lexbuf) | 4 -> ( 51 "subst.mll" Out.blit subst_buff lexbuf ; subst lexbuf) 60 | 5 -> ( 53 "subst.mll" ()) | 6 -> ( 54 "subst.mll" 65 raise (Error "Empty lexeme in subst")) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_subst_rec lexbuf n ;; 70 56 "subst.mll" let do_subst_this ({arg=arg ; subst=env} as x) = if not (is_top env) then begin 75 try let _ = String.index arg '#' in if !verbose > 1 then begin Printf.fprintf stderr "subst_this : [%s]\n" arg ; prerr_args () 80 end ; let _ = scan_this_arg subst x in let r = Out.to_string subst_buff in if !verbose > 1 then prerr_endline ("subst_this ["^arg^"] = "^r); 85 r with Not_found -> arg end else arg ;; 90 let subst_this s = do_subst_this (mkarg s (get_subst ())) let subst_arg lexbuf = do_subst_this (save_arg lexbuf) and subst_opt def lexbuf = do_subst_this (save_opt def lexbuf) 95 let subst_body = subst_arg <6>114 symb.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: symb.ml,v 1.17 1999/05/21 12:54:17 maranget Exp $" open Parse_opts 15 let tr = function "<" -> "<" | ">" -> ">" | "\\{" -> "{" | "\\}" -> "}" 20 | s -> s ;; let put_delim skip put d n = let put_skip s = put s ; skip () ; in 25 let rec do_rec s i = if i >= 1 then begin put_skip s; do_rec s (i-1) 30 end and do_bis s i = if i>= 2 then begin put_skip s ; 35 do_bis s (i-1) end else put s in if not !symbols || n=1 then 40 let d = tr d in do_bis d n else begin put "<FONT FACE=symbol>\n" ; if d = "(" then begin 45 put_skip "" ; do_rec "c" (n-2) ; put "e" end else if d=")" then begin put_skip "" ; 50 do_rec "" (n-2) ; put "" end else if d = "[" then begin put_skip "e" ; do_rec "e" (n-2) ; 55 put "e" end else if d="]" then begin put_skip "" ; do_rec "" (n-2) ; put "u" 60 end else if d = "\\lfloor" then begin do_rec "e" (n-1) ; put "e" end else if d="\\rfloor" then begin do_rec "" (n-1) ; 65 put "u" end else if d = "\\lceil" then begin put_skip "e" ; do_bis "e" (n-1) end else if d="\\rceil" then begin 70 put_skip "" ; do_bis "" (n-1) end else if d="|" then begin do_bis "" n end else if d="\\|" then begin 75 do_bis "" n end else if d = "\\{" then begin put_skip "" ; do_rec "i" ((n-3)/2) ; put_skip "" ; 80 do_rec "i" ((n-3)/2) ; put "i" end else if d = "\\}" then begin put_skip "u" ; do_rec "i" ((n-3)/2) ; 85 put_skip "" ; do_rec "i" ((n-3)/2) ; put "" end ; put "</FONT>" 90 end ;; <6>115 table.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1999 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) exception Empty type 'a t = {mutable next : int ; mutable data : 'a array} 15 let default_size = 32 ;; let create x = {next = 0 ; data = Array.create default_size x} 20 and reset t = t.next <- 0 ;; let incr_table table new_size = let t = Array.create new_size table.data.(0) in 25 Array.blit table.data 0 t 0 (Array.length table.data) ; table.data <- t let emit table i = let size = Array.length table.data in 30 if table.next >= size then incr_table table (2*size); table.data.(table.next) <- i ; table.next <- table.next + 1 35 let apply table f = if table.next = 0 then raise Empty ; f table.data.(table.next - 1) 40 let trim t = let r = Array.sub t.data 0 t.next in reset t ; r 45 let remove_last table = table.next <- table.next -1; if table.next < 0 then table.next <- 0 ; ;; 50 let get_size table = table.next ;; <6>116 tabular.ml 13 "tabular.mll" open Misc open Lexing 5 open Table open Lexstate open Subst exception Error of string 10 ;; type align = {hor : string ; mutable vert : string ; wrap : bool ; mutable pre : string ; mutable post : string ; width : Length.t} 15 let make_hor = function 'c' -> "center" | 'l' -> "left" | 'r' -> "right" 20 | 'p'|'m'|'b' -> "left" | _ -> raise (Misc.Fatal "make_hor") and make_vert = function | 'c'|'l'|'r' -> "" 25 | 'p' -> "top" | 'm' -> "middle" | 'b' -> "bottom" | _ -> raise (Misc.Fatal "make_vert") 30 type format = Align of align | Inside of string | Border of string ;; 35 (* Patch vertical alignment (for HTML) *) let check_vert f = try for i = 0 to Array.length f-1 do 40 match f.(i) with | Align {vert=s} when s <> "" -> raise Exit | _ -> () done ; f 45 with Exit -> begin for i = 0 to Array.length f-1 do match f.(i) with | Align ({vert=""} as f) -> f.vert <- "top" 50 | _ -> () done ; f end 55 (* Compute missing length (for text) *) and check_length f = for i = 0 to Array.length f - 1 do match f.(i) with | Align ({wrap=true ; width=Length.No _} as r) -> 60 f.(i) <- Align {r with width = Length.Percent 65 (truncate (100.0 /. float (Array.length f)))} | _ -> () done let border = ref false 70 let push s e = s := e:: !s and pop s = match !s with 75 [] -> raise (Misc.Fatal "Empty stack in Latexscan") | e::rs -> s := rs ; e let out_table = Table.create (Inside "") 80 let pretty_format = function | Align {vert = v ; hor = h ; pre = pre ; post = post ; wrap = b ; width = w} -> "[>{"^pre^"}"^ ", h="^h^", v="^v^ 85 ", <{"^post^"}"^(if b then ", wrap" else "")^ ", w="^Length.pretty w^"]" | Inside s -> "@{"^s^"}" | Border s -> s 90 let pretty_formats f = Array.iter (fun f -> prerr_string (pretty_format f) ; prerr_string "; ") f let lex_tables = { 95 Lexing.lex_base = "\000\000\001\000\000\000\002\000\253\255\000\000\255\255\254\255\ \251\255\252\255\255\255\018\000\253\255\254\255\250\255"; Lexing.lex_backtrk = "\001\000\006\000\001\000\005\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255"; Lexing.lex_default = 100 "\255\255\008\000\255\255\255\255\000\000\255\255\000\000\000\000\ \000\000\000\000\000\000\255\255\000\000\000\000\000\000"; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\010\000\010\000\000\000\000\000\010\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\010\000\255\255\004\000\011\000\005\000\000\000\000\000\ \000\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\ \000\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\000\000\000\000\006\000\255\255\006\000\255\255\ \000\000\255\255\004\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\012\000\013\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\013\000\012\000\000\000\ \000\000\012\000\000\000\013\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\255\255\007\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\014\000\008\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000"; Lexing.lex_check = "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\001\000\001\000\255\255\255\255\001\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\001\000\001\000\003\000\001\000\003\000\255\255\255\255\ \255\255\255\255\255\255\255\255\003\000\255\255\255\255\255\255\ \255\255\005\000\005\000\005\000\005\000\005\000\005\000\005\000\ \005\000\005\000\255\255\255\255\002\000\001\000\000\000\001\000\ \255\255\001\000\003\000\011\000\011\000\011\000\011\000\011\000\ \011\000\011\000\011\000\011\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\001\000\001\000\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\001\000\001\000\255\255\ \255\255\001\000\255\255\001\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\001\000\003\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\001\000\003\000\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255" 105 } let rec tfone lexbuf = __ocaml_lex_tfone_rec lexbuf 0 and __ocaml_lex_tfone_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 110 0 -> ( 109 "tabular.mll" let pre = subst_arg lexbuf in tfmiddle lexbuf ; try 115 apply out_table (function | Align a as r -> a.pre <- pre | _ -> raise (Error "Bad syntax in array argument (>)")) with Table.Empty -> raise (Error "Bad syntax in array argument (>)")) 120 | 1 -> ( 117 "tabular.mll" tfmiddle lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_tfone_rec lexbuf n 125 and tfmiddle lexbuf = __ocaml_lex_tfmiddle_rec lexbuf 1 and __ocaml_lex_tfmiddle_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 120 "tabular.mll" 130 tfmiddle lexbuf) | 1 -> ( 122 "tabular.mll" let f = Lexing.lexeme_char lexbuf 0 in let post = tfpostlude lexbuf in 135 emit out_table (Align {hor = make_hor f ; vert = make_vert f ; wrap = false ; pre = "" ; post = post ; width = Length.Default})) | 2 -> ( 128 "tabular.mll" 140 let f = Lexing.lexeme_char lexbuf 0 in let width = subst_arg lexbuf in let my_width = Length.main (Lexing.from_string width) in let post = tfpostlude lexbuf in emit out_table 145 (Align {hor = make_hor f ; vert = make_vert f ; wrap = true ; pre = "" ; post = post ; width = my_width})) | 3 -> ( 136 "tabular.mll" let lxm = lexeme lexbuf in 150 let i = Char.code (lxm.[1]) - Char.code '1' in Lexstate.scan_arg (scan_this_arg tfmiddle) i) | 4 -> ( 140 "tabular.mll" let lxm = lexeme lexbuf in 155 let name = column_to_command lxm in let pat,body = Latexmacros.find name in let args = Lexstate.make_stack name pat lexbuf in Lexstate.scan_body (function 160 | Lexstate.Subst body -> scan_this lexformat body ; | _ -> assert false) body args ; let post = tfpostlude lexbuf in if post <> "" then 165 try Table.apply out_table (function | Align f -> f.post <- post | _ -> Misc.warning ("``<'' after ``@'' in tabular arg scanning")) 170 with | Table.Empty -> raise (Error ("``<'' cannot start tabular arg"))) | 5 -> ( 159 "tabular.mll" 175 ()) | 6 -> ( 161 "tabular.mll" let rest = String.sub lexbuf.lex_buffer lexbuf.lex_curr_pos 180 (lexbuf.lex_buffer_len - lexbuf.lex_curr_pos) in raise (Error ("Syntax of array format near: "^rest))) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_tfmiddle_rec lexbuf n and tfpostlude lexbuf = __ocaml_lex_tfpostlude_rec lexbuf 2 185 and __ocaml_lex_tfpostlude_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 167 "tabular.mll" subst_arg lexbuf) 190 | 1 -> ( 168 "tabular.mll" "") | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_tfpostlude_rec lexbuf n 195 and lexformat lexbuf = __ocaml_lex_lexformat_rec lexbuf 3 and __ocaml_lex_lexformat_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 173 "tabular.mll" 200 let ntimes = save_arg lexbuf in let what = save_arg lexbuf in let rec do_rec = function 0 -> lexformat lexbuf | i -> 205 scan_this_arg lexformat what ; do_rec (i-1) in do_rec (Get.get_int ntimes)) | 1 -> ( 180 "tabular.mll" border := true ; emit out_table (Border "|") ; lexformat lexbuf) 210 | 2 -> ( 182 "tabular.mll" let lxm = Lexing.lexeme_char lexbuf 0 in let inside = subst_arg lexbuf in if lxm = '!' || inside <> "" then emit out_table (Inside inside) ; 215 lexformat lexbuf) | 3 -> ( 187 "tabular.mll" let lxm = lexeme lexbuf in let i = Char.code (lxm.[1]) - Char.code '1' in 220 Lexstate.scan_arg (scan_this_arg lexformat) i ; lexformat lexbuf) | 4 -> ( 191 "tabular.mll" ()) 225 | 5 -> ( 192 "tabular.mll" tfone lexbuf ; lexformat lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_lexformat_rec lexbuf n 230 ;; 196 "tabular.mll" open Parse_opts 235 let main {arg=s ; subst=env} = if !verbose > 1 then prerr_endline ("Table format: "^s); start_normal env ; lexformat (Lexing.from_string s) ; 240 end_normal () ; let r = check_vert (trim out_table) in begin match !destination with | (Text | Info) -> check_length r | Html -> () 245 end ; if !verbose > 1 then begin prerr_string "Format parsed: " ; pretty_formats r ; prerr_endline "" 250 end ; r <6>117 text.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: text.ml,v 1.53 2001/01/15 10:55:30 maranget Exp $" 15 open Misc open Parse_opts open Element open Lexstate open Latexmacros 20 open Stack open Length exception Error of string;; type block = string 25 let r_quote = String.create 1 ;; 30 let quote c = (r_quote.[0] <- c ; r_quote) ;; let r_translate = String.create 1 35 ;; let iso_translate = function | '' -> "!" | '' -> "cent" 40 | '' -> "pound" | '' -> "curren" | '' -> "yen" | '' -> "I" | '' -> "paragraphe" 45 | '' -> "trema" | '' -> "copyright" | '' -> "a" | '' -> "<<" | '' -> "not" 50 | '' -> "-" | '' -> "registered" | '' -> "-" | '' -> "degre" | '' -> "plus ou moins" 55 | '' -> "carre" | '' -> "cube" | '' -> "'" | '' -> "mu" | '' -> "" 60 | '' -> "." | '' -> "" | '' -> "1" | '' -> "eme" | '' -> ">>" 65 | '' -> "1/4" | '' -> "1/2" | '' -> "3/4" | '' -> "?" | 'A' -> "A" 70 | '' -> "A" | 'A' -> "A" | '' -> "A" | '' -> "A" | '' -> "A" 75 | '' -> "AE" | 'C' -> "C" | 'E' -> "E" | 'E' | 'E' | 'E' -> "E" | '' | '' | 'I' | 'I' -> "I" 80 | '' -> "D" | '' -> "N" | '' | '' | 'O' | '' | '' -> "O" | '' -> "x" | '' -> "0" 85 | '' | '' | 'U' | 'U' -> "U" | '' -> "Y" | '' -> "P" | '' -> "ss" | 'a' | '' | 'a' | '' | '' | '' -> "a" 90 | '' -> "ae" | 'c' -> "c" | 'e' | 'e' | 'e' | 'e' -> "e" | '' | '' | 'i' | 'i' -> "i" | '' -> "o" 95 | '' -> "n" | '' | '' | 'o' | '' | '' -> "o" | '' -> "/" | '' -> "o" | '' | '' | 'u' | 'u' -> "u" 100 | '' -> "y" | '' -> "y" | '' -> "y" | c -> (r_translate.[0] <- c ; r_translate) ;; 105 let iso c = if !Parse_opts.iso || !Lexstate.raw_chars then (r_translate.[0]<-c; r_translate) else 110 iso_translate c ;; let iso_buff = Out.create_buff () 115 let iso_string s = if !Parse_opts.iso then begin for i = 0 to String.length s - 1 do Out.put iso_buff (iso_translate s.[i]) done ; 120 Out.to_string iso_buff end else s 125 let failclose s = raise (Misc.Close s) ;; (* output globals *) 130 type status = { mutable nostyle : bool ; mutable active : text list ; mutable out : Out.t; mutable temp : bool 135 };; type stack_item = Normal of string * string * status 140 | Freeze of (unit -> unit) ;; exception PopFreeze ;; 145 let push_out s (a,b,c) = push s (Normal (a,b,c)) ;; let pretty_stack s = 150 Stack.pretty (function | Normal (s,args,_) -> "["^s^"]-{"^args^"} " | Freeze _ -> "Freeze ") s ;; 155 let rec pop_out s = match pop s with Normal (a,b,c) -> a,b,c | Freeze f -> raise PopFreeze ;; 160 let free_list = ref [];; let out_stack = Stack.create "out_stack";; 165 let pblock () = if empty out_stack then "" else match top out_stack with | Normal (s,_,_) -> s | _ -> "" 170 and parg () = if empty out_stack then "" else match top out_stack with | Normal (_,a,_) -> a | _ -> "" 175 ;; let free out = out.nostyle<-false; out.active<-[]; 180 Out.reset out.out; free_list := out :: !free_list ;; 185 let cur_out = ref { nostyle = false; active=[]; out=Out.create_null(); 190 temp=false };; let set_out out = !cur_out.out <- out 195 ;; let newstatus nostyle p a t = match !free_list with [] -> { nostyle = nostyle; 200 active = a; out = Out.create_buff (); temp = t; } | e::reste -> 205 free_list:=reste; e.nostyle <- nostyle; e.active <- a; e.temp <- t; assert (Out.is_empty e.out); 210 e ;; type saved_out = status * stack_item Stack.saved 215 let save_out () = !cur_out, Stack.save out_stack and restore_out (a,b) = if !cur_out != a then begin free !cur_out ; 220 Stack.finalize out_stack (function | Normal (_,_,out) -> out == a | _ -> false) (function 225 | Normal (_,_,out) -> if out.temp then free out | _ -> ()) end ; cur_out := a ; Stack.restore out_stack b 230 type align_t = Left | Center | Right type flags_t = { 235 mutable pending_par : int option; mutable empty : bool; (* Listes *) mutable nitems : int; mutable dt : string; 240 mutable dcount : string; mutable last_closed : string; (* Alignement et formattage *) mutable align : align_t; 245 mutable in_align : bool; mutable hsize : int; mutable x : int; mutable x_start : int; mutable x_end : int; 250 mutable last_space : int; mutable first_line : int; mutable underline : string; mutable nocount : bool ; mutable in_table : bool; 255 (* Maths *) mutable vsize : int; } ;; 260 let flags = { pending_par = None; empty = true; nitems = 0; 265 dt = ""; dcount = ""; last_closed = "rien"; align = Left; in_align = false; 270 hsize = !Parse_opts.width; x = 0; x_start = 0; x_end = !Parse_opts.width - 1; last_space = 0; 275 first_line = 2; underline = ""; nocount = false ; in_table = false; vsize = 0; 280 } ;; let copy_flags f = {f with vsize = flags.vsize} and set_flags f { 285 pending_par = pending_par ; empty = empty ; nitems = nitems ; dt = dt ; dcount = dcount ; 290 last_closed = last_closed ; align = align ; in_align = in_align ; hsize = hsize ; x = x ; 295 x_start = x_start ; x_end = x_end ; last_space = last_space ; first_line = first_line ; underline = underline ; 300 nocount = nocount ; in_table = in_table ; vsize = vsize } = f.pending_par <- pending_par ; 305 f.empty <- empty ; f.nitems <- nitems ; f.dt <- dt ; f.dcount <- dcount ; f.last_closed <- last_closed ; 310 f.align <- align ; f.in_align <- in_align ; f.hsize <- hsize ; f.x <- x ; f.x_start <- x_start ; 315 f.x_end <- x_end ; f.last_space <- last_space ; f.first_line <- first_line ; f.underline <- underline ; f.nocount <- nocount ; 320 f.in_table <- in_table ; f.vsize <- vsize type stack_t = { 325 s_nitems : int Stack.t ; s_dt : string Stack.t ; s_dcount : string Stack.t ; s_x : (int * int * int * int * int * int) Stack.t ; s_align : align_t Stack.t ; 330 s_in_align : bool Stack.t ; s_underline : string Stack.t ; s_nocount : bool Stack.t ; s_in_table : bool Stack.t ; s_vsize : int Stack.t ; 335 s_active : Out.t Stack.t ; s_pending_par : int option Stack.t ; s_after : (string -> string) Stack.t } 340 let stacks = { s_nitems = Stack.create "nitems" ; s_dt = Stack.create "dt" ; s_dcount = Stack.create "dcount" ; s_x = Stack.create "x" ; 345 s_align = Stack.create "align" ; s_in_align = Stack.create "in_align" ; s_underline = Stack.create "underline" ; s_nocount = Stack.create "nocount" ; s_in_table = Stack.create "in_table" ; 350 s_vsize = Stack.create "vsize" ; s_active = Stack.create "active" ; s_pending_par = Stack.create "pending_par" ; s_after = Stack.create "after" } 355 type saved_stacks = { ss_nitems : int Stack.saved ; ss_dt : string Stack.saved ; ss_dcount : string Stack.saved ; 360 ss_x : (int * int * int * int * int * int) Stack.saved ; ss_align : align_t Stack.saved ; ss_in_align : bool Stack.saved ; ss_underline : string Stack.saved ; ss_nocount : bool Stack.saved ; 365 ss_in_table : bool Stack.saved ; ss_vsize : int Stack.saved ; ss_active : Out.t Stack.saved ; ss_pending_par : int option Stack.saved ; ss_after : (string -> string) Stack.saved 370 } let save_stacks () = { ss_nitems = Stack.save stacks.s_nitems ; 375 ss_dt = Stack.save stacks.s_dt ; ss_dcount = Stack.save stacks.s_dcount ; ss_x = Stack.save stacks.s_x ; ss_align = Stack.save stacks.s_align ; ss_in_align = Stack.save stacks.s_in_align ; 380 ss_underline = Stack.save stacks.s_underline ; ss_nocount = Stack.save stacks.s_nocount ; ss_in_table = Stack.save stacks.s_in_table ; ss_vsize = Stack.save stacks.s_vsize ; ss_active = Stack.save stacks.s_active ; 385 ss_pending_par = Stack.save stacks.s_pending_par ; ss_after = Stack.save stacks.s_after } and restore_stacks 390 { ss_nitems = saved_nitems ; ss_dt = saved_dt ; ss_dcount = saved_dcount ; ss_x = saved_x ; 395 ss_align = saved_align ; ss_in_align = saved_in_align ; ss_underline = saved_underline ; ss_nocount = saved_nocount ; ss_in_table = saved_in_table ; 400 ss_vsize = saved_vsize ; ss_active = saved_active ; ss_pending_par = saved_pending_par ; ss_after = saved_after } = 405 Stack.restore stacks.s_nitems saved_nitems ; Stack.restore stacks.s_dt saved_dt ; Stack.restore stacks.s_dcount saved_dcount ; Stack.restore stacks.s_x saved_x ; Stack.restore stacks.s_align saved_align ; 410 Stack.restore stacks.s_in_align saved_in_align ; Stack.restore stacks.s_underline saved_underline ; Stack.restore stacks.s_nocount saved_nocount ; Stack.restore stacks.s_in_table saved_in_table ; Stack.restore stacks.s_vsize saved_vsize ; 415 Stack.restore stacks.s_active saved_active ; Stack.restore stacks.s_pending_par saved_pending_par ; Stack.restore stacks.s_after saved_after let check_stack what = 420 if not (Stack.empty what) && not !silent then begin prerr_endline ("Warning: stack "^Stack.name what^" is non-empty in Html.finalize") ; end ;; 425 let check_stacks () = match stacks with { s_nitems = nitems ; s_dt = dt ; 430 s_dcount = dcount ; s_x = x ; s_align = align ; s_in_align = in_align ; s_underline = underline ; 435 s_nocount = nocount ; s_in_table = in_table ; s_vsize = vsize ; s_active = active ; s_pending_par = pending_par ; 440 s_after = after } -> check_stack nitems ; check_stack dt ; check_stack dcount ; 445 check_stack x ; check_stack align ; check_stack in_align ; check_stack underline ; check_stack nocount ; 450 check_stack in_table ; check_stack vsize ; check_stack active ; check_stack pending_par ; check_stack after 455 let line = String.create (!Parse_opts.width +2);; type saved = string * flags_t * saved_stacks * saved_out 460 let check () = let saved_flags = copy_flags flags and saved_stacks = save_stacks () and saved_out = save_out () in String.copy line, saved_flags, saved_stacks, saved_out 465 and hot (l,f,s,o) = String.blit l 0 line 0 (String.length l) ; set_flags flags f ; 470 restore_stacks s ; restore_out o let stop () = Stack.push stacks.s_active !cur_out.out ; 475 Stack.push stacks.s_pending_par flags.pending_par ; !cur_out.out <- Out.create_null () and restart () = !cur_out.out <- Stack.pop stacks.s_active ; 480 flags.pending_par <- Stack.pop stacks.s_pending_par let do_do_put_char c = Out.put_char !cur_out.out c;; 485 let do_do_put s = Out.put !cur_out.out s;; let do_put_line s = 490 (* Ligne a formatter selon flags.align, avec les parametres courants.*) (* soulignage eventuel *) let taille = String.length s in let length = if s.[taille-1]='\n' then taille-1 else taille in let soul = ref false in 495 for i = 0 to length - 1 do soul := !soul || s.[i] <> ' '; done; soul := !soul && s<>"\n" && flags.underline <> ""; 500 let ligne = match flags.align with | Left -> s | Center -> let sp = (flags.hsize - (length -flags.x_start))/2 in String.concat "" [String.make sp ' '; s] 505 | Right -> let sp = flags.hsize - length + flags.x_start in String.concat "" [ String.make sp ' '; s] in if !verbose > 3 then prerr_endline ("line :"^ligne); 510 do_do_put ligne; if !soul then begin let souligne = 515 let l = String.make taille ' ' in let len = String.length flags.underline in if len = 0 then raise (Misc.Fatal ("cannot underline with nothing:#" ^String.escaped flags.underline^"#"^ (if (flags.underline <> "") then "true" else "false" 520 ))); for i = flags.x_start to length -1 do l.[i]<-flags.underline.[(i-flags.x_start) mod len] done; if taille <> length then l.[length]<-'\n'; 525 match flags.align with | Left -> l | Center -> let sp = (flags.hsize - length)/2 +flags.x_start/2 in String.concat "" [String.make sp ' '; l] 530 | Right -> let sp = (flags.hsize - length) + flags.x_start in String.concat "" [ String.make sp ' '; l] in if !verbose >3 then prerr_endline ("line underlined:"^souligne); 535 do_do_put souligne; end ;; 540 let do_flush () = if !verbose>3 && flags.x >0 then prerr_endline ("flush :#"^(String.sub line 0 (flags.x))^"#"); if flags.x >0 then do_put_line (String.sub line 0 (flags.x)) ; flags.x <- -1; 545 ;; let do_put_char_format c = if !verbose > 3 then prerr_endline ("caracters read : '"^Char.escaped c^"', x="^string_of_int flags.x^", length ="^string_of_int (flags.hsize)); 550 if c=' ' then flags.last_space <- flags.x; if flags.x =(-1) then begin (* La derniere ligne finissait un paragraphe : on indente *) flags.x<-flags.x_start + flags.first_line; 555 for i = 0 to flags.x-1 do line.[i]<-' '; done; flags.last_space<-flags.x-1; end; 560 line.[flags.x]<-c; if c='\n' then begin (* Ligne prete *) if !verbose > 2 then prerr_endline("line not cut :["^line^"]"); 565 do_put_line (String.sub line 0 (flags.x +1)); flags.x <- -1; end else flags.x<-flags.x + 1; if flags.x>(flags.x_end +1) then begin (* depassement de ligne *) 570 if (flags.x - flags.last_space) >= flags.hsize then begin (* On coupe brutalement le mot trop long *) if !verbose > 2 then prerr_endline ("line cut :"^line); warning ("line too long"); 575 line.[flags.x-1]<-'\n'; (* La ligne est prete et complete*) do_put_line (String.sub line 0 (flags.x)); for i = 0 to flags.x_start-1 do line.[i]<-' ' done; line.[flags.x_start]<-c; 580 flags.x<-flags.x_start + 1; flags.last_space<-flags.x_start-1; end else begin if !verbose > 2 then begin prerr_endline ("Line and the beginning of the next word :"^line); 585 prerr_endline ("x ="^string_of_int flags.x); prerr_endline ("x_start ="^string_of_int flags.x_start); prerr_endline ("x_end ="^string_of_int flags.x_end); prerr_endline ("hsize ="^string_of_int flags.hsize); prerr_endline ("last_space ="^string_of_int flags.last_space); 590 prerr_endline ("line size ="^string_of_int (String.length line)); end; (* On repart du dernier espace *) let reste = let len = flags.x - flags.last_space -1 in 595 if len = 0 then "" else String.sub line (flags.last_space +1) len in (* La ligne est prete et incomplete*) 600 line.[flags.last_space]<-'\n'; do_put_line (String.sub line 0 (flags.last_space+1)); for i = 0 to flags.x_start-1 do line.[i]<-' ' done; for i = flags.x_start to (flags.x_start+ String.length reste -1) do 605 line.[i]<- reste.[i-flags.x_start]; done; flags.x<- flags.x_start + (String.length reste); flags.last_space <- flags.x_start-1; end; 610 end; ;; let do_put_char c = if !verbose>3 then 615 prerr_endline ("put_char:|"^String.escaped (String.make 1 c)^"|"); if !cur_out.temp || (Out.is_null !cur_out.out) then do_do_put_char c else do_put_char_format c ;; 620 let finit_ligne () = if !verbose>3 then prerr_endline "ending the line."; if flags.x >0 then do_put_char '\n' ;; 625 let do_unskip () = if !cur_out.temp || (Out.is_null !cur_out.out) then Out.unskip !cur_out.out else begin 630 while flags.x > flags.x_start && line.[flags.x-1] = ' ' do flags.x <- flags.x - 1 done ; flags.last_space <- flags.x ; while 635 flags.last_space >= flags.x_start && line.[flags.last_space] <> ' ' do flags.last_space <- flags.last_space - 1 done; 640 if flags.x = flags.x_start && !cur_out.temp then Out.unskip !cur_out.out end 645 let do_put s = if !verbose>3 then prerr_endline ("put:|"^String.escaped s^"|"); for i = 0 to String.length s - 1 do do_put_char s.[i] 650 done ;; let get_last_closed () = flags.last_closed;; 655 let set_last_closed s = flags.last_closed<-s;; (* Gestion des styles : pas de style en mode texte *) let is_list = function 660 | "UL" | "DL" | "OL" -> true | _ -> false ;; let get_fontsize () = 3;; 665 let nostyle () = !cur_out.nostyle<-true ;; 670 let clearstyle () = !cur_out.active<-[] ;; let open_mod m = 675 if m=(Style "CODE") then begin do_put "`"; !cur_out.active <- m::!cur_out.active end; ;; 680 let do_close_mod = function | Style "CODE" -> do_put "'"; | _ -> () 685 ;; let close_mod () = match !cur_out.active with [] -> () | (Style "CODE" as s)::reste -> 690 do_close_mod s; !cur_out.active <- reste | _ -> () ;; 695 let erase_mods ml = () ;; let rec open_mods = function | [] -> () 700 | s::reste -> open_mod s; open_mods reste ;; let close_mods () = List.iter do_close_mod !cur_out.active; 705 !cur_out.active <- [] ;; let par = function (*Nombre de lignes a sauter avant le prochain put*) | Some n as p-> 710 begin flags.pending_par <- (match pblock() with | "QUOTE" | "QUOTATION" -> Some (n-1) | _ -> Some n); 715 if !verbose> 2 then prerr_endline ("par: last_close="^flags.last_closed^ " r="^string_of_int n); end 720 | _ -> () let forget_par () = let r = flags.pending_par in 725 flags.pending_par <- None; r ;; let flush_par n = 730 flags.pending_par <- None; let p = n in do_put_char '\n' ; for i=1 to p-1 do do_put_char '\n' 735 done; if !verbose >2 then prerr_endline ("flush_par : last_closed="^flags.last_closed^ "p="^string_of_int p); 740 flags.last_closed<-"rien" ;; let try_flush_par () = match flags.pending_par with 745 | Some n -> flush_par n | _ -> () ;; let do_pending () = 750 begin match flags.pending_par with | Some n -> flush_par n | _ -> () end; flags.last_closed <- "rien"; 755 ;; (* Blocs *) let try_open_block s args = 760 (* Prepare l'environnement specifique au bloc en cours *) if !verbose > 2 then prerr_endline ("=> try_open ``"^s^"''"); push stacks.s_x 765 (flags.hsize,flags.x,flags.x_start,flags.x_end, flags.first_line,flags.last_space); if is_list s then begin do_put_char '\n'; 770 push stacks.s_nitems flags.nitems; flags.nitems <- 0; flags.x_start <- flags.x_start + 3; flags.first_line <- -2; flags.hsize <- flags.x_end - flags.x_start+1; 775 if not flags.in_align then begin push stacks.s_align flags.align; flags.align <- Left end; 780 if s="DL" then begin push stacks.s_dt flags.dt; push stacks.s_dcount flags.dcount; flags.dt <- ""; flags.dcount <- ""; 785 end; end else match s with | "ALIGN" -> begin finit_ligne (); 790 push stacks.s_align flags.align; push stacks.s_in_align flags.in_align; flags.in_align<-true; flags.first_line <-2; match args with 795 "LEFT" -> flags.align <- Left | "CENTER" -> flags.align <- Center | "RIGHT" -> flags.align <- Right | _ -> raise (Misc.ScanError "Invalid argument in ALIGN"); end 800 | "HEAD" -> begin finit_ligne (); flags.first_line <-0 ; push stacks.s_underline flags.underline; 805 flags.underline <- args; end | "QUOTE" -> begin finit_ligne (); 810 push stacks.s_align flags.align; push stacks.s_in_align flags.in_align; flags.in_align<-true; flags.align <- Left; flags.first_line<-0; 815 flags.x_start<- flags.x_start + 20 * flags.hsize / 100; flags.hsize <- flags.x_end - flags.x_start+1; end | "QUOTATION" -> begin 820 finit_ligne (); push stacks.s_align flags.align; push stacks.s_in_align flags.in_align; flags.in_align<-true; flags.align <- Left; 825 flags.first_line<-2; flags.x_start<- flags.x_start + 20 * flags.hsize / 100; flags.hsize <- flags.x_end - flags.x_start+1; end | "PRE" -> 830 flags.first_line <-0; finit_ligne (); do_put "<<"; flags.first_line <-2; | "INFO" -> 835 push stacks.s_nocount flags.nocount ; flags.nocount <- true ; flags.first_line <-0 | "INFOLINE" -> push stacks.s_nocount flags.nocount ; 840 flags.nocount <- true ; flags.first_line <-0 ; finit_ligne () | _ -> (); 845 if !verbose > 2 then prerr_endline ("<= try_open ``"^s^"''") ;; let try_close_block s = 850 let (h,x,xs,xe,fl,lp) = pop stacks.s_x in flags.hsize<-h; flags.x_start<-xs; flags.x_end<-xe; flags.first_line <-fl; 855 if (is_list s) then begin finit_ligne(); if not flags.in_align then begin 860 let a = pop stacks.s_align in flags.align <- a end; flags.nitems <- pop stacks.s_nitems; if s="DL" then begin 865 flags.dt <- pop stacks.s_dt; flags.dcount <- pop stacks.s_dcount; end; end else match s with | "ALIGN" | "QUOTE" | "QUOTATION" -> 870 begin finit_ligne (); let a = pop stacks.s_align in flags.align <- a; let ia = pop stacks.s_in_align in 875 flags.in_align <- ia; end | "HEAD" -> begin finit_ligne(); 880 let u = pop stacks.s_underline in flags.underline <- u end | "PRE" -> flags.first_line <-0; 885 do_put ">>\n"; flags.first_line <-fl; | "INFO"|"INFOLINE"-> flags.nocount <- pop stacks.s_nocount | _ -> () 890 ;; let open_block s args = (* Cree et se place dans le bloc de nom s et d'arguments args *) if !verbose > 2 then 895 prerr_endline ("=> open_block ``"^s^"''"); let bloc,arg = if s="DIV" && args="ALIGN=center" then "ALIGN","CENTER" else s,args 900 in push_out out_stack (bloc,arg,!cur_out); try_flush_par (); (* Sauvegarde de l'etat courant *) 905 if !cur_out.temp || s="TEMP" || s="AFTER" then begin cur_out := newstatus !cur_out.nostyle !cur_out.active 910 [] true; end; try_open_block bloc arg; if !verbose > 2 then prerr_endline ("<= open_block ``"^bloc^"''") 915 ;; let force_block s content = if !verbose > 2 then prerr_endline (" force_block ``"^s^"''"); 920 let old_out = !cur_out in try_close_block s; let ps,pa,pout = pop_out out_stack in if ps <>"DELAY" then begin cur_out:=pout; 925 if ps = "AFTER" then begin let f = pop stacks.s_after in Out.copy_fun f old_out.out !cur_out.out end else if !cur_out.temp then Out.copy old_out.out !cur_out.out; 930 flags.last_closed<- s; if !cur_out.temp then free old_out; end else raise ( Misc.Fatal "text: unflushed DELAY") ;; 935 let close_block s = (* Fermeture du bloc : recuperation de la pile *) if !verbose > 2 then prerr_endline ("=> close_block ``"^s^"''"); 940 let bloc = if s = "DIV" then "ALIGN" else s in force_block bloc ""; if !verbose > 2 then prerr_endline ("<= close_block ``"^bloc^"''"); ;; 945 let insert_block tag arg = if tag = "ALIGN" then begin 950 match arg with "LEFT" -> flags.align <- Left | "CENTER" -> flags.align <- Center | "RIGHT" -> flags.align <- Right | _ -> raise (Misc.ScanError "Invalid argument in ALIGN"); 955 end; and insert_attr _ _ = () ;; 960 (* Autres *) (* Listes *) let set_dt s = flags.dt <- s 965 and set_dcount s = flags.dcount <- s ;; let do_item isnum = 970 if !verbose > 2 then begin prerr_string "do_item: stack="; pretty_stack out_stack end; let mods = !cur_out.active in 975 if flags.nitems = 0 then begin let _ = forget_par () in () end ; try_flush_par () ; flags.nitems<-flags.nitems+1; if isnum then do_put ("\n"^(string_of_int flags.nitems)^". ") 980 else do_put "\n- " ;; let item () = do_item false 985 and nitem () = do_item true ;; let ditem scan arg = 990 if !verbose > 2 then begin prerr_string "ditem: stack="; pretty_stack out_stack end; 995 let mods = !cur_out.active in let true_scan = if flags.nitems = 0 then begin let _ = forget_par() in (); ( fun arg -> scan arg) 1000 end else scan in try_flush_par(); flags.nitems<-flags.nitems+1; do_put_char '\n'; 1005 if flags.dcount <> "" then scan("\\refstepcounter{"^flags.dcount^"}"); true_scan ("\\makelabel{"^arg^"}") ; do_put_char ' ' ;; 1010 let erase_block s = if not !cur_out.temp then close_block s else begin 1015 if !verbose > 2 then begin Printf.fprintf stderr "erase_block: %s" s; prerr_newline () end ; try_close_block s ; 1020 let ts,_,tout = pop_out out_stack in if ts <> s then failclose ("erase_block: "^s^" closes "^ts); free !cur_out ; cur_out := tout 1025 end ;; let to_string f = open_block "TEMP" ""; 1030 f () ; let r = Out.to_string !cur_out.out in close_block "TEMP"; r ;; 1035 let open_group ss = open_block "" ""; open_mod (Style ss); ;; 1040 let open_aftergroup f = open_block "AFTER" "" ; push stacks.s_after f ;; 1045 let close_group () = close_mod (); close_block ""; ;; 1050 let put s = if !verbose > 3 then Printf.fprintf stderr "put: %s\n" s ; 1055 do_pending (); do_put s ;; let put_char c = 1060 if !verbose > 3 then Printf.fprintf stderr "put_char: %c\n" c ; do_pending (); do_put_char c ;; 1065 let flush_out () = Out.flush !cur_out.out ;; 1070 let skip_line () = if !verbose > 2 then prerr_endline "skip_line" ; put_char '\n' ;; 1075 let loc_name s1 = () ;; let open_chan chan = 1080 free !cur_out; !cur_out.out<- Out.create_chan chan ;; let close_chan () = 1085 Out.close !cur_out.out; !cur_out.out <- Out.create_buff() ;; 1090 let to_style f = !cur_out.active<-[]; open_block "TEMP" ""; f (); let r = !cur_out.active in 1095 erase_block "TEMP"; r ;; let get_current_output () = 1100 Out.to_string !cur_out.out ;; let finalize check = if check then 1105 check_stacks () ; finit_ligne () ; Out.close !cur_out.out ; !cur_out.out <- Out.create_null () ;; 1110 let unskip () = do_unskip () 1115 let put_separator () = put " " ;; let put_tag tag = () 1120 ;; let put_nbsp () = put " " ;; 1125 let put_open_group () = () ;; let put_close_group () = 1130 () ;; let put_in_math s = put s 1135 ;; (*--------------*) (*-- TABLEAUX --*) 1140 (*--------------*) type align = Top | Middle | Bottom | Base of int and wrap_t = True | False | Fill ;; 1145 type cell_t = { mutable ver : align; mutable hor : align_t; 1150 mutable h : int; mutable w : int; mutable wrap : wrap_t; mutable span : int; (* Nombre de colonnes *) mutable text : string; 1155 mutable pre : string; (* bordures *) mutable post : string; mutable pre_inside : int list; mutable post_inside : int list; } 1160 ;; type cell_set = Tabl of cell_t Table.t | Arr of cell_t array ;; 1165 type row_t = { mutable haut : int; mutable cells : cell_set; } ;; 1170 type table_t = { mutable lines : int; mutable cols : int; mutable width : int; 1175 mutable taille : int Table.t; mutable tailles : int array; mutable table : row_t Table.t; mutable line : int; mutable col : int; 1180 mutable in_cell : bool; } ;; let cell = ref { 1185 ver = Middle; hor = Left; h = 0; w = 0; wrap = False; 1190 span = 1; text = ""; pre = ""; post = ""; pre_inside = []; 1195 post_inside = []; } ;; 1200 let row= ref { haut = 0; cells = Tabl (Table.create !cell) } ;; 1205 let table = ref { lines = 0; cols = 0; width = 0; 1210 taille = Table.create 0; tailles = Array.create 0 0; table = Table.create {haut = 0; cells = Arr (Array.create 0 !cell)}; line = 0; col = 0; 1215 in_cell = false; } ;; let table_stack = Stack.create "table_stack";; 1220 let row_stack = Stack.create "row_stack";; let cell_stack = Stack.create "cell_stack";; let multi = ref [] and multi_stack = Stack.create "multi_stack";; 1225 let open_table border _ = (* creation d'une table : on prepare les donnees : creation de l'environnement qvb, empilage du precedent. *) push table_stack !table; 1230 push row_stack !row; push cell_stack !cell; push stacks.s_in_table flags.in_table; push multi_stack !multi; push stacks.s_align flags.align; 1235 if !verbose>2 then prerr_endline "=> open_table"; finit_ligne (); open_block "" ""; 1240 flags.first_line <- 0; table := { lines = 0; cols = 0; 1245 width = 0; taille = Table.create 0; tailles = Array.create 0 0; table = Table.create {haut = 0; cells = Arr (Array.create 0 !cell)}; line = -1; 1250 col = -1; in_cell = false; }; row := { 1255 haut = 0; cells = Tabl (Table.create !cell) }; cell := { 1260 ver = Middle; hor = Left; h = 0; w = 0; wrap = False; 1265 span = 1; text = ""; pre = ""; post = ""; pre_inside = []; 1270 post_inside = []; }; multi := []; flags.in_table<-true; 1275 ;; let new_row () = if !table.col> !table.cols then !table.cols<- !table.col; !table.col <- -1; 1280 !table.line <- !table.line +1; if !table.line = 1 && (( Array.length !table.tailles)=0) then !table.tailles<-Table.trim !table.taille; let _ =match !row.cells with | Tabl t -> Table.reset t 1285 | _-> raise (Error "invalid table type in array") in !cell.pre <- ""; !cell.pre_inside <- []; !row.haut<-0; 1290 if !verbose>2 then prerr_endline ("new_row, line ="^string_of_int !table.line) ;; let change_format format = match format with Tabular.Align {Tabular.vert=v ; Tabular.hor=h ; Tabular.wrap=w ; Tabular.width=size} -> 1295 !cell.ver <- (match v with | "" -> Base 50 | "middle" -> Base 50 | "top" -> Top 1300 | "bottom" -> Bottom | s -> let n = try int_of_string s 1305 with (Failure fail) -> raise (Misc.Fatal ("open_cell, invalid vertical format :"^v)); in if n>100 || n<0 then raise (Misc.Fatal ("open_cell, invalid vertical format :"^v)); Base n); !cell.hor <- 1310 (match h with | "" -> Left | "center" -> Center | "left" -> Left | "right" -> Right 1315 | _-> raise (Misc.Fatal ("open_cell, invalid horizontal format :"^h))); !cell.wrap <- (if w then True else False); if w then !cell.w <- (match size with 1320 | Length.Char l -> l | Length.Pixel l -> l / Length.font | Length.Percent l -> l * !Parse_opts.width / 100 | Length.Default -> !cell.wrap <- False; warning "cannot wrap column with no width"; 0 | Length.No s -> 1325 raise (Misc.Fatal ("No-length ``"^s^"'' in out-manager"))) else !cell.w <- 0; | _ -> raise (Misc.Fatal ("as_align")) ;; 1330 let open_cell format span insides = open_block "TEMP" ""; (* preparation du formattage : les flags de position sont sauvegardes par l'ouverture du bloc TEMP *) 1335 (* remplir les champs de formattage de cell *) !table.col <- !table.col+1; if !verbose>2 then prerr_endline ("open_cell, col="^string_of_int !table.col); 1340 change_format format; !cell.span <- span - insides; if !table.col > 0 && !cell.span=1 then begin !cell.pre <- ""; !cell.pre_inside <- []; 1345 end; !cell.post <- ""; !cell.post_inside <- []; open_block "" ""; if !cell.w > String.length line then raise ( Error "Column too wide"); 1350 if (!cell.wrap=True) then begin (* preparation de l'alignement *) !cur_out.temp <- false; flags.x_start <- 0; flags.x_end <- !cell.w-1; flags.hsize <- !cell.w; 1355 flags.first_line <- 0; flags.x <- -1; flags.last_space <- -1; push stacks.s_align flags.align; push stacks.s_in_align flags.in_align; 1360 flags.in_align <- true; flags.align <- Left; end; ;; 1365 let close_cell content = if !verbose>2 then prerr_endline "=> force_cell"; if (!cell.wrap=True) then begin do_flush (); 1370 flags.in_align <- pop stacks.s_in_align; flags.align <- pop stacks.s_align; end; force_block "" content; !cell.text<-Out.to_string !cur_out.out; 1375 close_block "TEMP"; if !verbose>2 then prerr_endline ("cell :#"^ !cell.text^ "#,pre :#"^ !cell.pre^ "#,post :#"^ !cell.post^ "#"); 1380 (* il faut remplir les champs w et h de cell *) if (!cell.wrap = False ) then !cell.w <- 0; !cell.h <- 1; let taille = ref 0 in for i = 0 to (String.length !cell.text) -1 do 1385 if !cell.text.[i]='\n' then begin !cell.h<- !cell.h+1; if (!cell.wrap = False) && (!taille > !cell.w) then begin !cell.w <- !taille; end; 1390 taille:=0; end else begin taille:=!taille+1; end; done; 1395 if (!cell.wrap = False) && (!taille > !cell.w) then !cell.w <- !taille; !cell.w <- !cell.w + (String.length !cell.pre) + (String.length !cell.post); if !verbose>2 then prerr_endline ("size : width="^string_of_int !cell.w^ ", height="^string_of_int !cell.h^ ", span="^string_of_int !cell.span); 1400 let _ = match !row.cells with | Tabl t -> Table.emit t { ver = !cell.ver; hor = !cell.hor; h = !cell.h; 1405 w = !cell.w; wrap = !cell.wrap; span = !cell.span; text = !cell.text; pre = !cell.pre; 1410 post = !cell.post; pre_inside = !cell.pre_inside; post_inside = !cell.post_inside; } | _ -> raise (Error "Invalid row type") 1415 in (* on a la taille de la cellule, on met sa largeur au bon endroit, si necessaire.. *) (* Multicolonne : Il faut mettre des zeros dans le tableau pour avoir la taille minimale des colonnes atomiques. Puis on range start,end dans une liste que l'on regardera a la fin pour ajuster les tailles selon la loi : la taille de la multicolonne doit etre <= la somme des tailles minimales. Sinon, il faut agrandir les colonnes atomiques pour que ca rentre. *) if !cell.span = 1 then begin 1420 if !table.line = 0 then Table.emit !table.taille !cell.w else begin if !table.col >= (Array.length !table.tailles) then 1425 begin (* depassement du tableau : on l'agrandit.. *) let t = Array.create (!table.col +1) 0 in Array.blit !table.tailles 0 t 0 (Array.length !table.tailles) ; !table.tailles <- t; end; 1430 if (!cell.w > (!table.tailles.(!table.col))) then begin !table.tailles.(!table.col)<- !cell.w; end; end; 1435 end else if !cell.span = 0 then begin if !table.line = 0 then Table.emit !table.taille 0; end else begin if !table.line=0 then for i = 1 to !cell.span do 1440 Table.emit !table.taille 0 done; multi := (!table.col,!table.col + !cell.span -1,!cell.w) :: !multi; end; !table.col <- !table.col + !cell.span -1; 1445 if !cell.h> !row.haut then !row.haut<- !cell.h; !cell.pre <- ""; !cell.pre_inside <- []; if !verbose>2 then prerr_endline "<= force_cell"; ;; 1450 let do_close_cell () = close_cell "" ;; let open_cell_group () = !table.in_cell <- true; 1455 and close_cell_group () = !table.in_cell <- false; and erase_cell_group () = !table.in_cell <- false; ;; 1460 let erase_cell () = if !verbose>2 then prerr_endline "erase cell"; if (!cell.wrap=True) then begin 1465 flags.in_align <- pop stacks.s_in_align; flags.align <- pop stacks.s_align; end; erase_block ""; let _ = Out.to_string !cur_out.out in 1470 erase_block "TEMP"; !table.col <- !table.col -1; !cell.pre <- ""; !cell.pre_inside <- []; ;; 1475 let erase_row () = !table.line <- !table.line -1 and close_row erase = if !verbose>2 then prerr_endline "close_row"; Table.emit !table.table 1480 { haut = !row.haut; cells = Arr (Table.trim (match !row.cells with | Tabl t -> t | _-> raise (Error "Invalid row type")))}; 1485 ;; let center_format = Tabular.Align {Tabular.hor="center" ; Tabular.vert = "top" ; 1490 Tabular.wrap = false ; Tabular.pre = "" ; Tabular.post = "" ; Tabular.width = Length.Default} ;; 1495 let make_border s = if !verbose> 2 then prerr_endline ("Adding border after column "^string_of_int !table.col^" :'"^s^"'"); if (!table.col = -1) || not ( !table.in_cell) then !cell.pre <- !cell.pre ^ s 1500 else !cell.post <- !cell.post ^ s ;; let make_inside s multi = 1505 if !verbose>2 then prerr_endline ("Adding inside after column "^string_of_int !table.col^" :'"^s^"'"); if (!table.col = -1) || not ( !table.in_cell) then begin let start = String.length !cell.pre in !cell.pre <- !cell.pre ^ s; 1510 for i = start to String.length !cell.pre -1 do !cell.pre_inside <- i::!cell.pre_inside; done; end else begin let start = String.length !cell.post in 1515 !cell.post <- !cell.post ^ s; for i = start to String.length !cell.post -1 do !cell.post_inside <- i::!cell.post_inside; done; end; 1520 ;; let make_hline w noborder = new_row(); 1525 open_cell center_format 0 0; close_mods (); !cell.w <- 0; !cell.wrap <- Fill; put_char '-'; 1530 close_cell ""; close_row (); ;; let text_out j hauteur height align = 1535 match align with | Top -> (j < height) | Middle -> ((j >= (hauteur-height)/2) && (j <= ((hauteur-height)/2)+height-1)) | Bottom -> (j >= hauteur - height) | Base i -> 1540 if ( hauteur * i) >= 50 * ( 2*hauteur - height ) then (j >= hauteur - height) (* Bottom *) else if ( hauteur * i) <= height * 50 then (j < height) (* Top *) else ((100*j >= i*hauteur - 50*height) && (100*j < i*hauteur + 50*height)) (* Elsewhere *) 1545 ;; (* dis si oui ou non on affiche la ligne de cette cellule, etant donne l'alignement vertical.*) let put_ligne texte pos align width taille wrap= (* envoie la ligne de texte apres pos, sur out, en alignant horizontalement et en completant pour avoir la bonne taille *) 1550 let pos_suiv = try String.index_from texte pos '\n' with | Not_found -> String.length texte | Invalid_argument _ -> 1555 let l = String.length texte in assert (pos=l) ; l in let s = String.sub texte pos (pos_suiv - pos) in 1560 let t,post= if wrap=True then String.length s,0 else width,width - String.length s in let ligne = match align with | Left -> String.concat "" 1565 [s; String.make (taille-t+post) ' '] | Center -> String.concat "" [String.make ((taille-t)/2) ' '; s; String.make (taille - t + post- (taille-t)/2) ' '] 1570 | Right -> String.concat "" [String.make (taille-t) ' '; s; String.make (post) ' '] in 1575 if !verbose>2 then prerr_endline ("line sent :#"^ligne^"#"); do_put ligne; pos_suiv + 1 ;; 1580 let put_border s inside j = for i = 0 to String.length s -1 do if j=0 || not (List.mem i inside) then do_put_char s.[i] else do_put_char ' '; 1585 done; ;; let rec somme debut fin = if debut = fin 1590 then !table.tailles.(debut) else !table.tailles.(debut) + (somme (debut+1) fin) ;; 1595 let calculate_multi () = (* Finalisation des multi-colonnes : on les repasse toutes pour ajuster les tailles eventuellement *) let rec do_rec = function [] -> () 1600 | (debut,fin,taille_mini) :: reste -> begin let taille = somme debut fin in if !verbose>3 then prerr_endline ("from "^string_of_int debut^ " to "^string_of_int fin^ ", size was "^string_of_int taille^ 1605 " and should be at least "^string_of_int taille_mini); if taille < taille_mini then begin (* il faut agrandir *) if !verbose>3 then prerr_endline ("ajusting.."); for i = debut to fin do if taille = 0 1610 then !table.tailles.(debut) <- taille_mini else let t = !table.tailles.(i) * taille_mini in !table.tailles.(i) <- (t / taille 1615 + ( if 2*(t mod taille) >= taille then 1 else 0)); done; (* Attention : on agrandit aussi les colonnes p !! *) end; do_rec reste; 1620 end in if !verbose>2 then prerr_endline "Finalizing multi-columns."; do_rec !multi; if !verbose>2 then prerr_endline "Finalized multi-columns."; 1625 ;; let close_table () = if !verbose>2 then begin 1630 prerr_endline "=> close_table"; pretty_stack out_stack end; if !table.line=0 then !table.tailles<-Table.trim !table.taille; let tab = Table.trim !table.table in 1635 (* il reste a formatter et a flusher dans la sortie principale.. *) !table.lines<-Array.length tab; if !verbose>2 then prerr_endline ("lines :"^string_of_int !table.lines); calculate_multi (); 1640 !table.width <- somme 0 (Array.length !table.tailles -1); finit_ligne(); if !table.width > flags.hsize then warning ("overfull line in array : array too wide"); 1645 for i = 0 to !table.lines - 1 do let ligne = match tab.(i).cells with | Arr a -> a | _-> raise (Error "Invalid row type:table") 1650 in (* affichage de la ligne *) (* il faut envoyer ligne apres ligne dans chaque cellule, en tenant compte de l'alignement vertical et horizontal..*) if !verbose>2 then prerr_endline ("line "^string_of_int i^", columns:"^string_of_int (Array.length ligne)^", height:"^string_of_int tab.(i).haut); let pos = Array.create (Array.length ligne) 0 in 1655 !row.haut <-0; for j = 0 to tab.(i).haut -1 do if not ( i=0 && j=0) then do_put_char '\n'; let col = ref 0 in for k = 0 to Array.length ligne -1 do 1660 begin (* ligne j de la cellule k *) if ligne.(k).wrap = Fill then ligne.(k).span <- Array.length !table.tailles; let taille_borders = (String.length ligne.(k).pre) + (String.length ligne.(k).post) in let taille = (somme !col (!col + ligne.(k).span-1)) - taille_borders in 1665 if !verbose>3 then prerr_endline ("cell to output:"^ ligne.(k).pre^ ligne.(k).text^ ligne.(k).post^ ", taille="^string_of_int taille); 1670 put_border ligne.(k).pre ligne.(k).pre_inside j; if (text_out j tab.(i).haut ligne.(k).h ligne.(k).ver) && (ligne.(k).wrap <> Fill )then begin 1675 pos.(k) <- put_ligne ligne.(k).text pos.(k) ligne.(k).hor 1680 (ligne.(k).w - taille_borders) taille ligne.(k).wrap end else if ligne.(k).wrap = Fill then do_put (String.make taille ligne.(k).text.[0]) 1685 else do_put (String.make taille ' '); col := !col + ligne.(k).span; put_border ligne.(k).post ligne.(k).post_inside j; end; done; 1690 if !col< Array.length !table.tailles -1 then begin let len = !table.width - (somme 0 (!col-1)) in do_put ( String.make len ' '); end; done; 1695 done; flags.align <- pop stacks.s_align; table := pop table_stack; row := pop row_stack; 1700 cell := pop cell_stack; multi := pop multi_stack; flags.in_table <- pop stacks.s_in_table; close_block ""; if not (flags.in_table) then finit_ligne (); 1705 if !verbose>2 then prerr_endline "<= close_table" ;; (* Info *) 1710 let infomenu arg = () ;; 1715 let infonode opt num arg = () and infoextranode num arg text = () ;; (* Divers *) 1720 let is_blank s = let b = ref true in for i = 0 to String.length s do b := !b && s.[i]=' ' 1725 done; !b ;; let is_empty () = 1730 flags.in_table && (Out.is_empty !cur_out.out) && (flags.x= -1);; let image arg n = if arg <> "" then begin put arg; 1735 put_char ' ' end ;; let horizontal_line s width height = 1740 if flags.in_table then begin !cell.w <- 0; !cell.wrap <- Fill; put_char '-'; end else begin 1745 open_block "INFO" ""; finit_ligne (); let taille = match width with | Char x -> x | Pixel x -> x / Length.font 1750 | Percent x -> (flags.hsize -1) * x / 100 | Default -> flags.hsize - 1 | No s -> raise (Fatal ("No-length ``"^s^"'' in out-manager")) in let ligne = String.concat "" [(match s with 1755 | "right" -> String.make (flags.hsize - taille -1) ' ' | "center" -> String.make ((flags.hsize - taille)/2) ' ' | _ -> ""); String.make taille '-'] in put ligne; 1760 finit_ligne (); close_block "INFO"; end ;; 1765 (*------------*) (*---MATHS ---*) (*------------*) 1770 let cm_format = Tabular.Align {Tabular.hor="center" ; Tabular.vert = "middle" ; Tabular.wrap = false ; Tabular.pre = "" ; Tabular.post = "" ; Tabular.width = Length.Default} ;; 1775 let lm_format = Tabular.Align {Tabular.hor="left" ; Tabular.vert = "middle" ; Tabular.wrap = false ; Tabular.pre = "" ; Tabular.post = "" ; Tabular.width = Length.Default} ;; 1780 let formated s = Tabular.Align { Tabular.hor= (match s with | "cm" | "cmm" | "cb" | "ct" -> "center" 1785 | "lt" | "lb" | "lm" -> "left" | _ -> "left") ; Tabular.vert = (match s with | "cm" | "lm" ->"middle" 1790 | "lt" | "ct" -> "top" | "lb" | "cb" -> "bottom" | "cmm" -> "45" | _ -> "middle") ; Tabular.wrap = false ; Tabular.pre = "" ; 1795 Tabular.post = "" ; Tabular.width = Length.Default} ;; 1800 let freeze f = push out_stack (Freeze f) ; if !verbose > 2 then begin prerr_string "freeze: stack=" ; pretty_stack out_stack 1805 end ;; let flush_freeze () = match top out_stack with Freeze f -> 1810 let _ = pop out_stack in if !verbose > 2 then begin prerr_string "flush_freeze" ; pretty_stack out_stack end ; 1815 f () ; true | _ -> false ;; let pop_freeze () = match top out_stack with 1820 Freeze f -> let _ = pop out_stack in f,true | _ -> (fun () -> ()),false ;; 1825 (* Displays *) let open_display args = open_table (!verbose>1) ""; new_row (); 1830 if !verbose > 1 then make_border "{"; open_cell cm_format 1 0; open_cell_group (); ;; 1835 let close_display () = if not (flush_freeze ()) then begin if !verbose > 1 then make_border "}"; close_cell_group (); close_cell (); 1840 close_row (); close_table (); end; ;; 1845 let item_display () = let f,is_freeze = pop_freeze () in if !verbose > 1 then make_border "|"; close_cell (); close_cell_group (); 1850 open_cell cm_format 1 0; open_cell_group (); if is_freeze then freeze f; ;; 1855 let item_display_format format = let f,is_freeze = pop_freeze () in if !verbose > 1 then make_border "|"; close_cell (); close_cell_group (); 1860 open_cell (formated format) 1 0; open_cell_group (); if is_freeze then freeze f; ;; 1865 let force_item_display () = item_display () ;; let erase_display () = erase_cell (); 1870 erase_cell_group (); erase_row (); close_table (); ;; 1875 let open_maths display = if !verbose >1 then prerr_endline "open_maths"; if display then begin 1880 open_block "ALIGN" "CENTER"; open_display ""; flags.first_line <- 0; 1885 open_display "" end else open_block "" ""; and close_maths display = if display then begin 1890 close_display (); close_display (); close_block "ALIGN"; end else close_block ""; if !verbose>1 then 1895 prerr_endline "close_maths"; ;; 1900 let open_vdisplay display = open_table (!verbose>1) ""; and close_vdisplay () = close_table (); 1905 and open_vdisplay_row s = new_row (); if !verbose > 0 then make_border "["; open_cell (formated s) 1 0; 1910 open_cell_group (); open_display ""; and close_vdisplay_row () = close_display (); 1915 if !verbose > 0 then make_border "]"; close_cell (); close_cell_group (); close_row (); if !verbose > 0 then make_hline 0 false; 1920 ;; let insert_sup_sub () = let f,is_freeze = pop_freeze () in let ps,parg,pout = pop_out out_stack in 1925 if ps <> "" then failclose ("sup_sub : "^ps^" closes \"\""); let new_out = newstatus false [] [] true in push_out out_stack (ps,parg,new_out); close_block ""; cur_out := pout; 1930 open_block "" ""; if is_freeze then freeze f; open_display ""; let s =(Out.to_string new_out.out) in do_put s; 1935 flags.empty <- (s=""); free new_out; ;; 1940 let standard_sup_sub scanner what sup sub display = if display then begin insert_sup_sub (); let f,ff = match sup.arg,sub.arg with | "","" -> "cm","cm" 1945 | "",_ -> change_format (formated "lt"); "lb","cm" | _,"" -> change_format (formated "lm"); "lt","cmm" | _,_ -> "cm","cm" in let vide= flags.empty in 1950 item_display_format f ; if sup.arg <>"" || sub.arg<>"" then begin open_vdisplay display; (*if sup<>"" || vide then*) begin open_vdisplay_row "lt"; 1955 scanner sup ; close_vdisplay_row (); end; open_vdisplay_row "lm"; what (); 1960 close_vdisplay_row (); if sub.arg <>"" || vide then begin open_vdisplay_row "lb"; scanner sub ; close_vdisplay_row (); 1965 end; close_vdisplay (); item_display (); end else what (); close_display (); 1970 change_format (formated ff); item_display (); end else begin what (); if sub.arg <> "" then begin 1975 put "_"; scanner sub; end; if sup.arg <> "" then begin put "^"; 1980 scanner sup; end; end and limit_sup_sub scanner what sup sub display = 1985 item_display (); open_vdisplay display; open_vdisplay_row "cm"; scanner sup; close_vdisplay_row (); 1990 open_vdisplay_row "cm"; what (); close_vdisplay_row (); open_vdisplay_row "cm"; scanner sub; 1995 close_vdisplay_row (); close_vdisplay (); item_display (); and int_sup_sub something vsize scanner what sup sub display = 2000 if something then what (); item_display (); open_vdisplay display; open_vdisplay_row "lm"; scanner sup; 2005 close_vdisplay_row (); open_vdisplay_row "lm"; put ""; close_vdisplay_row (); open_vdisplay_row "lm"; 2010 scanner sub; close_vdisplay_row (); close_vdisplay (); item_display (); ;; 2015 let insert_vdisplay open_fun = let ps,parg,pout = pop_out out_stack in if ps <> "" then 2020 failclose ("insert_vdisplay : "^ps^" closes the cell."); let pps,pparg,ppout = pop_out out_stack in if pps <> "TEMP" then failclose ("insert_vdisplay : "^pps^" closes the cell2."); let ts,targ,tout = pop_out out_stack in 2025 if ts <> "" then failclose ("insert_vdisplay : "^ts^" closes the table."); let new_out = newstatus false [] [] tout.temp in push_out out_stack (ts,targ,new_out); 2030 push_out out_stack (pps,pparg,ppout); push_out out_stack (ps,parg,pout); close_display (); 2035 cur_out :=tout; open_display ""; open_fun (); let s = Out.to_string new_out.out in 2040 put s; free new_out; [] ;; 2045 let over display lexbuf = if !verbose>1 then prerr_endline "over"; 2050 if display then begin let _=insert_vdisplay ( fun () -> begin open_vdisplay display; 2055 open_vdisplay_row "cm"; end) in close_vdisplay_row (); make_hline 0 false; open_vdisplay_row "cm"; 2060 freeze (fun () -> close_vdisplay_row (); close_vdisplay (); close_display ();); end else begin 2065 put "/"; end let translate = function "<" -> "<" 2070 | ">" -> ">" | "\\{" -> "{" | "\\}" -> "}" | s -> s ;; 2075 let left delim k = item_display (); open_display ""; close_cell_group (); 2080 if delim<>"." then make_border (translate delim); k 3 ; open_cell_group (); ;; 2085 let right delim = let vsize = 3 in if delim<>"." then make_border (translate delim); item_display (); close_display (); 2090 vsize ;; (* C'est fini, elegamment 2095 *) <6>118 thread.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: thread.ml,v 1.4 2000/05/22 12:19:14 maranget Exp $" let uptable = Hashtbl.create 17 and nexttable = Hashtbl.create 17 15 and prevtable = Hashtbl.create 17 ;; let setup file upname = Hashtbl.add uptable file (ref upname) and setprev file prevname = Hashtbl.add prevtable file (ref prevname) 20 let setnext file nextname = Hashtbl.add nexttable file (ref nextname) ;; let setprevnext prev now = if prev <> "" then begin 25 Hashtbl.add nexttable prev (ref now) ; Hashtbl.add prevtable now (ref prev) end ;; 30 let next name = !(Hashtbl.find nexttable name) and up name = !(Hashtbl.find uptable name) and prev name = !(Hashtbl.find prevtable name) ;; 35 let change_aux t oldname name = let olds = Hashtbl.find_all t oldname in List.iter (fun s -> Hashtbl.remove t oldname ; 40 Hashtbl.add t name s) olds ; Hashtbl.iter (fun k x -> if !x = oldname then begin 45 x := name end) t let change oldname name = 50 change_aux nexttable oldname name ; change_aux prevtable oldname name ; change_aux uptable oldname name <6>119 ultra.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: ultra.ml,v 1.8 2001/06/05 17:57:41 maranget Exp $ *) (***********************************************************************) open Tree open Htmltext 15 open Util let verbose = ref 0 let same_prop f s = 20 try let p = Htmltext.get_prop f.nat in List.exists (fun s -> p s.nat) s with | NoProp -> false 25 let rec part_factor some blanks i s keep leave = function | [] -> keep,leave | ((f,_) as x)::rem when there f s || same_prop f s || 30 (blanks && Htmltext.blanksNeutral f)-> part_factor some blanks i s (x::keep) leave rem | (f,j)::rem -> part_factor some blanks i s keep (some f j (i-1) leave) rem 35 let there_factor s fs = List.exists (fun (f,_) -> same_style s f) fs let rec start_factor i fs start = function | [] -> start 40 | s::rem when there_factor s fs -> start_factor i fs start rem | s::rem -> start_factor i fs ((s,i)::start) rem 45 let extend_factors some blanks i s r fs = let keep,leave = part_factor some blanks i s [] r fs in start_factor i fs keep s,leave 50 let rec part_factor_neutral some i keep leave = function | [] -> keep,leave | ((f,_) as x)::rem when Htmltext.blanksNeutral f -> part_factor_neutral some i (x::keep) leave rem | (f,j)::rem -> 55 part_factor_neutral some i keep (some f j (i-1) leave) rem let extend_factors_neutral some i r fs = part_factor_neutral some i [] r fs 60 let finish_factors some i r fs = part_factor some false i [] [] r fs let pfactor chan fs = List.iter (fun ((i,j),f) -> 65 Printf.fprintf chan " %d,%d:%s" i j f.txt) fs ; output_char chan '\n' let covers (i1:int) (j1:int) i2 j2 = 70 (i1 <= i2 && j2 < j1) || (i1 < i2 && j2 <= j1) let rec all_blanks ts i j = 75 if i <= j then is_blank ts.(i) && all_blanks ts (i+1) j else true 80 let rec get_same ts i j f = function | [] -> ((i,j),f) | ((ii,jj),g)::rem when covers i j ii jj && all_blanks ts i (ii-1) && 85 all_blanks ts (jj+1) j -> ((ii,jj),f) | _::rem -> get_same ts i j f rem let get_sames ts fs = let rec do_rec r = function 90 | [] -> r | (((i,j),f) as x)::rem -> do_rec (if blanksNeutral f then get_same ts i j f fs::r 95 else x::r) rem in do_rec [] fs 100 let group_font ts fs = let fonts,no_fonts = List.partition (fun (_,f) -> is_font f.nat) fs in 105 get_sames ts fonts@no_fonts let conflict_low i1 j1 i2 j2 = i1 < i2 && i2 <= j1 && j1 < j2 let correct_cfl_low ts i1 j1 i2 j2 = 110 if conflict_low i1 j1 i2 j2 && all_blanks ts i1 (i2-1) then i1 else 115 i2 and correct_cfl_high ts i1 j1 i2 j2 = if conflict_low i1 j1 i2 j2 && all_blanks ts (j1+1) j2 120 then j2 else j1 125 let rec mk_cover_one ts i j f = function 130 | [] -> (i,j),f | ((ii,jj),g)::rem -> mk_cover_one ts (correct_cfl_low ts ii jj i j) 135 (correct_cfl_high ts i j ii jj) f rem let rec mk_cover ts fs = function | [] -> [] 140 | ((i,j),f)::rem -> mk_cover_one ts i j f fs :: mk_cover ts fs rem let extend_neutrals ts fs = let neutral,not_neutral = 145 List.partition (fun (_,f) -> blanksNeutral f) fs in mk_cover ts fs neutral @ not_neutral let factorize low high ts = if low >= high then [] 150 else let extend_blanks_left i = let rec do_rec i = if i <= low then low else begin 155 if is_blank ts.(i-1) then do_rec (i-1) else i end in 160 do_rec i and limit_blanks_right i = let rec do_rec i = if i <= low then low 165 else begin if is_blank ts.(i) then do_rec (i-1) else i 170 end in do_rec i in let correct_prop f i j env = try 175 let _ = Htmltext.get_prop f.nat in let rec find_same k = match ts.(k) with | Node (s,_) when there f s -> k | _ -> find_same (k-1) in let j = find_same j in 180 if j=i || (blanksNeutral f && all_blanks ts i (j-1)) then env else ((i,j),f)::env with 185 | NoProp -> ((i,j),f)::env in let some f i j env = if not (Htmltext.blanksNeutral f) then begin if j-i > 0 then 190 correct_prop f i j env else env end else begin let r = ref 0 in 195 for k = i to j do if not (is_blank ts.(k)) then incr r done ; if !r > 1 then correct_prop f i (limit_blanks_right j) env 200 else env end in let rec do_rec i r fs = 205 if i <= high then begin let fs,r = match ts.(i) with | Node (s,ts) -> extend_factors some (is_blanks ts) i s r fs | t -> 210 if is_blank t then extend_factors_neutral some i r fs else finish_factors some i r fs in do_rec (i+1) r fs 215 end else let _,r = finish_factors some i r fs in r in let r = do_rec low [] [] in let r = group_font ts r in 220 let r = extend_neutrals ts r in if r <> [] && !verbose > 1 then begin Printf.fprintf stderr "Factors in %d %d\n" low high ; for i=low to high do Pp.tree stderr ts.(i) 225 done ; prerr_endline "\n*********" ; pfactor stderr r end ; r 230 let same ((i1,j1),_) ((i2,j2),_) = i1=i2 && j1=j2 let covers_cost ((((i1:int),(j1:int)),_),_) (((i2,j2),_),_) = covers i1 j1 i2 j2 235 let biggest fs = let rec through r = function | [] -> r | x::rem -> 240 if List.exists (fun y -> covers_cost y x) rem then through r rem else through (x::r) rem in through [] (through [] fs) 245 let conflicts ((i1,j1),_) ((i2,j2),_) = (i1 < i2 && i2 <= j1 && j1 < j2) || (i2 < i1 && i1 <= j2 && j2 < j1) 250 let num_conflicts f fs = List.fold_left (fun r g -> if conflicts f g then 1+r else r) 255 0 fs let put_conflicts fs = List.fold_left (fun r g -> (g,num_conflicts g fs)::r) 260 [] fs let rec add f = function | [] -> let i,f = f in [i,[f]] 265 | x::rem as r -> if same f x then let _,f = f and i,r = x in (i,(f::r))::rem 270 else if conflicts f x then r else x::add f rem 275 let get_them fs = List.fold_left (fun r (f,_) -> add f r) [] fs 280 let pfactorc chan fs = List.iter (fun (((i,j),f),c) -> Printf.fprintf chan " %d,%d:%s(%d)" i j f.txt c) fs ; 285 output_char chan '\n' let slen f = (if is_font f.nat then 5 290 else 0) + String.length f.txt + String.length f.ctxt let order_factors (((i1,j1),f1),c1) (((i2,j2),f2),c2) = if c1 < c2 then true 295 else if c1=c2 then slen f1 >= slen f2 else false 300 let select_factors fs = let fs1 = put_conflicts fs in let fs2 = biggest fs1 in let fs3 = Sort.list order_factors fs2 in if !verbose > 1 then begin 305 prerr_string "fs1:" ; pfactorc stderr fs1 ; prerr_string "fs2:" ; pfactorc stderr fs2 ; prerr_string "fs3:" ; pfactorc stderr fs3 end ; Sort.list 310 (fun ((_,j1),_) ((i2,_),_) -> j1 <= i2) (get_them fs3) let some_font s = List.exists (fun s -> is_font s.nat) s 315 let rec font_tree = function | Node (s,ts) -> some_font s || font_trees ts | Blanks _ -> true 320 | _ -> false and font_trees ts = List.for_all font_tree ts let other_props s = 325 let rec other r = function | [] -> r | s::rem when is_font s.nat -> other (List.fold_left 330 (fun r p -> if p s.nat then r else p::r) [] r) rem | _::rem -> other r rem in other font_props s 335 let rec all_props r ts = match r with | [] -> [] | _ -> match ts with | [] -> r 340 | Node (s,_)::rem when some_font s -> all_props (List.filter (fun p -> List.exists (fun s -> is_font s.nat && p s.nat) s) r) 345 rem | Node (_,ts)::rem -> all_props (all_props r ts) rem | Blanks _::rem -> all_props 350 (List.filter neutral_prop r) rem | _ -> assert false let extract_props ps s = 355 List.partition (fun s -> is_font s.nat && List.exists (fun p -> p s.nat) ps) s 360 let clean t k = match t with | Node ([],ts) -> ts@k | _ -> t::k 365 let rec as_long p = function | x::rem when p x -> let yes,no = as_long p rem in x::yes,no 370 | l -> [],l let rec as_long_end p = function | [] -> [],[] | x::rem -> 375 match as_long_end p rem with | [],no when p x -> [],x::no | yes,no -> x::yes,no 380 let bouts p ts = let bef,rem = as_long is_blank ts in let inside,aft = as_long_end is_blank rem in bef,inside,aft 385 exception Failed let extract_props_trees ps ts = let card = List.length ps in 390 let rec do_rec seen = function | [] -> seen,[] | Blanks _ as t::rem -> begin match do_rec seen rem with | r,rem -> r,t::rem 395 end | Node (s,args)::rem -> let lift,keep = extract_props ps s in let seen = union seen lift in if List.length seen > card then 400 raise Failed else let r,rem = do_rec seen rem in begin match keep with | [] -> r,args@rem 405 | _ -> r,Node (keep,args)::rem end | _ -> assert false in do_rec [] ts 410 let rec neutrals started r = function | [] -> r | Blanks _::rem -> neutrals started r rem | Node (s, _)::rem -> 415 if started then neutrals true (inter r (List.filter blanksNeutral s)) rem else neutrals true (List.filter blanksNeutral s) rem | _ -> [] 420 let rec remove_list fs ts = match ts with | [] -> [] | Node (gs,args)::rem -> begin match sub gs fs with 425 | [] -> args @ remove_list fs rem | ks -> Node (ks,args) :: remove_list fs rem end | t::rem -> t::remove_list fs rem 430 let lift_neutral fs ts k = match neutrals false [] ts with | [] -> Node (fs,ts)::k | lift -> Node (lift@fs, remove_list lift ts)::k 435 let check_node fs ts k = match ts with | Node (si,args)::rem when some_font fs && font_trees ts -> begin match all_props (other_props fs) ts with | [] -> lift_neutral fs ts k 440 | ps -> let lift,keep = extract_props ps si in lift_neutral (lift@fs) (clean (Node (keep,args)) rem) k end 445 | _ -> lift_neutral fs ts k let rec as_list i j ts k = if i > j then k else 450 (clean ts.(i)) (as_list (i+1) j ts k) let remove s = function | Node (os,ts) -> node (sub os s) ts | t -> t 455 let is_text = function | Text _ -> true | _ -> false 460 and is_text_blank = function | Text _ | Blanks _ -> true | _ -> false 465 and is_node = function | Node (_::_,_) -> true | _ -> false let rec cut_begin p ts l i = 470 if i >= l then l,[] else if p ts.(i) then let j,l = cut_begin p ts l (i+1) in j,ts.(i)::l 475 else i,[] let cut_end p ts l = let rec do_rec r i = 480 if i < 0 then i,r else if p ts.(i) then do_rec (ts.(i)::r) (i-1) else 485 i,r in do_rec [] (l-1) let is_other s = match s.nat with | Other -> true 490 | _ -> false let rec deeper i j ts k = let rec again r i = if i > j then r 495 else match ts.(i) with | Node ([],args) -> let b1 = List.exists is_node args in again (b1 || r) (i+1) | Node (s,args) when List.exists is_other s -> 500 let r = again r (i+1) in if not r then ts.(i) <- Node (s,opt true (Array.of_list args) []) ; r | t -> again r (i+1) in 505 if again false i then begin let ts = as_list i j ts [] in let rs = opt true (Array.of_list ts) k in rs end else 510 as_list i j ts k and trees i j ts k = if i > j then k 515 else match factorize i j ts with | [] -> deeper i j ts k | fs -> let rec zyva cur fs k = match fs with 520 | [] -> deeper cur j ts k | ((ii,jj),gs)::rem -> for k=ii to jj do ts.(k) <- remove gs ts.(k) done ; 525 deeper cur (ii-1) ts (check_node gs (trees ii jj ts []) (zyva (jj+1) rem k)) in let fs = select_factors fs in if !verbose > 1 then begin 530 prerr_endline "selected" ; List.iter (fun ((i,j),fs) -> Printf.fprintf stderr " %d,%d:" i j ; List.iter 535 (fun f -> output_string stderr (" "^f.txt)) fs) fs ; prerr_endline "" end ; 540 zyva i fs k and opt_onodes ts i = match ts.(i) with | ONode (o,c,args) -> begin match opt false (Array.of_list args) [] with | [Node (s,args)] -> 545 ts.(i) <- Node (s,[ONode (o,c,args)]) | t -> ts.(i) <- ONode (o,c,t) end | _ -> () 550 and opt top ts k = let l = Array.length ts in for i = 0 to l-1 do opt_onodes ts i 555 done ; let p = is_text_blank in let start,pre = cut_begin p ts l 0 in if start >= l then pre@k else 560 let fin,post = cut_end p ts l in if top then pre@trees start fin ts (post@k) else extend_blanks pre (trees start fin ts []) post k 565 and extend_blanks pre ts post k = match ts with | [Node (s,args)] when pre <> [] && post <> [] && List.exists blanksNeutral s && is_blanks pre && is_blanks post -> 570 let neutral,not_neutral = List.partition blanksNeutral s in [Node (neutral, (match not_neutral with 575 | [] -> pre@args@post@k | _ -> pre@Node (not_neutral,args)::post@k))] | _ -> pre@ts@post@k 580 let main chan ts = let ci = costs Htmllex.cost ts in let rs = opt true (Array.of_list (Explode.trees ts)) [] in let cf = costs Htmltext.cost rs in 585 if compare ci cf < 0 then begin if !verbose > 1 then begin prerr_endline "*********** Pessimization ***********" ; Pp.ptrees stderr ts ; prerr_endline "*********** Into ***********" ; 590 Pp.trees stderr rs end ; Pp.ptrees chan ts end else Pp.trees chan rs <6>120 util.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: util.ml,v 1.5 2001/05/28 17:28:56 maranget Exp $c *) (***********************************************************************) open Tree open Htmltext 15 let rec do_cost ks ((k1,k2) as c) = function | Text _ | Blanks _ -> c | ONode (_,_,ts) -> let c1,c2 = c in 20 do_costs ks (1+c1,c2) ts | Node (s,ts) -> let l1, l2 = ks s in do_costs ks (l1+k1, l2+k2) ts 25 and do_costs ks k ts = List.fold_left (do_cost ks) k ts let cost ks t = do_cost ks (0,0) t and costs ks ts = do_costs ks (0,0) ts 30 let cost_compare (tags1,fonts1) (tags2, fonts2) = if tags1 < tags2 then -1 else if tags1 > tags2 then 1 else if fonts1 < fonts2 then -1 else if fonts1 > fonts2 then 1 35 else 0 let there s l = List.exists (fun os -> Htmltext.same_style s os) l 40 let inter s1 s2 = List.fold_left (fun r s -> if there s s2 then s::r else r) [] s1 45 let sub s1 s2 = List.fold_left (fun r s -> if there s s2 then r else s::r) [] s1 50 let union s1 s2 = List.fold_left (fun r s -> if there s r then r else s::r) s1 s2 55 let neutral s = List.partition Htmltext.blanksNeutral s let rec is_blank = function 60 | Text _ -> false | Blanks _ -> true | Node (_,ts) | ONode (_,_,ts) -> is_blanks ts and is_blanks = function 65 | [] -> true | t::ts -> is_blank t && is_blanks ts let nodes ss ts = match ss with | [] -> ts 70 | _ -> [Node (ss,ts)] and node ss ts = Node (ss,ts) <6>121 verb.ml 12 "verb.mll" exception VError of string 5 module type S = sig end ;; module Make (Dest : OutManager.S) (Image : ImageManager.S) (Scan : Latexscan.S) : S = 10 struct open Misc open Lexing open Save open Lexstate 15 open Latexmacros open Stack open Scan open Subst 20 exception Eof of string ;; (* For file verbatim scanning *) let input_verb = ref false 25 ;; (* For scanning by line *) let verb_delim = ref (Char.chr 0) and line_buff = Out.create_buff () 30 and process = ref (fun () -> ()) and finish = ref (fun () -> ()) ;; let env_extract s = 35 let i = String.index s '{' and j = String.rindex s '}' in String.sub s (i+1) (j-i-1) and newlines_extract s = 40 let rec do_rec i = if i < String.length s then begin if s.[i] = '\n' then 1+do_rec (i+1) else 45 0 end else 0 in do_rec 0 50 (* For scanning the ``listings'' way *) let lst_process_error _ lxm = warning ("listings, unknown character: ``"^Char.escaped lxm^"''") 55 let lst_char_table = Array.create 256 lst_process_error ;; let lst_init_char c f = lst_char_table.(Char.code c) <- f 60 let lst_init_chars s f = let last = String.length s - 1 in for i = 0 to last do lst_char_table.(Char.code s.[i]) <- f 65 done let lst_init_save_char c f = let old = lst_char_table.(Char.code c) in lst_char_table.(Char.code c) <- f old 70 let lst_init_save_chars s f = let last = String.length s - 1 in for i = 0 to last do lst_init_save_char s.[i] f 75 done (* Output functions *) let lst_gobble = ref 0 and lst_nlines = ref 0 80 and lst_first = ref 1 and lst_last = ref 9999 and lst_print = ref true and lst_string_spaces = ref true and lst_texcl = ref false 85 and lst_extended = ref false and lst_sensitive = ref true and lst_mathescape = ref false and lst_directives = ref false and lst_showlines = ref false 90 let lst_effective_spaces = ref false (* false => spaces are spaces *) and lst_save_spaces = ref false let lst_buff = Out.create_buff () 95 let lst_last_char = ref ' ' and lst_finish_comment = ref 0 let lst_put c = 100 lst_last_char := c ; Out.put_char lst_buff c and lst_direct_put c = lst_last_char := c ; 105 Dest.put_char c type lst_scan_mode = | Letter | Other | Empty | Start | Directive of bool (* bool flags some letter read *) 110 let lst_scan_mode = ref Empty type comment_type = | Nested of int 115 | Balanced of (char -> string -> bool) | Line type lst_top_mode = | Skip 120 | String of (char * (char * (Lexing.lexbuf -> char -> unit)) list) | Normal | Comment of comment_type | Delim of int * (char * (Lexing.lexbuf -> char -> unit)) list | Gobble of lst_top_mode * int | Escape of lst_top_mode * char * bool (* bool flags mathescape *) 125 let string_of_top_mode = function | Delim (i,_) -> "Delim: "^string_of_int i | Skip -> "Skip" | Comment (Balanced _) -> "Balanced" 130 | Comment (Nested n) -> "(Nested "^string_of_int n^")" | _ -> "?" let lst_top_mode = ref Skip 135 let lst_ptok s = prerr_endline (s^": "^Out.to_string lst_buff) (* Final ouput, with transformations *) let dest_string s = 140 for i = 0 to String.length s - 1 do Dest.put (Dest.iso s.[i]) done (* Echo, with case change *) 145 let dest_case s = Dest.put (match !case with | Upper -> String.uppercase s | Lower -> String.lowercase s 150 | _ -> s) (* Keywords *) let def_print s = 155 Latexmacros.def "\\@tmp@lst" zero_pat (CamlCode (fun _ -> dest_case s)) ; Latexmacros.def "\\@tmp@lst@print" zero_pat (CamlCode (fun _ -> dest_string s)) ;; 160 let lst_output_other () = if not (Out.is_empty lst_buff) then begin let arg = Out.to_string lst_buff in match !lst_top_mode with 165 | Normal -> def_print arg ; scan_this Scan.main ("\\lst@output@other{\\@tmp@lst}{\\@tmp@lst@print}") | _ -> 170 scan_this main "\\@NewLine" ; dest_string arg end and lst_output_letter () = 175 if not (Out.is_empty lst_buff) then begin match !lst_top_mode with | Normal -> let arg = Out.to_string lst_buff in def_print arg ; 180 scan_this Scan.main ("\\lst@output{\\@tmp@lst}{\\@tmp@lst@print}") | _ -> scan_this main "\\@NewLine" ; dest_string (Out.to_string lst_buff) end 185 and lst_output_directive () = if not (Out.is_empty lst_buff) then begin match !lst_top_mode with | Normal -> 190 let arg = Out.to_string lst_buff in def_print arg ; scan_this Scan.main ("\\lst@output@directive{\\@tmp@lst}{\\@tmp@lst@print}") | _ -> scan_this main "\\@NewLine" ; 195 dest_string (Out.to_string lst_buff) end let lst_output_token () = match !lst_scan_mode with 200 | Letter -> lst_output_letter () | Other -> lst_output_other () | Directive _ -> lst_output_directive () | Empty|Start -> scan_this main "\\@NewLine" 205 let lst_finalize inline = scan_this main "\\lst@forget@lastline" ; if inline || !lst_showlines then lst_output_token () 210 (* Process functions *) let lst_do_gobble mode n = 215 if n > 1 then lst_top_mode := Gobble (mode,n-1) else lst_top_mode := mode 220 let lst_do_escape mode endchar math lb lxm = if lxm = endchar then begin scan_this main "\\begingroup\\lst@escapebegin" ; if math then scan_this main "$" ; scan_this main (Out.to_string lst_buff) ; 225 if math then scan_this main "$" ; scan_this main "\\lst@escapeend\\endgroup" ; lst_top_mode := mode end else Out.put_char lst_buff lxm 230 let rec lst_process_newline lb c = if !verbose > 1 then 235 Printf.fprintf stderr "lst_process_newline\n" ; match !lst_top_mode with | Skip -> if !lst_nlines = !lst_first - 1 then begin lst_top_mode := Normal ; 240 scan_this Scan.main "\\let\\old@br\\@br\\def\\@br{ } " ; lst_process_newline lb c ; scan_this Scan.main "\\let\\@br\\old@br" end else 245 incr lst_nlines | Gobble (mode,_) -> lst_top_mode := mode ; lst_process_newline lb c | Escape (mode,cc,math) -> 250 lst_do_escape (Comment Line) cc math lb c ; if !lst_top_mode = Comment Line then lst_process_newline lb c | Comment Line -> lst_output_token () ; 255 scan_this Scan.main "\\endgroup" ; lst_top_mode := Normal ; lst_process_newline lb c | mode -> scan_this Scan.main "\\lsthk@InitVarEOL\\lsthk@EOL" ; 260 begin match !lst_scan_mode with | Empty -> lst_scan_mode := Start | Start -> () | _ -> lst_output_token () ; 265 lst_scan_mode := Start end ; incr lst_nlines ; if !lst_nlines <= !lst_last then begin scan_this Scan.main 270 "\\lsthk@InitVarBOL\\lsthk@EveryLine" ; if !lst_gobble > 0 then lst_top_mode := Gobble (mode,!lst_gobble) end else lst_top_mode := Skip 275 let lst_process_letter lb lxm = if !verbose > 1 then Printf.fprintf stderr "lst_process_letter: %c\n" lxm ; match !lst_top_mode with | Skip -> () 280 | Gobble (mode,n) -> lst_do_gobble mode n | Escape (mode,c,math) -> lst_do_escape mode c math lb lxm | _ -> match !lst_scan_mode with | Letter -> lst_put lxm | Directive true -> 285 lst_put lxm | Directive false -> lst_scan_mode := Directive true ; lst_put lxm | Empty|Start -> 290 lst_scan_mode := Letter ; lst_put lxm | Other -> lst_output_other () ; lst_scan_mode := Letter ; 295 lst_put lxm let lst_process_digit lb lxm = if !verbose > 1 then Printf.fprintf stderr "lst_process_digit: %c\n" lxm ; 300 match !lst_top_mode with | Skip -> () | Gobble (mode,n) -> lst_do_gobble mode n | Escape (mode,c,math) -> lst_do_escape mode c math lb lxm | _ -> match !lst_scan_mode with 305 | Letter|Other -> lst_put lxm | Directive _ -> lst_output_directive () ; lst_scan_mode := Other ; lst_put lxm 310 | Empty|Start -> lst_scan_mode := Other ; lst_put lxm let lst_process_other lb lxm = 315 if !verbose > 1 then Printf.fprintf stderr "process_other: %c\n" lxm ; match !lst_top_mode with | Skip -> () | Gobble (mode,n) -> lst_do_gobble mode n 320 | Escape (mode,c,math) -> lst_do_escape mode c math lb lxm | _ -> match !lst_scan_mode with | Other -> lst_put lxm | Empty|Start -> lst_scan_mode := Other ; 325 lst_put lxm | Directive _ -> lst_output_directive () ; lst_scan_mode := Other ; lst_put lxm 330 | Letter -> lst_output_letter () ; lst_scan_mode := Other ; lst_put lxm 335 (* Caml code for \stepcounter{lst@space} *) let lst_output_space () = Counter.step_counter "lst@spaces" let lst_process_space lb lxm = if !verbose > 1 then 340 Printf.fprintf stderr "process_space: ``%c''\n" lxm ; match !lst_top_mode with | Skip -> () | Gobble (mode,n) -> lst_do_gobble mode n | Escape (mode,c,math) -> lst_do_escape mode c math lb lxm 345 | _ -> begin match !lst_scan_mode with | Other -> lst_output_other () ; lst_scan_mode := Empty 350 | Letter|Directive true -> lst_output_token () ; lst_scan_mode := Empty | Empty|Directive false -> () | Start -> 355 lst_scan_mode := Empty end ; lst_output_space () let lst_process_start_directive old_process lb lxm = 360 match !lst_top_mode with | Normal -> begin match !lst_scan_mode with | Start -> lst_scan_mode := Directive false | _ -> old_process lb lxm 365 end | _ -> old_process lb lxm 370 exception EndVerb let lst_process_end endstring old_process lb lxm = if !verbose > 1 then Printf.fprintf stderr "process_end: ``%c''\n" lxm ; 375 if (not !input_verb || Stack.empty stack_lexbuf) && if_next_string endstring lb then begin Save.skip_delim endstring lb ; raise EndVerb 380 end else old_process lb lxm let lst_init_char_table inline = lst_init_chars 385 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@_$" lst_process_letter ; lst_init_chars "!\"#%&'()*+,-./:;<=>?[\\]^{}|`~" lst_process_other ; lst_init_chars "0123456789" lst_process_digit ; lst_init_chars " \t" lst_process_space ; 390 if inline then lst_init_char '\n' lst_process_space else lst_init_char '\n' lst_process_newline ;; 395 (* TeX escapes *) let start_escape mode endchar math = lst_output_token () ; lst_top_mode := Escape (mode, endchar, math) 400 let lst_process_escape math ec old_process lb lxm = if !verbose > 1 then Printf.fprintf stderr "lst_process_escape: %c\n" lxm ; match !lst_top_mode with 405 | Skip -> () | Gobble (mode,n) -> lst_do_gobble mode n | Escape _ -> old_process lb lxm | mode -> start_escape mode ec math 410 (* Strings *) let rec restore_char_table to_restore = let rec do_rec = function | [] -> () 415 | (c,f)::rest -> lst_init_char c f ; do_rec rest in do_rec to_restore 420 let lst_bs_string old_process lb lxm = old_process lb lxm ; let saved = Array.copy lst_char_table in let process_quoted _ lxm = lst_put lxm ; 425 Array.blit saved 0 lst_char_table 0 (Array.length saved) in Array.fill lst_char_table 0 (Array.length lst_char_table) process_quoted let lst_init_quote s = 430 let r = ref [] in for i = 0 to String.length s-1 do if s.[i] = 'b' then begin r := ('\\',lst_char_table.(Char.code '\\')) :: !r ; lst_init_save_char '\\' lst_bs_string 435 end done ; !r let lst_process_stringizer quote old_process lb lxm = match !lst_top_mode with 440 | Normal -> lst_output_token () ; let to_restore = lst_init_quote quote in lst_top_mode := String (lxm, to_restore) ; lst_save_spaces := !lst_effective_spaces ; 445 lst_effective_spaces := !lst_string_spaces ; scan_this Scan.main "\\begingroup\\lst@string@style" ; old_process lb lxm | String (c,to_restore) when lxm = c -> old_process lb lxm ; 450 lst_output_token () ; scan_this Scan.main "\\endgroup" ; restore_char_table to_restore ; lst_effective_spaces := !lst_save_spaces ; lst_top_mode := Normal 455 | _ -> old_process lb lxm (* Comment *) 460 let chars_string c s = let rec do_rec r i = if i < String.length s then if List.mem s.[i] r then 465 do_rec r (i+1) else do_rec (s.[i]::r) (i+1) else r in 470 do_rec [c] 0 let init_char_table_delim chars wrapper = List.map (fun c -> 475 let old_process = lst_char_table.(Char.code c) in lst_init_save_char c wrapper ; (c,old_process)) chars 480 let eat_delim k new_mode old_process lb c s = let chars = chars_string c s in let wrapper old_process lb c = match !lst_top_mode with | Delim (n,to_restore) -> 485 old_process lb c ; if n = 1 then begin lst_output_token () ; lst_top_mode := new_mode ; restore_char_table to_restore ; 490 k () end else lst_top_mode := Delim (n-1,to_restore) | _ -> assert false in let to_restore = init_char_table_delim chars wrapper in 495 lst_top_mode := Delim (1+String.length s, to_restore) ; wrapper old_process lb c let begin_comment () = lst_output_token () ; 500 scan_this Scan.main "\\begingroup\\lst@comment@style" let lst_process_BNC _ s old_process lb c = match !lst_top_mode with | Normal when if_next_string s lb -> begin_comment () ; 505 eat_delim (fun () -> ()) (Comment (Nested 0)) old_process lb c s | Comment (Nested n) when if_next_string s lb -> eat_delim (fun () -> ()) (Comment (Nested (n+1))) old_process lb c s | _ -> old_process lb c 510 and lst_process_ENC s old_process lb c = match !lst_top_mode with | Comment (Nested 0) when if_next_string s lb -> eat_delim (fun () -> scan_this Scan.main "\\endgroup") Normal 515 old_process lb c s | Comment (Nested n) when if_next_string s lb -> eat_delim (fun () -> ()) 520 (Comment (Nested (n-1))) old_process lb c s | _ -> old_process lb c let lst_process_BBC check s old_process lb c = match !lst_top_mode with 525 | Normal when if_next_string s lb -> begin_comment () ; eat_delim (fun () -> ()) (Comment (Balanced check)) 530 old_process lb c s | _ -> old_process lb c and lst_process_EBC s old_process lb c = match !lst_top_mode with | Comment (Balanced check) when 535 check c s && if_next_string s lb -> eat_delim (fun () -> scan_this Scan.main "\\endgroup") Normal old_process 540 lb c s | _ -> old_process lb c let lst_process_LC s old_process lb c = match !lst_top_mode with | Normal when if_next_string s lb -> 545 begin_comment () ; eat_delim (fun () -> ()) (if !lst_texcl then Escape (Normal,'\n', false) else Comment Line) old_process lb c s 550 | _ -> old_process lb c let lex_tables = { Lexing.lex_base = "\000\000\001\000\002\000\003\000\004\000\005\000\006\000\253\255\ \000\000\255\255\000\000\000\000\254\255\254\255\001\000\252\255\ \000\000\000\000\000\000\007\000\008\000"; 555 Lexing.lex_backtrk = "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \002\000\255\255\255\255\255\255\255\255\255\255\002\000\255\255\ \255\255\255\255\255\255\255\255\255\255"; Lexing.lex_default = "\009\000\009\000\007\000\012\000\012\000\012\000\007\000\000\000\ \255\255\000\000\255\255\255\255\000\000\000\000\255\255\000\000\ \255\255\255\255\255\255\020\000\020\000"; Lexing.lex_trans = 560 "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\018\000\000\000\000\000\013\000\000\000\007\000\007\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\014\000\000\000\ \000\000\000\000\008\000\012\000\018\000\010\000\016\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\ \000\000\000\000\000\000\011\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\019\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\255\255\009\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \012\000\012\000\015\000\009\000\009\000\009\000\009\000\255\255\ \255\255"; Lexing.lex_check = "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\018\000\255\255\255\255\002\000\255\255\004\000\005\000\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \018\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\002\000\255\255\ \255\255\255\255\006\000\011\000\017\000\008\000\014\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\016\000\255\255\ \255\255\255\255\255\255\010\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\018\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\019\000\020\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\001\000\002\000\003\000\004\000\005\000\006\000\019\000\ \020\000" } 565 let rec inverb lexbuf = __ocaml_lex_inverb_rec lexbuf 0 and __ocaml_lex_inverb_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 567 "verb.mll" 570 (fun put -> let c = lexeme_char lexbuf 0 in if c = !verb_delim then begin Dest.close_group () ; end else begin put c ; 575 inverb lexbuf put end)) | 1 -> ( 575 "verb.mll" (fun put -> if not (empty stack_lexbuf) then 580 let lexbuf = previous_lexbuf () in inverb lexbuf put else raise (VError ("End of file after \\verb")))) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_inverb_rec lexbuf n 585 and start_inverb lexbuf = __ocaml_lex_start_inverb_rec lexbuf 1 and __ocaml_lex_start_inverb_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 590 583 "verb.mll" (fun put -> let c = lexeme_char lexbuf 0 in verb_delim := c ; inverb lexbuf put)) | 1 -> ( 595 587 "verb.mll" (fun put -> if not (empty stack_lexbuf) then let lexbuf = previous_lexbuf () in start_inverb lexbuf put 600 else raise (VError ("End of file after \\verb")))) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_start_inverb_rec lexbuf n and scan_byline lexbuf = __ocaml_lex_scan_byline_rec lexbuf 2 605 and __ocaml_lex_scan_byline_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 596 "verb.mll" let lxm = lexeme lexbuf in 610 let env = env_extract lxm in if (not !input_verb || Stack.empty stack_lexbuf) && env = !Scan.cur_env then begin !finish () ; 615 scan_this Scan.main ("\\end"^env) ; Scan.top_close_block "" ; Scan.close_env !Scan.cur_env ; Scan.check_alltt_skip lexbuf end else begin 620 Out.put line_buff lxm ; scan_byline lexbuf end) | 1 -> ( 611 "verb.mll" 625 !process () ; scan_byline lexbuf) | 2 -> ( 613 "verb.mll" let lxm = lexeme_char lexbuf 0 in Out.put_char line_buff lxm ; 630 scan_byline lexbuf) | 3 -> ( 617 "verb.mll" if not (Stack.empty stack_lexbuf) then begin let lexbuf = previous_lexbuf () in 635 scan_byline lexbuf end else begin !finish () ; raise (Eof "scan_byline") 640 end) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_scan_byline_rec lexbuf n and listings lexbuf = __ocaml_lex_listings_rec lexbuf 3 and __ocaml_lex_listings_rec lexbuf state = 645 match Lexing.engine lex_tables state lexbuf with 0 -> ( 628 "verb.mll" if not (Stack.empty stack_lexbuf) then begin let lexbuf = previous_lexbuf () in 650 listings lexbuf end else begin raise (Eof "listings") end) 655 | 1 -> ( 636 "verb.mll" let lxm = lexeme_char lexbuf 0 in lst_char_table.(Char.code lxm) lexbuf lxm ; listings lexbuf) 660 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_listings_rec lexbuf n and eat_line lexbuf = __ocaml_lex_eat_line_rec lexbuf 4 and __ocaml_lex_eat_line_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 665 0 -> ( 642 "verb.mll" if not (Stack.empty stack_lexbuf) then begin let lexbuf = previous_lexbuf () in eat_line lexbuf 670 end else begin raise (Eof "eat_line") end) | 1 -> ( 675 649 "verb.mll" eat_line lexbuf) | 2 -> ( 650 "verb.mll" lst_process_newline lexbuf '\n') 680 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_eat_line_rec lexbuf n and get_line lexbuf = __ocaml_lex_get_line_rec lexbuf 5 and __ocaml_lex_get_line_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 685 0 -> ( 654 "verb.mll" if not (Stack.empty stack_lexbuf) then begin let lexbuf = previous_lexbuf () in get_line lexbuf 690 end else begin raise (Eof "get_line") end) | 1 -> ( 695 662 "verb.mll" let lxm = lexeme_char lexbuf 0 in Out.put_char line_buff lxm ; get_line lexbuf) | 2 -> ( 700 665 "verb.mll" Out.to_string line_buff) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_get_line_rec lexbuf n and do_escape lexbuf = __ocaml_lex_do_escape_rec lexbuf 6 705 and __ocaml_lex_do_escape_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( ) | 1 -> ( 710 670 "verb.mll" let arg = save_arg lexbuf in scan_this main "\\mbox{" ; scan_this_arg Scan.main arg ; scan_this main "}" ; 715 do_escape lexbuf) | 2 -> ( 676 "verb.mll" let lxm = Lexing.lexeme_char lexbuf 0 in Dest.put (Dest.iso lxm) ; 720 do_escape lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_do_escape_rec lexbuf n ;; 725 679 "verb.mll" let _ = () ;; let put_char_star = function 730 | ' '|'\t' -> Dest.put_char '_' ; | c -> Dest.put (Dest.iso c) and put_char = function | '\t' -> Dest.put_char ' ' 735 | c -> Dest.put (Dest.iso c) ;; let open_verb put lexbuf = 740 Dest.open_group "CODE" ; start_inverb lexbuf put ;; def_code "\\verb" (open_verb (fun c -> Dest.put (Dest.iso c))); 745 def_code "\\verb*" (open_verb put_char_star); ();; let put_line_buff_verb () = Out.iter put_char line_buff ; 750 Out.reset line_buff and put_line_buff_verb_star () = Out.iter put_char_star line_buff ; Out.reset line_buff 755 ;; let noeof lexer lexbuf = try lexer lexbuf with 760 | Eof s -> raise (Misc.Close ("End of file in environment: ``"^ !Scan.cur_env^"'' ("^s^")")) | EndVerb -> () 765 let open_verbenv star = Scan.top_open_block "PRE" "" ; process := if star then 770 (fun () -> put_line_buff_verb_star () ; Dest.put_char '\n') else (fun () -> put_line_buff_verb () ; Dest.put_char '\n') ; finish := if star then 775 put_line_buff_verb_star else put_line_buff_verb and close_verbenv _ = Scan.top_close_block "PRE" 780 let put_html () = Out.iter (fun c -> Dest.put_char c) line_buff ; Out.reset line_buff ;; 785 let open_rawhtml lexbuf = begin match !Parse_opts.destination with | Parse_opts.Html -> () | _ -> Misc.warning "rawhtml detected" 790 end ; process := (fun () -> put_html () ; Dest.put_char '\n') ; finish := put_html ; noeof scan_byline lexbuf 795 and close_rawhtml _ = () let open_forget lexbuf = process := (fun () -> Out.reset line_buff) ; 800 finish := (fun () -> Out.reset line_buff) ; noeof scan_byline lexbuf and close_forget _ = () 805 let open_tofile chan lexbuf = process := (fun () -> output_string chan (Out.to_string line_buff) ; output_char chan '\n') ; 810 finish := (fun () -> output_string chan (Out.to_string line_buff) ; close_out chan) ; noeof scan_byline lexbuf 815 and close_tofile lexbuf = () let put_line_buff_image () = 820 Out.iter (fun c -> Image.put_char c) line_buff ; Out.reset line_buff let open_verbimage lexbuf = process := (fun () -> put_line_buff_image () ; Image.put_char '\n') ; 825 finish := put_line_buff_image ; noeof scan_byline lexbuf and close_verbimage _ = () ;; 830 def_code "\\verbatim" (fun lexbuf -> open_verbenv false ; 835 noeof scan_byline lexbuf) ; def_code "\\endverbatim" close_verbenv ; def_code "\\verbatim*" 840 (fun lexbuf -> open_verbenv true ; noeof scan_byline lexbuf) ; def_code "\\endverbatim*" close_verbenv ; 845 def_code "\\rawhtml" open_rawhtml ; def_code "\\endrawhtml" close_forget ; def_code "\\verblatex" open_forget ; def_code "\\endverblatex" Scan.check_alltt_skip ; def_code "\\verbimage" open_verbimage ; 850 def_code "\\endverbimage" Scan.check_alltt_skip ; () ;; let init_verbatim () = 855 (* comment clashes with the ``comment'' package *) Latexmacros.def "\\comment" zero_pat (CamlCode open_forget) ; Latexmacros.def "\\endcomment" zero_pat (CamlCode Scan.check_alltt_skip) ; () ;; 860 register_init "verbatim" init_verbatim ;; (* The program package for JJL que j'aime bien *) 865 let look_escape () = let lexbuf = Lexing.from_string (Out.to_string line_buff) in do_escape lexbuf ;; 870 let init_program () = def_code "\\program" (fun lexbuf -> Scan.top_open_block "PRE" "" ; 875 process := (fun () -> look_escape () ; Dest.put_char '\n') ; finish := look_escape ; noeof scan_byline lexbuf) ; def_code "\\endprogram" close_verbenv 880 ;; register_init "program" init_program ;; 885 (* The moreverb package *) let tab_val = ref 8 let put_verb_tabs () = 890 let char = ref 0 in Out.iter (fun c -> match c with | '\t' -> let limit = !tab_val - !char mod !tab_val in 895 for j = 1 to limit do Dest.put_char ' ' ; incr char done ; | c -> Dest.put (Dest.iso c) ; incr char) line_buff ; 900 Out.reset line_buff let open_verbenv_tabs () = Scan.top_open_block "PRE" "" ; process := (fun () -> put_verb_tabs () ; Dest.put_char '\n') ; 905 finish := put_verb_tabs and close_verbenv_tabs lexbuf = Scan.top_close_block "PRE" ; Scan.check_alltt_skip lexbuf 910 ;; let line = ref 0 and interval = ref 1 ;; 915 let output_line inter_arg star = if !line = 1 || !line mod inter_arg = 0 then scan_this Scan.main ("\\listinglabel{"^string_of_int !line^"}") 920 else Dest.put " " ; if star then put_line_buff_verb_star () else 925 put_verb_tabs () ; incr line let open_listing start_arg inter_arg star = 930 Scan.top_open_block "PRE" "" ; line := start_arg ; let first_line = ref true in let inter = if inter_arg <= 0 then 1 else inter_arg in process := 935 (fun () -> if !first_line then begin first_line := false ; if not (Out.is_empty line_buff) then output_line inter_arg star ; 940 end else output_line inter_arg star ; Dest.put_char '\n') ; finish := (fun () -> 945 if not (Out.is_empty line_buff) then output_line inter_arg star) and close_listing lexbuf = Scan.top_close_block "PRE" ; 950 Scan.check_alltt_skip lexbuf ;; register_init "moreverb" 955 (fun () -> def_code "\\verbatimwrite" (fun lexbuf -> let name = Scan.get_prim_arg lexbuf in Scan.check_alltt_skip lexbuf ; 960 let chan = open_out name in open_tofile chan lexbuf) ; def_code "\\endverbatimwrite" Scan.check_alltt_skip ; 965 def_code "\\verbatimtab" (fun lexbuf -> let opt = Get.get_int (save_opt "\\verbatimtabsize" lexbuf) in tab_val := opt ; open_verbenv_tabs () ; 970 Lexstate.save_lexstate () ; let first = get_line lexbuf in Lexstate.restore_lexstate () ; scan_this Scan.main first ; Dest.put_char '\n' ; 975 noeof scan_byline lexbuf) ; def_code "\\endverbatimtab" close_verbenv_tabs ; (* def_code "\\verbatimtabinput" (fun lexbuf -> 980 let opt = Get.get_int (save_opt "\\verbatimtabsize" lexbuf) in tab_val := opt ; let name = Scan.get_prim_arg lexbuf in open_verbenv_tabs () ; verb_input scan_byline name ; 985 close_verbenv_tabs lexbuf) ; *) def_code "\\listinglabel" (fun lexbuf -> let arg = Get.get_int (save_arg lexbuf) in 990 Dest.put (Printf.sprintf "%4d " arg)) ; def_code "\\listing" (fun lexbuf -> let inter = Get.get_int (save_opt "1" lexbuf) in 995 let start = Get.get_int (save_arg lexbuf) in interval := inter ; open_listing start inter false ; noeof scan_byline lexbuf) ; def_code "\\endlisting" close_listing ; 1000 (* def_code "\\listinginput" (fun lexbuf -> let inter = Get.get_int (save_opt "1" lexbuf) in let start = Get.get_int (save_arg lexbuf) in 1005 let name = Scan.get_prim_arg lexbuf in interval := inter ; open_listing start inter false ; verb_input scan_byline name ; close_listing lexbuf) ; 1010 *) def_code "\\listingcont" (fun lexbuf -> open_listing !line !interval false ; noeof scan_byline lexbuf) ; 1015 def_code "\\endlistingcont" close_listing ; def_code "\\listing*" (fun lexbuf -> let inter = Get.get_int (save_opt "1" lexbuf) in 1020 let start = Get.get_int (save_arg lexbuf) in interval := inter ; open_listing start inter true ; noeof scan_byline lexbuf) ; def_code "\\endlisting*" close_listing ; 1025 def_code "\\listingcont*" (fun lexbuf -> Scan.check_alltt_skip lexbuf ; open_listing !line !interval false ; 1030 noeof scan_byline lexbuf) ; def_code "\\endlistingcont*" close_listing ; ()) (* The comment package *) 1035 let init_comment () = def_code "\\@excludecomment" open_forget ; def_code "\\end@excludecomment" Scan.check_alltt_skip ; ;; 1040 register_init "comment" init_comment ;; (* The listings package *) 1045 (* Caml code for \def\lst@spaces {\whiledo{\value{lst@spaces}>0}{~\addtocounter{lst@spaces}{-1}}} 1050 *) let code_spaces lexbuf = let n = Counter.value_counter "lst@spaces" in if !lst_effective_spaces then for i = n-1 downto 0 do 1055 Dest.put_char '_' done else for i = n-1 downto 0 do Dest.put_nbsp () 1060 done ; Counter.set_counter "lst@spaces" 0 ;; let code_double_comment process_B process_E lexbuf = 1065 let lxm_B = get_prim_arg lexbuf in let lxm_E = get_prim_arg lexbuf in if lxm_B <> "" && lxm_E <> "" then begin let head_B = lxm_B.[0] and rest_B = String.sub lxm_B 1 (String.length lxm_B-1) 1070 and head_E = lxm_E.[0] and rest_E = String.sub lxm_E 1 (String.length lxm_E-1) in lst_init_save_char head_B (process_B (fun c s -> 1075 c = head_E && s = rest_E) rest_B) ; lst_init_save_char head_E (process_E rest_E) end 1080 let code_line_comment lexbuf = let lxm_LC = get_prim_arg lexbuf in if lxm_LC <> "" then begin let head = lxm_LC.[0] and rest = String.sub lxm_LC 1 (String.length lxm_LC-1) in 1085 lst_init_save_char head (lst_process_LC rest) end let code_stringizer lexbuf = let mode = Scan.get_prim_arg lexbuf in 1090 let schars = Scan.get_prim_arg lexbuf in lst_init_save_chars schars (lst_process_stringizer mode) ;; let open_lst inline keys lab = 1095 scan_this Scan.main ("\\lsthk@PreSet\\lstset{"^keys^"}") ; (* For inline *) if inline then scan_this Scan.main "\\lsthk@InlineUnsave" ; (* Ignoring output *) 1100 lst_gobble := Get.get_int (string_to_arg "\\lst@gobble") ; lst_first := Get.get_int (string_to_arg "\\lst@first") ; lst_last := Get.get_int (string_to_arg "\\lst@last") ; lst_nlines := 0 ; lst_init_char_table inline ; 1105 scan_this Scan.main "\\lsthk@SelectCharTable" ; if !lst_extended then for i = 128 to 255 do lst_init_char (Char.chr i) lst_process_letter done ; 1110 scan_this Scan.main "\\lsthk@Init" ; (* Directives *) if !lst_directives then begin lst_init_save_char '#' lst_process_start_directive end ; 1115 (* Print key *) if not !lst_print then begin lst_last := -2 ; lst_first := -1 end ; (* Strings *) 1120 (* Escapes to TeX *) if !lst_mathescape then begin lst_init_save_char '$' (lst_process_escape true '$') end ; let begc = Scan.get_this_main "\\@getprintnostyle{\\lst@BET}" 1125 and endc = Scan.get_this_main "\\@getprintnostyle{\\lst@EET}" in if begc <> "" && endc <> "" then begin lst_init_save_char begc.[0] (lst_process_escape false endc.[0]) end ; scan_this Scan.main "\\lsthk@InitVar" ; 1130 lst_scan_mode := Empty ; if inline then lst_top_mode := Normal else lst_top_mode := Skip 1135 and close_lst inline = lst_finalize inline ; while !Scan.cur_env = "command-group" do scan_this Scan.main "\\endgroup" 1140 done ; scan_this Scan.main "\\lsthk@DeInit" ;; let lst_boolean lexbuf = 1145 let b = get_prim_arg lexbuf in Dest.put (match b with | "" -> "false" | s when s.[0] = 't' || s.[0] = 'T' -> "true" 1150 | _ -> "false") ;; def_code "\\@callopt" (fun lexbuf -> 1155 let csname = Scan.get_csname lexbuf in let old_raw = !raw_chars in let all_arg = get_prim_arg lexbuf in let lexarg = Lexing.from_string all_arg in let opt = Subst.subst_opt "" lexarg in 1160 let arg = Save.rest lexarg in let exec = csname^"["^opt^"]{"^arg^"}" in scan_this Scan.main exec) ;; let init_listings () = 1165 Scan.newif_ref "lst@print" lst_print ; Scan.newif_ref "lst@extendedchars" lst_extended ; Scan.newif_ref "lst@texcl" lst_texcl ; Scan.newif_ref "lst@sensitive" lst_sensitive ; Scan.newif_ref "lst@mathescape" lst_mathescape ; 1170 Scan.newif_ref "lst@directives" lst_directives ; Scan.newif_ref "lst@stringspaces" lst_string_spaces ; Scan.newif_ref "lst@showlines" lst_showlines ; def_code "\\lst@spaces" code_spaces ; def_code "\\lst@boolean" lst_boolean ; 1175 def_code "\\lst@def@stringizer" code_stringizer ; def_code "\\lst@AddTo" (fun lexbuf -> let sep = Scan.get_prim_arg lexbuf in let name = Scan.get_csname lexbuf in 1180 let old = try match Latexmacros.find_fail name with | _, Subst s -> s | _,_ -> "" with 1185 | Latexmacros.Failed -> "" in let toadd = get_prim_arg lexbuf in Latexmacros.def name zero_pat (Subst (if old="" then toadd else old^sep^toadd))) ; def_code "\\lst@lExtend" 1190 (fun lexbuf -> let name = Scan.get_csname lexbuf in try match Latexmacros.find_fail name with | _, Subst body -> 1195 let toadd = Subst.subst_arg lexbuf in Latexmacros.def name zero_pat (Subst (body^"%\n"^toadd)) | _, _ -> warning ("Cannot \\lst@lExtend ``"^name^"''") with 1200 | Latexmacros.Failed -> warning ("Cannot \\lst@lExtend ``"^name^"''")) ; def_code "\\lstlisting" (fun lexbuf -> Image.stop () ; 1205 let keys = Subst.subst_opt "" lexbuf in let lab = Scan.get_prim_arg lexbuf in let lab = if lab = " " then "" else lab in if lab <> "" then def "\\lst@intname" zero_pat (CamlCode (fun _ -> Dest.put lab)) ; 1210 open_lst false keys lab ; scan_this Scan.main "\\lst@pre\\@open@lstbox" ; scan_this Scan.main "\\lst@basic@style" ; (* Eat first line *) save_lexstate () ; 1215 noeof eat_line lexbuf ; restore_lexstate () ; (* For detecting endstring, must be done after eat_line *) lst_init_save_char '\\' (lst_process_end "end{lstlisting}") ; noeof listings lexbuf ; 1220 close_lst false ; scan_this Scan.main "\\@close@lstbox\\lst@post" ; Scan.top_close_block "" ; Scan.close_env !Scan.cur_env ; Image.restart () ; 1225 Scan.check_alltt_skip lexbuf) ; (* Init comments from .hva *) def_code "\\lst@balanced@comment" (fun lexbuf -> code_double_comment lst_process_BBC lst_process_EBC lexbuf) ; 1230 def_code "\\lst@nested@comment" (fun lexbuf -> code_double_comment lst_process_BNC lst_process_ENC lexbuf) ; def_code "\\lst@line@comment" code_line_comment ; 1235 def_code "\\lstinline" (fun lexbuf -> let keys = Subst.subst_opt "" lexbuf in let {arg=arg} = save_verbatim lexbuf in Scan.new_env "*lstinline*" ; 1240 scan_this main "\\mbox{" ; open_lst true keys "" ; Dest.open_group "CODE" ; begin try scan_this listings arg 1245 with | Eof _ -> () end ; close_lst true ; Dest.close_group () ; 1250 scan_this main "}" ; Scan.close_env "*lstinline*") ; def_code "\\lst@definelanguage" (fun lexbuf -> 1255 let dialect = get_prim_opt "" lexbuf in let language = get_prim_arg lexbuf in let base_dialect = get_prim_opt "!*!" lexbuf in match base_dialect with 1260 | "!*!" -> let keys = subst_arg lexbuf in let _ = save_opt "" lexbuf in scan_this main ("\\lst@definelanguage@{"^language^"}{"^ 1265 dialect^"}{"^keys^"}") | _ -> let base_language = get_prim_arg lexbuf in let keys = subst_arg lexbuf in let _ = save_opt "" lexbuf in 1270 scan_this main ("\\lst@derivelanguage@{"^ language^"}{"^ dialect^"}{"^ base_language^"}{"^base_dialect^"}{"^ keys^"}")) 1275 ;; register_init "listings" init_listings ;; 1280 let init_fancyvrb () = def_code "\\@Verbatim" (fun lexbuf -> open_verbenv false ; 1285 noeof scan_byline lexbuf) ; def_code "\\@endVerbatim" close_verbenv ;; 1290 register_init "fancyvrb" init_fancyvrb ;; 1295 def_code "\\@scaninput" (fun lexbuf -> let pre = save_arg lexbuf in let file = get_prim_arg lexbuf in let {arg=post ; subst=post_subst} = save_arg lexbuf in 1300 try let true_name,chan = Myfiles.open_tex file in if !verbose > 0 then message ("Scan input file: "^true_name) ; let filebuff = Lexing.from_channel chan in 1305 start_lexstate () ; let old_input = !input_verb in if old_input then warning "Nested \\@scaninput" ; input_verb := true ; Location.set true_name filebuff ; 1310 begin try record_lexbuf (Lexing.from_string post) post_subst ; scan_this_may_cont Scan.main filebuff top_subst pre ; with e -> 1315 restore_lexstate () ; Location.restore () ; close_in chan ; raise e end ; 1320 restore_lexstate () ; Location.restore () ; close_in chan ; input_verb := old_input with 1325 | Myfiles.Except -> warning ("Not opening file: "^file) | Myfiles.Error s -> warning s) end <6>122 version.ml (***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet PARA, INRIA Rocquencourt *) (* *) (* Copyright 1998 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (***********************************************************************) let header = "$Id: version.ml,v 1.64 2001/05/29 15:11:19 maranget Exp $" let real_version = "1.06-7" let release_date = "2001-05-29" 15 let version = try let _ = String.index real_version '-' in real_version^" of "^release_date 20 with | Not_found -> real_version <6>123 videoc.ml 17 "videoc.mll" module type T = sig 5 end;; module Make (Dest : OutManager.S) (Image : ImageManager.S) 10 (Scan : Latexscan.S) = struct open Misc open Parse_opts open Lexing 15 open Myfiles open Lexstate open Latexmacros open Subst open Scan 20 let header = "$Id: videoc.mll,v 1.26 2001/05/25 12:37:35 maranget Exp $" (* So I can synchronize my changes from Luc's ones *) 25 let qnc_header = "30 oct 2000" exception EndSnippet ;; 30 exception EndTeXInclusion ;; (* Re-link with these variables inserted in latexscan. *) 35 let withinSnippet = ref false;; let withinTeXInclusion = ref false;; let endSnippetRead = ref false;; (* Snippet global defaults *) 40 let snippetLanguage = ref "";; let enableLispComment = ref false;; let enableSchemeCharacters = ref false;; 45 (* Snippet Environment: run a series of hooks provided they exist as user macros. *) let runHook prefix parsing name = let run name = begin 50 if !verbose > 2 then prerr_endline ("Trying to run hook " ^ name); if Latexmacros.exists name then begin Lexstate.scan_this parsing name; () end end in let rec iterate name suffix = 55 run name; if suffix <> "" then iterate (name ^ (String.make 1 (String.get suffix 0))) (String.sub suffix 1 ((String.length suffix) - 1)) in iterate (prefix ^ name ^ "Hook") !snippetLanguage;; 60 let snippetRunHook parsing name = runHook "\\snippet" parsing name;; let snipRunHook parsing name = 65 runHook "\\snip" parsing name;; (* Hack for mutual recursion between modules: *) let handle_command = ref 70 ((function lexbuf -> function s -> ()) : (Lexing.lexbuf -> string -> unit));; (* Convert a reference to a hint such as "3" "annote.ann" "premier indice" into "3_annote_ann". This is needed for the annote tool. *) 75 let compute_hint_id number filename notename = let result = number ^ "_" ^ filename in let rec convert i = begin if i<String.length(result) 80 then let c = String.get result i in if true || ('a' <= c && c <= 'z') (* test *) || ('A' <= c && c <= 'z') || ('0' <= c && c <= '9') then () 85 else String.set result i '_'; convert (i+1); end in convert 0; result;; 90 let increment_internal_counter = let counter = ref 99 in function () -> begin 95 counter := !counter + 1; !counter end;; let lex_tables = { 100 Lexing.lex_base = "\000\000\001\000\001\000\001\000\002\000\255\255\254\255\002\000\ \030\000\111\000\249\255\252\255\253\255\250\255\001\000\195\000\ \020\001\002\000"; Lexing.lex_backtrk = "\255\255\001\000\002\000\255\255\255\255\255\255\255\255\000\000\ \255\255\000\000\255\255\255\255\255\255\255\255\004\000\006\000\ \001\000\004\000"; Lexing.lex_default = 105 "\010\000\255\255\255\255\004\000\004\000\000\000\000\000\255\255\ \005\000\255\255\000\000\000\000\000\000\000\000\255\255\006\000\ \255\255\255\255"; Lexing.lex_trans = "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\011\000\012\000\006\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \011\000\007\000\007\000\013\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\005\000\005\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\014\000\017\000\017\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\015\000\008\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\005\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \005\000\006\000\255\255\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\255\255\000\000\ \000\000\000\000\000\000\000\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\006\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\000\ \000\000\000\000\000\000\000\000\000\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\255\255\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ \000\000\000\000\000\000\000\000\000\000"; Lexing.lex_check = "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\000\000\000\000\002\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\002\000\007\000\000\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\003\000\004\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\000\000\014\000\017\000\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\000\000\001\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\255\255\255\255\255\255\255\255\255\255\255\255\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\008\000\008\000\008\000\008\000\008\000\008\000\008\000\ \008\000\009\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\255\255\255\255\255\255\255\255\255\255\255\255\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\009\000\009\000\009\000\009\000\009\000\009\000\ \009\000\009\000\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \000\000\003\000\004\000\015\000\015\000\015\000\015\000\015\000\ \015\000\015\000\015\000\015\000\015\000\015\000\015\000\015\000\ \015\000\015\000\015\000\015\000\015\000\015\000\015\000\015\000\ \015\000\015\000\015\000\015\000\015\000\015\000\008\000\255\255\ \255\255\255\255\255\255\255\255\015\000\015\000\015\000\015\000\ \015\000\015\000\015\000\015\000\015\000\015\000\015\000\015\000\ \015\000\015\000\015\000\015\000\015\000\015\000\015\000\015\000\ \015\000\015\000\015\000\015\000\015\000\015\000\016\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\255\255\ \255\255\255\255\255\255\255\255\255\255\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\016\000\ \016\000\016\000\016\000\016\000\016\000\016\000\016\000\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\015\000\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ \255\255\255\255\255\255\255\255\255\255" 110 } let rec snippetenv lexbuf = __ocaml_lex_snippetenv_rec lexbuf 0 and __ocaml_lex_snippetenv_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 115 0 -> ( 119 "videoc.mll" () ) | 1 -> ( 121 "videoc.mll" 120 let csname = lexeme lexbuf in let pat,body = Latexmacros.find csname in begin match pat with | [],[] -> let args = make_stack csname pat lexbuf in 125 let cur_subst = get_subst () in let exec = function | Subst body -> if !verbose > 2 then prerr_endline ("user macro in snippet: "^body) ; 130 Lexstate.scan_this_may_cont Scan.main lexbuf cur_subst (string_to_arg body) | Toks l -> List.iter (fun s -> scan_this Scan.main s) 135 (List.rev l) | CamlCode f -> f lexbuf in scan_body exec body args | _ -> raise (Misc.ScanError ("Command with arguments inside snippet")) 140 end ; snippetenv lexbuf) | 2 -> ( 144 "videoc.mll" Dest.put_tag "<BR>"; 145 Dest.put_char '\n'; snippetRunHook Scan.main "AfterLine"; snippetRunHook Scan.main "BeforeLine"; snippetenv lexbuf) | 3 -> ( 150 150 "videoc.mll" Dest.put_nbsp (); snippetenv lexbuf) | 4 -> ( 153 "videoc.mll" 155 Dest.put (lexeme lexbuf); Dest.put_char ' '; if !enableLispComment then begin if !verbose > 1 then 160 prerr_endline "Within snippet: Lisp comment entered"; Lexstate.withinLispComment := true; Scan.top_open_block "SPAN" ("class=\"" ^ !snippetLanguage ^ "Comment\""); snippetRunHook Scan.main "BeforeComment"; 165 try Scan.main lexbuf with (* until a \n is read *) | exc -> begin snippetRunHook Scan.main "AfterComment"; Scan.top_close_block "SPAN"; Lexstate.withinLispComment := false; 170 (* re-raise every exception but EndOfLispComment *) try raise exc with | Misc.EndOfLispComment nlnum -> begin let addon = (if !endSnippetRead then "\\endsnippet" else "") in if !verbose > 1 then 175 Printf.fprintf stderr "%d NL after LispComment %s\n" nlnum ((if !endSnippetRead then "and " else "")^addon); let _ = Lexstate.scan_this snippetenv ((String.make (1+nlnum) '\n')^addon) in () 180 end; end; end; snippetenv lexbuf) | 5 -> ( 185 183 "videoc.mll" Dest.put_char '#'; if !enableSchemeCharacters then begin if !verbose > 1 then 190 prerr_endline "Within snippet: scheme characters enabled"; schemecharacterenv lexbuf end; snippetenv lexbuf) | 6 -> ( 195 192 "videoc.mll" Dest.put (Dest.iso (lexeme_char lexbuf 0)); snippetenv lexbuf) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_snippetenv_rec lexbuf n 200 and schemecharacterenv lexbuf = __ocaml_lex_schemecharacterenv_rec lexbuf 1 and __ocaml_lex_schemecharacterenv_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 199 "videoc.mll" 205 let csname = lexeme lexbuf in Dest.put csname) | 1 -> ( 202 "videoc.mll" () ) 210 | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_schemecharacterenv_rec lexbuf n and skip_blanks_till_eol_included lexbuf = __ocaml_lex_skip_blanks_till_eol_included_rec lexbuf 2 and __ocaml_lex_skip_blanks_till_eol_included_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 215 0 -> ( 208 "videoc.mll" skip_blanks_till_eol_included lexbuf) | 1 -> ( 210 "videoc.mll" 220 () ) | 2 -> ( 212 "videoc.mll" () ) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_skip_blanks_till_eol_included_rec lexbuf n 225 and comma_separated_values lexbuf = __ocaml_lex_comma_separated_values_rec lexbuf 3 and __ocaml_lex_comma_separated_values_rec lexbuf state = match Lexing.engine lex_tables state lexbuf with 0 -> ( 230 218 "videoc.mll" let lxm = lexeme lexbuf in let s = String.sub lxm 0 (String.length lxm - 1) in if !verbose > 2 then prerr_endline ("CSV" ^ s); s :: comma_separated_values lexbuf) 235 | 1 -> ( 223 "videoc.mll" [] ) | n -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_comma_separated_values_rec lexbuf n 240 ;; 227 "videoc.mll" let caml_print s = CamlCode (fun _ -> Dest.put s) 245 let snippet_def name d = Latexmacros.def name zero_pat (CamlCode d) let rec do_endsnippet _ = if !Lexstate.withinLispComment then begin endSnippetRead := true; 250 raise (Misc.EndOfLispComment 0) end; if !Scan.cur_env = "snippet" then raise EndSnippet else 255 raise (Misc.ScanError ("\\endsnippet without opening \\snippet")) and do_texinclusion lexbuf = Scan.top_open_block "SPAN" ("class=\"" ^ !snippetLanguage ^ "Inclusion\""); 260 snippetRunHook Scan.main "BeforeTeX"; withinTeXInclusion := true; begin (* Until a \] is read *) try Scan.main lexbuf with | exc -> begin 265 snippetRunHook Scan.main "AfterTeX"; Scan.top_close_block "SPAN"; snippetRunHook Scan.main "Restart"; (* Re-raise every thing but EndTeXInclusion *) try raise exc with 270 | EndTeXInclusion -> () end; end ; and do_texexclusion _ = 275 if !withinSnippet then begin if !verbose > 2 then prerr_endline "\\] caught within TeX escape"; withinTeXInclusion := false; raise EndTeXInclusion end else 280 raise (Misc.ScanError ("\\] without opening \\[ in snippet")) and do_backslash_newline _ = Dest.put "\\\n"; Lexstate.scan_this snippetenv "\n" 285 and do_four_backslashes _ = Dest.put "\\" (* HACK: Define a macro with a body that is obtained via substitution. This is a kind of restricted \edef as in TeX. 290 Syntax: \@EDEF\macroName{#2#1..} *) and do_edef lxm lexbuf = let name = Scan.get_csname lexbuf in let body = subst_arg lexbuf in 295 if Scan.echo_toimage () then Image.put ("\\def"^name^"{"^body^"}\n") ; Latexmacros.def name zero_pat (caml_print body); () 300 (* Syntax: \@MULEDEF{\macroName,\macroName,...}{#1#3...} This is an awful hack extending the \@EDEF command. It locally rebinds the (comma-separated) \macronames to the corresponding (comma-separated) expansion of second argument. All \macronames should be a zero-ary macro. *) 305 and do_muledef lxm lexbuf = let names = subst_arg lexbuf in let bodies = subst_arg lexbuf in let rec bind lasti lastj = 310 try let i = String.index_from names lasti ',' in try let j = String.index_from bodies lastj ',' in let name = String.sub names lasti (i - lasti) in let body = String.sub bodies lastj (j - lastj) in if !verbose > 2 then prerr_endline (lxm ^ name ^ ";" ^ body); 315 Latexmacros.def name zero_pat (caml_print body); bind (i+1) (j+1) with Not_found -> failwith "Missing bodies for \\@MULEDEF" with Not_found -> let name = String.sub names lasti (String.length names - lasti) in 320 let body = String.sub bodies lastj (String.length bodies - lastj) in if !verbose > 2 then prerr_endline (lxm ^ name ^ ";" ^ body); Latexmacros.def name zero_pat (caml_print body) ; in bind 0 0; () 325 (* The command that starts the \snippet inner environment: *) and do_snippet lexbuf = 330 if !withinSnippet then raise (Misc.ScanError "No snippet within snippet.") else begin (* Obtain the current TeX value of \snippetDefaultLanguage *) let snippetDefaultLanguage = "\\snippetDefaultLanguage" in 335 let language = get_prim_opt snippetDefaultLanguage lexbuf in let language = if language = "" then snippetDefaultLanguage else language in skip_blanks_till_eol_included lexbuf; Dest.put "<BR>\n"; 340 Scan.top_open_block "DIV" ("class=\"div" ^ language ^ "\""); Dest.put "\n"; Scan.new_env "snippet"; (* Define commands local to \snippet *) snippet_def "\\endsnippet" do_endsnippet; 345 snippet_def "\\[" do_texinclusion ; snippet_def "\\]" do_texexclusion ; snippet_def "\\\\" do_four_backslashes ; snippet_def "\\\n" do_backslash_newline ; 350 snippetLanguage := language; enableLispComment := false; enableSchemeCharacters := false; withinSnippet := true; snippetRunHook Scan.main "Before"; 355 try snippetenv lexbuf with exc -> begin snippetRunHook Scan.main "AfterLine"; snippetRunHook Scan.main "After"; withinSnippet := false; 360 Scan.close_env "snippet"; Scan.top_close_block "DIV"; (* Re-raise all exceptions but EndSnippet *) try raise exc with EndSnippet -> () 365 end; end and do_enable_backslashed_chars lexbuf = let def_echo s = snippet_def s (fun _ -> Dest.put s) in 370 let chars = subst_arg lexbuf in begin if !verbose > 2 then prerr_endline ("\\enableBackslashedChar "^chars); for i=0 to (String.length chars - 1) do let charcommandname = "\\" ^ (String.sub chars i 1) in def_echo charcommandname; 375 done; end; () and do_enableLispComment lexbuf = 380 enableLispComment := true; () and do_disableLispComment lexbuf = enableLispComment := false; 385 () and do_enableSchemeCharacters lexbuf = enableSchemeCharacters := true; () 390 and do_disableSchemeCharacters lexbuf = enableSchemeCharacters := false; () 395 and do_snippet_run_hook lexbuf = let name = subst_arg lexbuf in begin snippetRunHook Scan.main name; () end 400 and do_snip_run_hook lexbuf = let name = subst_arg lexbuf in begin snipRunHook Scan.main name; () 405 end (* These macros are defined in Caml since they are not nullary macros. They require some arguments but they cannot get them in the snippet environment. So I code them by hand. *) 410 and do_vicanchor lexbuf = begin let {arg=style} = Lexstate.save_opt "" lexbuf in if !verbose > 2 then prerr_endline ("\\vicanchor"^style); let {arg=nfn} = Lexstate.save_opt "0,filename,notename" lexbuf in 415 if !verbose > 2 then prerr_endline ("\\vicanchor"^style^nfn); let fields = comma_separated_values (Lexing.from_string (nfn ^ ",")) in match fields with | [number;filename;notename] -> 420 begin let uniqueNumber = (* Would be better: truncate(Unix.gettimeofday()) *) increment_internal_counter() and hintId = compute_hint_id number filename notename in Dest.put_tag ("<A id=\"a" ^ string_of_int(uniqueNumber) 425 ^ "__" ^ hintId ^ "\" href=\"javascript: void showMessage('" ^ hintId ^ "')\" class=\"mousable\"><SPAN style=\"" ^ style ^ "\"><!-- " ^ nfn ^ " -->"); () 430 end | _ -> failwith "Missing comma-separated arguments" end and do_vicendanchor lexbuf = begin 435 let {arg=nfn} = Lexstate.save_opt "0,filename,notename" lexbuf in if !verbose > 2 then prerr_endline ("\\vicendanchor"^nfn); let fields = comma_separated_values (Lexing.from_string (nfn ^ ",")) in match fields with 440 | [number;filename;notename] -> begin Dest.put_tag ("</SPAN></A>"); () end | _ -> failwith "Missing comma-separated arguments" 445 end and do_vicindex lexbuf = begin let nfn = Lexstate.save_opt "0,filename,notename" lexbuf in Dest.put_char ' '; 450 () end ;; 455 (* This is the initialization function of the plugin: *) let init = function () -> begin (* Register global TeX macros: *) 460 def_code "\\snippet" do_snippet; def_name_code "\\@EDEF" do_edef; def_name_code "\\@MULEDEF" do_muledef; def_code "\\ViCEndAnchor" do_vicendanchor; 465 def_code "\\ViCAnchor" do_vicanchor; def_code "\\ViCIndex" do_vicindex; def_code "\\enableLispComment" do_enableLispComment; def_code "\\disableLispComment" do_disableLispComment; 470 def_code "\\enableSchemeCharacters" do_enableSchemeCharacters; def_code "\\disableSchemeCharacters" do_disableSchemeCharacters; def_code "\\enableBackslashedChars" do_enable_backslashed_chars; def_code "\\snippetRunHook" do_snippet_run_hook; def_code "\\snipRunHook" do_snip_run_hook; 475 () end;; register_init "videoc" init ;; <6>124 zyva.ml end(***********************************************************************) (* *) (* HEVEA *) (* *) 5 (* Luc Maranget, projet Moscova, INRIA Rocquencourt *) (* *) (* Copyright 2001 Institut National de Recherche en Informatique et *) (* Automatique. Distributed only by permission. *) (* *) 10 (* $Id: zyva.ml,v 1.3 2001/05/25 12:37:36 maranget Exp $ *) (***********************************************************************) module type S = functor (Dest : OutManager.S) -> functor (Image : ImageManager.S) -> 15 functor (Scan : Latexscan.S) -> sig end module 20 Make (Dest: OutManager.S) (Image : ImageManager.S) (Scan : Latexscan.S) (ToMake : S) = struct module Rien = ToMake (Dest) (Image) (Scan) 25 end <6>125 Arbre.java import java.io.*; public class Arbre { String tag; int tagchiffre; //chaque tag a optimiser est repere par un chiffre 5 char type; //O pour ouverture, S pour special, F pour fermeture et T pour texte String attribut1; //pour type S String attribut2; //pour type S String attribut3; //pour type S 10 Arbre filsG; Arbre filsD; public Arbre(String balise) { if (balise == null) 15 tag = null; else { if (Balise.estOuverture(balise)) { int i = balise.indexOf(">"); tag = balise.substring(1,i); 20 i = tag.indexOf(" ");//pour les espaces if (i != -1) tag = tag.substring(0,i); type = 'O'; 25 tagchiffre = 0; while (! tag.equals(Balise.liste[tagchiffre]) ) tagchiffre++; if ( (tag.indexOf("font") == 0) || (tag.indexOf("basefont") == 0) ) { 30 type = 'S'; String tempo = balise; tagchiffre = 24; while (! tag.equals(Balise.liste[tagchiffre]) ) 35 tagchiffre++; int j = tempo.indexOf("size"); int k = tempo.indexOf("color"); int m = tempo.indexOf("face"); 40 if (j != -1) { tempo = balise.substring(j); tempo = tempo.substring(tempo.indexOf("=") + 1); while (tempo.indexOf(" ") == 0) 45 tempo = tempo.substring(1); j = tempo.indexOf(" "); if (j != -1) attribut1 = tempo.substring(0,j); else 50 attribut1 = tempo.substring(0,tempo.indexOf(">")); } if (k != -1) { tempo = balise.substring(k); 55 tempo = tempo.substring(tempo.indexOf("=") + 1); while (tempo.indexOf(" ") == 0) tempo = tempo.substring(1); k = tempo.indexOf(" "); if (k != -1) 60 attribut2 = tempo.substring(0,k); else attribut2 = tempo.substring(0,tempo.indexOf(">")); } 65 if (m != -1) { tempo = balise.substring(m); tempo = tempo.substring(tempo.indexOf("=") + 1); while (tempo.indexOf(" ") == 0) tempo = tempo.substring(m); 70 m = tempo.indexOf(" "); if (m != -1) attribut3 = tempo.substring(0,m); else attribut3 = tempo.substring(0,tempo.indexOf(">")); 75 } } } if (Balise.estFermeture(balise)) { 80 int i = balise.indexOf(">"); tag = balise.substring(2,i); while (tag.indexOf(" ") == 0) tag = tag.substring (1); i = balise.indexOf(" "); 85 if (i != -1) tag = tag.substring(0,i); type = 'F'; } 90 if (Balise.estText (balise)) { tag = balise; type = 'T'; tagchiffre = 26; } 95 } } //Pour imprimer un arbre avec toutes les balises sur la meme ligne public static void imprimer (Arbre a) { 100 if (a.type == 'T') System.out.print(a.tag); if (a.type == 'O') System.out.print('<' + a.tag + '>'); if (a.type == 'S') { 105 System.out.print('<' + a.tag); if (a.attribut1 != null) System.out.print(" size=" + a.attribut1); if (a.attribut2 != null) System.out.print(" color=" + a.attribut2); 110 if (a.attribut3 != null) System.out.print(" face=" + a.attribut3); System.out.print('>'); } 115 if (a.filsG == null) { if ( (a.type == 'O') || (a.type == 'S') ) { System.out.print(Balise.fermeture(a.tag)); } if (a.filsD == null) { 120 return; } else { imprimer(a.filsD); return; 125 } } else imprimer(a.filsG); if (a.filsD == null) { 130 if ( (a.type == 'O') || (a.type == 'S') ) System.out.print(Balise.fermeture(a.tag)); return; } else { 135 if ( (a.type == 'O') || (a.type == 'S') ) System.out.print(Balise.fermeture(a.tag)); imprimer(a.filsD); } return; 140 } //Creation de l'arbre public static Arbre construire () throws Exception { Arbre a = new Arbre (null); 145 if (Balise.estOuverture(HTML.balise_courante)) { a = new Arbre (HTML.balise_courante); HTML.Suivante(); if (Balise.estFermeture(HTML.balise_courante)) { 150 HTML.Suivante(); if ((HTML.balise_courante.indexOf("</") == 0) && (HTML.balise_courante.indexOf("html") != -1)) return a; else { if (Balise.estFermeture(HTML.balise_courante)) { 155 HTML.Suivante(); return a; } a.filsD = construire (); } 160 } else { a.filsG = construire (); if (HTML.balise_courante == null) return a; 165 if (Balise.estFermeture(HTML.balise_courante)) { HTML.Suivante(); return a; } 170 else a.filsD = construire (); } } else { 175 a = new Arbre (HTML.balise_courante); HTML.Suivante(); if (Balise.estFermeture(HTML.balise_courante)) { HTML.Suivante(); return a; 180 } else { a.filsD = construire (); if (HTML.balise_courante == null) return a; 185 if (Balise.estFermeture(HTML.balise_courante)) return a; else return a; } 190 } return a; } //Recollage de la branche1 le + bas a droite de la branche2 195 public static Arbre recoller(Arbre branche1, Arbre branche2) { if (branche2.filsD == null) { branche2.filsD = branche1; return branche2; } 200 else { branche2.filsD = recoller (branche1, branche2.filsD); return branche2; } } 205 //Suppression d'un element public static Arbre supprimer (Arbre a) { if (a.filsG == null) { if (a.filsD == null) 210 return new Arbre(null); else return a.filsD; } else { 215 if (a.filsD == null) return a.filsG; else { a.filsG = recoller (a.filsD,a.filsG); return a.filsG; 220 } } } //Comparaison des attributs de 2 balises speciales (tableau,arbre) 225 public static boolean[] memes_att (String[] Balise1, Arbre Balise2) { boolean[] tab = new boolean[4]; if (Balise1[0] == "vide") { if (Balise2.attribut1 == null) tab[0] = true; 230 else tab[0] = false; } else { if (Balise2.attribut1 == null) 235 tab[0] = false; else if (Balise1[0].equals(Balise2.attribut1)) tab[0] = true; else 240 tab[0] = false; } if (Balise1[1] == "vide") { if (Balise2.attribut2 == null) tab[1] = true; 245 else tab[1] = false; } else { if (Balise2.attribut2 == null) 250 tab[1] = false; else if (Balise1[1].equals(Balise2.attribut2)) tab[1] = true; else 255 tab[1] = false; } if (Balise1[2] == "vide") { if (Balise2.attribut3 == null) tab[2] = true; 260 else tab[2] = false; } else { if (Balise2.attribut3 == null) 265 tab[2] = false; else if (Balise1[2].equals(Balise2.attribut3)) tab[2] = true; else 270 tab[2] = false; } if ( (tab[0] == true) && (tab[1] == true) && (tab[2] == true) ) tab[3] = true; else 275 tab[3] = false; return tab; } //Comparaison des attributs de 2 balises speciales (arbre,arbre) 280 public static boolean[] memes_att (Arbre Balise1, Arbre Balise2) { boolean[] tab = new boolean[4]; if (Balise1.attribut1 == null) { if (Balise2.attribut1 == null) tab[0] = true; 285 else tab[0] = false; } else { if (Balise2.attribut1 == null) 290 tab[0] = false; else if (Balise1.attribut1.equals(Balise2.attribut1)) tab[0] = true; else 295 tab[0] = false; } if (Balise1.attribut2 == null) { if (Balise2.attribut2 == null) tab[1] = true; 300 else tab[1] = false; } else { if (Balise2.attribut2 == null) 305 tab[1] = false; else if (Balise1.attribut2.equals(Balise2.attribut2)) tab[1] = true; else 310 tab[1] = false; } if (Balise1.attribut3 == null) { if (Balise2.attribut3 == null) tab[2] = true; 315 else tab[2] = false; } else { if (Balise2.attribut3 == null) 320 tab[2] = false; else if (Balise1.attribut3.equals(Balise2.attribut3)) tab[2] = true; else 325 tab[2] = false; } if ( (tab[0] == true) && (tab[1] == true) && (tab[2] == true) ) tab[3] = true; else 330 tab[3] = false; return tab; } //Optimisation de l'arbre 335 public static Arbre optimiser (Arbre a) { //optimisation a droite //cas d'une ouverture sans rien dedans while ( (a.filsD != null) && (a.filsD.type != 'T') && (a.filsD.filsG == null) ) { 340 if (a.filsD.filsD == null) a.filsD = null; else a.filsD = a.filsD.filsD; } 345 //suppression d'une balise speciale sans attributs while ( (a.filsD != null) && (a.filsD.type == 'S') && (a.filsD.attribut1 == null) && (a.filsD.attribut2 == null) && (a.filsD.attribut3 == null) ) { if (a.filsD.filsD == null) a.filsD = a.filsD.filsG; 350 else a.filsD = recoller (a.filsD.filsD,a.filsD.filsG); while ( (a.filsD != null) && (a.filsD.type != 'T') && (a.filsD.filsG == null) ) { if (a.filsD.filsD == null) a.filsD = null; 355 else a.filsD = a.filsD.filsD; } } 360 //cas d'un fils droit identique a son pere while ( (a.filsD != null) && (a.tag.equals(a.filsD.tag)) && ( (a.filsD.type == 'O') || ( (a.filsD.type == 'S') && (memes_att (a, a.filsD)[3]) ) ) ){ if (a.filsD.filsG != null) { if (a.filsG == null) a.filsG = a.filsD.filsG; 365 else a.filsG = recoller (a.filsD.filsG,a.filsG); } if (a.filsD.filsD == null) a.filsD = null; 370 else a.filsD = a.filsD.filsD; while ( (a.filsD != null) && (a.filsD.type == 'S') && (a.filsD.attribut1 == null) && (a.filsD.attribut2 == null) && (a.filsD.attribut3 == null) ) { if (a.filsD.filsD == null) a.filsD = a.filsD.filsG; 375 else a.filsD = recoller (a.filsD.filsD,a.filsD.filsG); while ( (a.filsD != null) && (a.filsD.type != 'T') && (a.filsD.filsG == null) ) { if (a.filsD.filsD == null) a.filsD = null; 380 else a.filsD = a.filsD.filsD; } } } 385 // cas d'un fils droit deja ouvert plus haut while ( (a.filsD != null) && (HTML.tab[a.filsD.tagchiffre]) && (a.filsD.type == 'O') ) a.filsD = supprimer (a.filsD); 390 if (a.type == 'O') HTML.tab[a.tagchiffre] = true; if (a.type == 'S') { HTML.tab[a.tagchiffre] = true; if (a.attribut1 != null) 395 HTML.tab_att[0] = a.attribut1; if (a.attribut2 != null) HTML.tab_att[1] = a.attribut2; if (a.attribut3 != null) HTML.tab_att[2] = a.attribut3; 400 } //optimisation a gauche //suppression d'une balise speciale sans attributs 405 while ( (a.filsG != null) && (a.filsG.type == 'S') && (a.filsG.attribut1 == null) && (a.filsG.attribut2 == null) && (a.filsG.attribut3 == null) ) a.filsG = supprimer(a.filsG); //optimisation des balises deja ouvertes while ( (a.filsG != null) && (HTML.tab[a.filsG.tagchiffre]) && ( (a.filsG.type == 'O') || ( (a.filsG.type == 'S') && (memes_att (HTML.tab_att, a.filsG) [3] ) ) ) ) { 410 if (a.filsG.type == 'O') a.filsG = supprimer(a.filsG); if (a.filsG.type == 'S') { a.filsG.attribut1 = null; a.filsG.attribut2 = null; 415 a.filsG.attribut3 = null; } while ( (a.filsG != null) && (a.filsG.type == 'S') && (a.filsG.attribut1 == null) && (a.filsG.attribut2 == null) && (a.filsG.attribut3 == null) ) a.filsG = supprimer(a.filsG); } 420 //optimisation d'une balise speciale avec des attributs deja ouverts if ( (a.filsG != null) && (a.filsG.type == 'S') && (HTML.tab[a.filsG.tagchiffre]) && ( (memes_att (HTML.tab_att, a.filsG) [0]) || (memes_att (HTML.tab_att, a.filsG) [1]) || (memes_att (HTML.tab_att, a.filsG) [2]) ) ) { if (memes_att (HTML.tab_att, a.filsG) [0]) a.filsG.attribut1 = null; 425 if (memes_att (HTML.tab_att, a.filsG) [1]) a.filsG.attribut2 = null; if (memes_att (HTML.tab_att, a.filsG) [2]) a.filsG.attribut3 = null; } 430 //optimisation d'une balise speciale avec des attributs deja ouverts dans son pere if ( (a.filsG != null) && (a.filsG.type == 'S') && (a.tag.equals(a.filsG.tag)) ){ if (a.filsG.attribut1 != null) a.attribut1 = a.filsG.attribut1; 435 if (a.filsG.attribut2 != null) a.attribut2 = a.filsG.attribut2; if (a.filsG.attribut3 != null) a.attribut3 = a.filsG.attribut3; a.filsG = supprimer (a.filsG); 440 } //suppression d'une balise speciale sans attributs while ( (a.filsG != null) && (a.filsG.type == 'S') && (a.filsG.attribut1 == null) && (a.filsG.attribut2 == null) && (a.filsG.attribut3 == null) ) a.filsG = supprimer(a.filsG); 445 //parcours de l'arbre if (a.filsG == null) { if (a.type != 'T') HTML.tab[a.tagchiffre] = false; 450 if (a.type == 'S') { HTML.tab_att[0] = "vide"; HTML.tab_att[1] = "vide"; HTML.tab_att[2] = "vide"; } 455 if (a.filsD == null){ if (a.type == 'T') return a; else return new Arbre (null); 460 } else { if (a.type == 'T') { a.filsD = optimiser (a.filsD); return a; 465 } else return optimiser (a.filsD); } } 470 else { a.filsG = optimiser (a.filsG); } if (a.type != 'T') HTML.tab[a.tagchiffre] = false; 475 if (a.type == 'S') { HTML.tab_att[0] = "vide"; HTML.tab_att[1] = "vide"; HTML.tab_att[2] = "vide"; } 480 if (a.filsD == null) { if (a.filsG.tag == null) return new Arbre(null); else return a; 485 } else { if (a.filsG.tag == null) { return optimiser (a.filsD); } 490 else { a.filsD = optimiser (a.filsD); return a; } } 495 } <6>126 Balise.java }import java.io.*; public class Balise { //Liste des balises Text 5 public static String [] liste = { "tt", "i", "b", "big", "small", "strike", "s", "u", "del", "ins", "em", "strong", "dfn", "code", "samp", "kbd", "var", "cite", "abbr", "acronym", "sub", "sup", "html", "blink", "font", "basefont"}; 10 //Transformation d'une ouverture en fermeture public static String fermeture (String tag) { return "</" + tag + ">"; } 15 //Test des balises public static boolean estOuverture (String bal) { if ((bal.indexOf('<') == 0) && (bal.indexOf('/') != 1)) { for (int i = 0 ; i<26 ; i++) { int j = bal.indexOf(liste[i]); 20 int longueur = liste[i].length(); if (j != -1) if ( (bal.charAt(j-1)=='<') && ((bal.charAt(j+longueur)==' ') || (bal.charAt(j+longueur)=='>') ) ) return true; } 25 } return false; } public static boolean estFermeture (String bal) { 30 if ((bal.indexOf('<') == 0) && (bal.indexOf('/') == 1)) { for (int i = 0 ; i<26 ; i++) { int j = bal.indexOf(liste[i]); int longueur = liste[i].length(); if (j != -1) 35 if ( ( (bal.charAt(j-1)=='/') || (bal.charAt(j-1)==' ') ) && ( (bal.charAt(j+longueur)==' ') || (bal.charAt(j+longueur)=='>') ) ) return true; } } return false; 40 } public static boolean estText (String bal) { if ( (estOuverture(bal)) || (estFermeture(bal)) ) return false; 45 else return true; } <6>127 HTML.java }import java.io.*; public class HTML { //Declaration des variables globales public static String balise_courante = ""; 5 public static String ligne_balise = ""; public static StreamTokenizer tok; public static boolean [] tab = new boolean [27] ; public static String [] tab_att = new String [3] ; 10 //Tableau des majuscules public static char [] MAJ = { 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z'}; 15 //Tableau des minuscules public static char [] min = { 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 20 's', 't', 'u', 'v', 'w', 'x', 'y', 'z'}; //Echange un caractere MAJ en min public static String remplace (String balise, int i) { int j = 0; 25 String tempo = balise ; balise = ""; while (tempo.indexOf(MAJ[i]) != -1) { j = tempo.indexOf(MAJ[i]); balise = balise + tempo.substring(0,j) + min[i]; 30 tempo = tempo.substring(j+1); } return balise + tempo; } 35 //Transformation des balises en minuscules public static String minuscules (String ligne) { for (int i=0 ; i<26 ; i++) { ligne = remplace(ligne,i); } 40 return ligne; } //Decoupage des balises public static void Suivante () throws Exception { 45 //pour gerer la fin du fichier if ( (balise_courante.indexOf("</") == 0) && (balise_courante.indexOf("html") != -1) ) { balise_courante = null; return; 50 } //pour gerer les lignes commencant par des tabulations while (ligne_balise.indexOf(' ') == 0) if (ligne_balise.length() == 1) { 55 tok.nextToken(); tok.nextToken(); ligne_balise = tok.sval; } else 60 ligne_balise = ligne_balise.substring(1); //pour gerer les commentaires qui peuvent contenir des balises a cheval sur plusieurs lignes if ((ligne_balise.indexOf("<!--") == 0) && (ligne_balise.indexOf("-->") == -1)) { do { 65 tok.nextToken(); tok.nextToken(); tok.nextToken(); while (tok.sval == null) { tok.nextToken(); 70 tok.nextToken(); } ligne_balise = ligne_balise + tok.sval; } while(ligne_balise.indexOf("-->") == -1); 75 } //pour gerer les commentaires qui peuvent contenir des balises if ((ligne_balise.indexOf("<!--") == 0) && (ligne_balise.indexOf("-->") != -1)) { int i = ligne_balise.indexOf("-->") + 3; 80 balise_courante = ligne_balise.substring(0,i); if (ligne_balise.length() == i) { tok.nextToken(); tok.nextToken(); 85 tok.nextToken(); while (tok.sval == null) { tok.nextToken(); tok.nextToken(); } 90 ligne_balise = tok.sval; return; } else { ligne_balise = ligne_balise.substring(i); 95 return; } } //pour gerer les lignes commencant par du texte 100 if (ligne_balise.indexOf('<') != 0) { if (ligne_balise.indexOf('<') == -1) { balise_courante = ligne_balise; tok.nextToken(); tok.nextToken(); 105 tok.nextToken(); while (tok.sval == null) { tok.nextToken(); tok.nextToken(); } 110 ligne_balise = tok.sval; return; } else { int i = ligne_balise.indexOf('<'); 115 balise_courante = ligne_balise.substring(0,i); ligne_balise = ligne_balise.substring(i); return; } } 120 //pour gerer les lignes commencant par une balise incomplete if ((ligne_balise.indexOf('<') == 0) && (ligne_balise.indexOf('>') == -1)) { do { tok.nextToken(); 125 tok.nextToken(); tok.nextToken(); while (tok.sval == null) { tok.nextToken(); tok.nextToken(); 130 } balise_courante = tok.sval; while (balise_courante.indexOf(' ') == 0) if (balise_courante.length() == 1) { 135 tok.nextToken(); tok.nextToken(); balise_courante = tok.sval; } else 140 balise_courante = balise_courante.substring(1); ligne_balise = ligne_balise + " " + balise_courante; } while(ligne_balise.indexOf('>') == -1); } 145 //pour gerer les lignes commencant par une balise if ((ligne_balise.indexOf('<') == 0) && (ligne_balise.indexOf('>') != -1)) { int i = ligne_balise.indexOf('>') + 1; balise_courante = minuscules(ligne_balise.substring(0,i)); 150 if ((balise_courante.indexOf("</") == 0) && (balise_courante.indexOf("html") != -1) ) return; if (ligne_balise.length() == i) { 155 tok.nextToken(); tok.nextToken(); tok.nextToken(); while (tok.sval == null) { tok.nextToken(); 160 tok.nextToken(); } ligne_balise = tok.sval; return; } 165 else { ligne_balise = ligne_balise.substring(i); return; } } 170 return; } public static void main(String[] args) throws Exception { 175 if ((args.length != 0)&&(args.length != 1)) { System.err.println("Usage: java Fichier <nom>"); System.exit(1); } if (args.length == 0) { 180 BufferedReader f = new BufferedReader (new InputStreamReader (System.in)) ; tok = new StreamTokenizer (f); } else { FileReader f = new FileReader(args[0]); 185 tok = new StreamTokenizer(f); } tok.resetSyntax(); tok.wordChars(' ', ' ');//pour prendre les tabulations tok.wordChars(' ',''); //pour prendre les caracteres classiques 190 int i=0; Arbre a = new Arbre(null); tok.nextToken(); 195 while (tok.sval == null) { tok.nextToken(); tok.nextToken(); } 200 ligne_balise = tok.sval; //pour prendre la premiere balise Suivante(); while (! balise_courante.equals ("<html>")) { //pour imprimer les commentaires avant <html> System.out.println(balise_courante); 205 Suivante(); } for (int k=0; k<=26; k++) tab[k] = false; for (int k=0; k<=2; k++) 210 tab_att[k] = "vide"; a = Arbre.construire (); a = Arbre.optimiser (a); Arbre.imprimer(a); } 215 } <6>128 Jeton.java import java.io.*; class Jeton extends StreamTokenizer { 5 Jeton (Reader f) { super(f) ; } public int jetonSuivant() throws IOException { 10 int r = this.nextToken() ; System.err.println("jeton suivant : " + r + " << " + sval + ">>") ; return r ; } } This document was translated from LATEX by H<2>EV<2>EA.