(*********************************************************************************)

(*                Cameleon                                                       *)
(*                                                                               *)
(*    Copyright (C) 2005,2006 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 Library 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 Library General Public License for more details.                       *)
(*                                                                               *)
(*    You should have received a copy of the GNU Library 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                                          *)
(*                                                                               *)
(*********************************************************************************)


(* $Id: cam_plugins.ml 345 2006-10-10 12:32:54Z zoggy $ *)

(** Plugins management, in bytecode mode. *)


module O = Config_file

(**

Configuration

*)


let rc_plugins = Filename.concat Cam_rc.rc_dir "plugins.ini"
let plugins_ini = new O.group
let save_plugins () = plugins_ini#write rc_plugins
let load_plugins () = plugins_ini#read rc_plugins

let shared_plugins = new O.list_cp O.string_wrappers
    ~group: plugins_ini ["shared"]
    []
    ""

let personal_plugins = new O.list_cp O.string_wrappers
    ~group: plugins_ini ["personal"]
    []
    ""

(**

Loading/unloading

*)


let loaded_plugins = ref []

let get_plugins_files_in_dir dir =
  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.lstat complete_f in
          if st.Unix.st_kind = Unix.S_REG &&
            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 load_file file =
  let b = Buffer.create 256 in
  let ppf = Format.formatter_of_buffer b in
  try
    if Topdirs.load_file ppf file then
      if not (List.mem file !loaded_plugins) then
        loaded_plugins := file :: !loaded_plugins
      else
        ()
    else
      begin
        Format.pp_print_flush ppf ();
        failwith (Buffer.contents b)
      end
  with
    Failure 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 () =
  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 shared_plugins#get)
      )
      shared
  in
  let personal2 = List.filter
      (fun f ->
        let base = Filename.basename f in
        (not (List.mem f !loaded_plugins)) &&
        (List.mem base personal_plugins#get)
      )
      personal
  in
  List.iter load_file (shared2 @ personal2)

(**

Configuration box

*)


module C = Configwin

class plugins_config_box (option : 'Config_file.cp) 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#get)) 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#set !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 _configure_plugins args =
  let vbox = GPack.vbox () in
  let b_shared = new plugins_config_box
      shared_plugins
      Cam_installation.plugins_dir
      Cam_messages.shared_plugins_to_load
  in
  let b_personal = new plugins_config_box
      personal_plugins
      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;
    save_plugins ();
    load_plugins ();
  in
  let p = C.custom vbox f_apply true in
  ignore (C.simple_get Cam_messages.plugins [p])

let _ = Cam_commands.register
    { Cam_commands.com_name = Cam_constant.com_configure_plugins ;
      Cam_commands.com_args = [| |] ;
      Cam_commands.com_more_args = None ;
      Cam_commands.com_f = _configure_plugins;
    }


(* we add a command to allow the user to reload an already loaded plugin. *)
let _reload_plugin args =
  if Array.length args > 0 then
    Array.iter load_file args
  else
    match !loaded_plugins with
      [] -> GToolbox.message_box Cam_constant.com_reload_plugin Cam_messages.no_plugin_loaded
    | l ->
        match Cam_misc.select_in_list
            ~allow_empty: false
            ~value_in_list: true
             ~title: "Reload plugin"
            ~choices: l
             (Cam_messages.h_reload_plugin^" : ")
        with
          None -> ()
        | Some f -> load_file f

let _ = Cam_commands.register
    { Cam_commands.com_name = Cam_constant.com_reload_plugin ;
      Cam_commands.com_args = [| |] ;
      Cam_commands.com_more_args = Some Cam_messages.h_reload_plugin ;
      Cam_commands.com_f = _reload_plugin;
    }

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

let _ = load_plugins ()