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

(*                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_keymaps.ml 489 2006-12-01 16:08:44Z zoggy $ *)

module O = Config_file

let default_common_keymap =
  [
    "C-n"Cam_constant.com_new_file ;
    "C-e"Cam_constant.com_edit ;
    "C-q"Cam_constant.com_quit ;
    "C-m"Cam_constant.com_display_doc_box ;
    "C-r"Cam_constant.com_refresh_view ;
    "C-w"Cam_constant.com_close_view ;
    "A-x"Cam_constant.com_prompt_command ;
  ]

let keymap_common = new O.list_cp
    (O.tuple2_wrappers Configwin.key_cp_wrapper O.string_wrappers)
    ~group: Cam_rc.gui_ini
    ["keymaps""common"]
    []
    "Common key bindings for windows"

let init_common_keymaps () =
  match keymap_common#get with
    [] ->
      List.iter
        (fun (k,a) -> Cam_rc.add_binding keymap_common k a)
        default_common_keymap
  | _ ->
      ()

let set_window_common_keymaps window =
  Okey.remove_widget window ();
  let add ((mods, k), com) =
    Okey.add window ~mods k (fun () -> Cam_commands.eval_command com)
  in
  List.iter add keymap_common#get


let edit_binding new_allowed avail_commands (binding, action) =
  let ref_b = ref binding in
  let ref_a = ref action in
  let p_key = Configwin.hotkey ~f: (fun k -> ref_b := k) Cam_messages.binding !ref_b in
  let p_action = Configwin.combo
      ~f: (fun s -> ref_a := s)
      ~new_allowed
      ~blank_allowed: false
      Cam_messages.command
      avail_commands
      !ref_a
  in
  let ret = (Configwin.simple_get
               Cam_messages.edit_binding
               [ p_key ; p_action ]) = Configwin.Return_ok in
  (ret, (!ref_b, !ref_a))

let add_binding new_allowed avail_commands () =
  let (ret, (b, a)) = edit_binding new_allowed avail_commands
      (([`CONTROL], GdkKeysyms._A), "")
  in
  if ret then [b, a] else []

let configure_keymaps title op new_allowed available_commands f_save () =
  let p =
    Configwin.list
      ~f: (fun l -> op#set l; f_save ())
      ~titles: [ Cam_messages.binding ; Cam_messages.command ]
      ~add: (add_binding new_allowed available_commands)
      ~edit: (fun (b,a) -> snd (edit_binding new_allowed available_commands (b,a)))
      title
      (fun (k,a) -> [Configwin.key_to_string k ; a])
      op#get
  in
  ignore (Configwin.simple_get ~width: 400 ~height: 400 title [p])

let configure_common_keymaps =
  configure_keymaps
    Cam_messages.common_keyboard_shortcuts
    keymap_common
    true
    (Cam_commands.available_command_names ())
    Cam_rc.save_gui

let _ = Cam_commands.register
    { Cam_commands.com_name = Cam_constant.com_configure_common_keyboard_shortcuts ;
      Cam_commands.com_args = [| |] ;
      Cam_commands.com_more_args = None ;
      Cam_commands.com_f = (fun _ -> configure_common_keymaps ());
    }