Update js_of_ocaml

OCamlPro · Jan 30, 2013 · 75534ac · 75534ac
1 parent 602d9d6
commit 75534ac
Show file tree

Hide file tree

Showing 8 changed files with 85 additions and 10 deletions.
diff --git a/js_of_ocaml/lib/.depend b/js_of_ocaml/lib/.depend
@@ -18,6 +18,8 @@ js.cmo: js.cmi
 js.cmx: js.cmi
 json.cmo: js.cmi json.cmi
 json.cmx: js.cmx json.cmi
+keycode.cmo: keycode.cmi
+keycode.cmx: keycode.cmi
 lwt_js.cmo: js.cmi dom_html.cmi lwt_js.cmi
 lwt_js.cmx: js.cmx dom_html.cmx lwt_js.cmi
 lwt_js_events.cmo: lwt_js.cmi js.cmi firebug.cmi dom_html.cmi dom.cmi \
@@ -28,8 +30,8 @@ regexp.cmo: js.cmi regexp.cmi
 regexp.cmx: js.cmx regexp.cmi
 typed_array.cmo: js.cmi typed_array.cmi
 typed_array.cmx: js.cmx typed_array.cmi
-url.cmo: regexp.cmi js.cmi dom_html.cmi url.cmi
-url.cmx: regexp.cmx js.cmx dom_html.cmx url.cmi
+url.cmo: regexp.cmi js.cmi url.cmi
+url.cmx: regexp.cmx js.cmx url.cmi
 webGL.cmo: typed_array.cmi js.cmi dom_html.cmi webGL.cmi
 webGL.cmx: typed_array.cmx js.cmx dom_html.cmx webGL.cmi
 webSockets.cmo: js.cmi dom_html.cmi dom.cmi webSockets.cmi
@@ -48,6 +50,7 @@ firebug.cmi: js.cmi dom.cmi
 form.cmi: js.cmi file.cmi dom_html.cmi
 js.cmi:
 json.cmi: js.cmi
+keycode.cmi:
 lwt_js.cmi:
 lwt_js_events.cmi: js.cmi dom_html.cmi
 regexp.cmi:

diff --git a/js_of_ocaml/lib/Makefile b/js_of_ocaml/lib/Makefile
@@ -1,4 +1,5 @@
-MLOBJS= js.cmo dom.cmo typed_array.cmo dom_html.cmo file.cmo dom_events.cmo lwt_js.cmo firebug.cmo regexp.cmo CSS.cmo url.cmo form.cmo xmlHttpRequest.cmo event_arrows.cmo lwt_js_events.cmo json.cmo webGL.cmo webSockets.cmo
+MLOBJS= js.cmo dom.cmo typed_array.cmo dom_html.cmo file.cmo dom_events.cmo lwt_js.cmo firebug.cmo regexp.cmo CSS.cmo url.cmo form.cmo xmlHttpRequest.cmo event_arrows.cmo lwt_js_events.cmo json.cmo webGL.cmo webSockets.cmo keycode.cmo
+
 MLINTFS= $(MLOBJS:.cmo=.mli)
 COBJS= stubs$(OBJEXT)
 OBJS=$(MLOBJS) $(COBJS)

diff --git a/js_of_ocaml/lib/dom_html.ml b/js_of_ocaml/lib/dom_html.ml
@@ -239,6 +239,7 @@ and eventTarget = object ('self)
   method onkeypress : ('self t, keyboardEvent t) event_listener writeonly_prop
   method onkeydown : ('self t, keyboardEvent t) event_listener writeonly_prop
   method onkeyup : ('self t, keyboardEvent t) event_listener writeonly_prop
+  method onscroll : ('self t, event t) event_listener writeonly_prop
   method ondragstart : ('self t, dragEvent t) event_listener writeonly_prop
   method ondragend : ('self t, dragEvent t) event_listener writeonly_prop
   method ondragenter : ('self t, dragEvent t) event_listener writeonly_prop
@@ -374,6 +375,10 @@ module Event = struct
   let hashchange = Dom.Event.make "hashchange"
   let change = Dom.Event.make "change"
   let input = Dom.Event.make "input"
+  let submit = Dom.Event.make "submit"
+  let scroll = Dom.Event.make "scroll"
+  let focus = Dom.Event.make "focus"
+  let blur = Dom.Event.make "blur"
 
   let make = Dom.Event.make
 end
@@ -520,6 +525,8 @@ class type inputElement = object ('self)
   method onselect : ('self t, event t) event_listener prop
   method onchange : ('self t, event t) event_listener prop
   method oninput : ('self t, event t) event_listener prop
+  method onblur : ('self t, event t) event_listener prop
+  method onfocus : ('self t, event t) event_listener prop
 end
 
 class type textAreaElement = object ('self)
@@ -542,6 +549,8 @@ class type textAreaElement = object ('self)
   method onselect : ('self t, event t) event_listener prop
   method onchange : ('self t, event t) event_listener prop
   method oninput : ('self t, event t) event_listener prop
+  method onblur : ('self t, event t) event_listener prop
+  method onfocus : ('self t, event t) event_listener prop
 end
 
 class type buttonElement = object
@@ -691,6 +700,7 @@ class type scriptElement = object
   method defer : bool t prop
   method src : js_string t prop
   method _type : js_string t prop
+  method async : bool t prop
 end
 
 class type tableCellElement = object
@@ -909,7 +919,7 @@ class type document = object
   inherit nodeSelector
   method title : js_string t prop
   method referrer : js_string t readonly_prop
-  method domain : js_string t readonly_prop
+  method domain : js_string t prop
   method _URL : js_string t readonly_prop
   method head : headElement t prop
   method body : bodyElement t prop
@@ -988,15 +998,14 @@ class type window = object
   method location : location t readonly_prop
   method history : history t readonly_prop
   method undoManager : undoManager t readonly_prop
-  method navigator : navigator t
+  method navigator : navigator t readonly_prop
   method getSelection : selection t meth
   method close : unit meth
   method closed : bool t readonly_prop
   method stop : unit meth
   method focus : unit meth
   method blur : unit meth
   method scroll : int -> int -> unit meth
-  method screen : screen t readonly_prop
 
   method sessionStorage : storage t optdef readonly_prop
   method localStorage : storage t optdef readonly_prop
@@ -1017,6 +1026,12 @@ class type window = object
   method setTimeout : (unit -> unit) Js.callback -> float -> timeout_id meth
   method clearTimeout : timeout_id -> unit meth
 
+  method screen : screen t readonly_prop
+  method innerWidth : int optdef readonly_prop
+  method innerHeight : int optdef readonly_prop
+  method outerWidth : int optdef readonly_prop
+  method outerHeight : int optdef readonly_prop
+
   method onload : (window t, event t) event_listener prop
   method onbeforeunload : (window t, event t) event_listener prop
   method onblur : (window t, event t) event_listener prop
@@ -1621,3 +1636,8 @@ let _requestAnimationFrame : (unit -> unit) Js.callback -> unit =
            let dt = if dt < 0. then 0. else dt in
            last := t;
            ignore (window##setTimeout (callback, dt)))
+
+(****)
+
+let hasPushState () =
+  Js.Optdef.test ((Js.Unsafe.coerce (window##history))##pushState)
diff --git a/js_of_ocaml/lib/dom_html.mli b/js_of_ocaml/lib/dom_html.mli
@@ -248,6 +248,7 @@ and eventTarget = object ('self)
   method onkeypress : ('self t, keyboardEvent t) event_listener writeonly_prop
   method onkeydown : ('self t, keyboardEvent t) event_listener writeonly_prop
   method onkeyup : ('self t, keyboardEvent t) event_listener writeonly_prop
+  method onscroll : ('self t, event t) event_listener writeonly_prop
   method ondragstart : ('self t, dragEvent t) event_listener writeonly_prop
   method ondragend : ('self t, dragEvent t) event_listener writeonly_prop
   method ondragenter : ('self t, dragEvent t) event_listener writeonly_prop
@@ -493,6 +494,8 @@ class type inputElement = object ('self)
   method onselect : ('self t, event t) event_listener prop
   method onchange : ('self t, event t) event_listener prop
   method oninput : ('self t, event t) event_listener prop
+  method onblur : ('self t, event t) event_listener prop
+  method onfocus : ('self t, event t) event_listener prop
 end
 
 class type textAreaElement = object ('self)
@@ -515,6 +518,8 @@ class type textAreaElement = object ('self)
   method onselect : ('self t, event t) event_listener prop
   method onchange : ('self t, event t) event_listener prop
   method oninput : ('self t, event t) event_listener prop
+  method onblur : ('self t, event t) event_listener prop
+  method onfocus : ('self t, event t) event_listener prop
 end
 
 class type buttonElement = object
@@ -665,6 +670,7 @@ class type scriptElement = object
   method defer : bool t prop
   method src : js_string t prop
   method _type : js_string t prop
+  method async : bool t prop
 end
 
 class type tableCellElement = object
@@ -887,7 +893,7 @@ class type document = object
   inherit nodeSelector
   method title : js_string t prop
   method referrer : js_string t readonly_prop
-  method domain : js_string t readonly_prop
+  method domain : js_string t prop
   method _URL : js_string t readonly_prop
   method head : headElement t prop
   method body : bodyElement t prop
@@ -979,15 +985,14 @@ class type window = object
   method location : location t readonly_prop
   method history : history t readonly_prop
   method undoManager : undoManager t readonly_prop
-  method navigator : navigator t
+  method navigator : navigator t readonly_prop
   method getSelection : selection t meth
   method close : unit meth
   method closed : bool t readonly_prop
   method stop : unit meth
   method focus : unit meth
   method blur : unit meth
   method scroll : int -> int -> unit meth
-  method screen : screen t readonly_prop
 
   method sessionStorage : storage t optdef readonly_prop
   method localStorage : storage t optdef readonly_prop
@@ -1008,6 +1013,12 @@ class type window = object
   method setTimeout : (unit -> unit) Js.callback -> float -> timeout_id meth
   method clearTimeout : timeout_id -> unit meth
 
+  method screen : screen t readonly_prop
+  method innerWidth : int optdef readonly_prop
+  method innerHeight : int optdef readonly_prop
+  method outerWidth : int optdef readonly_prop
+  method outerHeight : int optdef readonly_prop
+
   method onload : (window t, event t) event_listener prop
   method onbeforeunload : (window t, event t) event_listener prop
   method onblur : (window t, event t) event_listener prop
@@ -1112,6 +1123,10 @@ module Event : sig
   val hashchange : hashChangeEvent t typ
   val change : event t typ
   val input : event t typ
+  val submit : event t typ
+  val scroll : event t typ
+  val focus : event t typ
+  val blur : event t typ
 
   val make : string -> 'a typ
 end
@@ -1408,3 +1423,4 @@ end
 (**/**)
 
 val onIE : bool
+val hasPushState : unit -> bool
diff --git a/js_of_ocaml/lib/js.ml b/js_of_ocaml/lib/js.ml
@@ -355,6 +355,21 @@ external to_bytestring : js_string t -> string = "caml_js_to_byte_string"
 external typeof : < .. > t -> js_string t = "caml_js_typeof"
 external instanceof : 'a -> 'b -> bool = "caml_js_instanceof"
 
+let isNaN (i : 'a) : bool =
+  to_bool (Unsafe.fun_call (Unsafe.variable "isNaN") [|Unsafe.inject i|])
+
+let parseInt (s : js_string t) : int =
+  let s = Unsafe.fun_call (Unsafe.variable "parseInt") [|Unsafe.inject s|] in
+  if isNaN s
+  then failwith "parseInt"
+  else s
+
+let parseFloat (s : js_string t) : float t =
+  let s = Unsafe.fun_call (Unsafe.variable "parseFloat") [|Unsafe.inject s|] in
+  if isNaN s
+  then failwith "parseFloat"
+  else s
+
 let _ =
   Printexc.register_printer
     (fun e ->

diff --git a/js_of_ocaml/lib/js.mli b/js_of_ocaml/lib/js.mli
@@ -439,6 +439,14 @@ val unescape : js_string t -> js_string t
   (** Unescape a string: 2-digit and 4-digit escape sequences are
       replaced by the corresponding UTF-16 code point. *)
 
+
+val isNaN : 'a -> bool
+
+val parseInt : js_string t -> int
+
+val parseFloat : js_string t -> float t
+
+
 (** {2 Conversion functions between Javascript and OCaml types} *)
 
 external bool : bool -> bool t = "caml_js_from_bool"

diff --git a/js_of_ocaml/lib/xmlHttpRequest.ml b/js_of_ocaml/lib/xmlHttpRequest.ml
@@ -32,6 +32,7 @@ class type xmlHttpRequest = object ('self)
     js_string t -> js_string t -> bool t ->
     js_string t opt -> js_string t opt -> unit meth
   method setRequestHeader : js_string t -> js_string t -> unit meth
+  method overrideMimeType : js_string t -> unit meth
   method send : js_string t opt -> unit meth
   method send_document : Dom.element Dom.document -> unit meth
   method send_formData : Form.formData t -> unit meth
@@ -160,6 +161,7 @@ let perform_raw_url
     ?(get_args=[])
     ?(form_arg:Form.form_contents option)
     ?(check_headers=(fun _ _ -> true))
+    ?override_mime_type
     url =
 
   let form_arg =
@@ -203,6 +205,11 @@ let perform_raw_url
   let (res, w) = Lwt.task () in
   let req = create () in
 
+  begin match override_mime_type with
+    None           -> ()
+  | Some mime_type -> req ## overrideMimeType (Js.string mime_type)
+  end;
+
   req##_open (Js.string method_, Js.string url, Js._true);
   (match content_type with
     | Some content_type ->
@@ -281,8 +288,10 @@ let perform
     ?(get_args=[])
     ?form_arg
     ?check_headers
+    ?override_mime_type
     url =
-  perform_raw_url ~headers ?content_type ?post_args ~get_args ?form_arg ?check_headers
+  perform_raw_url ~headers ?content_type ?post_args ~get_args ?form_arg
+    ?check_headers ?override_mime_type
     (Url.string_of_url url)
 
 let get s = perform_raw_url s

diff --git a/js_of_ocaml/lib/xmlHttpRequest.mli b/js_of_ocaml/lib/xmlHttpRequest.mli
@@ -33,6 +33,7 @@ class type xmlHttpRequest = object ('self)
     js_string t -> js_string t -> bool t ->
     js_string t opt -> js_string t opt -> unit meth
   method setRequestHeader : js_string t -> js_string t -> unit meth
+  method overrideMimeType : js_string t -> unit meth
   method send : js_string t opt -> unit meth
   method send_document : Dom.element Dom.document -> unit meth
   method send_formData : Form.formData t -> unit meth
@@ -89,6 +90,7 @@ val perform_raw_url :
   -> ?get_args:((string * string) list)  (* [] *)
   -> ?form_arg:Form.form_contents
   -> ?check_headers:(int -> (string -> string option) -> bool)
+  -> ?override_mime_type:string
   -> string
   -> http_frame Lwt.t
   (** [perform_raw_url ?headers ?content_type ?post_args ?get_args ?form_arg url]
@@ -107,6 +109,7 @@ val perform :
   -> ?get_args:((string * string) list)  (* [] *)
   -> ?form_arg:Form.form_contents
   -> ?check_headers:(int -> (string -> string option) -> bool)
+  -> ?override_mime_type:string
   -> Url.url
   -> http_frame Lwt.t
   (** [perform] is the same as {!perform_raw_url} except that the Url argument has type