import labltklabltk

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/labltk@2531 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 58 insertions, 0 deletions

diff --git a/otherlibs/labltk/builtin/builtini_bind.ml b/otherlibs/labltk/builtin/builtini_bind.ml
new file mode 100644
index 0000000000..8dbde204be
--- /dev/null
+++ b/otherlibs/labltk/builtin/builtini_bind.ml
@@ -0,0 +1,58 @@
+let cCAMLtoTKxEvent : xEvent -> string = function
+    `ButtonPress -> "ButtonPress"
+  | `ButtonPressDetail n -> "ButtonPress-"^string_of_int n
+  | `ButtonRelease -> "ButtonRelease"
+  | `ButtonReleaseDetail n -> "ButtonRelease-"^string_of_int n
+  | `Circulate -> "Circulate"
+  | `ColorMap -> "ColorMap"
+  | `Configure -> "Configure"
+  | `Destroy -> "Destroy"
+  | `Enter -> "Enter"
+  | `Expose -> "Expose"
+  | `FocusIn -> "FocusIn"
+  | `FocusOut -> "FocusOut"
+  | `Gravity -> "Gravity"
+  | `KeyPress -> "KeyPress"
+  | `KeyPressDetail s -> "KeyPress-"^s
+  | `KeyRelease -> "KeyRelease"
+  | `KeyReleaseDetail s -> "KeyRelease-"^s
+  | `Leave -> "Leave"
+  | `Map -> "Map"
+  | `Motion -> "Motion"
+  | `Property -> "Property"
+  | `Reparent -> "Reparent"
+  | `Unmap -> "Unmap"
+  | `Visibility -> "Visibility" 
+
+let cCAMLtoTKmodifier : modifier -> string = function
+   `Control -> "Control-"
+ | `Shift -> "Shift-"
+ | `Lock -> "Lock-"
+ | `Button1 -> "Button1-"
+ | `Button2 -> "Button2-"
+ | `Button3 -> "Button3-"
+ | `Button4 -> "Button4-"
+ | `Button5 -> "Button5-"
+ | `Double -> "Double-"
+ | `Triple -> "Triple-"
+ | `Mod1 -> "Mod1-"
+ | `Mod2 -> "Mod2-"
+ | `Mod3 -> "Mod3-"
+ | `Mod4 -> "Mod4-"
+ | `Mod5 -> "Mod5-"
+ | `Meta -> "Meta-"
+ | `Alt -> "Alt-"
+
+
+(* type event = modifier list * xEvent *)
+let cCAMLtoTKevent : (modifier list * xEvent) -> string = 
+ function (ml, xe) ->
+  "<" ^ (catenate_sep " " (List.map fun:cCAMLtoTKmodifier ml))  
+      ^ (cCAMLtoTKxEvent xe) ^ ">"
+  
+(* type eventSequence == (modifier list * xEvent) list *)
+let cCAMLtoTKeventSequence : (modifier list * xEvent) list -> tkArgs = 
+ function l ->
+  TkToken(catenate_sep "" (List.map fun:cCAMLtoTKevent l))
+
+