Download code

From LiteratePrograms

Back to OCAMAWEB/Sources

Download for Windows: single file, zip

Download for UNIX: single file, zip, tar.gz, tar.bz2

ocamaweb.ml

 (* Copyright (c) 2010 the authors listed at the following URL, and/or
 the authors of referenced articles or incorporated external code:
 http://en.literateprograms.org/OCAMAWEB/Sources?action=history&offset=20060320073235
 
 Permission is hereby granted, free of charge, to any person obtaining
 a copy of this software and associated documentation files (the
 "Software"), to deal in the Software without restriction, including
 without limitation the rights to use, copy, modify, merge, publish,
 distribute, sublicense, and/or sell copies of the Software, and to
 permit persons to whom the Software is furnished to do so, subject to
 the following conditions:
 
 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.
 
 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 Retrieved from: http://en.literateprograms.org/OCAMAWEB/Sources?oldid=3468
 *)
 
 
 let version = "6.0";;
 
 open Str;;
 open Xml;;
 
 (*<
   \section{Fonction globales et définitions}
 
   La variable d'environnement {\sf OCAMAWEB} est utilisée comme
   chemin pour le fichier de log (son nom est \code{"ocamaweb.log"})
   et pour le fichier {\tt ocamaweb.sty}.
   
 
   La variable d'environnement {\sf OCAMAWEB\_DEST} est utilisée comme
   repository de fichiers de doc.
 
   Attention: j'ai besoin du slash de fin!
 
 *)
 
 let log_file = 
   try
     open_out ((Sys.getenv "OCAMAWEB") ^ "ocamaweb.log")
   with Not_found -> 
     Printf.fprintf stderr "OCAMAWEB: WARNING! WARNING! WARNING!\n          environment variable 'OCAMAWEB' not defined!\n";
     open_out "ocamaweb.log"
 ;;
 
 (* to be used as output for undefined special keys *)
 let not_defined = "***NOT DEFINED***";;
 
 let root_string = "***ROOT***";;
 
 let empty_string = "***EMPTY***";;
 
 let relations     = Hashtbl.create 20;;
 
 let sub_relations = Hashtbl.create 20;;
 
 
 (*< 
   \subsection{parsing d'une ligne}
   Lors du parcours du fichier de CODE, chaque ligne va se voir attribuer un type [state].\\
   Les différents éléments de ce type sont :
   \begin{itemize}
 
   \item \code{Into_comments} : il s'agit d'une ligne de commentaire "classique"
   (elle fera partie soit du code soit des commentaires du bloc suivant sa position
   relative p/r aux autres lignes)
 
   \item \code{Begin_section} : il s'agit de la déclaration d'une section (par %%)
   (de cette ligne on va tirer le titre -d'où la référence sera déduite- et le début
   des commentaires de bloc)
 
   \item \code{Begin_subsection} : il s'agit d'une section incluse (par %<)
   (de cette ligne on va tirer le titre -d'où la référence sera déduite- et le début
   des commentaires de bloc)
 
   \item \code{End_subsection} : il s'agit d'une ligne de code
 
   \item \code{Begin_file} : c'est l'état en début de fichier
 
   \item \code{Unknown}    : c'est un état piégeant destiné aux erreurs
   \end{itemize}
 *)
 
 type state = Into_comments | Begin_section | Begin_subsection | 
   End_subsection | Into_code | Begin_file | Unknown;;
 
 type action = Add_comment | Add_code | Add_comments_into_code | New_section | 
   New_subsection | Into_first_section | Close_subsection | Stop;;
 
 (* used to attribute a level to sections *)
 type state_level = Not_relevant | Star | Double_star | Level of string;;
 
 (* j'ai le titre X le nombre d'espaces X un code de référence (numéro d'ordre) *)
 type indented_ref = Indented_ref of string * int * int;;
 
 (* quelques utilitaires pour clarifier le code *)
 let next1 s   = 
   try
     (String.sub s 1 ((String.length s) - 1))
   with Invalid_argument( ia_s) -> Printf.fprintf log_file "next1: String.sub problem on %s\n" s;
     (* flush log_file; *)
     ""
 ;;
 
 let next2 s   = 
   try
     (String.sub s 2 ((String.length s) - 2))
   with Invalid_argument( ia_s) -> Printf.fprintf log_file "next2: String.sub problem on %s\n" s;
     (* flush log_file; *)
     ""
 ;;
   
 let char1 s   = 
   try
     (String.sub s 0 1)
   with Invalid_argument( ia_s) -> Printf.fprintf log_file "char1: String.sub problem on %s\n" s;
     (* flush log_file; *)
     ""
 ;;
 
 let char1_c s = (String.get s 0);;
  
 let char2 s   = 
   try
      (String.sub s 0 2)
   with Invalid_argument( ia_s) -> Printf.fprintf log_file "char2: String.sub problem on %s\n" s;
     (* flush log_file; *)
     ""
 ;;
 
 
 (*<
   \subsection{Récupération de variables globales\label{sec:keys:glob}}
 
   Les mots clefs suivants sont associés à des variables "globales" qui seront utilisées pour 
   l'en-tête de la documentation.
   \def\keyline#1#2#3#4{\tt #1 & \tt #2 & \tt #3 & \tt #4\\}
   \def\globalkeys{%
   \begin{center}
   \begin{tabular}{|l|l|c|c|}\hline
    clef & déclencheur & début & fin\\\hline\hline
   \keyline{author}{node.author}{'}{'}
   \keyline{}{\% author}{'}{'}
   \keyline{}{\% auteur}{'}{'}\hline
   \keyline{title}{\% titre}{'}{'}
   \keyline{}{\% title}{'}{'}\hline
   \keyline{project}{\% project}{'}{'}
   \keyline{}{\% projet}{'}{'}\hline
   \keyline{mailto}{node.mailto}{'}{'}
   \keyline{}{\% mailto}{'}{'}\hline
   \keyline{date}{node.date}{'}{'}
   \keyline{}{\% date}{'}{'}\hline
   \keyline{version}{VERSION}{=}{;}
   \keyline{}{\% version}{'}{'}\hline
   \end{tabular}
   \end{center}}\globalkeys
   Je vais utiliser la structure suivante :
   \begin{itemize}
   \item une hashtable qui contient une description de chaque association de clef
      (cf tableau plus haut) avec un entier comme index.
      Une telle description est une structure de type {\tt key\_pattern}, qui contient comme
      champs :
      \begin{itemize}
      \item {\tt name\_key}    : le nom de la clef.
      \item {\tt trigger\_pat} : le "déclencheur"
      \item {\tt before\_pat}  : le tag de début
      \item {\tt after\_pat}   : le tag de fin
      \item {\tt is\_found}    : un booléen qui signale si cette clef a déjà été trouvée dans le texte
      \item {\tt value}        : la valeur de la clef
      \end{itemize}
      Pour résumer, la clef {\tt name\_key} prend sa valeur dans la zone crochetée du pattern :\\
      {\tt ... trigger\_pat ... before\_pat [ ... ] after\_pat}
   \item un type {\tt Line( string, bool, int)} qui permet de décrire l'état de la ligne en 
      cours de recherche de clef.\\
      {\tt Line( S, B, K)} décrit la ligne de contenu {\tt S} dans laquelle une clef a déjà été trouvée
      si {\tt B} est à {\it true}, et ne l'a pas si {\tt B} est à {\it false}. Lorsque {\tt B} vaut
      {\it false} : {\tt K} vaut $-1$, et sinon il vaut le numéro de la clef trouvée.
   \end{itemize}
 *)
 
 type key_pattern = { name_key    : string;
 		     trigger_pat : string;
 		     before_pat  : string;
 		     after_pat   : string;
 		     mutable is_found    : bool;
 		     mutable value       : string;
 		   } ;;
 
 let build_key_pattern name trigger before after =
   { name_key    = name;
     trigger_pat = trigger;
     before_pat  = before;
     after_pat   = after;
     is_found    = false;
     value       = "";
   } ;;
 
 let specify_key_pattern name value =
   { name_key    = name;
     trigger_pat = not_defined;
     before_pat  = not_defined;
     after_pat   = not_defined;
     is_found    = true;
     value       = value;
   } ;;
 
 let keys_counter = ref 0;;
 let keys_hashtbl = Hashtbl.create 20;;
 
 let add_key_pattern name trigger before after =
   Hashtbl.add keys_hashtbl !keys_counter 
     (build_key_pattern name trigger before after);
   keys_counter := !keys_counter + 1
 ;;
 
 let add_specified_key_pattern name value =
   Hashtbl.add keys_hashtbl !keys_counter 
     (specify_key_pattern name value);
   keys_counter := !keys_counter + 1
 ;;
 
 (* one line is the line string X a boolean (found or not) X the key into the hashtable 
    a "neutral  line" is (string, false, -1)
    a "resolved line" is (string, true, nb) with nb a key in keys_hashtbl
    *)
 type line_state_for_keys = Line of string * bool * int;;
 
 (*< 
   \subsubsection{Recherche de sous chaînes de charactères}
 
   Je n'ai pas trouvé en {\sf ocaml} de fonction {\tt String.index\_substring str1 str2} qui
   renvoie la position de {\tt str2} dans {\tt str1}.
 
   J'ai donc implémenté les fonctions {\tt compare\_strings} et {\tt contains\_substring} qui
   émulent cette fonctionnalité. J'ai recours pour cela à {\tt contains\_substring\_rec} qui
   cherche récursivement la position d'une chaîne dans un string.
   *)
 let compare_strings str1 str2 =
   let len = min (String.length str1) (String.length str2) in
     try
       String.sub str1 0 len = String.sub str2 0 len
     with Invalid_argument( ia_s) -> Printf.fprintf log_file "compare_...: String.sub problem on %s\n" str1;
       (* flush log_file; *)
       false
 ;;
 
 (* use: contains_substring str substr (String.length str) (String. length substr) 0 
    return the index of the end of substr into str, raises Not_found if not found *)
 let rec contains_substring_rec str sub_str l sl n =
   if char1 str = char1 sub_str then
     begin
       if compare_strings str sub_str then 
 	n + sl
       else
 	if l > sl then
 	  contains_substring_rec (next1 str) sub_str (l - 1) sl (n + 1)
 	else
 	  raise Not_found;
     end
   else
     if l > sl then
       contains_substring_rec (next1 str) sub_str (l - 1) sl (n + 1)
     else
       raise Not_found;
 ;;
 
 (* I do not understand why this does not exist in ocaml!! 
     returns the index of the end of substr into str or raises Not_found *)
 let contains_substring str substr =
   contains_substring_rec str substr (String.length str) (String.length substr) 0;;
 (*> *)
 
 (*< 
   \subsubsection{Recherche des occurences des clefs dans un string}
 
   J'utilise la fonction {\tt contains\_substring} pour déterminer si une des clefs contenues dans la hashtable 
   {\tt keys\_hastbl} est dans un string donné.
   *)
 (* to be used as : (confront_key_to_string k d str) *)
 let confront_key_to_string k key one_line =
   match one_line with
       Line( content, is_found, _) -> 
 	begin
 	  if is_found || key.is_found then
 	    one_line
 	  else
 	    try
 	      (* If the key trigger is in the line *)
 	      let deb = contains_substring content key.trigger_pat in
 		begin
 		  try
 		    Line( String.sub content deb ((String.length content) - deb) , true, k)
 		  with Invalid_argument( ia_s) -> 
 		    Printf.fprintf log_file "confront_...: String.sub problem on %s\n" content;
 		    (* flush log_file; *)
 		    Line( content , false, -1)
 		end
 	    with 
 		Not_found -> 
 		  Line( content, false, -1)
 	end
 ;;
 (*> *)
 
 (* to find which key is in the string *)
 let has_key one_string =
   if String.length one_string = 0 then
     false
   else
     let line_s = Line( one_string, false, -1) in
     let is_it_a_key = Hashtbl.fold confront_key_to_string keys_hashtbl line_s in
       match is_it_a_key with
 	  Line( str, is_found, nb) ->
 	    if is_found then
 	      let this_key = Hashtbl.find keys_hashtbl nb in
 		try
 		  (* extraction du morceau important *)
 		  let find_first = contains_substring str this_key.before_pat in
 		  let first_part = String.sub str find_first ((String.length str) - find_first) in
 		  (* en fait c'est bon :
 		     - si c'est le dernier
 		     - ou si le suivant n'est pas le même  *)
 		  let find_last  = contains_substring first_part this_key.after_pat in
 		  let this_value = String.sub first_part 0 (find_last - (String.length this_key.after_pat)) in
 		    this_key.is_found <- true;
 		    this_key.value    <- this_value;
 		    Printf.fprintf log_file "KEY: %s -> %s\n" this_value this_key.name_key;
 		    Hashtbl.replace keys_hashtbl nb this_key;
 		    true;
 		with
 		    Not_found -> false
 		  | Invalid_argument( ia_s) -> 
 		      Printf.fprintf log_file "has_key: String.sub problem on %s\n" str;
 		      (* flush log_file; *)
 		      false
 	    else
 	      false
 ;;
 
 (* a key value is N x B x S, (N is a key name) where B is false is S is not relevant, true otherwise. *)
 type key_value = Key_value of string * bool * string;;
 
 (* to be used on the keys hashtable to get the value of a key *)
 let get_key_value_fold index key current_key_value =
   match current_key_value with
       Key_value( name, is_found, value) ->
 	if is_found then
 	  current_key_value
 	else
 	  if (key.name_key = name) && key.is_found then
 	    Key_value( name, true, key.value)
 	  else
 	    current_key_value
 ;;
 
 (* to get the value of a given key *)
 let get_key_value k =
   let init_key_value = Key_value( k, false, "") in
   let found_result   = Hashtbl.fold get_key_value_fold keys_hashtbl init_key_value in
     match found_result with
 	Key_value( s, b, value) -> 
 	  if b then
 	    value
 	  else
 	    not_defined
 ;;
 
 (* to get all the defined keys *)
 let get_keys_names _ = 
   let init_gkn = [] in
   let add_kname k d init = 
     List.append init [ d.name_key]
   in
   Hashtbl.fold add_kname keys_hashtbl init_gkn
 ;;
 
 (*> *)
 
 (*> *)
 
 
 (*< 
   \subsection{Niveau d'étoile}
 
   Comme cela a été exposé plus haut, les spécifications de {\sf CWEB} précisent différents niveaux
   de blocs, marqués par un "étoilage" des marques de début de bloc.
 *)
 
 (* to determine the "star level" of the section mark *)
 let star_level str =
   let str_l = String.length str in
     if str_l < 3 then
       (str, Not_relevant)
     else
       let short_str = next2 str in
 	(* Printf.fprintf log_file ">>>| %s\n" str; *)
 	Printf.fprintf log_file "***| %s(%c)\n" short_str (char1_c short_str);
 	match char1_c short_str with
 	    '*' -> 
 	      if str_l < 4 then
 		(next1 short_str, Star)
 	      else
 		begin
 		  let very_short_str = next1 short_str in
 		    Printf.fprintf log_file "***| %s(%c)\n" very_short_str (char1_c very_short_str);
 		    match char1_c very_short_str with
 			'*'       -> (next1 very_short_str, Double_star)
 		      | '0' ..'9' -> (next1 very_short_str, Level( char1 very_short_str))
 		      | _         -> (very_short_str, Star)
 		end
 	  | _   -> (short_str, Not_relevant)
 ;;
 
 (* debug tool *)
 let get_star_level l =
   match l with
       Not_relevant -> "NR"
     | Star -> "STAR"
     | Double_star -> "2STAR"
     | Level( f) -> "Level(" ^ f ^ ")"
 ;;
 
 (*> *)
 
 
 (*< caractère de commentaire
 Si on le change on accède à n'importe quel langage (sans commentaires de bloc...
 *)
 let comment_char = ref "%";;
 (*> *)
 
 (*<
   \subsection{Explosion d'une ligne et attribution de son type}
    La tâche principale est de na pas tenir compte des blanc en début de ligne 
    et de repérer les 4 types de marqueurs de début de ligne :
   \begin{itemize}
   \item {\tt \%\_} pour les commentaires simples
   \item {\tt \%\%} pour les début de section
   \item {\tt \%<} pour les débuts de sous-section (avec retour charriot)
   \item {\tt \%>} pour les fins de sous-section
   \end{itemize}
   le reste étant du code
 *)
 let rec explode s = 
   if (String.length s) = 0 then
     (Into_code, "", Not_relevant)
   else
     (* before I used a match sentence but it seems that it's not compliant with the use of variables :
        let truc = "%";; match str with truc -> alpha | _ -> beta;;
        does not work as I imagined *)
     if (char1 s) = " " then explode (next1 s)
     else
       if (char1 s) = (!comment_char) then
 	begin
 	  if (String.length s) > 1 then
 	    (* dans les deux premier cas il faut regarder plus loin pour voir si la section est étoilée *)
 	    if (char2 s) = (!comment_char ^ !comment_char) then
 	      let (next_s, s_level) = star_level s in
 		Printf.fprintf log_file "+++| %s[%s]\n" next_s (get_star_level s_level);
 		(Begin_section, next_s, s_level)
 	    else
 	      if (char2 s) = (!comment_char ^ "<") then
 		let (next_s, s_level) = star_level s in
 		  Printf.fprintf log_file "+++| %s[%s]\n" next_s (get_star_level s_level);
 		  (Begin_subsection, next_s, s_level)
 	      else
 		if (char2 s) = (!comment_char ^ ">") then
 		  (End_subsection, (next2 s), Not_relevant)
 		else
 		  (Into_comments, (next1 s), Not_relevant)
 	  else
 	    (Into_comments, (next1 s), Not_relevant)
 	end
       else
 	(Into_code, s, Not_relevant)
 ;;
 (*> *)
 
 
 (*< 
   \subsection{debug tools}
 
   Différentes fonctions de parcours de résultats intermédiaires, destinées à 
   du débug.
 *)
 
 (* pour résumer un string*)
 let short_string str = (* str ;;*)
   try
     String.sub str 0 (min (String.length str) 10) 
   with Invalid_argument( ia_s) -> 
     Printf.fprintf log_file "short_string: String.sub problem on %s\n" str;
     (* flush log_file; *)
     ""
 ;;
 
 (* pour décrire l'état *)
 let say_state (s, str) =
   let s_str = short_string str in
     match s with
 	Begin_section    -> Printf.fprintf log_file "Debut de section      <-- %s\n" s_str 
       | Into_comments    -> Printf.fprintf log_file "Dans les commentaires <-- %s\n" s_str 
       | Begin_subsection -> Printf.fprintf log_file "Debut de sous section <-- %s\n" s_str 
       | End_subsection   -> Printf.fprintf log_file "Fin de sous section   <-- %s\n" s_str 
       | Into_code        -> Printf.fprintf log_file "Dans le code          <-- %s\n" s_str 
       | Begin_file       -> Printf.fprintf log_file "Tout début de fichier <-- %s\n" s_str 
       | _                -> Printf.fprintf log_file "ERREUR!!!<-- %s\n" s_str 
 ;;
 
 (*> *)
 
 
 (*< 
   \subsection{Structure de blocs\label{title:sec}}
   Un bloc (une \code{section}) est composé d'une structure comportant :
   \begin{itemize}
   \item une référence,
   \item un titre,
   \item une zone de commentaires,
   \item une zone de code.
   \end{itemize}
 *)
 
 (* je vais ranger mon code dans un arbre *)
 type 'a tree = Empty | Noeud of 'a * 'a tree list;;  
 (*type arbre = Empty | Noeud of section * arbre list;; *)
 
 
 (* fabrication d'un noeud vide *)
 type section = { refcode  : indented_ref ; 
 		 level    : state_level  ;
 		 title    : string ; 
 		 comments : string ; 
 		 code     : string ;
 	       };;
 
 let get_refcode_s d =
     match d.refcode with
 	Indented_ref( s, _, _) -> s
 ;;
 
 (* pour plus tard *)
 let root_section = { refcode  = Indented_ref( root_string, 0, 0);
 		     level    = Not_relevant ;
 		     title    = "" ; 
 		     comments = "" ; 
 		     code     = "" ;
 		   };;
 
 (* pour plus tard *)
 let empty_section = { refcode  = Indented_ref( empty_string, 0, 0);
 		      level    = Not_relevant ;
 		      title    = "" ; 
 		      comments = "" ; 
 		      code     = "" 
 		    };;
 
 (*<
   \paragraph{Encapsulation --- mise en page.}~\\
   Il s'agit de l'encapsulation d'une section.
 *)
 
 (* se débarasser des charactères spéciaux *)
 let rec without_escapes s =
   if (String.length s) = 0 then
     ""
   else
     match (char1 s) with
       | "}" -> "\\}" ^ (without_escapes (next1 s))
       | "{" -> "\\{" ^ (without_escapes (next1 s))
       | "_" -> "\\_" ^ (without_escapes (next1 s))
       | "^" -> "\\^\\ " ^ (without_escapes (next1 s))
       | "#" -> "\\#" ^ (without_escapes (next1 s))
       | "\\" -> "\\bs{}" ^ (without_escapes (next1 s))
       | _  -> (char1 s) ^ (without_escapes (next1 s))
 ;;
 
 (*<
   \paragraph{En ce qui concerne les inclusions.}~\\
   Ca se passe là:
 *)
 let get_relation f =
   try
     Hashtbl.find relations (get_refcode_s f)
   with Not_found ->
     Printf.fprintf log_file "--[%s:notfound]\n" (get_refcode_s f);
     empty_string
 ;;
 
 let get_subrelations f =
   try
     Hashtbl.find sub_relations (get_refcode_s f)
   with Not_found ->
     Printf.fprintf log_file "--[%s:notfound]\n" (get_refcode_s f);
     [ empty_string ]
 ;;
 
 let rec pretty_print_rel_list l=
     match l with
 	[]           -> ""
       | head :: tail ->
 	  if (head = root_string) || (head = empty_string) then
 	    Printf.sprintf "%s" (pretty_print_rel_list tail)
 	  else
 	    Printf.sprintf "\\refangles{refcode:%s} %s" head (pretty_print_rel_list tail)
 ;;
 
 let pretty_print_relations s empty_comments=
   Printf.fprintf log_file "PPR>\n";
   let prefix_relations = ref "" in
     if empty_comments then
       prefix_relations := ""
     else
       prefix_relations := "~\\\\\n";
     let p = get_relation s in
     let f = get_subrelations s in 
       if p = "0" then
 	if (List.length f) = 1 && (((List.hd f) = empty_string) || ((List.hd f) = root_string)) then
 	  ""
 	else
 	  Printf.sprintf "%s{\\footnotesize \\uses %s}" !prefix_relations (pretty_print_rel_list f)
       else
 	if f = [] then
 	  Printf.sprintf "%s{\\footnotesize \\usedby \\refangles{refcode:%s}}" !prefix_relations p 
 	else
 	  begin
 	    if (List.length f) = 1 && (((List.hd f) = empty_string) || ((List.hd f) = root_string)) then
 	      Printf.sprintf "%s{\\footnotesize \\usedby \\refangles{refcode:%s}}" !prefix_relations p 
 	    else
 	      Printf.sprintf "%s{\\footnotesize \\usedby \\anglesref{refcode:%s} --- \\uses %s}" 
 		!prefix_relations p (pretty_print_rel_list f)
 	  end
 ;;
 (*> *)
 
 
 let pretty_print_level l =
   match l with
       Not_relevant -> "0"
     | Star         -> "10"
     | Double_star  -> "100"
     | Level( f)    -> f
 ;;
 
 let before_code_symbol = "\\bcodesymbol\n%END LATEX\n\\begin{quote}\n\\begin{alltt}\n";;
 let after_code_symbol = "\\end{alltt}\n\\end{quote}\n%BEGIN LATEX\n}\n";;
 let before_section_symbol = "\\bsecsymbol";;
 
 let pretty_print_section sec =
   let after_comments_carriage = ref "" in
     if sec.comments = "" then
       after_comments_carriage := "\n"
     else
       after_comments_carriage := "~\\\\\n";
     match sec.refcode with
 	Indented_ref( s, n, c) ->
 	  "\\noindent" ^ before_section_symbol ^ "\\nopagebreak\\\\\n" ^ 
 	  "\\sectitle{" ^ (pretty_print_level sec.level) ^ "}{" ^ sec.title ^ "}" ^ 
 	  "{" ^ (string_of_int c) ^ "}\n" ^ sec.comments ^ !after_comments_carriage ^ 
 	  (pretty_print_relations sec (sec.comments = "")) ^ 
 	  "\n\n" ^ 
 	  "\\nopagebreak\n{\\footnotesize\n" ^
 	  before_code_symbol ^ 
 	  sec.code ^ 
 	  after_code_symbol ;;
 
 
 
 (* to gain CPU time*)
 let process_strings_regexp = (regexp "\([, (\[]'\)\([^']*\)\('\)");;
 
 (*
   Pas mieux pour l'instant:
   Test:
   # get_strings "ceci est un 'test' '''' assez 'étrange': A' + ['test''m''test', 'test','a'] ('al').";;
 *)
 let process_strings str = global_replace process_strings_regexp "\1\\stringc{\2}\3" str;;
 
 (* let process_cmts str = global_replace (regexp "\(%[^']*\)\(\\n\)") "\\cmt{\1}\\2" str;; *)
 (* for the "end of line" comments *)
 
 (* to gain CPU time*)
 let colorize_regexps = ref [];;
 (* [(regexp "|") ; (regexp "&") ; (regexp "=") ; (regexp "==") ;  (regexp "~") ;  (regexp "<=") ;  (regexp ">=")];; *)
 let colorize_regexpr = ref [];;
 (* "\\vt" ; "\\va" ;  "\\oeq" ; "\\ooeq" ; "\\otdl" ; "\\(\\leq\\)" ; "\\(\geq\\)" ];;*)
 
 let colorize_regexp_oo = ref (regexp "\\b\(function\|while\|continue\|try\|catch\|for\|end\|persistent\|switch\|case\|if\|else\|elseif\|return\|break\|otherwise\)\\b");;
 
 (*< 
   \subsection{Déclarations de clefs globales spécifiques à {\sf OCAMAWEB}}
 
   Je déclare ici les clefs de la section \ref{sec:keys:glob} :
   \globalkeys
 
 *)
 
 let dvipdfm = ref "<ocamaweb.xml> FILE NOT FOUND";;
 let dviext  = ref "<ocamaweb.xml> FILE NOT FOUND";;
 
 try
   let xml_inits = Xml.parse_file ((Sys.getenv "OCAMAWEB") ^ "ocamaweb.xml") in
   let caracts = (get_childs xml_inits) in
     (* caracts in a list of xml structs, I want the one with 'keypatterns' tag *)
   let is_pdfgenerator xml_struct =
     (get_name xml_struct) = "pdfgenerator"
   in 
   let pdfgenerator = match (List.find is_pdfgenerator caracts) with
       _,a,_ -> match (List.hd a) with
 	  "file", d -> d
 	| _ -> "**bad xml file**"
   in
   let pdfgenerator_ext = match (List.find is_pdfgenerator caracts) with
       _,a,_ -> match (List.nth a 1) with
 	  "ext", d -> d
 	| _ -> "pdf generator ext attribute not found in <ocamaweb.xml>"
   in
     (* here I want to get the regexps *)
   let is_regexp xml_struct =
     (get_name xml_struct) = "regexp"
   in
   let regexp_defs = (get_childs (List.find is_regexp caracts)) in
   let regexp_match_mine v =
     match v with
 	_,a,_ -> a
   in
   let regexp_info = (List.map regexp_match_mine regexp_defs) in
   let get_regexp_from v =
     match (List.nth v 0) with
 	_,a -> (regexp a)
   in
   let regexp_from = (List.map get_regexp_from regexp_info) in
   let get_regexp_to v =
     match (List.nth v 1) with
 	_,a -> a
   in
   let regexp_to = (List.map get_regexp_to regexp_info) in
     (* now I have the pdfgenerators name *)
   let is_comment_key xml_struct =
     (get_name xml_struct) = "commentkey"
   in 
   let commentkey = match (List.find is_comment_key caracts) with
       _,a,_ -> begin
 	match (List.hd a) with
 	    "value", v -> 
 	      (* c'est ici que j'attribue sa nouvelle valeur à |comment_char| *)
 	      comment_char := v;
 	      v
 	  | _ -> "**bad xml file : commentkey not properly defined**"
       end
   in
   let is_keypatterns xml_struct = 
     (get_name xml_struct) = "keypatterns" 
   in
   let key_patterns = (get_childs (List.find is_keypatterns caracts)) in
     (* now I have to put the keypatterns into my hashtable *)
   let xml_key_atomic_value xml_list n =
     let couple = List.nth xml_list n in
       match couple with
 	  a,b -> b
   in
   let add_key_pattern_from_xml xml_struct =
     match xml_struct with
 	name,attribs,childs ->
 	  let key_name    = xml_key_atomic_value attribs 0 in
 	  let key_sign    = xml_key_atomic_value attribs 1 in
 	  let before_name = xml_key_atomic_value attribs 2 in
 	  let after_name  = xml_key_atomic_value attribs 3 in
 	    add_key_pattern key_name key_sign before_name after_name
   in
   let is_matlabwords xml_struct = 
     (get_name xml_struct) = "matlabwords" 
   in
   let matlab_words = (get_childs (List.find is_matlabwords caracts)) in
     (* now I have to put the matlabwords into a list *)
   let extract_name_from_matlabwords xml_struct = 
     match xml_struct with
 	name,attribs,childs -> 
 	  xml_key_atomic_value attribs 0
   in
     (* here I form a list with all the matlab words *)
   let matlabwords_list = List.map extract_name_from_matlabwords matlab_words in
   let matlabwords_concat mw_init mw_next = 
     (mw_init ^ "\|" ^ mw_next) 
   in
   let matlabwords_regexp = (regexp ("\\b\(" ^ (List.fold_left matlabwords_concat (List.hd matlabwords_list) (List.tl matlabwords_list) 
 					       ^ "\)\\b"))) in
     (* here I have got the correct regexp, for instance :
        (global_replace matlabwords_regexp "\\ocamawebdefinition{\\0}" "if a==0 then 1 else 2 end;")
        returns a correct answer *)
     colorize_regexp_oo := matlabwords_regexp; 
 
     (* get the keypattern informations *)
     List.iter add_key_pattern_from_xml key_patterns;
 
     (* get the pdfgenerator *)
     dvipdfm := pdfgenerator;
     dviext  := pdfgenerator_ext;
     
     (* get the regexps *)
     colorize_regexps := regexp_from;
     colorize_regexpr := regexp_to
 
 with e -> 
   Printf.fprintf stderr "OCAMAWEB: I cannot find <ocamaweb.xml> file in <%s> or this file is not completed\n" (Sys.getenv "OCAMAWEB") ; 
   match e with
       Not_found    -> Printf.fprintf stderr "NOT FOUND\n"
     | Xml_error(e) -> Printf.fprintf stderr "XML error during <ocamaweb.xml> parsing : %s\n" e
     | _            -> Printf.fprintf stderr "UNKOWN ERROR\n"
   ;
   
   add_key_pattern "author"  "node.author" "'" "'";
   add_key_pattern "author"  "% author"    "'" "'";
   add_key_pattern "author"  "% auteur"    "'" "'";
   add_key_pattern "title"   "% title"     "'" "'";
   add_key_pattern "title"   "% titre"     "'" "'";
   add_key_pattern "project" "% project"   "'" "'";
   add_key_pattern "project" "% projet"    "'" "'";
   add_key_pattern "mailto"  "node.mailto" "'" "'";
   add_key_pattern "mailto"  "% mailto"    "'" "'";
   add_key_pattern "date"    "node.date"   "'" "'";
   add_key_pattern "date"    "% date"      "'" "'";
   add_key_pattern "version" "% version"   "'" "'";
   add_key_pattern "version" "VERSION"     "=" ";"
 ;;
 
 (*> *)
 
 
 
 (* to colorize the code parts *)
 (* [let garzol = follow_file "sample.m";;] *)
 let colorize str =
   let internal_str = (global_replace !colorize_regexp_oo "\\ocamawebdefinition{\\0}" (without_escapes str)) in
   let regexp_this str regs regr =
     (global_replace regs ( "{" ^ regr ^ "}" ) str)
   in
     process_strings (List.fold_left2 regexp_this internal_str !colorize_regexps !colorize_regexpr) 
 (*  let 
     process_strings
       (global_replace colorize_regexp_1 "{\\vt}"
 	 (global_replace colorize_regexp_2 "{\\va}"
 	    (global_replace colorize_regexp_3 "{\\oeq}"
 	       (global_replace colorize_regexp_4 "{\\ooeq}"
 		  (global_replace colorize_regexp_5 "{\\otdl}"
 		     (global_replace colorize_regexp_6 "{\\(\\leq\\)}"
 			(global_replace colorize_regexp_7 "{\\(\geq\\)}"
 			   (global_replace !colorize_regexp_oo "\\ocamawebdefinition{\\0}"
 			      (without_escapes str)))))))))
 *)    
 ;;
 
 let without_path f =
   try
     let deb_path = 1 + (String.rindex f '/') in
       String.sub f deb_path ((String.length f) - deb_path)
   with Not_found ->
     try
       let deb_path = 1 + (String.rindex f '\\') in
 	String.sub f deb_path ((String.length f) - deb_path)
     with Not_found ->
       f
 ;;
 
 let neutralize_filenames_regexp = (regexp "_");;
 
 (* juste pour neutraliser les _ et \ dans les noms de (fichiers) *)
 let neutralize_filenames str_fname =
   let str = without_path str_fname in
     try
       let ridx = (1 + (String.rindex str '/')) in
       let only_filename = String.sub str ridx ((String.length str) - ridx) in
 	global_replace neutralize_filenames_regexp "\\_" only_filename
     with 
 	Not_found -> global_replace neutralize_filenames_regexp "\\_" str
 ;;
 
 let rec first_defined str_lst =
   match str_lst with
       []           -> not_defined
     | head :: tail -> 
 	if head = not_defined then
 	  first_defined tail
 	else
 	  head
 ;;
 
 let get_email str =
   if str = not_defined then
     ""
   else
     "\\\\{\\tt mailto:" ^ str ^ "}"
 ;;
 
 (* to include ocamaweb.sty file into the LaTeX one *)
 let windows_path_to_unix str = global_replace (regexp "[\\]") "/" str;;
 
 let get_style_path =
   try
     (windows_path_to_unix (Sys.getenv "OCAMAWEB"))
   with Not_found ->
     ""
 ;;
 
 let get_first_line _ =
   let project_name_v = (get_key_value "project") in
     if project_name_v = not_defined then
       ""
     else
       project_name_v ^ "\\\\" 
 ;;
 
 let title_or_filename _ =
   let tit = (get_key_value "title") in 
   if tit = not_defined then
     (get_key_value "filename")
   else
     tit
 ;;
 
 
 let head_of_file _ =
   let all_knames = 
     (* all_knames_full sans les doublons ni filename *)
     let uniquel clist str =
       let this_equal v = 
 	(str = v) 
       in
 	(* filename keyword is a very special one *)
 	if (not (List.exists this_equal clist)) && (not (str = "filename")) then
 	  (List.append clist [ str ])
 	else
 	  clist
     in
       List.fold_left uniquel [] (get_keys_names ())
   in
   let form_latexdef kname =
     "\\def\\ocamaweb" ^ kname ^ "{" ^ (get_key_value kname) ^ "}\n"
   in
   let all_kvalues = String.concat "" (List.map form_latexdef all_knames) in 
     "\\ifx\\firstocamaweb\\undefined\n" ^
     "\\input{" ^ get_style_path ^ "ocamaweb.sty}\n\n" ^
     "\\fi\n" ^
     (* filename keyword is a very special one *)
     "\\def\\ocamawebtitle{" ^ (title_or_filename ()) ^ "}\n" ^
     "\\def\\ocamawebfilename{" ^ (get_key_value "filename") ^ "}\n" ^ 
     "\\def\\ocamawebv{" ^ version ^ "}\n" ^
     all_kvalues ^ 
     (* 
        "\\def\\ocamawebauthor{" ^ (get_key_value "author") ^ "}\n" ^
        "\\def\\ocamawebproject{" ^ (get_key_value "project") ^ "}\n" ^
        "\\def\\ocamawebfilename{" ^ (get_key_value "filename") ^ "}\n" ^
        "\\def\\ocamawebmailto{" ^ (get_key_value "mailto") ^ "}\n" ^
        "\\def\\ocamawebdate{" ^ (get_key_value "date") ^ "}\n" ^
        "\\def\\ocamawebversion{" ^ (get_key_value "version") ^ "}\n\n" ^
     *)
     "\n\\ocamawebstart\n\n"
 ;;
 (*
    "\\title{" ^ 
    (get_first_line ()) ^ 
    (first_defined [(get_key_value "title")   ; (get_key_value "filename") ]) ^ "}\n" ^
    "\\author{"  ^ (get_key_value "author") ^ (get_email (get_key_value "mailto")) ^ "}\n" ^
    "\\date{Imprimé le \\today,\\\\dernière modification le " ^ (get_key_value "date") ^ "}\n" ^
    "\\ocamawebstart\n\n";; 
 *)
 
 let foot_of_file =
   "\n\\noindent\\rule{5cm}{1pt}\\nopagebreak\\\\\n\\ocamawebend\n";;
 
 (*> *)
 
 (*< 
   \subsection{fonctions de manipulation de l'arbre}
 
   Un arbre est ou bien vide, ou bien un \code{Noeud} contenant un label
   et une liste de n\oe uds.\\
 
   L'arbre d'un fichier est donc une racine qui a comme fils les blocs 
   principaux. Chaque bloc principal a comme fils les blocs arbitraire qu'il
   contient et de même chaque bloc arbitraire a comme fils les blocs 
   arbitraire qu'il contient.\\
 
   Le label d'un n\oe ud est composé d'une section (cf \ref{title:sec}).
 *)
 
 (* pour résoudre un problème d'empilage: je vais créer une fonction
    qui inverse l'ordre du premier niveau de l'arbre *)
 let reverse_sons t =
   match t with 
       Empty -> t
     | Noeud(s, f) -> (* je vais inverser l'ordre des fils |f| et les remettre dans s: *)
 	Noeud(s, List.rev f)
 ;;
 
 
 (* affiche un titre *)
 let print_title s =
   Printf.fprintf stdout "%s%s\n" (String.make 1 ' ') s.title;;
 
 (* listing des titres des noeuds d'un arbre *)
 let rec get_section = function
     Empty -> empty_section
   | Noeud(s, _) -> s
 ;;
 
 (* liste les différents titres d'un arbre *)
 let rec get_t nb n =
   match n with
       Empty -> Printf.fprintf stdout "%s\n" (String.make nb '@');
     | Noeud(s, l) -> 
 	begin
 	  Printf.fprintf stdout "%s%s\n" (String.make nb '@') s.title;
 	  ignore (List.map (get_t (2 + nb)) l);
 	end;
 ;;
 
 (* liste les différents commentaires d'un arbre *)
 let rec get_c nb n =
   match n with
       Empty -> ignore (Printf.fprintf stdout "%s\n" (String.make nb '@'));
     | Noeud(s, l) -> 
 	begin
 	  Printf.fprintf stdout "%s%s\n%s\n" (String.make nb '@') s.title s.comments;
 	  ignore (List.map (get_c (2 + nb)) l);
 	end;
 	()
 ;;
 
 (*< 
   \paragraph{remplissage d'un vecteur avec la correspondance péres --- fils.}~\\
   J'utilise deux variables globales pour cela (je sais ce n'est pas très élégant, mais je
   suis pressé pour l'instant). Ces deux variables sont remplies à la fin du parsing.
   
   Il s'agit de Hashtables qui contiennent respectivement les fils et les pères de chaque
   section.
  *)
 
 let concat_subrelation k v =
   try
     let l = Hashtbl.find sub_relations k in
       Hashtbl.replace sub_relations k (List.append l [ v])
   with Not_found ->
     Hashtbl.add sub_relations k [v]
 ;;
 
 let get_ref_number s =
   match s.refcode with
       Indented_ref(_, _, s) -> (string_of_int s)
 ;;
 
 let add_to_relations f d =
   (* Printf.fprintf stdout "REL> %s --son of-- %s\n"    (get_refcode_s d) (get_refcode_s f); *)
   Hashtbl.add relations (get_refcode_s d) (get_ref_number f);
   (* Printf.fprintf stdout "REL> %s --father of-- %s\n" (get_refcode_s f) (get_refcode_s d); *)
   concat_subrelation (get_refcode_s f) (get_ref_number d)
 ;;
 
 (* renseigne récursivement les hashtables d'indexation des pères et fils *)
 let rec build_relations_rec f a_tree = 
     match a_tree with
 	Empty -> ()
       | Noeud(desc, fils) -> 
 	  add_to_relations f desc;
 	  ignore (List.map (build_relations_rec desc) fils)
 ;;
 
 (*> *)
 
 (*<
   \paragraph{Affichage itératif des fils de la racine d'un arbre.}~\\
   C'est une des fonctions importantes du code, elle appelle \code{son_to_string}
   sur toutes les branches de l'arbre.
 *)
 
 (* affichage du contenu d'un élément puis de ses fils comme déclarations de blocs *)
 let rec son_to_string str l_tree =
   match l_tree with 
       Empty -> str
     | Noeud(t, l) -> 
 	str ^ (pretty_print_section t ) ^ (List.fold_left son_to_string "" l)
 ;;
 
 let to_string t =
   match t with
       Empty -> "";
     | Noeud(s, l) -> (* j'ai les noeud principaux,
 			je vais afficher :
 			- le contenu du premier avec un code c
 			- puis ses blocs de référence
 			- puis pour chaque autre élément de la liste :
 			- le contenu du premier
 			- puis ses blocs de référence
 		     *)
 	let first = List.nth l 0 in 
 	  List.fold_left son_to_string "" l
 ;;
 (*> *)
 
 (*> *)
 
 (*> *)
 
 (*> *)
 
 (*< 
   \section{file parsing}
  *)
 
 (* récupération de l'état d'une ligne *)
 let get_line_state (s, _, _) = s;;
 let get_line_str   (_, s, _) = s;;
 let get_line_level (_, _, l) = l;;
 
 (* croisement de l'état global et de celui d'une ligne.
    C'est LA grosse machine à états du parseur
 *)
 let cross_states g_state pline =
   let this_level = get_line_level pline in
   let l_state    = get_line_state pline in
   let str        = short_string (get_line_str   pline) in
     match g_state with
 	Begin_section | Into_comments | Begin_subsection   -> begin
 	  match l_state with
 	      Begin_section    -> Printf.fprintf log_file "a(1) new section: %s ...\n" str;
 		( Begin_section, New_section, this_level)
 	    | Into_comments    -> Printf.fprintf log_file "b(2) add comments to current (sub?)section: %s ...\n" str;
 		( Into_comments, Add_comment, this_level)
 	    | Begin_subsection -> Printf.fprintf log_file "c(3) new subsection (insert into former code): %s ...\n" str;
 		( Begin_subsection, New_subsection, this_level)
 	    | End_subsection   -> Printf.fprintf log_file "d(4) close current (sub)section: %s ...\n" str;
 		( End_subsection, Close_subsection, this_level)
 	    | Into_code        -> Printf.fprintf log_file "e(5) close comment part and begin code part: %s ...\n" str;
 		( Into_code, Add_code, this_level)
 	    | Begin_file       -> Printf.fprintf log_file "f(*) ERROR!!: %s ...\n" str;
 		( Unknown, Stop, this_level)
 	    | _                -> ( Unknown, Stop, this_level)
 	end;
       | End_subsection | Into_code   -> begin
 	  match l_state with
 	      Begin_section    -> Printf.fprintf log_file "g(1) new section: %s ...\n" str;
 		( Begin_section, New_section, this_level)
 	    | Into_comments    -> Printf.fprintf log_file "h(6) stay into code: %s ...\n" str;
 		( Into_code, Add_comments_into_code, this_level)
 	    | Begin_subsection -> Printf.fprintf log_file "i(3) new subsection (insert into former code): %s ...\n" str;
 		( Begin_subsection, New_subsection, this_level)
 	    | End_subsection   -> Printf.fprintf log_file "j(4) close current (sub)section: %s ...\n" str;
 		(End_subsection, Close_subsection, this_level)
 	    | Into_code        -> Printf.fprintf log_file "k(6) stay into code: %s ...\n" str;
 		(Into_code, Add_code, this_level)
 	    | Begin_file       -> Printf.fprintf log_file "l(*) ERROR!!: %s ...\n" str;
 		(Unknown, Stop, this_level)
 	    | _                -> ( Unknown, Stop, this_level)
 	end;
       | Begin_file       ->begin
 	  match l_state with
 	      Begin_section    -> Printf.fprintf log_file "m(7) compose the first section: %s ...\n" str;
 		(Into_comments, Into_first_section, this_level)
 	    | Into_comments    -> Printf.fprintf log_file "n(8) stay into Begin_file (add to code): %s ...\n" str;
 		(Begin_file, Add_code, this_level)
 	    | Begin_subsection -> Printf.fprintf log_file "o(*) ERROR!!: %s ...\n" str;
 		(Unknown, Stop, this_level)
 	    | End_subsection   -> Printf.fprintf log_file "p(*) ERROR!!: %s ...\n" str;
 		(Unknown, Stop, this_level)
 	    | Into_code        -> Printf.fprintf log_file "q(8) stay into Begin_file (add to code): %s ...\n" str;
 		(Begin_file, Add_code, this_level)
 	    | Begin_file       -> Printf.fprintf log_file "l(*) ERROR!!: %s ...\n" str;
 		( Unknown, Stop, this_level)
 	    | _                -> ( Unknown, Stop, this_level)
 	end;
       | _ -> ( Unknown, Stop, this_level)
 ;;
 
 (* variable globale *)
 let global_state = ref Begin_file ;;
 
 (*< 
   \section{outils de manipulation de fichier}
  *)
 
 (* renvoie tout avant le premier ["."] rencontré *)
 let title_part str_ = 
   if String.length str_ = 0 then
     ""
   else
     let spaces_nb = ref 0 in
       try
 	while (String.sub str_ !spaces_nb 1= " ") do
 	  spaces_nb := !spaces_nb + 1
 	done;
 	let str = String.sub str_ !spaces_nb (String.length str_ - !spaces_nb) in
 	  begin
 	    try
 	      let point_pos = String.index str '.' in
 		if point_pos > 0 then
 		  String.sub str 0 point_pos
 		else
 		  ""
 	    with 
 		Not_found -> str
 	  end
       with Invalid_argument( ia_s) -> 
 	Printf.fprintf log_file "title_part: String.sub problem on %s\n" str_;
 	(* flush log_file; *)
 	str_
 ;;
 
 (* renvoie tout après le premier ["."] rencontré *)
 let comment_part str = 
   try
     let point_pos = String.index str '.' in
     let str_len   = String.length str in
       if str_len > (1 + point_pos) then
 	String.sub str (1 + point_pos) ( str_len - point_pos - 1)
       else
 	""
   with 
       Not_found -> ""
 ;;
 
 (* I had my xml parsing functions here *)
 
 (*< 
   \subsection{Parsing spécifique aux langages sans commentaires par blocs}
 
   Cette partie doit être remplacée par une autre pour les langages (comme le {\tt c} ou {\tt ocaml})
   qui offrent la possibilité de créer des blocs de commentaires ({\tt /* ... */} ou {\tt (* *)}).
 *)
 
 let refcode_counter = ref 0;;
 
 let make_generic_refcode str_ dec = 
   refcode_counter := !refcode_counter + 1 - dec;
   if String.length str_ = 0 then
     Indented_ref ("", 0, !refcode_counter)
   else
     let spaces_nb = ref 0 in
       while (String.sub str_ !spaces_nb 1= " ") do
 	spaces_nb := !spaces_nb + 1
       done;
       let str = String.sub str_ !spaces_nb (String.length str_ - !spaces_nb) in
       let (str_unstar, s) = star_level str in
       let title = title_part str_unstar in
 	(* Printf.fprintf log_file "RRR> %s\n-*-> %s\n" str str_unstar; *)
 	if dec = 1 then
 	  begin
 	    Printf.fprintf log_file "RR1> %s |%d|%d (%d)\n" title !spaces_nb (!refcode_counter + dec) dec;
 	    Indented_ref (title, !spaces_nb, !refcode_counter + dec);
 	  end
 	else
 	  begin
 	    Printf.fprintf log_file "RR0> %s |%d|%d (%d)\n" str 0 (!refcode_counter + dec) dec;
 	    Indented_ref (str, 0, !refcode_counter + dec)
 	  end
 ;;
 (* renvoie un refcode pour le string :
    un "nettoyage" (pour WEB) de la partie du string avant le 1er ["."] rencontré.
    D'abord j'enlève (et je compte) le nombre d'espaces qu'il y a avant
 *)
 let make_refcode str_ =
   make_generic_refcode str_ 0;;
 
 (* le même mais dans le vide *)
 let make_fake_refcode str_ =
   make_generic_refcode str_ 1;;
 
 
 (* référence un bloc par refcode (les retours charriot ne sont pas compris) *)
 let insert_refcode my_refcode = 
   match my_refcode with
     |  Indented_ref( s, n, c) ->
 	 (String.make n ' ') ^ "\\refcode{" ^ s ^ "}{" ^ (string_of_int c) ^ "}" ;;
 
 (* declare un bloc par refcode (les retours charriot ne sont pas compris) 
 let declare_refcode str = "@<" ^ str ^ "@>=";;
 
 let end_of_first_comments = "@c\n";;
 let end_of_comments       = "@p\n";;
 *)
 
 (*> *)
 
 (*> *)
 
 (*<
   \section{Traitements principaux}
 *)
 
 (* j'ai besoin d'une racine :
    une liste de noeuds (je la met à l'extérieur pour que cela ne soit pas trop récursif -mal de tête-) *)
 let root_nodes = ref [];;
 
 let regexp_no_tabs = regexp "[\t]";;
 
 (*<
   \subsection{parcours récursif d'un fichier (channel)}
 *)
 let rec make_section first_line channel_name first_line_level =
   let refcode_     = ref (Indented_ref("", 0, 0)) in
   let title_       = ref "" in
   let level_       = ref first_line_level in
   let comments_    = ref "" in
   let code_        = ref "" in
   let into_parsing = ref true in
   let fils         = ref [] in
     if !global_state <> Begin_file then
       begin
 	title_    := title_part first_line;
 	comments_ := comment_part first_line;
 	refcode_  := make_refcode first_line;
 
 	Printf.fprintf log_file "**>> %s\n" (get_star_level !level_);
       end;
     
     (* tant je ne dois pas créer une section de façon récursive *)
     while !into_parsing do
       (* flush log_file; *)
       try
 	let this_line = 
 	  (global_replace regexp_no_tabs " " (input_line channel_name)) in
 	let has_any_special_keys = has_key this_line in
 	let this_parsed_line     = explode this_line in
 	let this_str             = (get_line_str this_parsed_line) in
 	let carriage             = "\n" in
 	let (new_state, this_action, this_state_level) = cross_states !global_state this_parsed_line in
 
 	  global_state := new_state;
 
 	  (* j'ai remplacé certains this_str par des this_line car pour l'instant
 	     j'utiliser le package alltt, j'espère bien y remédier... *)
 	  match this_action with
 	      Add_comment            -> comments_ := !comments_ ^ carriage ^ this_str
 		(* ATTENTION: je devrais chercher les commentaires de fin de ligne 
 		   problème des '%'!!! *)
 	    | Add_code               -> code_     := !code_     ^ carriage ^ (colorize this_line)
 	    | Add_comments_into_code -> code_     := !code_     ^ carriage ^ "\comments{" ^ this_str ^ "}"
 	    | New_section            ->
 		begin
 		  Printf.fprintf log_file "*>>> (%s)%s\n" this_str (get_star_level this_state_level);
 		  root_nodes := !root_nodes @ [ (make_section this_str channel_name this_state_level) ]; 
 		  (* root_nodes := [ (make_section this_str channel_name) ] @ !root_nodes; :pas bon du tout *)
 		  into_parsing := false
 		end;
 	    | New_subsection -> 
 		begin
 		  code_    := !code_ ^ carriage ^ (insert_refcode (make_fake_refcode this_line)); (* this_str *)
 		  Printf.fprintf log_file "*>>> (%s)%s\n" this_str (get_star_level this_state_level);
 		  fils     := !fils  @ [ (make_section this_str channel_name this_state_level) ]
 		end;
 	    | Into_first_section -> 
 		begin
 		  title_    := title_part     this_str;
 		  level_    := get_line_level this_parsed_line;
 		  comments_ := comment_part   this_str;
 		  refcode_  := make_refcode   this_str;
 		end;
 	    | Close_subsection -> into_parsing := false
 	    | Stop             -> into_parsing := false	    
 		
 	  with End_of_file -> into_parsing := false
 	    
     done;
 
     (* je renvoie un noeud quicontient la description de cette section *)
     let this_section = { refcode  = !refcode_ ; 
 			 level    = !level_ ;
 			 title    = !title_ ; 
 			 comments = !comments_ ; 
 			 code     = !code_
 		       } in
       Noeud( this_section, !fils )
 ;;
 (*> *)
 
 (*<
   \subsection{fonction principale}
   \begin{itemize}
   \item ouverture du fichier
   \item mise à "vide" de l'ensemble des noeuds racine
   \item mise à \code{Begin_file} du \code{global_state}
   \item lancement du parcours recursif
   \end{itemize}
 *)
 let follow_file fname =
   root_nodes   := [];
   global_state := Begin_file ;
   add_specified_key_pattern "filename" (neutralize_filenames fname) ;
   let this_channel = open_in fname in
     let first_node   = make_section "" this_channel Not_relevant in
       (* attention: je fais ici un List.rev pour supprimer un comportement INEXPLIQUE:
 	 le premier niveau de liste se retrouve empilé à l'envers! *)
     let all_nodes    = Noeud( root_section, List.rev (!root_nodes @ [ first_node ])) in
       flush log_file;
       all_nodes
 ;;
 
 (*> *)
 
 (*< 
   \subsection{for testing purpose}
  *)
 
 let send_to_file a_tree filename =
   build_relations_rec empty_section a_tree;
   let this_chan = open_out_bin filename in
     Printf.fprintf this_chan "%s%s%s" (head_of_file ()) (to_string a_tree) foot_of_file;
     close_out this_chan
 ;;
 
 let without_ext f =
   let deb_ext = String.rindex f '.' in
     String.sub f 0 deb_ext
 ;;
 
 let rec move_files name dest exts =
   match exts with
       [] -> 0
     | head :: tail ->
 	(Sys.command( "move " ^ name ^ head ^ " " ^ dest)) + 
 	move_files name dest tail
 ;;
 
 let get_dest_path =
   try
     (Sys.getenv "OCAMAWEB_DEST")
   with Not_found ->
     Printf.fprintf log_file "ENV: OCAMAWEB_DEST not found!!!\n";
     ""
 ;;
 
 let latexize f mode =
   let rez = ref 0 in
   let new_f   = without_ext f in
     rez := !rez + (Sys.command( "del " ^ get_dest_path ^ (without_path new_f) ^ ".* "));
     rez := !rez + 2 * (Sys.command( "latex " ^ (without_path f)));
     rez := !rez + 4 * (Sys.command( "latex " ^ (without_path f)));
     rez := !rez + 8 * (Sys.command( !dvipdfm ^ " " ^ (without_path new_f) ^ !dviext));
     if mode = 2 then
       begin
 	!rez + 100  * (move_files (without_path (without_ext f))
 			 (Sys.getenv "OCAMAWEB_DEST")
 			 [ ".pdf" ; ".tex" ; ".dvi" ; ".log" ; ".aux" ; ".toc" ; ".ps"] );
       end
     else 
       !rez + 16;
 ;;
 
 let ocamaweb_process f1 f2 mode =
   Printf.fprintf stderr "%s --> %s\n" f1 f2;
     let garzol = follow_file f1 in 
       if mode < 3 then
 	begin
 	  send_to_file garzol (without_path f2);
 	  latexize f2 mode
 	end
       else
 	begin
 	  send_to_file garzol f2;  
 	  1
 	end
 ;;
 
 
 let main () =
   Printf.fprintf stderr "OCAMAWEB version-%s\n" version;
   if !Sys.interactive then
     begin
       2
     end
   else
     begin
       match Array.length Sys.argv with 
 	    2 -> 
 	      let file_to_comment = Sys.argv.(1) in
 	      let file_to_write   = (Sys.getenv "OCAMAWEB_DEST") ^ 
 				    (without_path (without_ext file_to_comment)) ^ ".tex" in
 		ocamaweb_process file_to_comment file_to_write 2
 	  | 3 ->
 	      let file_to_comment = Sys.argv.(1) in
 	      let file_to_write   = Sys.argv.(2) in
 		ocamaweb_process file_to_comment file_to_write 3
 	  | _ -> 
 	      ignore (Printf.fprintf stdout "ocamaweb input_file.m [output_file.tex]\n");
 	      
       close_out log_file;
       1;
     end
 ;;
 
 main ();;
 
 
 
 (*> *)
 
 (*> *)