6>1 colscan.mll6>
(***********************************************************************)
(* *)
(* 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.mll6>
(***********************************************************************)
(* *)
(* 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.mll6>
(***********************************************************************)
(* *)
(* 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.mll6>
(***********************************************************************)
(* *)
(* 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.mll6>
(***********************************************************************)
(* *)
(* 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|" ")+ {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.mll6>
(***********************************************************************)
(* *)
(* 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.mll6>
(***********************************************************************)
(* *)
(* 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 (); (* " "*)
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 " ";
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 " " ; 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.mll6>
(***********************************************************************)
(* *)
(* 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.mll6>
(***********************************************************************)
(* *)
(* 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}
| " " {Out.put tag_buff " " ; tagout lexbuf}
365 | ">" {Out.put tag_buff ">" ; tagout lexbuf}
| "<" {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.mll6>
(***********************************************************************)
(* *)
(* 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.mll6>
(***********************************************************************)
(* *)
(* 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.mll6>
(***********************************************************************)
(* *)
(* 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.mll6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.mli6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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.ml6>
(***********************************************************************)
(* *)
(* 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 " " ;
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.ml6>
(***********************************************************************)
(* *)
(* 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
| '<' -> "<"
| '>' -> ">"
| '&' -> "&"
| c -> (r_quote.[0] <- c ; r_quote)
40 ;;
let r_translate = String.create 1
;;
45 let iso_translate = function
| '<' -> "<"
| '>' -> ">"
| '&' -> "&"
| '' -> " "
50 | '' -> "¡"
| '' -> "¢"
| '' -> "£"
| '' -> "¤"
| '' -> "¥"
55 | '' -> "¦"
| '' -> "§"
| '' -> "¨"
| '' -> "©"
| '' -> "ª"
60 | '' -> "«"
| '' -> "¬"
| '' -> "­"
| '' -> "®"
| '' -> "¯"
65 | '' -> "°"
| '' -> "±"
| '' -> "²"
| '' -> "³"
| '' -> "´"
70 | '' -> "µ"
| '' -> "¶"
| '' -> "·"
| '' -> "¸"
| '' -> "¹"
75 | '' -> "º"
| '' -> "»"
| '' -> "¼"
| '' -> "½"
| '' -> "¾"
80 | '' -> "¿"
| 'A' -> "À"
| '' -> "Á"
| 'A' -> "Â"
| '' -> "Ã"
85 | '' -> "Ä"
| '' -> "Å"
| '' -> "Æ"
| 'C' -> "Ç"
| 'E' -> "È"
90 | 'E' -> "É"
| 'E' -> "Ê"
| 'E' -> "Ë"
| '' -> "Ì"
| '' -> "Í"
95 | 'I' -> "Î"
| 'I' -> "Ï"
| '' -> "Ð"
| '' -> "Ñ"
| '' -> "Ò"
100 | '' -> "Ó"
| 'O' -> "Ô"
| '' -> "Õ"
| '' -> "Ö"
| '' -> "×"
105 | '' -> "Ø"
| '' -> "Ù"
| '' -> "Ú"
| 'U' -> "Û"
| 'U' -> "Ü"
110 | '' -> "Ý"
| '' -> "Þ"
| '' -> "ß"
| 'a' -> "à"
| '' -> "á"
115 | 'a' -> "â"
| '' -> "ã"
| '' -> "ä"
| '' -> "å"
| '' -> "æ"
120 | 'c' -> "ç"
| 'e' -> "è"
| 'e' -> "é"
| 'e' -> "ê"
| 'e' -> "ë"
125 | '' -> "ì"
| '' -> "í"
| 'i' -> "î"
| 'i' -> "ï"
| '' -> "ð"
130 | '' -> "ñ"
| '' -> "ò"
| '' -> "ó"
| 'o' -> "ô"
| '' -> "õ"
135 | '' -> "ö"
| '' -> "÷"
| '' -> "ø"
| '' -> "ù"
| '' -> "ú"
140 | 'u' -> "û"
| 'u' -> "ü"
| '' -> "ý"
| '' -> "þ"
| '' -> "ÿ"
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 " "
;;
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 " ";
open_cell center_format 1 0;
put s;
530 end else begin
open_cell center_format 1 0;
put s;
close_cell " "
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\" > ― </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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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 (); (* " "*)
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 " ";
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 " " ; 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.ml6>
# 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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> ⁢ </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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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.ml6>
(***********************************************************************)
(* *)
(* 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.ml6>
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.ml6>
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.java6>
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.java6>
}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.java6>
}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.java6>
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>E2>V<2>E2>A.