(**************************************************************************)
(*                   Cameleon                                             *)
(*                                                                        *)
(*      Copyright (C) 2002 Institut National de Recherche en Informatique et   *)
(*      en Automatique. All rights reserved.                              *)
(*                                                                        *)
(*      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  *)
(*      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                                                   *)
(*                                                                        *)
(*      Contact: Maxence.Guesdon@inria.fr                                *)
(**************************************************************************)

(** load plugins, in bytecode mode *)

let (!!) = Options.(!!)
let (=:=) = Options.(=:=)

let loaded_plugins = ref []




let get_plugins_files_in_dir dir =
  let l = ref [] in
  try
    let dir_desc = Unix.opendir dir in
    let rec iter () =
      try 
        let f = Unix.readdir dir_desc in
        let complete_f = Filename.concat dir f in
        try
          let st = Unix.stat complete_f in
	  if Filename.check_suffix f ".cmo" or
	    Filename.check_suffix f ".cma" 
	  then
	    f :: (iter ())
	  else
	    iter ()
        with
        | e ->
            prerr_endline (Printf.sprintf "get_plugins_files %s" 
                             (Printexc.to_string e));
            iter ()
      with
        End_of_file -> 
          []
      | e ->
          prerr_endline (Printf.sprintf "get_plugins_files %s" 
                           (Printexc.to_string e));
          []
    in
    let l = iter () in
    Unix.closedir dir_desc;
    l
  with
    Unix.Unix_error (e, s1, s2) ->
      prerr_endline ((Unix.error_message e)^": "^s1^" "^s2);
      []

let _ =  Dynlink.init ()
let _ =  Dynlink.allow_unsafe_modules true

let load_file file =
  try
    let _ = Dynlink.loadfile file in
    if not (List.mem file !loaded_plugins) then
      loaded_plugins := file :: !loaded_plugins
    else
      ()
  with
    Dynlink.Error e -> 
      prerr_endline (Cam_messages.error_load_file file (Dynlink.error_message e))
  | Not_found ->
      prerr_endline (Cam_messages.error_load_file file "Not_found")
  | Sys_error s ->
      prerr_endline (Cam_messages.error_load_file file s)


let get_plugins_files dir =
  let l = get_plugins_files_in_dir dir in
  List.map (Filename.concat dir) l

let plugins_files = 
  (get_plugins_files Cam_installation.plugins_dir) @
  (get_plugins_files Cam_messages.plugins_dir)


let load_plugins () =
  let shared = get_plugins_files Cam_installation.plugins_dir in
  let personal = get_plugins_files Cam_messages.plugins_dir in
  let shared2 = List.filter
      (fun f -> 
	let base = Filename.basename f in
	(not (List.mem f !loaded_plugins)) &&
	(List.mem base !!Cam_config.shared_plugins_to_load)
      )
      shared
  in
  let personal2 = List.filter
      (fun f -> 
	let base = Filename.basename f in
	(not (List.mem f !loaded_plugins)) &&
	(List.mem base !!Cam_config.personal_plugins_to_load)
      )
      personal
  in
  List.iter load_file (shared2 @ personal2)

(* we add a tab in the configuration window, to select the plugins 
   (personal and shared) to load. *)

class create_box option dir label =
  let files = get_plugins_files_in_dir dir in
  let table = Hashtbl.create 13 in
  let _ = List.iter (fun base -> Hashtbl.add table base (List.mem base !!option)) files in
  let wf = GBin.frame ~label () in
  let vbox = GPack.vbox ~packing: wf#add () in
  object (self)
    method box = wf#coerce

    method apply =
      let l = ref [] in
      List.iter
	(fun base ->
	  if Hashtbl.find table base then l := base :: !l else ())
	files;
      option =:= !l

    initializer
      List.iter
	(fun base ->
	  let label =
	    base^(
		  if List.mem (Filename.concat dir base) !loaded_plugins then 
		    " ("^Cam_messages.already_loaded^")"
		  else
		    ""
		 )
	  in
	  let wchk = GButton.check_button ~label
	      ~active: (Hashtbl.find table base)
	      ~packing: (vbox#pack  ~expand: false ~padding: 2) 
	      () 
	  in
	  ignore (wchk#connect#clicked
		    (fun () -> 
		      Hashtbl.remove table base;
		      Hashtbl.add table base wchk#active));
	)
	files
  end

let f_config_box () =
  let vbox = GPack.vbox () in
  let b_shared = new create_box 
      Cam_config.shared_plugins_to_load 
      Cam_installation.plugins_dir
      Cam_messages.shared_plugins_to_load
  in
  let b_personal = new create_box 
      Cam_config.personal_plugins_to_load 
      Cam_messages.plugins_dir
      Cam_messages.personal_plugins_to_load
  in
  vbox#pack ~expand: true b_shared#box;
  vbox#pack ~expand: true b_personal#box;
  let f_apply () = 
    b_shared#apply;
    b_personal#apply;
    load_plugins ()
  in
  Configwin.Section (Cam_messages.plugins, [Configwin.custom vbox  f_apply true])

let _ = Cam_plug.add_config_box f_config_box

(* we add a command to allow the user to reload an already loaded plugin. *)
let reload_plugin args =
  match args with
    _ :: _ ->
      List.iter load_file args
  | [] ->
      match !loaded_plugins with
	[] -> GToolbox.message_box Cam_messages.a_reload_plugin Cam_messages.no_plugin_loaded
      | l ->
	  let module C = Configwin in
	  let choix = ref None in
	  let param = C.combo
	      ~f: (fun s -> choix := Some s)
	      ~new_allowed: false
	      ~blank_allowed: false
	      (Cam_messages.plugin_to_reload^" : ")
	      l
	      (List.hd l)
	  in
	  ignore (C.simple_get Cam_messages.a_reload_plugin ~width: 350 [param]);
	  match !choix with
	    None -> ()
	  | Some f -> load_file f

let _ = Cam_plug.add_command 
    Cam_messages.a_reload_plugin 
    Cam_messages.h_reload_plugin
    reload_plugin

(* finally, we load the plugins at launch time *)

let _ = load_plugins ()


