summaryrefslogtreecommitdiff
path: root/ide/utils/okey.ml
diff options
context:
space:
mode:
Diffstat (limited to 'ide/utils/okey.ml')
-rw-r--r--ide/utils/okey.ml115
1 files changed, 59 insertions, 56 deletions
diff --git a/ide/utils/okey.ml b/ide/utils/okey.ml
index 17e371f5..57939266 100644
--- a/ide/utils/okey.ml
+++ b/ide/utils/okey.ml
@@ -1,33 +1,34 @@
-(**************************************************************************)
-(* 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 *)
-(**************************************************************************)
+(*********************************************************************************)
+(* Cameleon *)
+(* *)
+(* Copyright (C) 2005 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 *)
+(* *)
+(*********************************************************************************)
type modifier = Gdk.Tags.modifier
type handler = {
cond : (unit -> bool) ;
cback : (unit -> unit) ;
- }
+ }
type handler_spec = int * int * Gdk.keysym
(** mods * mask * key *)
@@ -49,9 +50,9 @@ let int_of_modifier = function
let print_modifier l =
List.iter
- (fun m ->
+ (fun m ->
print_string
- (((function
+ (((function
`SHIFT -> "SHIFT"
| `LOCK -> "LOCK"
| `CONTROL -> "CONTROL"
@@ -69,11 +70,11 @@ let print_modifier l =
)
l;
print_newline ()
-
+
let int_of_modifiers l =
List.fold_left (fun acc -> fun m -> acc + (int_of_modifier m)) 0 l
-module H =
+module H =
struct
type t = handler_spec * handler
let equal (m,k) (mods, mask, key) =
@@ -85,7 +86,7 @@ module H =
let find_handlers mods key l =
List.map snd
(List.filter
- (fun ((m,ma,k),_) -> equal (mods,key) (m,ma,k))
+ (fun ((m,ma,k),_) -> equal (mods,key) (m,ma,k))
l
)
@@ -97,23 +98,25 @@ let key_press w ev =
let key = GdkEvent.Key.keyval ev in
let modifiers = GdkEvent.Key.state ev in
try
- let (r : H.t list ref) = Hashtbl.find table w#get_oid in
+ let (r : H.t list ref) = Hashtbl.find table (Oo.id w) in
let l = H.find_handlers (int_of_modifiers modifiers) key !r in
- let b = ref true in
- List.iter
- (fun h ->
- if h.cond () then
- (h.cback () ; b := false)
- else
- ()
- )
- l;
- !b
+ match l with
+ [] -> false
+ | _ ->
+ List.iter
+ (fun h ->
+ if h.cond () then
+ try h.cback ()
+ with e -> prerr_endline (Printexc.to_string e)
+ else ()
+ )
+ l;
+ true
with
Not_found ->
- true
+ false
-let associate_key_press w =
+let associate_key_press w =
ignore ((w#event#connect#key_press ~callback: (key_press w)) : GtkSignal.id)
let default_modifiers = ref ([] : modifier list)
@@ -122,24 +125,25 @@ let default_mask = ref ([`MOD2 ; `MOD3 ; `MOD4 ; `MOD5 ; `LOCK] : modifier list)
let set_default_modifiers l = default_modifiers := l
let set_default_mask l = default_mask := l
-let remove_widget (w : < event : GObj.event_ops ; get_oid : int ; ..>) () =
- try
- let r = Hashtbl.find table w#get_oid in
+let remove_widget (w : < event : GObj.event_ops ; ..>) () =
+ try
+ let r = Hashtbl.find table (Oo.id w) in
r := []
- with
+ with
Not_found ->
()
let add1 ?(remove=false) w
- ?(cond=(fun () -> true))
+ ?(cond=(fun () -> true))
?(mods= !default_modifiers)
?(mask= !default_mask)
k callback =
+
let r =
- try Hashtbl.find table w#get_oid
- with Not_found ->
+ try Hashtbl.find table (Oo.id w)
+ with Not_found ->
let r = ref [] in
- Hashtbl.add table w#get_oid r;
+ Hashtbl.add table (Oo.id w) r;
ignore (w#connect#destroy ~callback: (remove_widget w));
associate_key_press w;
r
@@ -147,7 +151,7 @@ let add1 ?(remove=false) w
let n_mods = int_of_modifiers mods in
let n_mask = lnot (int_of_modifiers mask) in
let new_h = { cond = cond ; cback = callback } in
- if remove then
+ if remove then
(
let l = H.filter_with_mask n_mods n_mask k !r in
r := ((n_mods, n_mask, k), new_h) :: l
@@ -156,30 +160,29 @@ let add1 ?(remove=false) w
r := ((n_mods, n_mask, k), new_h) :: !r
let add w
- ?(cond=(fun () -> true))
+ ?(cond=(fun () -> true))
?(mods= !default_modifiers)
?(mask= !default_mask)
k callback =
add1 w ~cond ~mods ~mask k callback
let add_list w
- ?(cond=(fun () -> true))
+ ?(cond=(fun () -> true))
?(mods= !default_modifiers)
?(mask= !default_mask)
k_list callback =
List.iter (fun k -> add w ~cond ~mods ~mask k callback) k_list
let set w
- ?(cond=(fun () -> true))
+ ?(cond=(fun () -> true))
?(mods= !default_modifiers)
?(mask= !default_mask)
k callback =
add1 ~remove: true w ~cond ~mods ~mask k callback
let set_list w
- ?(cond=(fun () -> true))
+ ?(cond=(fun () -> true))
?(mods= !default_modifiers)
?(mask= !default_mask)
k_list callback =
List.iter (fun k -> set w ~cond ~mods ~mask k callback) k_list
-