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

(** Read/write functions for config files, and config option. *)

let print_DEBUG s = print_string s ; print_newline ()

open Cam_types
open Cam_menus

open Options
module M = Cam_messages

let string_of_option = function
    None -> ""
  | Some s -> s

let option_of_string = function
    "" -> None
  | s -> Some s


(** {2 Core options} *)

let core_ini = create_options_file M.rc_core

let save_core () = Options.save_with_help core_ini

(** {3 Doc sources} *)

let shared_plugins_to_load = Options.define_option core_ini ["plugins" ; "shared"]
    M.shared_plugins_to_load
    (list_option string_option)
    ["make.cmo" ; "editors.cmo" ; "test.cmo" ; "chat.cma" ; "omom_plugin.cma"]

let personal_plugins_to_load = Options.define_option core_ini ["plugins" ; "personal"]
    M.personal_plugins_to_load
    (list_option string_option)
    []

module Doc_source = struct
  let value_to_ds v =
    match v with
      List [StringValue f ; StringValue lab; StringValue com ]
    | SmallList [StringValue f ; StringValue lab; StringValue com ] ->
	(
	 let l_opt = 
	   match (lab, com) with
	     ("", "") -> None
	   | _ -> Some (lab, com)
	 in
	 { ds_file = f ; ds_label_com = l_opt }
	)
    | _ ->
	prerr_endline "Doc_source.value_to_ds";
	raise Not_found

  let ds_to_value ds =
    let (lab, com) = 
      match ds.ds_label_com with
	None -> ("", "")
      |	Some (l,c) -> (l,c)
    in
    SmallList [ StringValue ds.ds_file ; StringValue lab; StringValue com ]

  let (t : doc_source option_class) = 
    define_option_class "doc_source" value_to_ds ds_to_value

end

let doc_sources = Options.define_option core_ini ["doc_files"]
    "" (list_option Doc_source.t)
    [ { ds_file = Filename.concat Cam_installation.lib_dir "stdlib.odoc";
	ds_label_com = None } ;
      { ds_file = Filename.concat Cam_installation.lib_dir "cameleon.odoc" ;
	ds_label_com = None } ;
    ] 

(** {3 File types} *)

module File_types = struct
  let value_to_templates v =
    match v with
      List l | SmallList l ->
	(
	 List.map 
	   (function v ->
	     match v with
	       StringValue s -> s
	     | _ ->
		 prerr_endline "File_types.value_to_templates";
		 raise Not_found
	   )
	   l
	)
    | _ ->
	prerr_endline "File_types.value_to_templates";
	raise Not_found

  let list_to_ft l =
    match l with
      [ StringValue regexp ;
	StringValue name ;
	StringValue color ;
	StringValue editor ;
	vtemps ;
	vbinary ;
      ]	->
	{
	  ft_regexp_string = regexp ;
	  ft_regexp = Str.regexp regexp ;
	  ft_name = name ;
	  ft_color = option_of_string color ;
	  ft_edit = Cam_types.editor_of_string editor ;
	  ft_templates = value_to_templates vtemps ;
	  ft_binary = Options.value_to_bool vbinary ;
	} 
    | _ ->
	prerr_endline "File_types.list_to_ft";
	raise Not_found

  let value_to_ft v =
    match v with
      List l | SmallList l -> list_to_ft l
    | _ ->
	prerr_endline "File_types.value_to_ft";
	raise Not_found

  let ft_to_value ft =
    List
      [
	StringValue ft.ft_regexp_string ;
	StringValue ft.ft_name ;
	StringValue (string_of_option ft.ft_color) ;
	StringValue (Cam_types.string_of_editor ft.ft_edit) ;
	List (List.map (fun s -> StringValue s) ft.ft_templates) ;
	(Options.bool_to_value ft.ft_binary) ;
      ]	
      
  let (t : file_type option_class) = 
    define_option_class "file_type" value_to_ft ft_to_value
end

let ft re name col edit temps bin =
  {
    ft_regexp_string = re ;
    ft_regexp = Str.regexp re ;
    ft_name = name ;
    ft_color = Some col ;
    ft_edit = edit ;
    ft_templates = temps ;
    ft_binary = bin ;
  } 

let tplt f = Filename.concat Cam_installation.templates_dir f

let file_types = Options.define_option core_ini ["file_types"]
    "" (list_option File_types.t)
    [
      ft ".*configure\\.in" "Autoconf file" "Purple2" Emacs [tplt "template_configure.in"] false ;
      ft ".*\\.ml$" "OCaml implementation" "#BC5200" Emacs [tplt "template_ml"] false ;
      ft ".*\\.mli$" "OCaml interface" "#FF0E00" Emacs [tplt "template_ml"] false ;
      ft ".*\\.mll$" "OCaml lexer" "DarkOliveGreen4" Emacs [tplt "template_lexer"] false ;
      ft ".*\\.mly$" "OCaml parser" "DarkOliveGreen4" Emacs [tplt "template_parser"] false ;
      ft ".*\\.c$" "C source" "#0F9D48" Emacs [] false ;
      ft ".*\\.sch$" "Database schema" "#0079FF" Dbforge [] false ;
      ft ".*\\.zog" "Graphical interface" "#B8BC04" Zoggy [tplt "template_zoggy"] false ;
      ft ".*\\.rep$" "XML/HTML Report" "#1825FF" Report [] false ;
      ft ".*\\.epr$" "Epeire config file" "#74E800" (Custom_editor "epeire") [] false ;
      ft ".*\\.html" "HTML Document" "#938343" Emacs [tplt "template_html"] false ;
      ft ".*\\.gif$" "Picture" "HotPink" (Custom_editor "gimp") [] true ;
      ft ".*\\.jpg$" "Picture" "HotPink" (Custom_editor "gimp") [] true ;
      ft ".*\\.xpm" "Pixmap" "#FF38C1" (Custom_editor "gimp") [] false ;
      ft ".*\\.bib$" "Tex bibliography" "DeepSkyBlue3" Emacs [tplt "template_texbib"] false ;
      ft ".*\\.tex$" "Tex document" "DeepSkyBlue4" Emacs [tplt "template_latex"] false ;
      ft ".*\\.sty$" "Tex style" "DeepSkyBlue1" Emacs [] false ;
      ft ".*\\.txt$" "Text file" "#3A1165" Emacs [] false ;
      ft ".*INSTALL.*" "Installation note" "PaleTurquoise4" Emacs [tplt "template_INSTALL"] false ;
      ft ".*LICENSE.*" "License information" "PaleTurquoise4" Emacs [tplt "template_LICENSE"] false ;
      ft ".*\\.cm" "OCamlmake-o-matic specification" "Green" (Custom_editor "omom-edit") [tplt "template_omom"] false ;
      ft ".*[m|M]akefile.*$" "Makefile" "Slate Blue" Emacs [tplt "template_makefile"] false ;
      ft ".*\\.cvsignore" "CVS ignore file" "#AEAEAE" Emacs [tplt "template_cvsignore"] false ;
      ft ".*ChangeLog" "Change log" "#AA7F4B" Emacs [] false ;
      ft ".*README.*" "Read me note" "#7E7E7E" Emacs [tplt "template_README"] false ;
      ft ".*/META" "Findlib meta file" "#7DD2D5" Emacs [] false ;
      ft ".*\\.gz" "Gzipped file" "#FF7100" (Custom_editor "echo %f") [] true ;
      ft ".*\\.1" "Man page" "#41418C" Emacs [tplt "template_man"] false ;
      ft ".*\\.1" "Man page" "#41418C" Emacs [tplt "template_man"] false ;
    ]

let default_editor = Options.define_option core_ini ["default_editor"]
    "" string_option (Cam_types.string_of_editor Cam_types.Efuns)

(** {2 Gui options} *)

module KeyOption = Configwin.KeyOption

module Custom_tools = struct
  let value_to_ct v =
    match v with
      List [StringValue label ; StringValue xpm; StringValue com ]
    | SmallList [StringValue label ; StringValue xpm; StringValue com ] ->
	{ tool_label = label ; 
	  tool_pixmap = xpm ;
	  tool_command = com ;
	} 
    | _ ->
	prerr_endline "Custom_tools.value_to_ct";
	raise Not_found

  let ct_to_value ct =
    SmallList [ StringValue ct.tool_label ; 
		StringValue ct.tool_pixmap; 
		StringValue ct.tool_command ]

  let (t : custom_tool option_class) = 
    define_option_class "custom_tool" value_to_ct ct_to_value  
end


let gui_ini = create_options_file M.rc_gui

let save_gui () = save_with_help gui_ini

(** {3 Custom toolbar buttons} *)

let ct com label xpm =
  { tool_label = label ;
    tool_pixmap = xpm ;
    tool_command = com ;
  } 

let pix f = Filename.concat Cam_installation.pixmaps_dir f

let custom_tools = Options.define_option gui_ini ["custom_tools"]
    "" (list_option Custom_tools.t)
    [
      ct M.a_config M.m_configuration (pix "config.xpm") ;
      ct M.a_new_file M.m_new_dots (pix "new_file.xpm") ;
      ct M.a_edit M.m_edit (pix "edit.xpm") ;
      ct "#topcameleon" "topcameleon" (pix "small_camel.xpm") ;
    ] 

(** {3 Colors and fonts} *)

let color_doc_type = define_option gui_ini ["colors" ; "doc" ; "type"]
    "" string_option "Brown"
let color_doc_keyword = define_option gui_ini ["colors" ; "doc" ; "keyword"]
    "" string_option "Red"
let color_doc_constructor = define_option gui_ini ["colors" ; "doc" ; "constructor"]
    "" string_option "SlateBlue"
let color_doc_code = define_option gui_ini ["colors" ; "doc" ; "code"]
    "" string_option "Orange"

let color_exec_stdout = define_option gui_ini ["colors"; "exec" ; "stdout"]
    "" string_option "Black"
let color_exec_stderr = define_option gui_ini ["colors"; "exec" ; "stderr"]
    "" string_option "red"

let font_exec = define_option gui_ini ["fonts" ; "exec" ]
    "" string_option "fixed"
let font_doc_code = define_option gui_ini ["fonts" ; "doc" ;  "code" ]
    "" string_option "fixed"
let font_doc_code_bold = define_option gui_ini ["fonts" ; "doc" ; "bold_code" ]
    "" string_option "-misc-fixed-bold-r-normal--13-100-100-100-c-70-iso8859-1"
let font_doc_bold = define_option gui_ini ["fonts" ; "doc" ; "bold" ]
    "" string_option "7x13bold"
let font_doc_normal = define_option gui_ini ["fonts" ; "doc" ; "normal" ]
    "" string_option "-adobe-times-medium-r-normal-*-*-140-*-*-p-*-iso8859-1"

let color_view_module = define_option gui_ini ["colors" ; "modules_view" ; "module"]
    "" string_option "Blue"
let color_view_class = define_option gui_ini ["colors" ; "modules_view" ; "class"]
    "" string_option "DarkGreen"
let color_view_type = define_option gui_ini ["colors" ; "modules_view" ; "type"]
    "" string_option "Brown"
let color_view_value = define_option gui_ini ["colors" ; "modules_view" ; "value"]
    "" string_option "Black"
let color_view_exception = define_option gui_ini ["colors" ; "modules_view" ; "exception"]
    "" string_option "Red"


(** {3 Bookmarks} *)

let doc_bookmarks = define_option gui_ini ["bookmarks" ; "doc"]
    "" (list_option string_option) []

(** Add a doc bookmark to the list of bookmarks. *)
let add_doc_bookmark s =
  let l = Cam_misc.remove_doubles (!!doc_bookmarks @ [s]) in
  doc_bookmarks =:= l;
  save_gui ()

(** {3 Key mappings} *)

let keymap_doc = define_option gui_ini ["keymaps"; "doc"]
    "Doc browser key bindings" 
    (list_option (tuple2_option (KeyOption.t, string_option))) []

let keymap_main = define_option gui_ini ["keymaps"; "main"]
    "Main window key bindings" 
    (list_option (tuple2_option (KeyOption.t, string_option))) []

let add_binding map binding action = 
  map =:= (KeyOption.string_to_key binding, action) :: !!map

let add_shortcut w l ((mods, k), action) = 
  try
    let (c_opt, f) = List.assoc action l in
    Okey.add ?cond: c_opt w ~mods k f
  with
    Not_found ->
      prerr_endline (Cam_messages.error_unknown_action action)

(** {3 Menus} *)

let menus = define_option gui_ini ["menus"]
    "Menus of the main window"
    (list_option string_option)
    [ Cam_menus.string_of_menu 
	{ mn_label = M.m_file ;
	  mn_doc = false ;
	  mn_children = 
	  [ Cam_menus.Command { mii_label = M.m_new_dots ; mii_command = M.a_new_file} ;
	    Cam_menus.Command { mii_label = M.m_edit ; mii_command = M.a_edit} ;
	    Cam_menus.Command { mii_label = M.m_configuration ; mii_command = M.a_config} ;
	    Cam_menus.Separator " ";
	    Cam_menus.Command { mii_label = M.m_quit ; mii_command = M.a_quit} ]
	}  ;
      Cam_menus.string_of_menu 
	{ mn_label = M.m_cvs ;
	  mn_doc = false ;
	  mn_children = 
	  [ 
	    Cam_menus.Command { mii_label = M.m_add_dir ; mii_command = M.a_add_dir} ;
	    Cam_menus.Command { mii_label = M.m_update_dir ; mii_command = M.a_update_dir} ;
	    Cam_menus.Command { mii_label = M.m_commit_dir ; mii_command = M.a_commit_dir} ;
	    Cam_menus.Command { mii_label = M.m_tag_dir ; mii_command = M.a_tag_dir} ;
	    Cam_menus.Separator " ";
	    Cam_menus.Command { mii_label = M.m_add_files ; mii_command = M.a_add_file} ;
	    Cam_menus.Command { mii_label = M.m_add_binary_files ; mii_command = M.a_add_binary_file} ;
	    Cam_menus.Command { mii_label = M.m_commit_files ; mii_command = M.a_commit_files} ;
	    Cam_menus.Command { mii_label = M.m_tag_files ; mii_command = M.a_tag_file} ;
	    Cam_menus.Command { mii_label = M.m_tags_of_file ; mii_command = M.a_tags_of_file} ;
	    Cam_menus.Command { mii_label = M.m_remove_files ; mii_command = M.a_remove_file} ;
	    Cam_menus.Command { mii_label = M.m_last_diff ; mii_command = M.a_last_differences} ;
	    Cam_menus.Command { mii_label = M.m_diff_with ; mii_command = M.a_diff_with} ;
	    Cam_menus.Command { mii_label = M.m_diff_between ; mii_command = M.a_diff_between} ;
	    Cam_menus.Command { mii_label = M.m_resolve_conflicts ; mii_command = M.a_resolve_conflicts} ;
	    Cam_menus.Command { mii_label = M.m_log_file ; mii_command = M.a_log} ;
	  ]
	}  ;

      Cam_menus.string_of_menu 
	{ mn_label = M.m_make ;
	  mn_doc = false ;
	  mn_children = 
	  (
	   let targets = ["all" ; "byte" ; "clean" ; "depend" ; "doc" ; "opt" ; "%s"] in
	   List.map
	     (fun t -> Cam_menus.Command { mii_label = t ; mii_command = "make "^t})
	     targets
	  )
	}  ;

      Cam_menus.string_of_menu
	{ mn_label = M.m_doc ;
	  mn_doc = true ;
	  mn_children = [] ;
	} ;

      Cam_menus.string_of_menu
	{ mn_label = M.m_display ;
	  mn_doc = false ;
	  mn_children = 
	  [
	    Cam_menus.Command { mii_label = M.m_modules_box ; mii_command = M.a_display_doc_box} ; 
	    Cam_menus.Command { mii_label = M.m_list_commands ; mii_command = M.a_list_commands} ; 
	    Cam_menus.Command { mii_label = M.m_update_dir_view ; mii_command = M.a_update_dir_view} ; 
	  ] ;
	} ;

      Cam_menus.string_of_menu
	{ mn_label = M.m_question_mark ;
	  mn_doc = false ;
	  mn_children = [ Cam_menus.Command  { mii_label = M.m_about ; mii_command = M.a_about_box} ]
	} ;
    ]

(** {3 Other options} *)

let expanded_dirs = define_option gui_ini
    ["expanded_dirs"]
    ""
    (list_option string_option)
    []

let check_edited_files_delay = define_option gui_ini
    ["check_edited_files_delay"]
    Cam_messages.opt_check_edited_files_delay
    int_option
    15000

let auto_update_file_view = define_option gui_ini
    ["auto_update_file_view"]
    ""
    bool_option
    true

let file_double_click_command = define_option gui_ini
    ["file_double_click_command"]
    ""
    string_option
    Cam_messages.a_edit

(**/**)

let _ = load gui_ini
let _ = load core_ini

let _ = Cam_global.menus := List.map Cam_menus.menu_of_string  !!menus
let _ = Cam_types.default_editor := Cam_types.editor_of_string !!default_editor

(* init key mappings *)
let init_keymaps () =
  (match !!keymap_doc with
    [] -> 
      let l = [
	"C-n", M.a_next_element ;
	"C-p", M.a_prev_element ;
	"Return", M.a_follow_link ;
	"C-Return", M.a_follow_link_in_new ;
	"C-c", M.a_close ;
	"C-s", M.a_search ;
	"C-r", M.a_search_backward ;
	"C-BackSpace", M.a_back ;
	"C-a", M.a_add_bookmark ;
	"C-Home", M.a_home ;
	"C-End", M.a_end ;
	"C-m", M.a_menu ;
      ]	
      in
      List.iter
	(fun (k,a) -> add_binding keymap_doc k a)
	l
  | _ ->
      ()
  );
  (match !!keymap_main with
    [] -> 
      let l = [
	"C-n", M.a_new_file ;
	"C-e", M.a_edit ;
	"C-p", M.a_config ;
	"C-q", M.a_quit ;
	"C-d", M.a_add_dir ;
	"C-u", M.a_update_dir ;
	"CS-c", M.a_commit_dir ;
	"CS-t", M.a_tag_dir ;
	"C-a", M.a_add_file ;
	"C-b", M.a_add_binary_file ;
	"C-c", M.a_commit_files ;
	"C-t", M.a_tag_file ;
	"C-l", M.a_tags_of_file ;
	"C-x", M.a_remove_file ;
	"A-l", M.a_last_differences ;
	"A-w", M.a_diff_with ;
	"A-b", M.a_diff_between ;
	"C-r", M.a_resolve_conflicts ;
	"C-m", M.a_display_doc_box ;
      ]	
      in
      List.iter
	(fun (k,a) -> add_binding keymap_main k a)
	l
  | _ ->
      ()
  )

let _ = init_keymaps ()

let _ = save_gui ()
let _ = save_core ()
