(*
    HLins: insert http-links into HTML documents.
    See http://www.lri.fr/~treinen/hlins

    Copyright (C) 1999 Ralf Treinen <treinen@lri.fr>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

*)



(* (allequal l), where l is a list, tests whether all elements
   of l are equal
*)
let allequal = function
    [] -> true
  | (h::l) -> List.for_all (function x -> x=h) l;;


(* (geturl names urls foundinds expandinds) returns a url for name
   where name is the array of names, urls the array of urls, foundinds
   the set of indices of the word found and expandinds the set of
   indices of words that the word found is an abbreviation of.
*) 
let geturl quiet names urls foundinds expandinds s =
  let foundurls = List.map (Array.get urls) (foundinds@expandinds)
  in begin
    if quiet || allequal foundurls
    then List.hd foundurls
    else 
      begin
	prerr_string ("A conflict occured on the name "^s^":\n");
	List.iter (function i ->
		     prerr_string ("  has url "^urls.(i)^"\n")) foundinds;
	List.iter (function i ->
		     prerr_string ("  abbreviates "^names.(i)^
				   " which has url "^
				   urls.(i)^"\n")) expandinds; 
	prerr_endline ("Choosing " ^ (List.hd  foundurls));
	List.hd foundurls
      end;
    end
;;

let replace_function quiet names urls hitcounter foundinds expandinds  s= 
  incr hitcounter;
  "<a href=\""^
  (geturl quiet names urls foundinds expandinds s^
   "\">" ^ s ^ "</a>")
;;

