/usr/lib/ocaml/obrowser/AXOEvents.ml is in libobrowser-ocaml-dev 1.1.1+dfsg-1build3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 | (* Obrowser
* http://www.ocsigen.org
* Copyright (C) 2009
* Raphaël Proust
* Laboratoire PPS - CNRS Université Paris Diderot
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser 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.
*)
(** This module provides ways to tamper with events. One can use common cases at
* the end of the module as example. *)
open JSOO
open AXOLang
exception Cannot_destruct of exn
module type PARAMS = sig
type v (* event valuation *)
val name : string
val name_modifier : string option
(** A custom tag to ensure your bindings can't be unbound by another module.
It changes the internal representation of bounded handlers. *)
val destruct : obj -> v
(** Converts the [obj] describing the event to a caml value.
* /!\ The [obj] the [destruct] function is called upon is an event object
* (and not the DOM object the event was fired upon ; to get the target node
* of the event use [get_target]).
*)
val default_value : v option
(** The value to send if an exception occurs during the conversion
* of the value, if any.
* If the default value is [None]
* and the destruction failed with exception [e],
* the exception [Cannot_destruct e] is raised.
*)
end
module Make = functor (Params : PARAMS) ->
struct
open Params
let handlers_field = "caml_" ^ name ^ "_handlers"
^ (LOption.unopt ~default:"" name_modifier)
let bind f obj =
let handlers =
try
Obj.obj (obj >>> get handlers_field >>> as_block)
with Failure "as_block" ->
(* first event handler *)
let handlers = ref [] in
obj >>> set handlers_field (inject (Block (Obj.repr handlers))) ;
obj >>> set name
(wrap_event
(fun evt ->
let v =
try destruct evt with e ->
match default_value with
| Some v -> v
| None -> raise (Cannot_destruct e)
in
List.iter (fun f -> f v) !handlers)) ;
handlers
in handlers := f :: (List.filter ((!=) f) !handlers)
let unbind f obj =
let handlers =
try
Obj.obj (obj >>> get handlers_field >>> as_block)
with Failure "as_block" ->
ref []
in
handlers := List.filter ((!=) f) !handlers ;
if !handlers = [] then (
obj >>> set handlers_field (inject Nil) ;
obj >>> set name (inject Nil)
)
let clear () obj =
obj >>> set handlers_field (inject Nil) ;
obj >>> set name (inject Nil)
end
(** [get_target evt] get the DOM node originaly associated to the event. *)
let get_target evt = evt >>> JSOO.get "target"
(** [get_current_target evt] get the DOM node
currently associated to the event *)
let get_current_target evt = evt >>> JSOO.get "currentTerget"
(**[stop_propagation evt] prevent the event for going up in the DOM tree. *)
let stop_propagation evt = evt >>> JSOO.call_method "stopPropagation" [| |]
module Onclick =
Make (
struct
type v = unit
let name = "onclick"
let name_modifier = None
let destruct = fun _ -> ()
let default_value = Some ()
end)
module Mouse_up =
Make (
struct
type v = int * int
let name = "onmouseup"
let name_modifier = None
let destruct obj =
(obj >>> get "clientX" >>> as_int,
obj >>> get "clientY" >>> as_int)
let default_value = None
end
)
module Mouse_down =
Make (
struct
type v = int * int
let name = "onmousedown"
let name_modifier = None
let destruct obj =
(obj >>> get "clientX" >>> as_int,
obj >>> get "clientY" >>> as_int)
let default_value = None
end
)
|