# 12 "infoRef.mll"
 
let header = "$Id: infoRef.mll,v 1.25 2005-11-08 10:14:19 maranget Exp $"
;;


open Lexing
open Misc

let compat_mem tbl key =
  try let _ = Hashtbl.find tbl key in true with Not_found -> false
;;


exception Error of string

type node_t = {
    mutable name : string;
    mutable comment : string;
    mutable previous : node_t option;
    mutable next : node_t option;
    mutable up : node_t option;
    mutable pos : int;
  } 
;;

type menu_t = {
    mutable num : int;
    mutable nom : string;
    mutable nod : node_t option;
    mutable nodes : node_t list;
  }
;;


let menu_list = ref [];;

let nodes = Hashtbl.create 17;;
let delayed  = ref [];;
let current_node = ref None;;

let menu_num = ref 0
;;

let counter = ref 0
and pos_file = ref 0
;;

let abs_pos () = !counter + !pos_file
;;


let cur_file = ref (Parse_opts.name_out)
;;

let file_number = ref 1
;;

type label_t = {
    mutable lab_name : string;
    mutable noeud : node_t option;
  };;

let labels_list = ref [];;

let files = ref [];;
let top_node = ref false;;

let hot_start () =
  menu_list :=  [];
  Hashtbl.clear nodes ;
  current_node := None ;
  menu_num := 0 ;
  counter := 0 ;
  pos_file := 0 ;
  cur_file := Parse_opts.name_out ;
  files := [] ;
  top_node := false ;
  file_number :=  1 ;
  labels_list := []
;;

let infomenu arg =
  menu_num:=!menu_num+1;
  menu_list := { 
    num = !menu_num;
    nom = arg;
    nod = !current_node;
    nodes = [];
  } ::!menu_list;
  Text.open_block "INFOLINE" "";
  Text.put ("\\@menu"^string_of_int !menu_num^"\n");
  Text.close_block "INFOLINE"
;;

let rec cherche_menu m = function
  | [] -> raise (Error ("Menu ``"^m^"'' not found"))
  | menu::r -> 
      if menu.nom = m then menu
      else cherche_menu m r
;;

let rec cherche_menu_par_num n = function
  | [] -> raise (Error ("Menu not found"))
  | menu::r -> 
      if menu.num = n then menu
      else cherche_menu_par_num n r
;; 

let ajoute_node_dans_menu n m =
  try
  let menu = cherche_menu m !menu_list in
  menu.nodes <- n :: menu.nodes;
  menu.nod
  with _ -> None
;;


let verifie name =
  let nom = String.copy name in
  for i = 0 to String.length name -1 do
    match nom.[i] with
    | '\t' -> nom.[i] <- ' '
    | ',' -> nom.[i] <- ' '
    | '.' -> nom.[i] <- '-'
    | '\n' -> nom.[i] <- ' '
    |  _ -> ()
  done;
  nom
;;




(* 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
;;

let rec change_label s = function
  |  [] -> Misc.warning ("Cannot change label: ``"^s^"''")
  | l::r ->
      if l.lab_name = s then
        l.noeud <- !current_node 
      else
        change_label s r

let loc_name s1 = (* pose un label *)
  let _ = 
    try 
      let _ = cherche_label s1 !labels_list in
      Misc.warning ("Multiple use of label: "^s1)
    with Not_found -> ()
  in

  let l = {
    lab_name = s1;
    noeud = !current_node ;
  } in

  labels_list := l:: !labels_list;
  Text.open_block "INFO" "" ;
  Text.put "\\@name{" ;
  Text.put s1 ;
  Text.put "}" ;
  Text.close_block "INFO" ;
  if !verbose > 1 then prerr_endline ("InfoRef.loc_name, label="^s1);
;;



(* Sortie du fichier final *)

let out_cur = ref (Out.create_null ())
;;

let set_out chan =
  if !verbose >3 then prerr_endline "Set_out";
  out_cur := chan
;;

let set_out_file s =
  if !verbose >3 then prerr_endline ("Set_out_file :"^s);
  cur_file := s
;;

let put s = 
  if !verbose >3 then
    prerr_endline ("put :"^s);
  counter:=!counter + String.length s;
  Out.put !out_cur s
;;

let put_char c =
  if !verbose >3 then
    prerr_endline ("put_char :"^String.make 1 c);
  counter:=!counter +1;
  Out.put_char !out_cur c
;;

let put_credits () =
  put "\n\n-------------------------------------\nThis file has been translated from LaTeX by HeVeA.\n\n";

and put_header () =
  put "This file has been translated from LaTeX by HeVeA.\n"
;;

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
    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 () ;
  counter := 0

;;




let noeud_name n = n.name
;;


let affiche_menu num =
  let menu = cherche_menu_par_num num !menu_list in
  if menu.nodes <> [] then begin
    put "* Menu:\n\n";
    let rec affiche_items = function
      | [] -> ()
      | n::reste ->
	  put ("* "^noeud_name n^"::\t"^n.comment^"\n");
	  affiche_items reste;
    in
    affiche_items (List.rev menu.nodes);
    if !verbose >1 then
      prerr_endline ("Menu :"^menu.nom);
  end
;;
    

let  do_affiche_tag_table s = 
  put ("\n\nTag table:\n"^(if s<> "" then s^"\n" else "")) ;
  Hashtbl.iter
    (fun _ n ->
      put ("Node: "^noeud_name n^""^string_of_int n.pos^"\n")) nodes;
  put "\nEnd tag table\n";
;;


let affiche_tag_table ()=
  match !files with
  | [_] ->
    do_affiche_tag_table ""
  | _   ->
    let rec do_indirect = function
      | [] -> ()
      | (f,p)::reste ->
          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)) ;
    put_header () ;
    put "\nIndirect:\n";
    do_indirect (List.rev !files);
    do_affiche_tag_table "(Indirect)"
;;


let affiche_node nom =
  if !top_node then begin
    put_credits () ;
    top_node := false
  end ;
  let noeud = 
    try Hashtbl.find nodes nom
    with Not_found ->  raise (Error ("Node not found :"^nom))
  in
  if not Parse_opts.filter && !counter > 50000 then begin
    next_file ()
  end;
  noeud.pos <- abs_pos ();
  put "\n";
  put ("Node: "^noeud_name noeud);
  (match noeud.next with
  | None -> ()
  | Some n -> put (",\tNext: "^noeud_name n));
  (match noeud.previous with
  | None -> ()
  | Some n -> put (",\tPrev: "^noeud_name n));
  (match noeud.up with
  | None ->
      if noeud.name = "Top" then begin
        put ",\tUp: (dir)" ;
        top_node := true
      end
  | Some n -> put (",\tUp: "^noeud_name n));
  put_char '\n';
  if !verbose >1 then
    prerr_endline ("Node : "^noeud_name noeud);
  
;;

let affiche_ref key =
  try
    let l =  cherche_label key !labels_list in
    match l with
    | None -> ()
    | Some node -> put ("*Note "^noeud_name node^"::")
  with
  | Not_found -> () (* A warning has already been given *)
;;

let footNote_label = ref ""
;;


# 326 "infoRef.ml"
let __ocaml_lex_tables = {
  Lexing.lex_base = 
   "\000\000\250\255\251\255\000\000\000\000\000\000\000\000\001\000\
    \002\000\000\000\255\255\004\000\000\000\002\000\254\255\003\000\
    \000\000\252\255\003\000\005\000\001\000\006\000\006\000\000\000\
    \007\000\001\000\253\255\001\000\017\000\002\000\003\000\004\000\
    \005\000\006\000\007\000\026\000\011\000\009\000\001\000\011\000\
    \020\000\002\000";
  Lexing.lex_backtrk = 
   "\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\255\255\255\255\255\255\
    \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\001\000\255\255\
    \255\255\001\000\255\255\255\255\001\000\255\255\255\255\255\255\
    \255\255\255\255";
  Lexing.lex_default = 
   "\001\000\000\000\000\000\255\255\255\255\255\255\255\255\255\255\
    \255\255\255\255\000\000\255\255\255\255\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\000\000\014\000\255\255\030\000\031\000\031\000\
    \033\000\034\000\034\000\014\000\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\000\000\000\000\014\000\010\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\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\028\000\028\000\028\000\028\000\028\000\028\000\028\000\
    \028\000\028\000\028\000\000\000\000\000\000\000\000\000\000\000\
    \004\000\028\000\028\000\028\000\028\000\028\000\028\000\028\000\
    \028\000\028\000\028\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\003\000\000\000\000\000\000\000\
    \000\000\011\000\039\000\024\000\013\000\018\000\008\000\014\000\
    \016\000\019\000\020\000\022\000\025\000\007\000\006\000\012\000\
    \009\000\015\000\005\000\021\000\023\000\010\000\036\000\038\000\
    \040\000\041\000\000\000\017\000\026\000\010\000\000\000\000\000\
    \000\000\000\000\014\000\010\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\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
    \000\000\000\000\000\000\000\000\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\255\255\255\255\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\026\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\029\000\030\000\031\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\027\000\027\000\027\000\027\000\027\000\027\000\027\000\
    \027\000\027\000\027\000\255\255\255\255\255\255\255\255\255\255\
    \003\000\028\000\028\000\028\000\028\000\028\000\028\000\028\000\
    \028\000\028\000\028\000\036\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\006\000\038\000\023\000\012\000\005\000\007\000\013\000\
    \015\000\018\000\019\000\021\000\024\000\004\000\004\000\006\000\
    \008\000\011\000\004\000\020\000\022\000\009\000\035\000\037\000\
    \039\000\040\000\255\255\016\000\025\000\041\000\255\255\255\255\
    \255\255\255\255\032\000\033\000\034\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\
    \000\000\027\000\029\000\030\000\031\000\032\000\033\000\034\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\035\000";
  Lexing.lex_base_code = 
   "";
  Lexing.lex_backtrk_code = 
   "";
  Lexing.lex_default_code = 
   "";
  Lexing.lex_trans_code = 
   "";
  Lexing.lex_check_code = 
   "";
  Lexing.lex_code = 
   "";
}

let rec main lexbuf =
    __ocaml_lex_main_rec lexbuf 0
and __ocaml_lex_main_rec lexbuf __ocaml_lex_state =
  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
      | 0 ->
# 339 "infoRef.mll"
    (
  let num = numero lexbuf in
  affiche_menu num;
  main lexbuf)
# 447 "infoRef.ml"

  | 1 ->
# 344 "infoRef.mll"
    (
  let nom = finitLigne lexbuf in
  affiche_node nom;
  main lexbuf)
# 455 "infoRef.ml"

  | 2 ->
# 349 "infoRef.mll"
    (
  let key = arg lexbuf in
  affiche_ref key;
  main lexbuf)
# 463 "infoRef.ml"

  | 3 ->
# 354 "infoRef.mll"
  (let _ = arg lexbuf in
  main lexbuf)
# 469 "infoRef.ml"

  | 4 ->
# 357 "infoRef.mll"
    (affiche_tag_table ())
# 474 "infoRef.ml"

  | 5 ->
# 360 "infoRef.mll"
    (let lxm = lexeme_char lexbuf 0 in
    put_char lxm;
    main lexbuf)
# 481 "infoRef.ml"

  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_main_rec lexbuf __ocaml_lex_state

and numero lexbuf =
    __ocaml_lex_numero_rec lexbuf 27
and __ocaml_lex_numero_rec lexbuf __ocaml_lex_state =
  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
      | 0 ->
# 366 "infoRef.mll"
    (let lxm = lexeme lexbuf in
    int_of_string lxm)
# 493 "infoRef.ml"

  | 1 ->
# 368 "infoRef.mll"
    (raise (Error "Syntax error in info temp file"))
# 498 "infoRef.ml"

  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_numero_rec lexbuf __ocaml_lex_state

and finitLigne lexbuf =
    __ocaml_lex_finitLigne_rec lexbuf 29
and __ocaml_lex_finitLigne_rec lexbuf __ocaml_lex_state =
  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
      | 0 ->
# 372 "infoRef.mll"
    (let lxm = lexeme lexbuf in
    String.sub lxm 0 ((String.length lxm) -1))
# 510 "infoRef.ml"

  | 1 ->
# 374 "infoRef.mll"
    (raise ( Error "Syntax error in info temp file: no node name."))
# 515 "infoRef.ml"

  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_finitLigne_rec lexbuf __ocaml_lex_state

and arg lexbuf =
    __ocaml_lex_arg_rec lexbuf 32
and __ocaml_lex_arg_rec lexbuf __ocaml_lex_state =
  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
      | 0 ->
# 378 "infoRef.mll"
    (let lxm= lexeme lexbuf in
    String.sub lxm 0 ((String.length lxm) -1))
# 527 "infoRef.ml"

  | 1 ->
# 380 "infoRef.mll"
    (raise (Error "Syntax error in info temporary file: invalid reference."))
# 532 "infoRef.ml"

  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_arg_rec lexbuf __ocaml_lex_state

and labels lexbuf =
    __ocaml_lex_labels_rec lexbuf 35
and __ocaml_lex_labels_rec lexbuf __ocaml_lex_state =
  match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
      | 0 ->
# 384 "infoRef.mll"
    (let key = arg lexbuf in
    key::labels lexbuf)
# 544 "infoRef.ml"

  | 1 ->
# 386 "infoRef.mll"
    (labels lexbuf)
# 549 "infoRef.ml"

  | 2 ->
# 387 "infoRef.mll"
      ([])
# 554 "infoRef.ml"

  | __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_labels_rec lexbuf __ocaml_lex_state

;;

# 390 "infoRef.mll"
 
let do_infonode opt num arg = 

  let n = {
    name = verifie num;
    comment = arg;
    previous = None;
    next = None;
    up = None;
    pos = 0;
  } in
  if compat_mem nodes n.name then
    raise (Error ("Duplicate node name: "^n.name));  
  n.up <- (match opt with
    "" -> None
  | 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";
  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

and flushextranodes () =
  let rec flush_rec = function
    | [] -> ()
    | (num,nom,text) :: rest ->
        do_infonode "" num nom ;
        Text.open_block "INFO" "" ;
        Text.put text ;
        Text.close_block "INFO" ;
        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 := [] 
;;

let infonode opt num arg =
  flushextranodes () ;
  do_infonode opt num arg


(* finalisation des liens entre les noeuds *)
let rec do_finalize_nodes suivant = function
  | [] -> ()
  | n::reste -> 
      if !verbose>2 then prerr_endline ("node :"^n.name);
      n.next <- suivant;
      (match  suivant with
      |	None -> ()
      |	Some suiv -> suiv.previous <- Some n );
      do_finalize_nodes (Some n) reste
;;

let rec do_finalize_menus = function
  | [] -> ()
  | m::reste ->
      if m.nodes <> [] then begin
	do_finalize_nodes 
	  (match m.nod with
	    None -> None
	  | Some n -> n.next)
	  m.nodes;
	(match m.nod with
	  None -> ()
	|	 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 *)
	    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 *)
	  );
	do_finalize_menus reste;
      end
;;

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.";
;;

let dump buff =
  let name,out_chan = match Parse_opts.name_out with
  | ""|"-" -> "", Out.create_chan stdout
  | s  ->
      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 ;
  set_out_file name ;
  put_header () ;
  files := [name,abs_pos ()] ;
  main buff ;
  Out.close !out_cur ;
  if !file_number = 1 then
    Mysys.rename !cur_file Parse_opts.name_out

# 669 "infoRef.ml"