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