summaryrefslogtreecommitdiff
path: root/otherlibs/labltk/builtin/builtini_bind.ml
diff options
context:
space:
mode:
Diffstat (limited to 'otherlibs/labltk/builtin/builtini_bind.ml')
-rw-r--r--otherlibs/labltk/builtin/builtini_bind.ml58
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))
+
+