diff options
author | Samuel Mimram <smimram@debian.org> | 2006-04-28 14:59:16 +0000 |
---|---|---|
committer | Samuel Mimram <smimram@debian.org> | 2006-04-28 14:59:16 +0000 |
commit | 3ef7797ef6fc605dfafb32523261fe1b023aeecb (patch) | |
tree | ad89c6bb57ceee608fcba2bb3435b74e0f57919e /ide/utils/okey.ml | |
parent | 018ee3b0c2be79eb81b1f65c3f3fa142d24129c8 (diff) |
Imported Upstream version 8.0pl3+8.1alphaupstream/8.0pl3+8.1alpha
Diffstat (limited to 'ide/utils/okey.ml')
-rw-r--r-- | ide/utils/okey.ml | 115 |
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 - |