Source file dom_html.ml

(* Js_of_ocaml library
 * http://www.ocsigen.org/js_of_ocaml/
 * Copyright (C) 2010 Jérôme Vouillon
 * 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.
 *)

open Js
open! Import

external caml_js_on_ie : unit -> bool t = "caml_js_on_ie"

let onIE = Js.to_bool (caml_js_on_ie ())

external html_escape : js_string t -> js_string t = "caml_js_html_escape"

external decode_html_entities : js_string t -> js_string t = "caml_js_html_entities"

class type cssStyleDeclaration =
  object
    method animation : js_string t prop

    method animationDelay : js_string t prop

    method animationDirection : js_string t prop

    method animationDuration : js_string t prop

    method animationFillMode : js_string t prop

    method animationIterationCount : js_string t prop

    method animationName : js_string t prop

    method animationPlayState : js_string t prop

    method animationTimingFunction : js_string t prop

    method background : js_string t prop

    method backgroundAttachment : js_string t prop

    method backgroundColor : js_string t prop

    method backgroundImage : js_string t prop

    method backgroundPosition : js_string t prop

    method backgroundRepeat : js_string t prop

    method border : js_string t prop

    method borderBottom : js_string t prop

    method borderBottomColor : js_string t prop

    method borderBottomStyle : js_string t prop

    method borderBottomWidth : js_string t prop

    method borderCollapse : js_string t prop

    method borderColor : js_string t prop

    method borderLeft : js_string t prop

    method borderLeftColor : js_string t prop

    method borderLeftStyle : js_string t prop

    method borderLeftWidth : js_string t prop

    method borderRadius : js_string t prop

    method borderRight : js_string t prop

    method borderRightColor : js_string t prop

    method borderRightStyle : js_string t prop

    method borderRightWidth : js_string t prop

    method borderSpacing : js_string t prop

    method borderStyle : js_string t prop

    method borderTop : js_string t prop

    method borderTopColor : js_string t prop

    method borderTopStyle : js_string t prop

    method borderTopWidth : js_string t prop

    method borderWidth : js_string t prop

    method bottom : js_string t prop

    method captionSide : js_string t prop

    method clear : js_string t prop

    method clip : js_string t prop

    method color : js_string t prop

    method content : js_string t prop

    method counterIncrement : js_string t prop

    method counterReset : js_string t prop

    method cssFloat : js_string t prop

    method cssText : js_string t prop

    method cursor : js_string t prop

    method direction : js_string t prop

    method display : js_string t prop

    method emptyCells : js_string t prop

    method fill : js_string t prop

    method font : js_string t prop

    method fontFamily : js_string t prop

    method fontSize : js_string t prop

    method fontStyle : js_string t prop

    method fontVariant : js_string t prop

    method fontWeight : js_string t prop

    method height : js_string t prop

    method left : js_string t prop

    method letterSpacing : js_string t prop

    method lineHeight : js_string t prop

    method listStyle : js_string t prop

    method listStyleImage : js_string t prop

    method listStylePosition : js_string t prop

    method listStyleType : js_string t prop

    method margin : js_string t prop

    method marginBottom : js_string t prop

    method marginLeft : js_string t prop

    method marginRight : js_string t prop

    method marginTop : js_string t prop

    method maxHeight : js_string t prop

    method maxWidth : js_string t prop

    method minHeight : js_string t prop

    method minWidth : js_string t prop

    method opacity : js_string t optdef prop

    method outline : js_string t prop

    method outlineColor : js_string t prop

    method outlineOffset : js_string t prop

    method outlineStyle : js_string t prop

    method outlineWidth : js_string t prop

    method overflow : js_string t prop

    method overflowX : js_string t prop

    method overflowY : js_string t prop

    method padding : js_string t prop

    method paddingBottom : js_string t prop

    method paddingLeft : js_string t prop

    method paddingRight : js_string t prop

    method paddingTop : js_string t prop

    method pageBreakAfter : js_string t prop

    method pageBreakBefore : js_string t prop

    method pointerEvents : js_string t prop

    method position : js_string t prop

    method right : js_string t prop

    method stroke : js_string t prop

    method strokeWidth : js_string t prop

    method tableLayout : js_string t prop

    method textAlign : js_string t prop

    method textAnchor : js_string t prop

    method textDecoration : js_string t prop

    method textIndent : js_string t prop

    method textTransform : js_string t prop

    method top : js_string t prop

    method transform : js_string t prop

    method verticalAlign : js_string t prop

    method visibility : js_string t prop

    method whiteSpace : js_string t prop

    method width : js_string t prop

    method wordSpacing : js_string t prop

    method zIndex : js_string t prop
  end

type ('a, 'b) event_listener = ('a, 'b) Dom.event_listener

type mouse_button =
  | No_button
  | Left_button
  | Middle_button
  | Right_button

class type event =
  object
    inherit [element] Dom.event
  end

and ['a] customEvent =
  object
    inherit [element, 'a] Dom.customEvent
  end

and focusEvent =
  object
    inherit event

    method relatedTarget : element t opt optdef readonly_prop
  end

and mouseEvent =
  object
    inherit event

    method relatedTarget : element t opt optdef readonly_prop

    method clientX : int readonly_prop

    method clientY : int readonly_prop

    method screenX : int readonly_prop

    method screenY : int readonly_prop

    method ctrlKey : bool t readonly_prop

    method shiftKey : bool t readonly_prop

    method altKey : bool t readonly_prop

    method metaKey : bool t readonly_prop

    method button : int readonly_prop

    method which : mouse_button optdef readonly_prop

    method fromElement : element t opt optdef readonly_prop

    method toElement : element t opt optdef readonly_prop

    method pageX : int optdef readonly_prop

    method pageY : int optdef readonly_prop
  end

and keyboardEvent =
  object
    inherit event

    method altKey : bool t readonly_prop

    method shiftKey : bool t readonly_prop

    method ctrlKey : bool t readonly_prop

    method metaKey : bool t readonly_prop

    method location : int readonly_prop

    method key : js_string t optdef readonly_prop

    method code : js_string t optdef readonly_prop

    method which : int optdef readonly_prop

    method charCode : int optdef readonly_prop

    method keyCode : int readonly_prop

    method keyIdentifier : js_string t optdef readonly_prop
  end

and mousewheelEvent =
  object
    (* All browsers but Firefox *)
    inherit mouseEvent

    method wheelDelta : int readonly_prop

    method wheelDeltaX : int optdef readonly_prop

    method wheelDeltaY : int optdef readonly_prop
  end

and mouseScrollEvent =
  object
    (* Firefox *)
    inherit mouseEvent

    method detail : int readonly_prop

    method axis : int optdef readonly_prop

    method _HORIZONTAL_AXIS : int optdef readonly_prop

    method _VERTICAL_AXIS : int optdef readonly_prop
  end

and touchEvent =
  object
    inherit event

    method touches : touchList t readonly_prop

    method targetTouches : touchList t readonly_prop

    method changedTouches : touchList t readonly_prop

    method ctrlKey : bool t readonly_prop

    method shiftKey : bool t readonly_prop

    method altKey : bool t readonly_prop

    method metaKey : bool t readonly_prop

    method relatedTarget : element t opt optdef readonly_prop
  end

and touchList =
  object
    method length : int readonly_prop

    method item : int -> touch t optdef meth
  end

and touch =
  object
    method identifier : int readonly_prop

    method target : element t optdef readonly_prop

    method screenX : int readonly_prop

    method screenY : int readonly_prop

    method clientX : int readonly_prop

    method clientY : int readonly_prop

    method pageX : int readonly_prop

    method pageY : int readonly_prop
  end

and dragEvent =
  object
    inherit mouseEvent

    method dataTransfer : dataTransfer t readonly_prop
  end

and dataTransfer =
  object
    method dropEffect : js_string t prop

    method effectAllowed : js_string t prop

    method files : File.fileList t readonly_prop

    method types : js_string t js_array t readonly_prop

    method addElement : element t -> unit meth

    method clearData : js_string t -> unit meth

    method clearData_all : unit meth

    method getData : js_string t -> js_string t meth

    method setData : js_string t -> js_string t -> unit meth

    method setDragImage : element t -> int -> int -> unit meth
  end

and eventTarget =
  object ('self)
    method onclick : ('self t, mouseEvent t) event_listener writeonly_prop

    method ondblclick : ('self t, mouseEvent t) event_listener writeonly_prop

    method onmousedown : ('self t, mouseEvent t) event_listener writeonly_prop

    method onmouseup : ('self t, mouseEvent t) event_listener writeonly_prop

    method onmouseover : ('self t, mouseEvent t) event_listener writeonly_prop

    method onmousemove : ('self t, mouseEvent t) event_listener writeonly_prop

    method onmouseout : ('self t, mouseEvent t) event_listener writeonly_prop

    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

    method ondragover : ('self t, dragEvent t) event_listener writeonly_prop

    method ondragleave : ('self t, dragEvent t) event_listener writeonly_prop

    method ondrag : ('self t, dragEvent t) event_listener writeonly_prop

    method ondrop : ('self t, dragEvent t) event_listener writeonly_prop

    method onanimationstart : ('self t, animationEvent t) event_listener writeonly_prop

    method onanimationend : ('self t, animationEvent t) event_listener writeonly_prop

    method onanimationiteration :
      ('self t, animationEvent t) event_listener writeonly_prop

    method onanimationcancel : ('self t, animationEvent t) event_listener writeonly_prop

    method ongotpointercapture : ('self t, pointerEvent t) event_listener writeonly_prop

    method onlostpointercapture : ('self t, pointerEvent t) event_listener writeonly_prop

    method onpointerenter : ('self t, pointerEvent t) event_listener writeonly_prop

    method onpointercancel : ('self t, pointerEvent t) event_listener writeonly_prop

    method onpointerdown : ('self t, pointerEvent t) event_listener writeonly_prop

    method onpointerleave : ('self t, pointerEvent t) event_listener writeonly_prop

    method onpointermove : ('self t, pointerEvent t) event_listener writeonly_prop

    method onpointerout : ('self t, pointerEvent t) event_listener writeonly_prop

    method onpointerover : ('self t, pointerEvent t) event_listener writeonly_prop

    method onpointerup : ('self t, pointerEvent t) event_listener writeonly_prop

    method dispatchEvent : event t -> bool t meth
  end

and popStateEvent =
  object
    inherit event

    method state : Js.Unsafe.any readonly_prop
  end

and pointerEvent =
  object
    inherit mouseEvent

    method pointerId : int Js.readonly_prop

    method width : float Js.readonly_prop

    method height : float Js.readonly_prop

    method pressure : float Js.readonly_prop

    method tangentialPressure : float Js.readonly_prop

    method tiltX : int Js.readonly_prop

    method tiltY : int Js.readonly_prop

    method twist : int Js.readonly_prop

    method pointerType : Js.js_string Js.t Js.readonly_prop

    method isPrimary : bool Js.t Js.readonly_prop
  end

and storageEvent =
  object
    inherit event

    method key : js_string t opt readonly_prop

    method oldValue : js_string t opt readonly_prop

    method newValue : js_string t opt readonly_prop

    method url : js_string t readonly_prop

    method storageArea : storage t opt readonly_prop
  end

and storage =
  object
    method length : int readonly_prop

    method key : int -> js_string t opt meth

    method getItem : js_string t -> js_string t opt meth

    method setItem : js_string t -> js_string t -> unit meth

    method removeItem : js_string t -> unit meth

    method clear : unit meth
  end

and hashChangeEvent =
  object
    inherit event

    method oldURL : js_string t readonly_prop

    method newURL : js_string t readonly_prop
  end

and animationEvent =
  object
    inherit event

    method animationName : js_string t readonly_prop

    method elapsedTime : float readonly_prop

    method pseudoElement : js_string t readonly_prop
  end

and mediaEvent =
  object
    inherit event
  end

and nodeSelector =
  object
    method querySelector : js_string t -> element t opt meth

    method querySelectorAll : js_string t -> element Dom.nodeList t meth
  end

and tokenList =
  object
    method length : int readonly_prop

    method item : int -> js_string t optdef meth

    method contains : js_string t -> bool t meth

    method add : js_string t -> unit meth

    method remove : js_string t -> unit meth

    method toggle : js_string t -> bool t meth

    method stringifier : js_string t prop
  end

and element =
  object
    inherit Dom.element

    inherit nodeSelector

    method id : js_string t prop

    method title : js_string t prop

    method lang : js_string t prop

    method dir : js_string t prop

    method className : js_string t prop

    method classList : tokenList t readonly_prop

    method style : cssStyleDeclaration t prop

    method innerHTML : js_string t prop

    method outerHTML : js_string t prop

    method textContent : js_string t opt prop

    method clientLeft : int readonly_prop

    method clientTop : int readonly_prop

    method clientWidth : int readonly_prop

    method clientHeight : int readonly_prop

    method offsetLeft : int readonly_prop

    method offsetTop : int readonly_prop

    method offsetParent : element t opt readonly_prop

    method offsetWidth : int readonly_prop

    method offsetHeight : int readonly_prop

    method scrollLeft : int prop

    method scrollTop : int prop

    method scrollWidth : int prop

    method scrollHeight : int prop

    method getClientRects : clientRectList t meth

    method getBoundingClientRect : clientRect t meth

    method scrollIntoView : bool t -> unit meth

    method click : unit meth

    method focus : unit meth

    method blur : unit meth

    inherit eventTarget
  end

and clientRect =
  object
    method top : float readonly_prop

    method right : float readonly_prop

    method bottom : float readonly_prop

    method left : float readonly_prop

    method width : float optdef readonly_prop

    method height : float optdef readonly_prop
  end

and clientRectList =
  object
    method length : int readonly_prop

    method item : int -> clientRect t opt meth
  end

let no_handler : ('a, 'b) event_listener = Dom.no_handler

let handler = Dom.handler

let full_handler = Dom.full_handler

let invoke_handler = Dom.invoke_handler

module Event = struct
  type 'a typ = 'a Dom.Event.typ

  let click = Dom.Event.make "click"

  let dblclick = Dom.Event.make "dblclick"

  let mousedown = Dom.Event.make "mousedown"

  let mouseup = Dom.Event.make "mouseup"

  let mouseover = Dom.Event.make "mouseover"

  let mousemove = Dom.Event.make "mousemove"

  let mouseout = Dom.Event.make "mouseout"

  let keypress = Dom.Event.make "keypress"

  let keydown = Dom.Event.make "keydown"

  let keyup = Dom.Event.make "keyup"

  let mousewheel = Dom.Event.make "mousewheel"

  let _DOMMouseScroll = Dom.Event.make "DOMMouseScroll"

  let touchstart = Dom.Event.make "touchstart"

  let touchmove = Dom.Event.make "touchmove"

  let touchend = Dom.Event.make "touchend"

  let touchcancel = Dom.Event.make "touchcancel"

  let dragstart = Dom.Event.make "dragstart"

  let dragend = Dom.Event.make "dragend"

  let dragenter = Dom.Event.make "dragenter"

  let dragover = Dom.Event.make "dragover"

  let dragleave = Dom.Event.make "dragleave"

  let drag = Dom.Event.make "drag"

  let drop = Dom.Event.make "drop"

  let hashchange = Dom.Event.make "hashchange"

  let change = Dom.Event.make "change"

  let input = Dom.Event.make "input"

  let timeupdate = Dom.Event.make "timeupdate"

  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 load = Dom.Event.make "load"

  let unload = Dom.Event.make "unload"

  let beforeunload = Dom.Event.make "beforeunload"

  let resize = Dom.Event.make "resize"

  let orientationchange = Dom.Event.make "orientationchange"

  let popstate = Dom.Event.make "popstate"

  let error = Dom.Event.make "error"

  let abort = Dom.Event.make "abort"

  let select = Dom.Event.make "select"

  let online = Dom.Event.make "online"

  let offline = Dom.Event.make "offline"

  let checking = Dom.Event.make "checking"

  let noupdate = Dom.Event.make "noupdate"

  let downloading = Dom.Event.make "downloading"

  let progress = Dom.Event.make "progress"

  let updateready = Dom.Event.make "updateready"

  let cached = Dom.Event.make "cached"

  let obsolete = Dom.Event.make "obsolete"

  let domContentLoaded = Dom.Event.make "DOMContentLoaded"

  let animationstart = Dom.Event.make "animationstart"

  let animationend = Dom.Event.make "animationend"

  let animationiteration = Dom.Event.make "animationiteration"

  let animationcancel = Dom.Event.make "animationcancel"

  let canplay = Dom.Event.make "canplay"

  let canplaythrough = Dom.Event.make "canplaythrough"

  let durationchange = Dom.Event.make "durationchange"

  let emptied = Dom.Event.make "emptied"

  let ended = Dom.Event.make "ended"

  let gotpointercapture = Dom.Event.make "gotpointercapture"

  let loadeddata = Dom.Event.make "loadeddata"

  let loadedmetadata = Dom.Event.make "loadedmetadata"

  let loadstart = Dom.Event.make "loadstart"

  let lostpointercapture = Dom.Event.make "lostpointercapture"

  let pause = Dom.Event.make "pause"

  let play = Dom.Event.make "play"

  let playing = Dom.Event.make "playing"

  let pointerenter = Dom.Event.make "pointerenter"

  let pointercancel = Dom.Event.make "pointercancel"

  let pointerdown = Dom.Event.make "pointerdown"

  let pointerleave = Dom.Event.make "pointerleave"

  let pointermove = Dom.Event.make "pointermove"

  let pointerout = Dom.Event.make "pointerout"

  let pointerover = Dom.Event.make "pointerover"

  let pointerup = Dom.Event.make "pointerup"

  let ratechange = Dom.Event.make "ratechange"

  let seeked = Dom.Event.make "seeked"

  let seeking = Dom.Event.make "seeking"

  let stalled = Dom.Event.make "stalled"

  let suspend = Dom.Event.make "suspend"

  let volumechange = Dom.Event.make "volumechange"

  let waiting = Dom.Event.make "waiting"

  let make = Dom.Event.make
end

type event_listener_id = Dom.event_listener_id

let addEventListener = Dom.addEventListener

let addEventListenerWithOptions = Dom.addEventListenerWithOptions

let removeEventListener = Dom.removeEventListener

let createCustomEvent = Dom.createCustomEvent

class type ['node] collection =
  object
    method length : int readonly_prop

    method item : int -> 'node t opt meth

    method namedItem : js_string t -> 'node t opt meth
  end

class type htmlElement = element

class type headElement =
  object
    inherit element

    method profile : js_string t prop
  end

class type linkElement =
  object
    inherit element

    method disabled : bool t prop

    method charset : js_string t prop

    method crossorigin : js_string t prop

    method href : js_string t prop

    method hreflang : js_string t prop

    method media : js_string t prop

    method rel : js_string t prop

    method rev : js_string t prop

    method target : js_string t prop

    method _type : js_string t prop
  end

class type titleElement =
  object
    inherit element

    method text : js_string t prop
  end

class type metaElement =
  object
    inherit element

    method content : js_string t prop

    method httpEquiv : js_string t prop

    method name : js_string t prop

    method scheme : js_string t prop
  end

class type baseElement =
  object
    inherit element

    method href : js_string t prop

    method target : js_string t prop
  end

class type styleElement =
  object
    inherit element

    method disabled : bool t prop

    method media : js_string t prop

    method _type : js_string t prop
  end

class type bodyElement = element

class type formElement =
  object
    inherit element

    method elements : element collection t readonly_prop

    method length : int readonly_prop

    method acceptCharset : js_string t prop

    method action : js_string t prop

    method enctype : js_string t prop

    method _method : js_string t prop

    method target : js_string t prop

    method submit : unit meth

    method reset : unit meth

    method onsubmit : ('self t, event t) event_listener writeonly_prop
  end

class type optGroupElement =
  object
    inherit element

    method disabled : bool t prop

    method label : js_string t prop
  end

class type optionElement =
  object
    inherit optGroupElement

    method form : formElement t opt readonly_prop

    method defaultSelected : bool t prop

    method text : js_string t readonly_prop

    method index : int readonly_prop

    method selected : bool t prop

    method value : js_string t prop
  end

class type selectElement =
  object ('self)
    inherit element

    method _type : js_string t readonly_prop

    method selectedIndex : int prop

    method value : js_string t prop

    method length : int prop

    method form : formElement t opt readonly_prop

    method options : optionElement collection t readonly_prop

    method disabled : bool t prop

    method multiple : bool t prop

    method name : js_string t readonly_prop

    method size : int prop

    method tabIndex : int prop

    method add : #optGroupElement t -> #optGroupElement t opt -> unit meth

    method remove : int -> unit meth

    method required : bool t writeonly_prop

    method onchange : ('self t, event t) event_listener prop

    method oninput : ('self t, event t) event_listener prop
  end

class type inputElement =
  object ('self)
    inherit element

    method defaultValue : js_string t prop

    method defaultChecked : js_string t prop

    method form : formElement t opt readonly_prop

    method accept : js_string t prop

    method accessKey : js_string t prop

    method align : js_string t prop

    method alt : js_string t prop

    method checked : bool t prop

    method disabled : bool t prop

    method maxLength : int prop

    method name : js_string t readonly_prop

    method readOnly : bool t prop

    method required : bool t writeonly_prop

    method size : int prop

    method src : js_string t prop

    method tabIndex : int prop

    method _type : js_string t readonly_prop

    method useMap : js_string t prop

    method value : js_string t prop

    method select : unit meth

    method files : File.fileList t optdef readonly_prop

    method placeholder : js_string t writeonly_prop

    method selectionDirection : js_string t prop

    method selectionStart : int prop

    method selectionEnd : int prop

    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, focusEvent t) event_listener prop

    method onfocus : ('self t, focusEvent t) event_listener prop
  end

class type textAreaElement =
  object ('self)
    inherit element

    method defaultValue : js_string t prop

    method form : formElement t opt readonly_prop

    method accessKey : js_string t prop

    method cols : int prop

    method disabled : bool t prop

    method name : js_string t readonly_prop

    method readOnly : bool t prop

    method rows : int prop

    method selectionDirection : js_string t prop

    method selectionEnd : int prop

    method selectionStart : int prop

    method tabIndex : int prop

    method _type : js_string t readonly_prop

    method value : js_string t prop

    method select : unit meth

    method required : bool t writeonly_prop

    method placeholder : js_string t writeonly_prop

    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, focusEvent t) event_listener prop

    method onfocus : ('self t, focusEvent t) event_listener prop
  end

class type buttonElement =
  object
    inherit element

    method form : formElement t opt readonly_prop

    method accessKey : js_string t prop

    method disabled : bool t prop

    method name : js_string t readonly_prop

    method tabIndex : int prop

    method _type : js_string t readonly_prop

    method value : js_string t prop
  end

class type labelElement =
  object
    inherit element

    method form : formElement t opt readonly_prop

    method accessKey : js_string t prop

    method htmlFor : js_string t prop
  end

class type fieldSetElement =
  object
    inherit element

    method form : formElement t opt readonly_prop
  end

class type legendElement =
  object
    inherit element

    method form : formElement t opt readonly_prop

    method accessKey : js_string t prop
  end

class type uListElement = element

class type oListElement = element

class type dListElement = element

class type liElement = element

class type divElement = element

class type paragraphElement = element

class type headingElement = element

class type quoteElement =
  object
    inherit element

    method cite : js_string t prop
  end

class type preElement = element

class type brElement = element

class type hrElement = element

class type modElement =
  object
    inherit element

    method cite : js_string t prop

    method dateTime : js_string t prop
  end

class type anchorElement =
  object
    inherit element

    method accessKey : js_string t prop

    method charset : js_string t prop

    method coords : js_string t prop

    method href : js_string t prop

    method hreflang : js_string t prop

    method name : js_string t prop

    method rel : js_string t prop

    method rev : js_string t prop

    method shape : js_string t prop

    method tabIndex : int prop

    method target : js_string t prop

    method _type : js_string t prop
  end

class type imageElement =
  object ('self)
    inherit element

    method alt : js_string t prop

    method src : js_string t prop

    method useMap : js_string t prop

    method isMap : bool t prop

    method width : int prop

    method height : int prop

    method naturalWidth : int optdef readonly_prop

    method naturalHeight : int optdef readonly_prop

    method complete : bool t prop

    method onload : ('self t, event t) event_listener prop

    method onerror : ('self t, event t) event_listener prop

    method onabort : ('self t, event t) event_listener prop
  end

class type objectElement =
  object
    inherit element

    method form : formElement t opt readonly_prop

    method code : js_string t prop

    method archive : js_string t prop

    method codeBase : js_string t prop

    method codeType : js_string t prop

    method data : js_string t prop

    method declare : bool t prop

    method height : js_string t prop

    method name : js_string t prop

    method standby : js_string t prop

    method tabIndex : int prop

    method _type : js_string t prop

    method useMap : js_string t prop

    method width : js_string t prop

    method document : Dom.element Dom.document t opt readonly_prop
  end

class type paramElement =
  object
    inherit element

    method name : js_string t prop

    method _type : js_string t prop

    method value : js_string t prop

    method valueType : js_string t prop
  end

class type areaElement =
  object
    inherit element

    method accessKey : js_string t prop

    method alt : js_string t prop

    method coords : js_string t prop

    method href : js_string t prop

    method noHref : bool t prop

    method shape : js_string t prop

    method tabIndex : int prop

    method target : js_string t prop
  end

class type mapElement =
  object
    inherit element

    method areas : areaElement collection t readonly_prop

    method name : js_string t prop
  end

class type scriptElement =
  object
    inherit element

    method text : js_string t prop

    method charset : js_string t prop

    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 embedElement =
  object
    inherit element

    method src : js_string t prop

    method height : js_string t prop

    method width : js_string t prop

    method _type : js_string t prop
  end

class type tableCellElement =
  object
    inherit element

    method cellIndex : int readonly_prop

    method abbr : js_string t prop

    method align : js_string t prop

    method axis : js_string t prop

    method ch : js_string t prop

    method chOff : js_string t prop

    method colSpan : int prop

    method headers : js_string t prop

    method rowSpan : int prop

    method scope : js_string t prop

    method vAlign : js_string t prop
  end

class type tableRowElement =
  object
    inherit element

    method rowIndex : int readonly_prop

    method sectionRowIndex : int readonly_prop

    method cells : tableCellElement collection t readonly_prop

    method align : js_string t prop

    method ch : js_string t prop

    method chOff : js_string t prop

    method vAlign : js_string t prop

    method insertCell : int -> tableCellElement t meth

    method deleteCell : int -> unit meth
  end

class type tableColElement =
  object
    inherit element

    method align : js_string t prop

    method ch : js_string t prop

    method chOff : js_string t prop

    method span : int prop

    method vAlign : js_string t prop

    method width : js_string t prop
  end

class type tableSectionElement =
  object
    inherit element

    method align : js_string t prop

    method ch : js_string t prop

    method chOff : js_string t prop

    method vAlign : js_string t prop

    method rows : tableRowElement collection t readonly_prop

    method insertRow : int -> tableRowElement t meth

    method deleteRow : int -> unit meth
  end

class type tableCaptionElement = element

class type tableElement =
  object
    inherit element

    method caption : tableCaptionElement t prop

    method tHead : tableSectionElement t prop

    method tFoot : tableSectionElement t prop

    method rows : tableRowElement collection t readonly_prop

    method tBodies : tableSectionElement collection t readonly_prop

    method align : js_string t prop

    method border : js_string t prop

    method cellPadding : js_string t prop

    method cellSpacing : js_string t prop

    method frame : js_string t prop

    method rules : js_string t prop

    method summary : js_string t prop

    method width : js_string t prop

    method createTHead : tableSectionElement t meth

    method deleteTHead : unit meth

    method createTFoot : tableSectionElement t meth

    method deleteTFoot : unit meth

    method createCaption : tableCaptionElement t meth

    method deleteCaption : unit meth

    method insertRow : int -> tableRowElement t meth

    method deleteRow : int -> unit meth
  end

class type timeRanges =
  object
    method length : int readonly_prop

    method start : int -> float meth

    method end_ : int -> float meth
  end

type networkState =
  | NETWORK_EMPTY
  | NETWORK_IDLE
  | NETWORK_LOADING
  | NETWORK_NO_SOURCE

type readyState =
  | HAVE_NOTHING
  | HAVE_METADATA
  | HAVE_CURRENT_DATA
  | HAVE_FUTURE_DATA
  | HAVE_ENOUGH_DATA

(* http://www.w3schools.com/tags/ref_av_dom.asp *)
(* only features supported by all browser. (IE9+) *)
class type mediaElement =
  object
    inherit element

    method canPlayType : js_string t -> js_string t meth

    method load : unit meth

    method play : unit meth

    method pause : unit meth

    method autoplay : bool t prop

    method buffered : timeRanges t readonly_prop

    method controls : bool t prop

    method currentSrc : js_string t readonly_prop

    method currentTime : float prop

    method duration : float readonly_prop

    method ended : bool t readonly_prop

    method loop : bool t prop

    method mediagroup : js_string t prop

    method muted : bool t prop

    method networkState_int : int readonly_prop

    method networkState : networkState readonly_prop

    method paused : bool t readonly_prop

    method playbackRate : float prop

    method played : timeRanges t readonly_prop

    method preload : js_string t prop

    method readyState_int : int readonly_prop

    method readyState : readyState readonly_prop

    method seekable : timeRanges t readonly_prop

    method seeking : bool t readonly_prop

    method src : js_string t prop

    method volume : float prop

    method oncanplay : ('self t, mediaEvent t) event_listener writeonly_prop

    method oncanplaythrough : ('self t, mediaEvent t) event_listener writeonly_prop

    method ondurationchange : ('self t, mediaEvent t) event_listener writeonly_prop

    method onemptied : ('self t, mediaEvent t) event_listener writeonly_prop

    method onended : ('self t, mediaEvent t) event_listener writeonly_prop

    method onloadeddata : ('self t, mediaEvent t) event_listener writeonly_prop

    method onloadedmetadata : ('self t, mediaEvent t) event_listener writeonly_prop

    method onloadstart : ('self t, mediaEvent t) event_listener writeonly_prop

    method onpause : ('self t, mediaEvent t) event_listener writeonly_prop

    method onplay : ('self t, mediaEvent t) event_listener writeonly_prop

    method onplaying : ('self t, mediaEvent t) event_listener writeonly_prop

    method onratechange : ('self t, mediaEvent t) event_listener writeonly_prop

    method onseeked : ('self t, mediaEvent t) event_listener writeonly_prop

    method onseeking : ('self t, mediaEvent t) event_listener writeonly_prop

    method onstalled : ('self t, mediaEvent t) event_listener writeonly_prop

    method onsuspend : ('self t, mediaEvent t) event_listener writeonly_prop

    method onvolumechange : ('self t, mediaEvent t) event_listener writeonly_prop

    method onwaiting : ('self t, mediaEvent t) event_listener writeonly_prop
  end

class type audioElement =
  object
    inherit mediaElement
  end

class type videoElement =
  object
    inherit mediaElement
  end

type context = js_string t

let _2d_ = Js.string "2d"

type canvasPattern

class type canvasElement =
  object
    inherit element

    method width : int prop

    method height : int prop

    method toDataURL : js_string t meth

    method toDataURL_type : js_string t -> js_string t meth

    method toDataURL_type_compression : js_string t -> float -> js_string t meth

    method getContext : js_string t -> canvasRenderingContext2D t meth
  end

and canvasRenderingContext2D =
  object
    method canvas : canvasElement t readonly_prop

    method save : unit meth

    method restore : unit meth

    method scale : float -> float -> unit meth

    method rotate : float -> unit meth

    method translate : float -> float -> unit meth

    method transform : float -> float -> float -> float -> float -> float -> unit meth

    method setTransform : float -> float -> float -> float -> float -> float -> unit meth

    method globalAlpha : float prop

    method globalCompositeOperation : js_string t prop

    method strokeStyle : js_string t writeonly_prop

    method strokeStyle_gradient : canvasGradient t writeonly_prop

    method strokeStyle_pattern : canvasPattern t writeonly_prop

    method fillStyle : js_string t writeonly_prop

    method fillStyle_gradient : canvasGradient t writeonly_prop

    method fillStyle_pattern : canvasPattern t writeonly_prop

    method createLinearGradient :
      float -> float -> float -> float -> canvasGradient t meth

    method createRadialGradient :
      float -> float -> float -> float -> float -> float -> canvasGradient t meth

    method createPattern : imageElement t -> js_string t -> canvasPattern t meth

    method createPattern_fromCanvas :
      canvasElement t -> js_string t -> canvasPattern t meth

    method createPattern_fromVideo : videoElement t -> js_string t -> canvasPattern t meth

    method lineWidth : float prop

    method lineCap : js_string t prop

    method lineJoin : js_string t prop

    method miterLimit : float prop

    method shadowOffsetX : float prop

    method shadowOffsetY : float prop

    method shadowBlur : float prop

    method shadowColor : js_string t prop

    method clearRect : float -> float -> float -> float -> unit meth

    method fillRect : float -> float -> float -> float -> unit meth

    method strokeRect : float -> float -> float -> float -> unit meth

    method beginPath : unit meth

    method closePath : unit meth

    method moveTo : float -> float -> unit meth

    method lineTo : float -> float -> unit meth

    method quadraticCurveTo : float -> float -> float -> float -> unit meth

    method bezierCurveTo : float -> float -> float -> float -> float -> float -> unit meth

    method arcTo : float -> float -> float -> float -> float -> unit meth

    method rect : float -> float -> float -> float -> unit meth

    method arc : float -> float -> float -> float -> float -> bool t -> unit meth

    method fill : unit meth

    method stroke : unit meth

    method clip : unit meth

    method isPointInPath : float -> float -> bool t meth

    method drawFocusRing : #element t -> float -> float -> bool t -> bool t meth

    method font : js_string t prop

    method textAlign : js_string t prop

    method textBaseline : js_string t prop

    method fillText : js_string t -> float -> float -> unit meth

    method fillText_withWidth : js_string t -> float -> float -> float -> unit meth

    method strokeText : js_string t -> float -> float -> unit meth

    method strokeText_withWidth : js_string t -> float -> float -> float -> unit meth

    method measureText : js_string t -> textMetrics t meth

    method drawImage : imageElement t -> float -> float -> unit meth

    method drawImage_withSize :
      imageElement t -> float -> float -> float -> float -> unit meth

    method drawImage_full :
         imageElement t
      -> float
      -> float
      -> float
      -> float
      -> float
      -> float
      -> float
      -> float
      -> unit meth

    method drawImage_fromCanvas : canvasElement t -> float -> float -> unit meth

    method drawImage_fromCanvasWithSize :
      canvasElement t -> float -> float -> float -> float -> unit meth

    method drawImage_fullFromCanvas :
         canvasElement t
      -> float
      -> float
      -> float
      -> float
      -> float
      -> float
      -> float
      -> float
      -> unit meth

    method drawImage_fromVideoWithVideo : videoElement t -> float -> float -> unit meth

    method drawImage_fromVideoWithSize :
      videoElement t -> float -> float -> float -> float -> unit meth

    method drawImage_fullFromVideo :
         videoElement t
      -> float
      -> float
      -> float
      -> float
      -> float
      -> float
      -> float
      -> float
      -> unit meth

    method createImageData : int -> int -> imageData t meth

    method getImageData : float -> float -> float -> float -> imageData t meth

    method putImageData : imageData t -> float -> float -> unit meth
  end

and canvasGradient =
  object
    method addColorStop : float -> js_string t -> unit meth
  end

and textMetrics =
  object
    method width : float readonly_prop
  end

and imageData =
  object
    method width : int readonly_prop

    method height : int readonly_prop

    method data : canvasPixelArray t readonly_prop
  end

and canvasPixelArray =
  object
    method length : int readonly_prop
  end

external pixel_get : canvasPixelArray t -> int -> int = "caml_js_get"

external pixel_set : canvasPixelArray t -> int -> int -> unit = "caml_js_set"

class type range =
  object
    method collapsed : bool t readonly_prop

    method startOffset : int readonly_prop

    method endOffset : int readonly_prop

    method startContainer : Dom.node t readonly_prop

    method endContainer : Dom.node t readonly_prop

    method setStart : Dom.node t -> int -> unit meth

    method setEnd : Dom.node t -> int -> unit meth

    method setStartBefore : Dom.node t -> unit meth

    method setEndBefore : Dom.node t -> unit meth

    method setStartAfter : Dom.node t -> unit meth

    method setEndAfter : Dom.node t -> unit meth

    method selectNode : Dom.node t -> unit meth

    method selectNodeContents : Dom.node t -> unit meth

    method collapse : bool t -> unit meth

    method cloneContents : Dom.documentFragment t meth

    method extractContents : Dom.documentFragment t meth

    method deleteContents : unit meth

    method insertNode : Dom.node t -> unit meth

    method surroundContents : Dom.node t -> unit meth

    method cloneRange : range t meth

    method toString : js_string t meth
  end

(** Information on current selection *)
class type selection =
  object
    method anchorNode : Dom.node t readonly_prop

    method anchorOffset : int readonly_prop

    method focusNode : Dom.node t readonly_prop

    method focusOffset : int readonly_prop

    method isCollapsed : bool t readonly_prop

    method rangeCount : int readonly_prop

    method getRangeAt : int -> range t meth

    method collapse : bool t -> unit meth

    method extend : Dom.node t -> int -> unit meth

    method modify : js_string t -> js_string t -> js_string t -> unit meth

    method collapseToStart : unit meth

    method collapseToEnd : unit meth

    method selectAllChildren : Dom.node t -> unit meth

    method addRange : range t -> unit meth

    method removeRange : range t -> unit meth

    method removeAllRanges : unit meth

    method deleteFromDocument : unit meth

    method containsNode : Dom.node t -> bool t -> bool t meth

    method toString : js_string t meth
  end

class type document =
  object
    inherit [element] Dom.document

    inherit nodeSelector

    inherit eventTarget

    method title : js_string t prop

    method referrer : 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

    method documentElement : htmlElement t readonly_prop

    method images : imageElement collection t readonly_prop

    method applets : element collection t readonly_prop

    method links : element collection t readonly_prop

    method forms : formElement collection t readonly_prop

    method anchors : element collection t readonly_prop

    method cookie : js_string t prop

    method designMode : js_string t prop

    method open_ : unit meth

    method close : unit meth

    method write : js_string t -> unit meth

    method execCommand : js_string t -> bool t -> js_string t opt -> unit meth

    method createRange : range t meth

    method readyState : js_string t readonly_prop

    method getElementsByClassName : js_string t -> element Dom.nodeList t meth

    method getElementsByName : js_string t -> element Dom.nodeList t meth

    method activeElement : element t opt readonly_prop

    inherit eventTarget
  end

type interval_id

type timeout_id

type animation_frame_request_id

class type location =
  object
    method href : js_string t prop

    method protocol : js_string t prop

    method host : js_string t prop

    method hostname : js_string t prop

    method origin : js_string t optdef readonly_prop

    method port : js_string t prop

    method pathname : js_string t prop

    method search : js_string t prop

    method hash : js_string t prop

    method assign : js_string t -> unit meth

    method replace : js_string t -> unit meth

    method reload : unit meth
  end

let location_origin (loc : location t) =
  Optdef.case
    loc##.origin
    (fun () ->
      let protocol = loc##.protocol in
      let hostname = loc##.hostname in
      let port = loc##.port in
      if protocol##.length = 0 && hostname##.length = 0
      then Js.string ""
      else
        let origin = protocol##concat_2 (Js.string "//") hostname in
        if port##.length > 0 then origin##concat_2 (Js.string ":") loc##.port else origin)
    (fun o -> o)

class type history =
  object
    method length : int readonly_prop

    method state : Js.Unsafe.any readonly_prop

    method go : int opt -> unit meth

    method back : unit meth

    method forward : unit meth

    method pushState : 'a. 'a -> js_string t -> js_string t opt -> unit meth

    method replaceState : 'a. 'a -> js_string t -> js_string t opt -> unit meth
  end

class type undoManager = object end

class type navigator =
  object
    method appCodeName : js_string t readonly_prop

    method appName : js_string t readonly_prop

    method appVersion : js_string t readonly_prop

    method cookieEnabled : bool t readonly_prop

    method onLine : bool t readonly_prop

    method platform : js_string t readonly_prop

    method userAgent : js_string t readonly_prop

    method language : js_string t optdef readonly_prop

    method userLanguage : js_string t optdef readonly_prop
  end

class type screen =
  object
    method width : int readonly_prop

    method height : int readonly_prop

    method availWidth : int readonly_prop

    method availHeight : int readonly_prop
  end

class type applicationCache =
  object
    method status : int readonly_prop

    method update : unit meth

    method abort : unit meth

    method swapCache : unit meth

    method onchecking : (applicationCache t, event t) event_listener prop

    method onerror : (applicationCache t, event t) event_listener prop

    method onnoupdate : (applicationCache t, event t) event_listener prop

    method ondownloading : (applicationCache t, event t) event_listener prop

    method onprogress : (applicationCache t, event t) event_listener prop

    method onupdateready : (applicationCache t, event t) event_listener prop

    method oncached : (applicationCache t, event t) event_listener prop

    method onobsolete : (applicationCache t, event t) event_listener prop

    inherit eventTarget
  end

class type _URL =
  object
    method createObjectURL : #File.blob t -> js_string t meth

    method revokeObjectURL : js_string t -> unit meth
  end

class type window =
  object
    inherit eventTarget

    method document : document t readonly_prop

    method applicationCache : applicationCache t readonly_prop

    method name : js_string t prop

    method location : location t readonly_prop

    method history : history t readonly_prop

    method undoManager : undoManager t readonly_prop

    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 scrollBy : int -> int -> unit meth

    method sessionStorage : storage t optdef readonly_prop

    method localStorage : storage t optdef readonly_prop

    method top : window t readonly_prop

    method parent : window t readonly_prop

    method frameElement : element t opt readonly_prop

    method open_ : js_string t -> js_string t -> js_string t opt -> window t opt meth

    method alert : js_string t -> unit meth

    method confirm : js_string t -> bool t meth

    method prompt : js_string t -> js_string t -> js_string t opt meth

    method print : unit meth

    method setInterval : (unit -> unit) Js.callback -> float -> interval_id meth

    method clearInterval : interval_id -> unit meth

    method setTimeout : (unit -> unit) Js.callback -> float -> timeout_id meth

    method clearTimeout : timeout_id -> unit meth

    method requestAnimationFrame :
      (float -> unit) Js.callback -> animation_frame_request_id meth

    method cancelAnimationFrame : animation_frame_request_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 getComputedStyle : #element t -> cssStyleDeclaration t meth

    method getComputedStyle_pseudoElt :
      #element t -> js_string t -> cssStyleDeclaration t meth

    method atob : js_string t -> js_string t meth

    method btoa : js_string t -> js_string t meth

    method onload : (window t, event t) event_listener prop

    method onunload : (window t, event t) event_listener prop

    method onbeforeunload : (window t, event t) event_listener prop

    method onblur : (window t, focusEvent t) event_listener prop

    method onfocus : (window t, focusEvent t) event_listener prop

    method onresize : (window t, event t) event_listener prop

    method onorientationchange : (window t, event t) event_listener prop

    method onpopstate : (window t, popStateEvent t) event_listener prop

    method onhashchange : (window t, hashChangeEvent t) event_listener prop

    method ononline : (window t, event t) event_listener writeonly_prop

    method onoffline : (window t, event t) event_listener writeonly_prop

    method _URL : _URL t readonly_prop

    method devicePixelRatio : float readonly_prop
  end

let window : window t = Js.Unsafe.global

(* The toplevel object *)

let document = window##.document

let getElementById id =
  Js.Opt.case
    (document##getElementById (Js.string id))
    (fun () -> raise Not_found)
    (fun pnode -> pnode)

let getElementById_exn id =
  Js.Opt.case
    (document##getElementById (Js.string id))
    (fun () -> failwith (Printf.sprintf "getElementById_exn: %S not found" id))
    (fun pnode -> pnode)

let getElementById_opt id = Js.Opt.to_option (document##getElementById (Js.string id))

let getElementById_coerce id coerce =
  Js.Opt.case
    (document##getElementById (Js.string id))
    (fun () -> None)
    (fun e -> Js.Opt.to_option (coerce e))

(****)

class type frameSetElement =
  object
    inherit element

    method cols : js_string t prop

    method rows : js_string t prop
  end

class type frameElement =
  object
    inherit element

    method frameBorder : js_string t prop

    method longDesc : js_string t prop

    method marginHeight : js_string t prop

    method marginWidth : js_string t prop

    method name : js_string t prop

    method noResize : bool t prop

    method scrolling : js_string t prop

    method src : js_string t prop

    method contentDocument : document t opt readonly_prop
  end

class type iFrameElement =
  object
    inherit element

    method frameBorder : js_string t prop

    method height : js_string t prop

    method width : js_string t prop

    method longDesc : js_string t prop

    method marginHeight : js_string t prop

    method marginWidth : js_string t prop

    method name : js_string t prop

    method scrolling : js_string t prop

    method src : js_string t prop

    method contentDocument : document t opt readonly_prop

    method contentWindow : window t readonly_prop
  end

(****)

(*XXX Should provide creation functions a la lablgtk... *)

let opt_iter x f =
  match x with
  | None -> ()
  | Some v -> f v

let createElement (doc : document t) name = doc##createElement (Js.string name)

let unsafeCreateElement doc name = Js.Unsafe.coerce (createElement doc name)

let createElementSyntax = ref `Unknown

let rec unsafeCreateElementEx ?_type ?name doc elt =
  if Poly.(_type = None) && Poly.(name = None)
  then Js.Unsafe.coerce (createElement doc elt)
  else
    match !createElementSyntax with
    | `Standard ->
        let res = Js.Unsafe.coerce (createElement doc elt) in
        opt_iter _type (fun t -> res##._type := t);
        opt_iter name (fun n -> res##.name := n);
        res
    | `Extended ->
        let a = new%js Js.array_empty in
        ignore (a##push_2 (Js.string "<") (Js.string elt));
        opt_iter _type (fun t ->
            ignore (a##push_3 (Js.string " type=\"") (html_escape t) (Js.string "\"")));
        opt_iter name (fun n ->
            ignore (a##push_3 (Js.string " name=\"") (html_escape n) (Js.string "\"")));
        ignore (a##push (Js.string ">"));
        Js.Unsafe.coerce (doc##createElement (a##join (Js.string "")))
    | `Unknown ->
        createElementSyntax :=
          if try
               let el : inputElement Js.t =
                 Js.Unsafe.coerce
                   (document##createElement (Js.string "<input name=\"x\">"))
               in
               el##.tagName##toLowerCase == Js.string "input"
               && el##.name == Js.string "x"
             with _ -> false
          then `Extended
          else `Standard;
        unsafeCreateElementEx ?_type ?name doc elt

let createHtml doc : htmlElement t = unsafeCreateElement doc "html"

let createHead doc : headElement t = unsafeCreateElement doc "head"

let createLink doc : linkElement t = unsafeCreateElement doc "link"

let createTitle doc : titleElement t = unsafeCreateElement doc "title"

let createMeta doc : metaElement t = unsafeCreateElement doc "meta"

let createBase doc : baseElement t = unsafeCreateElement doc "base"

let createStyle doc : styleElement t = unsafeCreateElement doc "style"

let createBody doc : bodyElement t = unsafeCreateElement doc "body"

let createForm doc : formElement t = unsafeCreateElement doc "form"

let createOptgroup doc : optGroupElement t = unsafeCreateElement doc "optgroup"

let createOption doc : optionElement t = unsafeCreateElement doc "option"

let createSelect ?_type ?name doc : selectElement t =
  unsafeCreateElementEx ?_type ?name doc "select"

let createInput ?_type ?name doc : inputElement t =
  unsafeCreateElementEx ?_type ?name doc "input"

let createTextarea ?_type ?name doc : textAreaElement t =
  unsafeCreateElementEx ?_type ?name doc "textarea"

let createButton ?_type ?name doc : buttonElement t =
  unsafeCreateElementEx ?_type ?name doc "button"

let createLabel doc : labelElement t = unsafeCreateElement doc "label"

let createFieldset doc : fieldSetElement t = unsafeCreateElement doc "fieldset"

let createLegend doc : legendElement t = unsafeCreateElement doc "legend"

let createUl doc : uListElement t = unsafeCreateElement doc "ul"

let createOl doc : oListElement t = unsafeCreateElement doc "ol"

let createDl doc : dListElement t = unsafeCreateElement doc "dl"

let createLi doc : liElement t = unsafeCreateElement doc "li"

let createDiv doc : divElement t = unsafeCreateElement doc "div"

let createEmbed doc : embedElement t = unsafeCreateElement doc "embed"

let createP doc : paragraphElement t = unsafeCreateElement doc "p"

let createH1 doc : headingElement t = unsafeCreateElement doc "h1"

let createH2 doc : headingElement t = unsafeCreateElement doc "h2"

let createH3 doc : headingElement t = unsafeCreateElement doc "h3"

let createH4 doc : headingElement t = unsafeCreateElement doc "h4"

let createH5 doc : headingElement t = unsafeCreateElement doc "h5"

let createH6 doc : headingElement t = unsafeCreateElement doc "h6"

let createQ doc : quoteElement t = unsafeCreateElement doc "q"

let createBlockquote doc : quoteElement t = unsafeCreateElement doc "blockquote"

let createPre doc : preElement t = unsafeCreateElement doc "pre"

let createBr doc : brElement t = unsafeCreateElement doc "br"

let createHr doc : hrElement t = unsafeCreateElement doc "hr"

let createIns doc : modElement t = unsafeCreateElement doc "ins"

let createDel doc : modElement t = unsafeCreateElement doc "del"

let createA doc : anchorElement t = unsafeCreateElement doc "a"

let createImg doc : imageElement t = unsafeCreateElement doc "img"

let createObject doc : objectElement t = unsafeCreateElement doc "object"

let createParam doc : paramElement t = unsafeCreateElement doc "param"

let createMap doc : mapElement t = unsafeCreateElement doc "map"

let createArea doc : areaElement t = unsafeCreateElement doc "area"

let createScript doc : scriptElement t = unsafeCreateElement doc "script"

let createTable doc : tableElement t = unsafeCreateElement doc "table"

let createCaption doc : tableCaptionElement t = unsafeCreateElement doc "caption"

let createCol doc : tableColElement t = unsafeCreateElement doc "col"

let createColgroup doc : tableColElement t = unsafeCreateElement doc "colgroup"

let createThead doc : tableSectionElement t = unsafeCreateElement doc "thead"

let createTfoot doc : tableSectionElement t = unsafeCreateElement doc "tfoot"

let createTbody doc : tableSectionElement t = unsafeCreateElement doc "tbody"

let createTr doc : tableRowElement t = unsafeCreateElement doc "tr"

let createTh doc : tableCellElement t = unsafeCreateElement doc "th"

let createTd doc : tableCellElement t = unsafeCreateElement doc "td"

let createSub doc = createElement doc "sub"

let createSup doc = createElement doc "sup"

let createSpan doc = createElement doc "span"

let createTt doc = createElement doc "tt"

let createI doc = createElement doc "i"

let createB doc = createElement doc "b"

let createBig doc = createElement doc "big"

let createSmall doc = createElement doc "small"

let createEm doc = createElement doc "em"

let createStrong doc = createElement doc "strong"

let createCite doc = createElement doc "cite"

let createDfn doc = createElement doc "dfn"

let createCode doc = createElement doc "code"

let createSamp doc = createElement doc "samp"

let createKbd doc = createElement doc "kbd"

let createVar doc = createElement doc "var"

let createAbbr doc = createElement doc "abbr"

let createDd doc = createElement doc "dd"

let createDt doc = createElement doc "dt"

let createNoscript doc = createElement doc "noscript"

let createAddress doc = createElement doc "address"

let createFrameset doc : frameSetElement t = unsafeCreateElement doc "frameset"

let createFrame doc : frameElement t = unsafeCreateElement doc "frame"

let createIframe doc : iFrameElement t = unsafeCreateElement doc "iframe"

let createAudio doc : audioElement t = unsafeCreateElement doc "audio"

let createVideo doc : audioElement t = unsafeCreateElement doc "video"

exception Canvas_not_available

let createCanvas doc : canvasElement t =
  let c = unsafeCreateElement doc "canvas" in
  if not (Opt.test c##.getContext) then raise Canvas_not_available;
  c

let html_element : htmlElement t constr = Js.Unsafe.global##._HTMLElement

module CoerceTo = struct
  let element : #Dom.node Js.t -> element Js.t Js.opt =
    if def html_element == undefined
    then
      (* ie < 9 does not have HTMLElement: we have to cheat to check
        that something is an html element *)
      fun e ->
      if def (Js.Unsafe.coerce e)##.innerHTML == undefined
      then Js.null
      else Js.some (Js.Unsafe.coerce e)
    else
      fun e ->
      if Js.instanceof e html_element then Js.some (Js.Unsafe.coerce e) else Js.null

  let unsafeCoerce tag (e : #element t) =
    if e##.tagName##toLowerCase == Js.string tag
    then Js.some (Js.Unsafe.coerce e)
    else Js.null

  let a e = unsafeCoerce "a" e

  let area e = unsafeCoerce "area" e

  let base e = unsafeCoerce "base" e

  let blockquote e = unsafeCoerce "blockquote" e

  let body e = unsafeCoerce "body" e

  let br e = unsafeCoerce "br" e

  let button e = unsafeCoerce "button" e

  let canvas e = unsafeCoerce "canvas" e

  let caption e = unsafeCoerce "caption" e

  let col e = unsafeCoerce "col" e

  let colgroup e = unsafeCoerce "colgroup" e

  let del e = unsafeCoerce "del" e

  let div e = unsafeCoerce "div" e

  let dl e = unsafeCoerce "dl" e

  let fieldset e = unsafeCoerce "fieldset" e

  let embed e = unsafeCoerce "embed" e

  let form e = unsafeCoerce "form" e

  let frameset e = unsafeCoerce "frameset" e

  let frame e = unsafeCoerce "frame" e

  let h1 e = unsafeCoerce "h1" e

  let h2 e = unsafeCoerce "h2" e

  let h3 e = unsafeCoerce "h3" e

  let h4 e = unsafeCoerce "h4" e

  let h5 e = unsafeCoerce "h5" e

  let h6 e = unsafeCoerce "h6" e

  let head e = unsafeCoerce "head" e

  let hr e = unsafeCoerce "hr" e

  let html e = unsafeCoerce "html" e

  let iframe e = unsafeCoerce "iframe" e

  let img e = unsafeCoerce "img" e

  let input e = unsafeCoerce "input" e

  let ins e = unsafeCoerce "ins" e

  let label e = unsafeCoerce "label" e

  let legend e = unsafeCoerce "legend" e

  let li e = unsafeCoerce "li" e

  let link e = unsafeCoerce "link" e

  let map e = unsafeCoerce "map" e

  let meta e = unsafeCoerce "meta" e

  let _object e = unsafeCoerce "object" e

  let ol e = unsafeCoerce "ol" e

  let optgroup e = unsafeCoerce "optgroup" e

  let option e = unsafeCoerce "option" e

  let p e = unsafeCoerce "p" e

  let param e = unsafeCoerce "param" e

  let pre e = unsafeCoerce "pre" e

  let q e = unsafeCoerce "q" e

  let script e = unsafeCoerce "script" e

  let select e = unsafeCoerce "select" e

  let style e = unsafeCoerce "style" e

  let table e = unsafeCoerce "table" e

  let tbody e = unsafeCoerce "tbody" e

  let td e = unsafeCoerce "td" e

  let textarea e = unsafeCoerce "textarea" e

  let tfoot e = unsafeCoerce "tfoot" e

  let th e = unsafeCoerce "th" e

  let thead e = unsafeCoerce "thead" e

  let title e = unsafeCoerce "title" e

  let tr e = unsafeCoerce "tr" e

  let ul e = unsafeCoerce "ul" e

  let audio e = unsafeCoerce "audio" e

  let video e = unsafeCoerce "video" e

  let unsafeCoerceEvent constr (ev : #event t) =
    if def constr != undefined && Js.instanceof ev constr
    then Js.some (Js.Unsafe.coerce ev)
    else Js.null

  let mouseEvent ev = unsafeCoerceEvent Js.Unsafe.global##._MouseEvent ev

  let keyboardEvent ev = unsafeCoerceEvent Js.Unsafe.global##._KeyboardEvent ev

  let wheelEvent ev = unsafeCoerceEvent Js.Unsafe.global##._WheelEvent ev

  let mouseScrollEvent ev = unsafeCoerceEvent Js.Unsafe.global##._MouseScrollEvent ev

  let popStateEvent ev = unsafeCoerceEvent Js.Unsafe.global##._PopStateEvent ev
end

(****)

let eventTarget = Dom.eventTarget

let eventRelatedTarget (e : #mouseEvent t) =
  Optdef.get e##.relatedTarget (fun () ->
      match Js.to_string e##._type with
      | "mouseover" -> Optdef.get e##.fromElement (fun () -> assert false)
      | "mouseout" -> Optdef.get e##.toElement (fun () -> assert false)
      | _ -> Js.null)

let eventAbsolutePosition' (e : #mouseEvent t) =
  let body = document##.body in
  let html = document##.documentElement in
  ( e##.clientX + body##.scrollLeft + html##.scrollLeft
  , e##.clientY + body##.scrollTop + html##.scrollTop )

let eventAbsolutePosition (e : #mouseEvent t) =
  Optdef.case
    e##.pageX
    (fun () -> eventAbsolutePosition' e)
    (fun x -> Optdef.case e##.pageY (fun () -> eventAbsolutePosition' e) (fun y -> x, y))

let elementClientPosition (e : #element t) =
  let r = e##getBoundingClientRect in
  let body = document##.body in
  let html = document##.documentElement in
  ( truncate r##.left - body##.clientLeft - html##.clientLeft
  , truncate r##.top - body##.clientTop - html##.clientTop )

let getDocumentScroll () =
  let body = document##.body in
  let html = document##.documentElement in
  body##.scrollLeft + html##.scrollLeft, body##.scrollTop + html##.scrollTop

let buttonPressed (ev : #mouseEvent Js.t) =
  Js.Optdef.case
    ev##.which
    (fun () ->
      match ev##.button with
      | 1 -> Left_button
      | 2 -> Right_button
      | 4 -> Middle_button
      | _ -> No_button)
    (fun x -> x)

let hasMousewheelEvents () =
  let d = createDiv document in
  d##setAttribute (Js.string "onmousewheel") (Js.string "return;");
  Js.typeof (Js.Unsafe.get d (Js.string "onmousewheel")) == Js.string "function"

let addMousewheelEventListenerWithOptions e ?capture ?once ?passive h =
  if hasMousewheelEvents ()
  then
    addEventListenerWithOptions
      ?capture
      ?once
      ?passive
      e
      Event.mousewheel
      (handler (fun (e : mousewheelEvent t) ->
           let dx = -Optdef.get e##.wheelDeltaX (fun () -> 0) / 40 in
           let dy = -Optdef.get e##.wheelDeltaY (fun () -> e##.wheelDelta) / 40 in
           h (e :> mouseEvent t) ~dx ~dy))
  else
    addEventListenerWithOptions
      ?capture
      ?once
      ?passive
      e
      Event._DOMMouseScroll
      (handler (fun (e : mouseScrollEvent t) ->
           let d = e##.detail in
           if e##.axis == e##._HORIZONTAL_AXIS
           then h (e :> mouseEvent t) ~dx:d ~dy:0
           else h (e :> mouseEvent t) ~dx:0 ~dy:d))

let addMousewheelEventListener e h capt =
  addMousewheelEventListenerWithOptions ~capture:capt e h

(*****)

module Keyboard_code = struct
  type t =
    | Unidentified
    (* Alphabetic Characters *)
    | KeyA
    | KeyB
    | KeyC
    | KeyD
    | KeyE
    | KeyF
    | KeyG
    | KeyH
    | KeyI
    | KeyJ
    | KeyK
    | KeyL
    | KeyM
    | KeyN
    | KeyO
    | KeyP
    | KeyQ
    | KeyR
    | KeyS
    | KeyT
    | KeyU
    | KeyV
    | KeyW
    | KeyX
    | KeyY
    | KeyZ
    (* Digits *)
    | Digit0
    | Digit1
    | Digit2
    | Digit3
    | Digit4
    | Digit5
    | Digit6
    | Digit7
    | Digit8
    | Digit9
    | Minus
    | Equal
    (* Whitespace *)
    | Tab
    | Enter
    | Space
    (* Editing *)
    | Escape
    | Backspace
    | Insert
    | Delete
    | CapsLock
    (* Misc Printable *)
    | BracketLeft
    | BracketRight
    | Semicolon
    | Quote
    | Backquote
    | Backslash
    | Comma
    | Period
    | Slash
    (* Function keys *)
    | F1
    | F2
    | F3
    | F4
    | F5
    | F6
    | F7
    | F8
    | F9
    | F10
    | F11
    | F12
    (* Numpad keys *)
    | Numpad0
    | Numpad1
    | Numpad2
    | Numpad3
    | Numpad4
    | Numpad5
    | Numpad6
    | Numpad7
    | Numpad8
    | Numpad9
    | NumpadMultiply
    | NumpadSubtract
    | NumpadAdd
    | NumpadDecimal
    | NumpadEqual
    | NumpadEnter
    | NumpadDivide
    | NumLock
    (* Modifier keys *)
    | ControlLeft
    | ControlRight
    | MetaLeft
    | MetaRight
    | ShiftLeft
    | ShiftRight
    | AltLeft
    | AltRight
    (* Arrow keys *)
    | ArrowLeft
    | ArrowRight
    | ArrowUp
    | ArrowDown
    (* Navigation *)
    | PageUp
    | PageDown
    | Home
    | End
    (* Sound *)
    | VolumeMute
    | VolumeDown
    | VolumeUp
    (* Media *)
    | MediaTrackPrevious
    | MediaTrackNext
    | MediaPlayPause
    | MediaStop
    (* Browser special *)
    | ContextMenu
    | BrowserSearch
    | BrowserHome
    | BrowserFavorites
    | BrowserRefresh
    | BrowserStop
    | BrowserForward
    | BrowserBack
    (* Misc *)
    | OSLeft
    | OSRight
    | ScrollLock
    | PrintScreen
    | IntlBackslash
    | IntlYen
    | Pause

  let try_code v =
    match Js.to_string v with
    (* Alphabetic Characters *)
    | "KeyA" -> KeyA
    | "KeyB" -> KeyB
    | "KeyC" -> KeyC
    | "KeyD" -> KeyD
    | "KeyE" -> KeyE
    | "KeyF" -> KeyF
    | "KeyG" -> KeyG
    | "KeyH" -> KeyH
    | "KeyI" -> KeyI
    | "KeyJ" -> KeyJ
    | "KeyK" -> KeyK
    | "KeyL" -> KeyL
    | "KeyM" -> KeyM
    | "KeyN" -> KeyN
    | "KeyO" -> KeyO
    | "KeyP" -> KeyP
    | "KeyQ" -> KeyQ
    | "KeyR" -> KeyR
    | "KeyS" -> KeyS
    | "KeyT" -> KeyT
    | "KeyU" -> KeyU
    | "KeyV" -> KeyV
    | "KeyW" -> KeyW
    | "KeyX" -> KeyX
    | "KeyY" -> KeyY
    | "KeyZ" -> KeyZ
    (* Digits *)
    | "Digit0" -> Digit0
    | "Digit1" -> Digit1
    | "Digit2" -> Digit2
    | "Digit3" -> Digit3
    | "Digit4" -> Digit4
    | "Digit5" -> Digit5
    | "Digit6" -> Digit6
    | "Digit7" -> Digit7
    | "Digit8" -> Digit8
    | "Digit9" -> Digit9
    | "Minus" -> Minus
    | "Equal" -> Equal
    (* Whitespace *)
    | "Tab" -> Tab
    | "Enter" -> Enter
    | "Space" -> Space
    (* Editing *)
    | "Escape" -> Escape
    | "Backspace" -> Backspace
    | "Insert" -> Insert
    | "Delete" -> Delete
    | "CapsLock" -> CapsLock
    (* Misc Printable *)
    | "BracketLeft" -> BracketLeft
    | "BracketRight" -> BracketRight
    | "Semicolon" -> Semicolon
    | "Quote" -> Quote
    | "Backquote" -> Backquote
    | "Backslash" -> Backslash
    | "Comma" -> Comma
    | "Period" -> Period
    | "Slash" -> Slash
    (* Function keys *)
    | "F1" -> F1
    | "F2" -> F2
    | "F3" -> F3
    | "F4" -> F4
    | "F5" -> F5
    | "F6" -> F6
    | "F7" -> F7
    | "F8" -> F8
    | "F9" -> F9
    | "F10" -> F10
    | "F11" -> F11
    | "F12" -> F12
    (* Numpad keys *)
    | "Numpad0" -> Numpad0
    | "Numpad1" -> Numpad1
    | "Numpad2" -> Numpad2
    | "Numpad3" -> Numpad3
    | "Numpad4" -> Numpad4
    | "Numpad5" -> Numpad5
    | "Numpad6" -> Numpad6
    | "Numpad7" -> Numpad7
    | "Numpad8" -> Numpad8
    | "Numpad9" -> Numpad9
    | "NumpadMultiply" -> NumpadMultiply
    | "NumpadSubtract" -> NumpadSubtract
    | "NumpadAdd" -> NumpadAdd
    | "NumpadDecimal" -> NumpadDecimal
    | "NumpadEqual" -> NumpadEqual
    | "NumpadEnter" -> NumpadEnter
    | "NumpadDivide" -> NumpadDivide
    | "NumLock" -> NumLock
    (* Modifier keys *)
    | "ControlLeft" -> ControlLeft
    | "ControlRight" -> ControlRight
    | "MetaLeft" -> MetaLeft
    | "MetaRight" -> MetaRight
    | "ShiftLeft" -> ShiftLeft
    | "ShiftRight" -> ShiftRight
    | "AltLeft" -> AltLeft
    | "AltRight" -> AltRight
    (* Arrow keys *)
    | "ArrowLeft" -> ArrowLeft
    | "ArrowRight" -> ArrowRight
    | "ArrowUp" -> ArrowUp
    | "ArrowDown" -> ArrowDown
    (* Navigation *)
    | "PageUp" -> PageUp
    | "PageDown" -> PageDown
    | "Home" -> Home
    | "End" -> End
    (* Sound *)
    | "VolumeMute" -> VolumeMute
    | "VolumeDown" -> VolumeDown
    | "VolumeUp" -> VolumeUp
    (* Media *)
    | "MediaTrackPrevious" -> MediaTrackPrevious
    | "MediaTrackNext" -> MediaTrackNext
    | "MediaPlayPause" -> MediaPlayPause
    | "MediaStop" -> MediaStop
    (* Browser special *)
    | "ContextMenu" -> ContextMenu
    | "BrowserSearch" -> BrowserSearch
    | "BrowserHome" -> BrowserHome
    | "BrowserFavorites" -> BrowserFavorites
    | "BrowserRefresh" -> BrowserRefresh
    | "BrowserStop" -> BrowserStop
    | "BrowserForward" -> BrowserForward
    | "BrowserBack" -> BrowserBack
    (* Misc *)
    | "OSLeft" -> OSLeft
    | "OSRight" -> OSRight
    | "ScrollLock" -> ScrollLock
    | "PrintScreen" -> PrintScreen
    | "IntlBackslash" -> IntlBackslash
    | "IntlYen" -> IntlYen
    | "Pause" -> Pause
    | _ -> Unidentified

  let try_key_code_left = function
    | 16 -> ShiftLeft
    | 17 -> ControlLeft
    | 18 -> AltLeft
    | 91 -> MetaLeft
    | _ -> Unidentified

  let try_key_code_right = function
    | 16 -> ShiftRight
    | 17 -> ControlRight
    | 18 -> AltRight
    | 91 -> MetaRight
    | _ -> Unidentified

  let try_key_code_numpad = function
    | 46 -> NumpadDecimal
    | 45 -> Numpad0
    | 35 -> Numpad1
    | 40 -> Numpad2
    | 34 -> Numpad3
    | 37 -> Numpad4
    | 12 -> Numpad5
    | 39 -> Numpad6
    | 36 -> Numpad7
    | 38 -> Numpad8
    | 33 -> Numpad9
    | 13 -> NumpadEnter
    | 111 -> NumpadDivide
    | 107 -> NumpadAdd
    | 109 -> NumpadSubtract
    | 106 -> NumpadMultiply
    | 110 -> NumpadDecimal
    | 96 -> Numpad0
    | 97 -> Numpad1
    | 98 -> Numpad2
    | 99 -> Numpad3
    | 100 -> Numpad4
    | 101 -> Numpad5
    | 102 -> Numpad6
    | 103 -> Numpad7
    | 104 -> Numpad8
    | 105 -> Numpad9
    | _ -> Unidentified

  let try_key_code_normal = function
    | 27 -> Escape
    | 112 -> F1
    | 113 -> F2
    | 114 -> F3
    | 115 -> F4
    | 116 -> F5
    | 117 -> F6
    | 118 -> F7
    | 119 -> F8
    | 120 -> F9
    | 121 -> F10
    | 122 -> F11
    | 123 -> F12
    | 42 -> PrintScreen
    | 145 -> ScrollLock
    | 19 -> Pause
    | 192 -> Backquote
    | 49 -> Digit1
    | 50 -> Digit2
    | 51 -> Digit3
    | 52 -> Digit4
    | 53 -> Digit5
    | 54 -> Digit6
    | 55 -> Digit7
    | 56 -> Digit8
    | 57 -> Digit9
    | 48 -> Digit0
    | 189 -> Minus
    | 187 -> Equal
    | 8 -> Backspace
    | 9 -> Tab
    | 81 -> KeyQ
    | 87 -> KeyW
    | 69 -> KeyE
    | 82 -> KeyR
    | 84 -> KeyT
    | 89 -> KeyY
    | 85 -> KeyU
    | 73 -> KeyI
    | 79 -> KeyO
    | 80 -> KeyP
    | 219 -> BracketLeft
    | 221 -> BracketRight
    | 220 -> Backslash
    | 20 -> CapsLock
    | 65 -> KeyA
    | 83 -> KeyS
    | 68 -> KeyD
    | 70 -> KeyF
    | 71 -> KeyG
    | 72 -> KeyH
    | 74 -> KeyJ
    | 75 -> KeyK
    | 76 -> KeyL
    | 186 -> Semicolon
    | 222 -> Quote
    | 13 -> Enter
    | 90 -> KeyZ
    | 88 -> KeyX
    | 67 -> KeyC
    | 86 -> KeyV
    | 66 -> KeyB
    | 78 -> KeyN
    | 77 -> KeyM
    | 188 -> Comma
    | 190 -> Period
    | 191 -> Slash
    | 32 -> Space
    | 93 -> ContextMenu
    | 45 -> Insert
    | 36 -> Home
    | 33 -> PageUp
    | 46 -> Delete
    | 35 -> End
    | 34 -> PageDown
    | 37 -> ArrowLeft
    | 40 -> ArrowDown
    | 39 -> ArrowRight
    | 38 -> ArrowUp
    | _ -> Unidentified

  let make_unidentified _ = Unidentified

  let try_next value f = function
    | Unidentified -> Optdef.case value make_unidentified f
    | v -> v

  let run_next value f = function
    | Unidentified -> f value
    | v -> v

  let get_key_code evt = evt##.keyCode

  let try_key_location evt =
    match evt##.location with
    | 1 -> run_next (get_key_code evt) try_key_code_left
    | 2 -> run_next (get_key_code evt) try_key_code_right
    | 3 -> run_next (get_key_code evt) try_key_code_numpad
    | _ -> make_unidentified

  let ( |> ) x f = f x

  let of_event evt =
    Unidentified
    |> try_next evt##.code try_code
    |> try_key_location evt
    |> run_next (get_key_code evt) try_key_code_normal

  let of_key_code = try_key_code_normal
end

module Keyboard_key = struct
  type t = Uchar.t option

  let char_of_int value =
    if 0 < value then try Some (Uchar.of_int value) with _ -> None else None

  let empty_string _ = Js.string ""

  let none _ = None

  let of_event evt =
    let key = Optdef.get evt##.key empty_string in
    match key##.length with
    | 0 -> Optdef.case evt##.charCode none char_of_int
    | 1 -> char_of_int (int_of_float (key##charCodeAt 0))
    | _ -> None
end

(*****)

let element : #Dom.element t -> element t = Js.Unsafe.coerce

type taggedElement =
  | A of anchorElement t
  | Area of areaElement t
  | Audio of audioElement t
  | Base of baseElement t
  | Blockquote of quoteElement t
  | Body of bodyElement t
  | Br of brElement t
  | Button of buttonElement t
  | Canvas of canvasElement t
  | Caption of tableCaptionElement t
  | Col of tableColElement t
  | Colgroup of tableColElement t
  | Del of modElement t
  | Div of divElement t
  | Dl of dListElement t
  | Embed of embedElement t
  | Fieldset of fieldSetElement t
  | Form of formElement t
  | Frameset of frameSetElement t
  | Frame of frameElement t
  | H1 of headingElement t
  | H2 of headingElement t
  | H3 of headingElement t
  | H4 of headingElement t
  | H5 of headingElement t
  | H6 of headingElement t
  | Head of headElement t
  | Hr of hrElement t
  | Html of htmlElement t
  | Iframe of iFrameElement t
  | Img of imageElement t
  | Input of inputElement t
  | Ins of modElement t
  | Label of labelElement t
  | Legend of legendElement t
  | Li of liElement t
  | Link of linkElement t
  | Map of mapElement t
  | Meta of metaElement t
  | Object of objectElement t
  | Ol of oListElement t
  | Optgroup of optGroupElement t
  | Option of optionElement t
  | P of paramElement t
  | Param of paramElement t
  | Pre of preElement t
  | Q of quoteElement t
  | Script of scriptElement t
  | Select of selectElement t
  | Style of styleElement t
  | Table of tableElement t
  | Tbody of tableSectionElement t
  | Td of tableCellElement t
  | Textarea of textAreaElement t
  | Tfoot of tableSectionElement t
  | Th of tableCellElement t
  | Thead of tableSectionElement t
  | Title of titleElement t
  | Tr of tableRowElement t
  | Ul of uListElement t
  | Video of videoElement t
  | Other of element t

let other e = Other (e : #element t :> element t)

let tagged (e : #element t) =
  let tag = Js.to_bytestring e##.tagName##toLowerCase in
  if String.length tag = 0
  then other e
  else
    match String.unsafe_get tag 0 with
    | 'a' -> (
        match tag with
        | "a" -> A (Js.Unsafe.coerce e)
        | "area" -> Area (Js.Unsafe.coerce e)
        | "audio" -> Audio (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'b' -> (
        match tag with
        | "base" -> Base (Js.Unsafe.coerce e)
        | "blockquote" -> Blockquote (Js.Unsafe.coerce e)
        | "body" -> Body (Js.Unsafe.coerce e)
        | "br" -> Br (Js.Unsafe.coerce e)
        | "button" -> Button (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'c' -> (
        match tag with
        | "canvas" -> Canvas (Js.Unsafe.coerce e)
        | "caption" -> Caption (Js.Unsafe.coerce e)
        | "col" -> Col (Js.Unsafe.coerce e)
        | "colgroup" -> Colgroup (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'd' -> (
        match tag with
        | "del" -> Del (Js.Unsafe.coerce e)
        | "div" -> Div (Js.Unsafe.coerce e)
        | "dl" -> Dl (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'e' -> (
        match tag with
        | "embed" -> Embed (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'f' -> (
        match tag with
        | "fieldset" -> Fieldset (Js.Unsafe.coerce e)
        | "form" -> Form (Js.Unsafe.coerce e)
        | "frameset" -> Frameset (Js.Unsafe.coerce e)
        | "frame" -> Frame (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'h' -> (
        match tag with
        | "h1" -> H1 (Js.Unsafe.coerce e)
        | "h2" -> H2 (Js.Unsafe.coerce e)
        | "h3" -> H3 (Js.Unsafe.coerce e)
        | "h4" -> H4 (Js.Unsafe.coerce e)
        | "h5" -> H5 (Js.Unsafe.coerce e)
        | "h6" -> H6 (Js.Unsafe.coerce e)
        | "head" -> Head (Js.Unsafe.coerce e)
        | "hr" -> Hr (Js.Unsafe.coerce e)
        | "html" -> Html (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'i' -> (
        match tag with
        | "iframe" -> Iframe (Js.Unsafe.coerce e)
        | "img" -> Img (Js.Unsafe.coerce e)
        | "input" -> Input (Js.Unsafe.coerce e)
        | "ins" -> Ins (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'l' -> (
        match tag with
        | "label" -> Label (Js.Unsafe.coerce e)
        | "legend" -> Legend (Js.Unsafe.coerce e)
        | "li" -> Li (Js.Unsafe.coerce e)
        | "link" -> Link (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'm' -> (
        match tag with
        | "map" -> Map (Js.Unsafe.coerce e)
        | "meta" -> Meta (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'o' -> (
        match tag with
        | "object" -> Object (Js.Unsafe.coerce e)
        | "ol" -> Ol (Js.Unsafe.coerce e)
        | "optgroup" -> Optgroup (Js.Unsafe.coerce e)
        | "option" -> Option (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'p' -> (
        match tag with
        | "p" -> P (Js.Unsafe.coerce e)
        | "param" -> Param (Js.Unsafe.coerce e)
        | "pre" -> Pre (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'q' -> (
        match tag with
        | "q" -> Q (Js.Unsafe.coerce e)
        | _ -> other e)
    | 's' -> (
        match tag with
        | "script" -> Script (Js.Unsafe.coerce e)
        | "select" -> Select (Js.Unsafe.coerce e)
        | "style" -> Style (Js.Unsafe.coerce e)
        | _ -> other e)
    | 't' -> (
        match tag with
        | "table" -> Table (Js.Unsafe.coerce e)
        | "tbody" -> Tbody (Js.Unsafe.coerce e)
        | "td" -> Td (Js.Unsafe.coerce e)
        | "textarea" -> Textarea (Js.Unsafe.coerce e)
        | "tfoot" -> Tfoot (Js.Unsafe.coerce e)
        | "th" -> Th (Js.Unsafe.coerce e)
        | "thead" -> Thead (Js.Unsafe.coerce e)
        | "title" -> Title (Js.Unsafe.coerce e)
        | "tr" -> Tr (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'u' -> (
        match tag with
        | "ul" -> Ul (Js.Unsafe.coerce e)
        | _ -> other e)
    | 'v' -> (
        match tag with
        | "video" -> Video (Js.Unsafe.coerce e)
        | _ -> other e)
    | _ -> other e

let opt_tagged e = Opt.case e (fun () -> None) (fun e -> Some (tagged e))

type taggedEvent =
  | MouseEvent of mouseEvent t
  | KeyboardEvent of keyboardEvent t
  | MousewheelEvent of mousewheelEvent t
  | MouseScrollEvent of mouseScrollEvent t
  | PopStateEvent of popStateEvent t
  | OtherEvent of event t

let taggedEvent (ev : #event Js.t) =
  Js.Opt.case
    (CoerceTo.mouseEvent ev)
    (fun () ->
      Js.Opt.case
        (CoerceTo.keyboardEvent ev)
        (fun () ->
          Js.Opt.case
            (CoerceTo.wheelEvent ev)
            (fun () ->
              Js.Opt.case
                (CoerceTo.mouseScrollEvent ev)
                (fun () ->
                  Js.Opt.case
                    (CoerceTo.popStateEvent ev)
                    (fun () -> OtherEvent (ev :> event t))
                    (fun ev -> PopStateEvent ev))
                (fun ev -> MouseScrollEvent ev))
            (fun ev -> MousewheelEvent ev))
        (fun ev -> KeyboardEvent ev))
    (fun ev -> MouseEvent ev)

let opt_taggedEvent ev = Opt.case ev (fun () -> None) (fun ev -> Some (taggedEvent ev))

let stopPropagation ev =
  let e = Js.Unsafe.coerce ev in
  Optdef.case
    e##.stopPropagation
    (fun () -> e##.cancelBubble := Js._true)
    (fun _ -> e##_stopPropagation)

let _requestAnimationFrame : (unit -> unit) Js.callback -> unit =
  Js.Unsafe.pure_expr (fun _ ->
      let w = Js.Unsafe.coerce window in
      let l =
        [ w##.requestAnimationFrame
        ; w##.mozRequestAnimationFrame
        ; w##.webkitRequestAnimationFrame
        ; w##.oRequestAnimationFrame
        ; w##.msRequestAnimationFrame
        ]
      in
      try
        let req = List.find (fun c -> Js.Optdef.test c) l in
        fun callback -> Js.Unsafe.fun_call req [| Js.Unsafe.inject callback |]
      with Not_found ->
        let now () = (new%js Js.date_now)##getTime in
        let last = ref (now ()) in
        fun callback ->
          let t = now () in
          let dt = !last +. (1000. /. 60.) -. t in
          let dt = if Poly.(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

let hasPlaceholder () =
  let i = createInput document in
  Js.Optdef.test (Js.Unsafe.coerce i)##.placeholder

let hasRequired () =
  let i = createInput document in
  Js.Optdef.test (Js.Unsafe.coerce i)##.required

let overflow_limit = 2147483_000.

(* ms *)

type timeout_id_safe = timeout_id option ref

let setTimeout callback d : timeout_id_safe =
  let id = ref None in
  let rec loop d () =
    let step, remain =
      if Poly.(d > overflow_limit) then overflow_limit, d -. overflow_limit else d, 0.
    in
    let cb = if Poly.(remain = 0.) then callback else loop remain in
    id := Some (window##setTimeout (Js.wrap_callback cb) step)
  in
  loop d ();
  id

let clearTimeout (id : timeout_id_safe) =
  match !id with
  | None -> ()
  | Some x ->
      id := None;
      window##clearTimeout x

let js_array_of_collection (c : #element collection Js.t) : #element Js.t Js.js_array Js.t
    =
  Js.Unsafe.(meth_call (js_expr "[].slice") "call" [| inject c |])