PageRenderTime 105ms CodeModel.GetById 13ms app.highlight 83ms RepoModel.GetById 1ms app.codeStats 0ms

/tryocaml/js_of_ocaml-patched/lib/dom_html.ml

http://github.com/cago/tryocaml
OCaml | 1430 lines | 1249 code | 146 blank | 35 comment | 29 complexity | d3069ea0220d148ddec475cf1d347af2 MD5 | raw file
Possible License(s): GPL-2.0
   1(* Js_of_ocaml library
   2 * http://www.ocsigen.org/js_of_ocaml/
   3 * Copyright (C) 2010 Jérôme Vouillon
   4 * Laboratoire PPS - CNRS Université Paris Diderot
   5 *
   6 * This program is free software; you can redistribute it and/or modify
   7 * it under the terms of the GNU Lesser General Public License as published by
   8 * the Free Software Foundation, with linking exception;
   9 * either version 2.1 of the License, or (at your option) any later version.
  10 *
  11 * This program is distributed in the hope that it will be useful,
  12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 * GNU Lesser General Public License for more details.
  15 *
  16 * You should have received a copy of the GNU Lesser General Public License
  17 * along with this program; if not, write to the Free Software
  18 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  19 *)
  20
  21open Js
  22
  23external caml_js_on_ie : unit -> bool t = "caml_js_on_ie"
  24
  25let onIE  = Js.to_bool (caml_js_on_ie ())
  26
  27external html_escape : js_string t -> js_string t = "caml_js_html_escape"
  28
  29class type cssStyleDeclaration = object
  30  method background : js_string t prop
  31  method backgroundAttachment : js_string t prop
  32  method backgroundColor : js_string t prop
  33  method backgroundImage : js_string t prop
  34  method backgroundPosition : js_string t prop
  35  method backgroundRepeat : js_string t prop
  36  method border : js_string t prop
  37  method borderBottom : js_string t prop
  38  method borderBottomColor : js_string t prop
  39  method borderBottomStyle : js_string t prop
  40  method borderBottomWidth : js_string t prop
  41  method borderCollapse : js_string t prop
  42  method borderColor : js_string t prop
  43  method borderLeft : js_string t prop
  44  method borderLeftColor : js_string t prop
  45  method borderLeftStyle : js_string t prop
  46  method borderLeftWidth : js_string t prop
  47  method borderRight : js_string t prop
  48  method borderRightColor : js_string t prop
  49  method borderRightStyle : js_string t prop
  50  method borderRightWidth : js_string t prop
  51  method borderSpacing : js_string t prop
  52  method borderStyle : js_string t prop
  53  method borderTop : js_string t prop
  54  method borderTopColor : js_string t prop
  55  method borderTopStyle : js_string t prop
  56  method borderTopWidth : js_string t prop
  57  method borderWidth : js_string t prop
  58  method bottom : js_string t prop
  59  method captionSide : js_string t prop
  60  method clear : js_string t prop
  61  method clip : js_string t prop
  62  method color : js_string t prop
  63  method content : js_string t prop
  64  method counterIncrement : js_string t prop
  65  method counterReset : js_string t prop
  66  method cssText : js_string t prop
  67  method cursor : js_string t prop
  68  method direction : js_string t prop
  69  method display : js_string t prop
  70  method emptyCells : js_string t prop
  71  method font : js_string t prop
  72  method fontFamily : js_string t prop
  73  method fontSize : js_string t prop
  74  method fontStyle : js_string t prop
  75  method fontVariant : js_string t prop
  76  method fontWeight : js_string t prop
  77  method height : js_string t prop
  78  method left : js_string t prop
  79  method letterSpacing : js_string t prop
  80  method lineHeight : js_string t prop
  81  method listStyle : js_string t prop
  82  method listStyleImage : js_string t prop
  83  method listStylePosition : js_string t prop
  84  method listStyleType : js_string t prop
  85  method margin : js_string t prop
  86  method marginBottom : js_string t prop
  87  method marginLeft : js_string t prop
  88  method marginRight : js_string t prop
  89  method marginTop : js_string t prop
  90  method maxHeight : js_string t prop
  91  method maxWidth : js_string t prop
  92  method minHeight : js_string t prop
  93  method minWidth : js_string t prop
  94  method opacity : js_string t optdef prop
  95  method outline : js_string t prop
  96  method outlineColor : js_string t prop
  97  method outlineOffset : js_string t prop
  98  method outlineStyle : js_string t prop
  99  method outlineWidth : js_string t prop
 100  method overflow : js_string t prop
 101  method overflowX : js_string t prop
 102  method overflowY : js_string t prop
 103  method padding : js_string t prop
 104  method paddingBottom : js_string t prop
 105  method paddingLeft : js_string t prop
 106  method paddingRight : js_string t prop
 107  method paddingTop : js_string t prop
 108  method pageBreakAfter : js_string t prop
 109  method pageBreakBefore : js_string t prop
 110  method position : js_string t prop
 111  method right : js_string t prop
 112  method tableLayout : js_string t prop
 113  method textAlign : js_string t prop
 114  method textDecoration : js_string t prop
 115  method textIndent : js_string t prop
 116  method textTransform : js_string t prop
 117  method top : js_string t prop
 118  method verticalAlign : js_string t prop
 119  method visibility : js_string t prop
 120  method whiteSpace : js_string t prop
 121  method width : js_string t prop
 122  method wordSpacing : js_string t prop
 123  method zIndex : js_string t prop
 124end
 125
 126type ('a, 'b) event_listener = ('a, 'b optdef -> bool t) meth_callback opt
 127
 128type mouse_button =
 129  | No_button
 130  | Left_button
 131  | Middle_button
 132  | Right_button
 133
 134class type event = object
 135  method _type : js_string t readonly_prop
 136  method target : element t optdef readonly_prop
 137  method srcElement : element t optdef readonly_prop
 138end
 139
 140and mouseEvent = object
 141  inherit event
 142  method relatedTarget : element t opt optdef readonly_prop
 143  method clientX : int readonly_prop
 144  method clientY : int readonly_prop
 145  method screenX : int readonly_prop
 146  method screenY : int readonly_prop
 147  method ctrlKey : bool t readonly_prop
 148  method shiftKey : bool t readonly_prop
 149  method altKey : bool t readonly_prop
 150  method metaKey : bool t readonly_prop
 151  method button : int readonly_prop
 152  method which : mouse_button optdef readonly_prop
 153
 154  method fromElement : element t opt optdef readonly_prop
 155  method toElement : element t opt optdef readonly_prop
 156  method pageX : int optdef readonly_prop
 157  method pageY : int optdef readonly_prop
 158end
 159
 160and keyboardEvent = object
 161  inherit event
 162  method charCode : int optdef readonly_prop
 163  method keyCode : int readonly_prop
 164  method keyIdentifier : js_string t optdef readonly_prop
 165  method altKey : bool t readonly_prop
 166  method shiftKey : bool t readonly_prop
 167  method ctrlKey : bool t readonly_prop
 168  method metaKey : bool t readonly_prop
 169end
 170
 171and wheelEvent = object (* All browsers but Firefox *)
 172  inherit mouseEvent
 173  method delta : int readonly_prop
 174  method deltaX : int optdef readonly_prop
 175  method deltaY : int optdef readonly_prop
 176end
 177
 178and mouseScrollEvent = object (* Firefox *)
 179  inherit mouseEvent
 180  method detail : int readonly_prop
 181  method axis : int optdef readonly_prop
 182  method _HORIZONTAL_AXIS : int optdef readonly_prop
 183  method _VERTICAL_AXIS : int optdef readonly_prop
 184end
 185
 186and eventTarget = object ('self)
 187  method onclick : ('self t, mouseEvent t) event_listener writeonly_prop
 188  method ondblclick : ('self t, mouseEvent t) event_listener writeonly_prop
 189  method onmousedown : ('self t, mouseEvent t) event_listener writeonly_prop
 190  method onmouseup : ('self t, mouseEvent t) event_listener writeonly_prop
 191  method onmouseover : ('self t, mouseEvent t) event_listener writeonly_prop
 192  method onmousemove : ('self t, mouseEvent t) event_listener writeonly_prop
 193  method onmouseout : ('self t, mouseEvent t) event_listener writeonly_prop
 194  method onkeypress : ('self t, keyboardEvent t) event_listener writeonly_prop
 195  method onkeydown : ('self t, keyboardEvent t) event_listener writeonly_prop
 196  method onkeyup : ('self t, keyboardEvent t) event_listener writeonly_prop
 197end
 198
 199and popStateEvent = object
 200  inherit event
 201  method state : Js.Unsafe.any readonly_prop
 202end
 203
 204and storageEvent = object
 205  inherit event
 206  method key : js_string t readonly_prop
 207  method oldValue : js_string t optdef readonly_prop
 208  method keynewValue : js_string t optdef readonly_prop
 209  method url : js_string t readonly_prop
 210  method storageArea : storage t optdef readonly_prop
 211end
 212
 213and storage = object
 214  method length : int readonly_prop
 215  method key : int -> js_string t optdef meth
 216  method getItem : js_string t -> js_string t optdef meth
 217  method setItem : js_string t -> js_string t -> unit meth
 218  method removeItem : js_string t -> unit meth
 219  method clear : unit meth
 220end
 221
 222and element = object
 223  inherit Dom.element
 224  method id : js_string t prop
 225  method title : js_string t prop
 226  method lang : js_string t prop
 227  method dir : js_string t prop
 228  method className : js_string t prop
 229  method style : cssStyleDeclaration t prop
 230
 231  method innerHTML : js_string t prop
 232
 233  method clientLeft : int readonly_prop
 234  method clientTop : int readonly_prop
 235  method clientWidth : int readonly_prop
 236  method clientHeight : int readonly_prop
 237  method offsetLeft : int readonly_prop
 238  method offsetTop : int readonly_prop
 239  method offsetParent : element t opt readonly_prop
 240  method offsetWidth : int readonly_prop
 241  method offsetHeight : int readonly_prop
 242  method scrollLeft : int prop
 243  method scrollTop : int prop
 244  method scrollWidth : int prop
 245  method scrollHeight : int prop
 246
 247  method getClientRects : clientRectList t meth
 248  method getBoundingClientRect : clientRect t meth
 249
 250  method scrollIntoView: bool t -> unit meth
 251
 252  inherit eventTarget
 253end
 254
 255and clientRect = object
 256  method top : float t readonly_prop
 257  method right : float t readonly_prop
 258  method bottom : float t readonly_prop
 259  method left : float t readonly_prop
 260  method width : float t optdef readonly_prop
 261  method height : float t optdef readonly_prop
 262end
 263
 264and clientRectList = object
 265  method length : int readonly_prop
 266  method item : int -> clientRect t optdef meth
 267end
 268
 269let no_handler : ('a, 'b) event_listener = Js.null
 270let window_event () : #event t = Js.Unsafe.variable "event"
 271(* The function preventDefault must be called explicitely when
 272   using addEventListener... *)
 273let handler f =
 274  Js.some (Js.wrap_callback
 275    (fun e ->
 276       Optdef.case e
 277         (fun () ->
 278            let e = window_event () in
 279            let res = f e in
 280            e##returnValue <- res; res)
 281         (fun e ->
 282            let res = f e in
 283            if not (Js.to_bool res) then
 284              (Js.Unsafe.coerce e)##preventDefault ();
 285            res)))
 286let full_handler f =
 287  Js.some (Js.wrap_meth_callback
 288    (fun this e ->
 289       Optdef.case e
 290         (fun () ->
 291            let e = window_event () in
 292            let res = f this e in
 293            e##returnValue <- res; res)
 294         (fun e ->
 295            let res = f this e in
 296            if not (Js.to_bool res) then
 297              (Js.Unsafe.coerce e)##preventDefault ();
 298            res)))
 299let invoke_handler
 300  (f : ('a, 'b) event_listener) (this : 'a) (event : 'b) : bool t =
 301  Js.Unsafe.call f this [|Js.Unsafe.inject event|]
 302
 303module Event = struct
 304  type 'a typ = js_string t
 305  let click = Js.string "click"
 306  let dblclick = Js.string "dblclick"
 307  let mousedown = Js.string "mousedown"
 308  let mouseup = Js.string "mouseup"
 309  let mouseover = Js.string "mouseover"
 310  let mousemove = Js.string "mousemove"
 311  let mouseout = Js.string "mouseout"
 312  let keypress = Js.string "keypress"
 313  let keydown = Js.string "keydown"
 314  let keyup = Js.string "keyup"
 315  let mousewheel = Js.string "mousewheel"
 316  let _DOMMouseScroll = Js.string "DOMMouseScroll"
 317end
 318
 319type event_listener_id = unit -> unit
 320
 321let addEventListener (e : #eventTarget t) typ h capt =
 322  if (Js.Unsafe.coerce e)##addEventListener == Js.undefined then begin
 323    let ev = (Js.string "on")##concat(typ) in
 324    let callback = fun e -> Js.Unsafe.call (h, e, [||]) in
 325    (Js.Unsafe.coerce e)##attachEvent(ev, callback);
 326    fun () -> (Js.Unsafe.coerce e)##detachEvent(ev, callback)
 327  end else begin
 328    (Js.Unsafe.coerce e)##addEventListener(typ, h, capt);
 329    fun () -> (Js.Unsafe.coerce e)##removeEventListener (typ, h, capt)
 330  end
 331
 332let removeEventListener id = id ()
 333
 334class type ['node] collection = object
 335  method length : int readonly_prop
 336  method item : int -> 'node t optdef meth
 337  method namedItem : js_string t -> 'node t opt meth
 338end
 339
 340class type htmlElement = element
 341
 342class type headElement = object
 343  inherit element
 344  method profile : js_string t prop
 345end
 346
 347class type linkElement = object
 348  inherit element
 349  method disabled : bool t prop
 350  method charset : js_string t prop
 351  method href : js_string t prop
 352  method hreflang : js_string t prop
 353  method media : js_string t prop
 354  method rel : js_string t prop
 355  method rev : js_string t prop
 356  method target : js_string t prop
 357  method _type : js_string t prop
 358end
 359
 360class type titleElement = object
 361  inherit element
 362  method text : js_string t prop
 363end
 364
 365class type metaElement = object
 366  inherit element
 367  method content : js_string t prop
 368  method httpEquiv : js_string t prop
 369  method name : js_string t prop
 370  method scheme : js_string t prop
 371end
 372
 373class type baseElement = object
 374  inherit element
 375  method href : js_string t prop
 376  method target : js_string t prop
 377end
 378
 379class type styleElement = object
 380  inherit element
 381  method disabled : bool t prop
 382  method media : js_string t prop
 383  method _type : js_string t prop
 384end
 385
 386class type bodyElement = element
 387
 388class type formElement = object
 389  inherit element
 390  method elements : element collection t readonly_prop
 391  method length : int readonly_prop
 392  method acceptCharset : js_string t prop
 393  method action : js_string t prop
 394  method enctype : js_string t prop
 395  method _method : js_string t prop
 396  method target : js_string t prop
 397  method submit : unit meth
 398  method reset : unit meth
 399
 400  method onsubmit : ('self t, event t) event_listener writeonly_prop
 401end
 402
 403class type optGroupElement = object
 404  inherit element
 405  method disabled : bool t prop
 406  method label : js_string t prop
 407end
 408
 409class type optionElement = object
 410  inherit optGroupElement
 411  method form : formElement t opt readonly_prop
 412  method defaultSelected : bool t prop
 413  method text : js_string t readonly_prop
 414  method index : int readonly_prop
 415  method selected : bool prop
 416  method value : js_string t prop
 417end
 418
 419class type selectElement = object ('self)
 420  inherit element
 421  method _type : js_string t readonly_prop
 422  method selectedIndex : int prop
 423  method value : js_string t prop
 424  method length : int prop
 425  method form : formElement t opt readonly_prop
 426  method options : optionElement collection t readonly_prop
 427  method disabled : bool t prop
 428  method multiple : bool t prop
 429  method name : js_string t readonly_prop
 430  method size : int prop
 431  method tabIndex : int prop
 432  method add : #optGroupElement t -> #optGroupElement t opt -> unit meth
 433  method remove : int -> unit meth
 434  method blur : unit meth
 435  method focus : unit meth
 436
 437  method onchange : ('self t, event t) event_listener prop
 438end
 439
 440class type inputElement = object ('self)
 441  inherit element
 442  method defaultValue : js_string t prop
 443  method defaultChecked : js_string t prop
 444  method form : formElement t opt readonly_prop
 445  method accept : js_string t prop
 446  method accessKey : js_string t prop
 447  method align : js_string t prop
 448  method alt : js_string t prop
 449  method checked : bool t prop
 450  method disabled : bool t prop
 451  method maxLength : int prop
 452  method name : js_string t readonly_prop
 453  method readOnly : bool t prop
 454  method size : int prop
 455  method src : js_string t prop
 456  method tabIndex : int prop
 457  method _type : js_string t readonly_prop
 458  method useMap : js_string t prop
 459  method value : js_string t prop
 460  method blur : unit meth
 461  method focus : unit meth
 462  method select : unit meth
 463  method click : unit meth
 464
 465  method onselect : ('self t, event t) event_listener prop
 466  method onchange : ('self t, event t) event_listener prop
 467end
 468
 469class type textAreaElement = object ('self)
 470  inherit element
 471  method defaultValue : js_string t prop
 472  method form : formElement t opt readonly_prop
 473  method accessKey : js_string t prop
 474  method cols : int prop
 475  method disabled : bool t prop
 476  method name : js_string t readonly_prop
 477  method readOnly : bool t prop
 478  method rows : int prop
 479  method tabIndex : int prop
 480  method _type : js_string t readonly_prop
 481  method value : js_string t prop
 482  method blur : unit meth
 483  method focus : unit meth
 484  method select : unit meth
 485
 486  method onselect : ('self t, event t) event_listener prop
 487  method onchange : ('self t, event t) event_listener prop
 488end
 489
 490class type buttonElement = object
 491  inherit element
 492  method form : formElement t opt readonly_prop
 493  method accessKey : js_string t prop
 494  method disabled : bool t prop
 495  method name : js_string t readonly_prop
 496  method tabIndex : int prop
 497  method _type : js_string t readonly_prop
 498  method value : js_string t prop
 499end
 500
 501class type labelElement = object
 502  inherit element
 503  method form : formElement t opt readonly_prop
 504  method accessKey : js_string t prop
 505  method htmlFor : js_string t prop
 506end
 507
 508class type fieldSetElement = object
 509  inherit element
 510  method form : formElement t opt readonly_prop
 511end
 512
 513class type legendElement = object
 514  inherit element
 515  method form : formElement t opt readonly_prop
 516  method accessKey : js_string t prop
 517end
 518
 519class type uListElement = element
 520
 521class type oListElement = element
 522
 523class type dListElement = element
 524
 525class type liElement = element
 526
 527class type divElement = element
 528
 529class type paragraphElement = element
 530
 531class type headingElement = element
 532
 533class type quoteElement = object
 534  inherit element
 535  method cite : js_string t prop
 536end
 537
 538class type preElement = element
 539
 540class type brElement = element
 541
 542class type hrElement = element
 543
 544class type modElement = object
 545  inherit element
 546  method cite : js_string t prop
 547  method dateTime : js_string t prop
 548end
 549
 550class type anchorElement = object
 551  inherit element
 552  method accessKey : js_string t prop
 553  method charset : js_string t prop
 554  method coords : js_string t prop
 555  method href : js_string t prop
 556  method hreflang : js_string t prop
 557  method name : js_string t prop
 558  method rel : js_string t prop
 559  method rev : js_string t prop
 560  method shape : js_string t prop
 561  method tabIndex : int prop
 562  method target : js_string t prop
 563  method _type : js_string t prop
 564  method blur : unit meth
 565  method focus : unit meth
 566end
 567
 568class type imageElement = object ('self)
 569  inherit element
 570  method alt : js_string t prop
 571  method src : js_string t prop
 572  method useMap : js_string t prop
 573  method isMap : bool t prop
 574  method width : int prop
 575  method height : int prop
 576  method naturalWidth : int optdef readonly_prop
 577  method naturalHeight : int optdef readonly_prop
 578  method complete : bool t prop
 579
 580  method onload : ('self t, event t) event_listener prop
 581end
 582
 583class type objectElement = object
 584  inherit element
 585  method form : formElement t opt readonly_prop
 586  method code : js_string t prop
 587  method archive : js_string t prop
 588  method codeBase : js_string t prop
 589  method codeType : js_string t prop
 590  method data : js_string t prop
 591  method declare : bool t prop
 592  method height : js_string t prop
 593  method name : js_string t prop
 594  method standby : js_string t prop
 595  method tabIndex : int prop
 596  method _type : js_string t prop
 597  method useMap : js_string t prop
 598  method width : js_string t prop
 599  method document : Dom.element Dom.document t opt readonly_prop
 600end
 601
 602class type paramElement = object
 603  inherit element
 604  method name : js_string t prop
 605  method _type : js_string t prop
 606  method value : js_string t prop
 607  method valueType : js_string t prop
 608end
 609
 610class type areaElement = object
 611  inherit element
 612  method accessKey : js_string t prop
 613  method alt : js_string t prop
 614  method coords : js_string t prop
 615  method href : js_string t prop
 616  method noHref : bool t prop
 617  method shape : js_string t prop
 618  method tabIndex : int prop
 619  method target : js_string t prop
 620end
 621
 622class type mapElement = object
 623  inherit element
 624  method areas : areaElement collection t readonly_prop
 625  method name : js_string t prop
 626end
 627
 628class type scriptElement = object
 629  inherit element
 630  method text : js_string t prop
 631  method charset : js_string t prop
 632  method defer : bool t prop
 633  method src : js_string t prop
 634  method _type : js_string t prop
 635end
 636
 637class type tableCellElement = object
 638  inherit element
 639  method cellIndex : int readonly_prop
 640  method abbr : js_string t prop
 641  method align : js_string t prop
 642  method axis : js_string t prop
 643  method ch : js_string t prop
 644  method chOff : js_string t prop
 645  method colSpan : int prop
 646  method headers : js_string t prop
 647  method rowSpan : int prop
 648  method scope : js_string t prop
 649  method vAlign : js_string t prop
 650end
 651
 652class type tableRowElement = object
 653  inherit element
 654  method rowIndex : int readonly_prop
 655  method sectionRowIndex : int readonly_prop
 656  method cells : tableCellElement collection t readonly_prop
 657  method align : js_string t prop
 658  method ch : js_string t prop
 659  method chOff : js_string t prop
 660  method vAlign : js_string t prop
 661  method insertCell : int -> tableCellElement t meth
 662  method deleteCell : int -> unit meth
 663end
 664
 665class type tableColElement = object
 666  inherit element
 667  method align : js_string t prop
 668  method ch : js_string t prop
 669  method chOff : js_string t prop
 670  method span : int prop
 671  method vAlign : js_string t prop
 672  method width : js_string t prop
 673end
 674
 675class type tableSectionElement = object
 676  inherit element
 677  method align : js_string t prop
 678  method ch : js_string t prop
 679  method chOff : js_string t prop
 680  method vAlign : js_string t prop
 681  method rows : tableRowElement collection t readonly_prop
 682  method insertRow : int -> tableRowElement t meth
 683  method deleteRow : int -> unit meth
 684end
 685
 686class type tableCaptionElement = element
 687
 688class type tableElement = object
 689  inherit element
 690  method caption : tableCaptionElement t prop
 691  method tHead : tableSectionElement t prop
 692  method tFood : tableSectionElement t prop
 693  method rows : tableRowElement collection t readonly_prop
 694  method tbodies : tableSectionElement collection t readonly_prop
 695  method align : js_string t prop
 696  method border : js_string t prop
 697  method cellPadding : js_string t prop
 698  method cellSpacing : js_string t prop
 699  method frame : js_string t prop
 700  method rules : js_string t prop
 701  method summary : js_string t prop
 702  method width : js_string t prop
 703  method createTHead : tableSectionElement t meth
 704  method deleteTHead : unit meth
 705  method createTFoot : tableSectionElement t meth
 706  method deleteTFoot : unit meth
 707  method createCaption : tableCaptionElement t meth
 708  method deleteCaption : unit meth
 709  method insertRow : int -> tableRowElement t meth
 710  method deleteRow : int -> unit meth
 711end
 712
 713type context = js_string t
 714let _2d_ = Js.string "2d"
 715
 716type canvasPattern
 717
 718class type canvasElement = object
 719  inherit element
 720  method width : int prop
 721  method height : int prop
 722  method toDataURL : js_string t meth
 723  method getContext : js_string t -> canvasRenderingContext2D t meth
 724end
 725
 726and canvasRenderingContext2D = object
 727  method canvas : canvasElement t readonly_prop
 728  method save : unit meth
 729  method restore : unit meth
 730  method scale : float -> float -> unit meth
 731  method rotate : float -> unit meth
 732  method translate : float -> float -> unit meth
 733  method transform :
 734    float -> float -> float -> float -> float -> float -> unit meth
 735  method setTransform :
 736    float -> float -> float -> float -> float -> float -> unit meth
 737  method globalAlpha : float_prop
 738  method globalCompositeOperation : js_string t prop
 739  method strokeStyle : js_string t writeonly_prop
 740  method strokeStyle_gradient : canvasGradient t writeonly_prop
 741  method strokeStyle_pattern : canvasPattern t writeonly_prop
 742  method fillStyle : js_string t writeonly_prop
 743  method fillStyle_gradient : canvasGradient t writeonly_prop
 744  method fillStyle_pattern : canvasPattern t writeonly_prop
 745  method createLinearGradient :
 746    float -> float -> float -> float -> canvasGradient t meth
 747  method createRadialGradient :
 748    float -> float -> float -> float -> float -> float ->
 749    canvasGradient t meth
 750  method createPattern : imageElement t -> js_string t -> canvasPattern t meth
 751  method createPattern_fromCanvas :
 752    canvasElement t -> js_string t -> canvasPattern t meth
 753(*
 754  CanvasPattern createPattern(in HTMLVideoElement image, in DOMJs_String repetition);
 755*)
 756  method lineWidth : float_prop
 757  method lineCap : js_string t prop
 758  method lineJoin : js_string t prop
 759  method miterLimit : float_prop
 760
 761  method shadowOffsetX : float_prop
 762  method shadowOffsetY : float_prop
 763  method shadowBlur : float_prop
 764  method shadowColor : js_string t prop
 765
 766  method clearRect : float -> float -> float -> float -> unit meth
 767  method fillRect : float -> float -> float -> float -> unit meth
 768  method strokeRect : float -> float -> float -> float -> unit meth
 769
 770  method beginPath : unit meth
 771  method closePath : unit meth
 772  method moveTo : float -> float -> unit meth
 773  method lineTo : float -> float -> unit meth
 774  method quadraticCurveTo : float -> float -> float -> float -> unit meth
 775  method bezierCurveTo :
 776    float -> float -> float -> float -> float -> float -> unit meth
 777  method arcTo : float -> float -> float -> float -> float -> unit meth
 778  method rect : float -> float -> float -> float -> unit meth
 779  method arc :
 780    float -> float -> float -> float -> float -> bool t -> unit meth
 781  method fill : unit meth
 782  method stroke : unit meth
 783  method clip : unit meth
 784  method isPointInPath : float -> float -> bool t meth
 785
 786  method drawFocusRing : #element t -> float -> float -> bool t -> bool t meth
 787
 788  method font : js_string t prop
 789  method textAlign : js_string t prop
 790  method textBaseline : js_string t prop
 791  method fillText : js_string t -> float -> float -> unit meth
 792  method fillText_withWidth :
 793    js_string t -> float -> float -> float -> unit meth
 794  method strokeText : js_string t -> float -> float -> unit meth
 795  method strokeText_withWidth :
 796    js_string t -> float -> float -> float -> unit meth
 797  method measureText : js_string t -> textMetrics t meth
 798
 799  method drawImage :
 800    imageElement t -> float -> float -> unit meth
 801  method drawImage_withSize :
 802    imageElement t -> float -> float -> float -> float -> unit meth
 803  method drawImage_full :
 804    imageElement t -> float -> float -> float -> float ->
 805    float -> float -> float -> float -> unit meth
 806  method drawImage_fromCanvas :
 807    canvasElement t -> float -> float -> unit meth
 808  method drawImage_fromCanvasWithSize :
 809    canvasElement t -> float -> float -> float -> float -> unit meth
 810  method drawImage_fullFromCanvas :
 811    canvasElement t -> float -> float -> float -> float ->
 812    float -> float -> float -> float -> unit meth
 813(*
 814  void drawImage(in HTMLVideoElement image, in float dx, in float dy, in optional float dw, in float dh);
 815  void drawImage(in HTMLVideoElement image, in float sx, in float sy, in float sw, in float sh, in float dx, in float dy, in float dw, in float dh);
 816*)
 817
 818  method createImageData : int -> int -> imageData t meth
 819  method getImageData : float -> float -> float -> float -> imageData t meth
 820  method putImageData : imageData t -> float -> float -> unit meth
 821end
 822
 823and canvasGradient = object
 824  method addColorStop : float -> js_string t -> unit meth
 825end
 826
 827and textMetrics = object
 828  method width : float readonly_prop
 829end
 830
 831and imageData = object
 832  method width : int readonly_prop
 833  method height : int readonly_prop
 834  method data : canvasPixelArray t readonly_prop
 835end
 836
 837and canvasPixelArray = object
 838  method length : int readonly_prop
 839end
 840
 841external pixel_get : canvasPixelArray t -> int -> int = "caml_js_get"
 842external pixel_set : canvasPixelArray t -> int -> int -> unit = "caml_js_set"
 843
 844class type document = object
 845  inherit [element] Dom.document
 846  method title : js_string t prop
 847  method referrer : js_string t readonly_prop
 848  method domain : js_string t readonly_prop
 849  method _URL : js_string t readonly_prop
 850  method head : headElement t prop
 851  method body : bodyElement t prop
 852  method documentElement : htmlElement t readonly_prop
 853  method images : imageElement collection t readonly_prop
 854  method applets : element collection t readonly_prop
 855  method links : element collection t readonly_prop
 856  method forms : formElement collection t readonly_prop
 857  method anchors : element collection t readonly_prop
 858  method cookie : js_string t prop
 859  method designMode : js_string t prop
 860  method open_ : unit meth
 861  method close : unit meth
 862  method write : js_string t -> unit meth
 863  method execCommand : js_string t -> bool t -> js_string t opt -> unit meth
 864
 865  inherit eventTarget
 866end
 867
 868type interval_id
 869type timeout_id
 870
 871class type location = object
 872  method href : js_string t prop
 873  method protocol : js_string t prop
 874  method host : js_string t prop
 875  method hostname : js_string t prop
 876  method port : js_string t prop
 877  method pathname : js_string t prop
 878  method search : js_string t prop
 879  method hash : js_string t prop
 880
 881  method assign : js_string t -> unit meth
 882  method replace : js_string t -> unit meth
 883  method reload : unit meth
 884end
 885
 886class type history = object
 887  method length : int readonly_prop
 888  method state : Js.Unsafe.any readonly_prop
 889  method go : int opt -> unit meth
 890  method back : unit meth
 891  method forward : unit meth
 892  method pushState : Js.Unsafe.any -> js_string t -> js_string t opt -> unit meth
 893  method replaceState : Js.Unsafe.any -> js_string t -> js_string t opt -> unit meth
 894end
 895
 896class type undoManager = object
 897end
 898
 899class type selection = object
 900end
 901
 902class type window = object
 903  method document : document t readonly_prop
 904  method name : js_string t prop
 905  method location : location t readonly_prop
 906  method history : history t readonly_prop
 907  method undoManager : undoManager t readonly_prop
 908  method getSelection : selection t meth
 909  method close : unit meth
 910  method stop : unit meth
 911  method focus : unit meth
 912  method blur : unit meth
 913  method scroll : int -> int -> unit meth
 914
 915  method sessionStorage : storage t readonly_prop
 916  method localStorage : storage t readonly_prop
 917
 918  method top : window t readonly_prop
 919  method parent : window t readonly_prop
 920  method frameElement : element t opt readonly_prop
 921
 922  method alert : js_string t -> unit meth
 923  method confirm : js_string t -> bool t meth
 924  method prompt : js_string t -> js_string t -> js_string t meth
 925  method print : unit meth
 926
 927  method setInterval : (unit -> unit) Js.callback -> float -> interval_id meth
 928  method clearInterval : interval_id -> unit meth
 929
 930  method setTimeout : (unit -> unit) Js.callback -> float -> timeout_id meth
 931  method clearTimeout : timeout_id -> unit meth
 932
 933  method onload : (window t, event t) event_listener prop
 934  method onbeforeunload : (window t, event t) event_listener prop
 935  method onblur : (window t, event t) event_listener prop
 936  method onfocus : (window t, event t) event_listener prop
 937  method onresize : (window t, event t) event_listener prop
 938  method onpopstate : (window t, popStateEvent t) event_listener prop
 939  method open_ : js_string t -> js_string t -> js_string t opt -> unit meth
 940  method close : unit meth
 941end
 942
 943let window : window t = Js.Unsafe.variable "window"
 944
 945let document = window##document
 946
 947(****)
 948
 949class type frameSetElement = object
 950  inherit element
 951  method cols : js_string t prop
 952  method rows : js_string t prop
 953end
 954
 955class type frameElement = object
 956  inherit element
 957  method frameBorder : js_string t prop
 958  method longDesc : js_string t prop
 959  method marginHeight : js_string t prop
 960  method marginWidth : js_string t prop
 961  method name : js_string t prop
 962  method noResize : bool t prop
 963  method scrolling : js_string t prop
 964  method src : js_string t prop
 965  method contentDocument : document t opt readonly_prop
 966end
 967
 968class type iFrameElement = object
 969  inherit element
 970  method frameBorder : js_string t prop
 971  method height : js_string t prop
 972  method width : js_string t prop
 973  method longDesc : js_string t prop
 974  method marginHeight : js_string t prop
 975  method marginWidth : js_string t prop
 976  method name : js_string t prop
 977  method scrolling : js_string t prop
 978  method src : js_string t prop
 979  method contentDocument : document t opt readonly_prop
 980  method contentWindow  : window t readonly_prop
 981end
 982
 983(****)
 984
 985(*XXX Should provide creation functions a la lablgtk... *)
 986
 987let opt_iter x f = match x with None -> () | Some v -> f v
 988
 989let createElement (doc : document t) name = doc##createElement(Js.string name)
 990let unsafeCreateElement doc name = Js.Unsafe.coerce (createElement doc name)
 991let unsafeCreateElementEx ?_type ?name doc elt =
 992  if _type = None && name = None then
 993    Js.Unsafe.coerce (createElement doc elt)
 994  else if not onIE then begin
 995    let res = Js.Unsafe.coerce (createElement doc elt) in
 996    opt_iter _type (fun t -> res##_type <- t);
 997    opt_iter name (fun n -> res##name <- n);
 998    res
 999  end else begin
1000    let a = jsnew Js.array_empty () in
1001    ignore (a##push_2(Js.string "<", Js.string elt));
1002    opt_iter _type (fun t ->
1003      ignore (a##push_3(Js.string " type=\"", html_escape t, Js.string "\"")));
1004    opt_iter name (fun n ->
1005      ignore (a##push_3(Js.string " name=\"", html_escape n, Js.string "\"")));
1006    ignore (a##push(Js.string ">"));
1007    Js.Unsafe.coerce (doc##createElement (a##join (Js.string "")))
1008  end
1009
1010let createHtml doc : htmlElement t = unsafeCreateElement doc "html"
1011let createHead doc : headElement t = unsafeCreateElement doc "head"
1012let createLink doc : linkElement t = unsafeCreateElement doc "link"
1013let createTitle doc : titleElement t = unsafeCreateElement doc "title"
1014let createMeta doc : metaElement t = unsafeCreateElement doc "meta"
1015let createBase doc : baseElement t = unsafeCreateElement doc "base"
1016let createStyle doc : styleElement t = unsafeCreateElement doc "style"
1017let createBody doc : bodyElement t = unsafeCreateElement doc "body"
1018let createForm doc : formElement t = unsafeCreateElement doc "form"
1019let createOptgroup doc : optGroupElement t = unsafeCreateElement doc "optgroup"
1020let createOption doc : optionElement t = unsafeCreateElement doc "option"
1021let createSelect ?_type ?name doc : selectElement t =
1022  unsafeCreateElementEx ?_type ?name doc "select"
1023let createInput ?_type ?name doc : inputElement t =
1024  unsafeCreateElementEx ?_type ?name doc "input"
1025let createTextarea ?_type ?name doc : textAreaElement t =
1026  unsafeCreateElementEx ?_type ?name doc "textarea"
1027let createButton ?_type ?name doc : buttonElement t =
1028  unsafeCreateElementEx ?_type ?name doc "button"
1029let createLabel doc : labelElement t = unsafeCreateElement doc "label"
1030let createFieldset doc : fieldSetElement t = unsafeCreateElement doc "fieldset"
1031let createLegend doc : legendElement t = unsafeCreateElement doc "legend"
1032let createUl doc : uListElement t = unsafeCreateElement doc "ul"
1033let createOl doc : oListElement t = unsafeCreateElement doc "ol"
1034let createDl doc : dListElement t = unsafeCreateElement doc "dl"
1035let createLi doc : liElement t = unsafeCreateElement doc "li"
1036let createDiv doc : divElement t = unsafeCreateElement doc "div"
1037let createP doc : paragraphElement t = unsafeCreateElement doc "p"
1038let createH1 doc : headingElement t = unsafeCreateElement doc "h1"
1039let createH2 doc : headingElement t = unsafeCreateElement doc "h2"
1040let createH3 doc : headingElement t = unsafeCreateElement doc "h3"
1041let createH4 doc : headingElement t = unsafeCreateElement doc "h4"
1042let createH5 doc : headingElement t = unsafeCreateElement doc "h5"
1043let createH6 doc : headingElement t = unsafeCreateElement doc "h6"
1044let createQ doc : quoteElement t = unsafeCreateElement doc "q"
1045let createBlockquote doc : quoteElement t =
1046  unsafeCreateElement doc "blockquote"
1047let createPre doc : preElement t = unsafeCreateElement doc "pre"
1048let createBr doc : brElement t = unsafeCreateElement doc "br"
1049let createHr doc : hrElement t = unsafeCreateElement doc "hr"
1050let createIns doc : modElement t = unsafeCreateElement doc "ins"
1051let createDel doc : modElement t = unsafeCreateElement doc "del"
1052let createA doc : anchorElement t = unsafeCreateElement doc "a"
1053let createImg doc : imageElement t = unsafeCreateElement doc "img"
1054let createObject doc : objectElement t = unsafeCreateElement doc "object"
1055let createParam doc : paramElement t = unsafeCreateElement doc "param"
1056let createMap doc : mapElement t = unsafeCreateElement doc "map"
1057let createArea doc : areaElement t = unsafeCreateElement doc "area"
1058let createScript doc : scriptElement t = unsafeCreateElement doc "script"
1059let createTable doc : tableElement t = unsafeCreateElement doc "table"
1060let createCaption doc : tableCaptionElement t =
1061  unsafeCreateElement doc "caption"
1062let createCol doc : tableColElement t = unsafeCreateElement doc "col"
1063let createColgroup doc : tableColElement t = unsafeCreateElement doc "colgroup"
1064let createThead doc : tableSectionElement t = unsafeCreateElement doc "thead"
1065let createTfoot doc : tableSectionElement t = unsafeCreateElement doc "tfoot"
1066let createTbody doc : tableSectionElement t = unsafeCreateElement doc "tbody"
1067let createTr doc : tableRowElement t = unsafeCreateElement doc "tr"
1068let createTh doc : tableCellElement t = unsafeCreateElement doc "th"
1069let createTd doc : tableCellElement t = unsafeCreateElement doc "td"
1070let createSub doc = createElement doc "sub"
1071let createSup doc = createElement doc "sup"
1072let createSpan doc = createElement doc "span"
1073let createTt doc = createElement doc "tt"
1074let createI doc = createElement doc "i"
1075let createB doc = createElement doc "b"
1076let createBig doc = createElement doc "big"
1077let createSmall doc = createElement doc "small"
1078let createEm doc = createElement doc "em"
1079let createStrong doc = createElement doc "strong"
1080let createCite doc = createElement doc "cite"
1081let createDfn doc = createElement doc "dfn"
1082let createCode doc = createElement doc "code"
1083let createSamp doc = createElement doc "samp"
1084let createKbd doc = createElement doc "kbd"
1085let createVar doc = createElement doc "var"
1086let createAbbr doc = createElement doc "abbr"
1087let createDd doc = createElement doc "dd"
1088let createDt doc = createElement doc "dt"
1089let createNoscript doc = createElement doc "noscript"
1090let createAddress doc = createElement doc "address"
1091let createFrameset doc : frameSetElement t = unsafeCreateElement doc "frameset"
1092let createFrame doc : frameElement t = unsafeCreateElement doc "frame"
1093let createIframe doc : iFrameElement t = unsafeCreateElement doc "iframe"
1094
1095exception Canvas_not_available
1096
1097let createCanvas doc : canvasElement t =
1098  let c = unsafeCreateElement doc "canvas" in
1099  if not (Opt.test c##getContext) then raise Canvas_not_available;
1100  c
1101
1102let html_element : htmlElement t constr = Js.Unsafe.variable "window.HTMLElement"
1103
1104module CoerceTo = struct
1105  let element : #Dom.node Js.t -> element Js.t Js.opt =
1106    if def html_element == undefined then
1107      (* ie < 9 does not have HTMLElement: we have to cheat to check
1108	 that something is an html element *)
1109      (fun e ->
1110	if def ((Js.Unsafe.coerce e)##innerHTML) == undefined then
1111	  Js.null
1112	else Js.some (Js.Unsafe.coerce e))
1113    else
1114      (fun e ->
1115	if Js.instanceof e html_element then
1116	  Js.some (Js.Unsafe.coerce e)
1117	else Js.null)
1118
1119  let unsafeCoerce tag (e : #element t) =
1120    if e##tagName##toLowerCase() == Js.string tag then
1121      Js.some (Js.Unsafe.coerce e)
1122    else
1123      Js.null
1124  let a e =  unsafeCoerce "a" e
1125  let area e =  unsafeCoerce "area" e
1126  let base e =  unsafeCoerce "base" e
1127  let blockquote e =  unsafeCoerce "blockquote" e
1128  let body e =  unsafeCoerce "body" e
1129  let br e =  unsafeCoerce "br" e
1130  let button e =  unsafeCoerce "button" e
1131  let canvas e =  unsafeCoerce "canvas" e
1132  let caption e =  unsafeCoerce "caption" e
1133  let col e =  unsafeCoerce "col" e
1134  let colgroup e = unsafeCoerce "colgroup" e
1135  let del e = unsafeCoerce "del" e
1136  let div e = unsafeCoerce "div" e
1137  let dl e = unsafeCoerce "dl" e
1138  let fieldset e = unsafeCoerce "fieldset" e
1139  let form e = unsafeCoerce "form" e
1140  let frameset e = unsafeCoerce "frameset" e
1141  let frame e = unsafeCoerce "frame" e
1142  let h1 e = unsafeCoerce "h1" e
1143  let h2 e = unsafeCoerce "h2" e
1144  let h3 e = unsafeCoerce "h3" e
1145  let h4 e = unsafeCoerce "h4" e
1146  let h5 e = unsafeCoerce "h5" e
1147  let h6 e = unsafeCoerce "h6" e
1148  let head e = unsafeCoerce "head" e
1149  let hr e = unsafeCoerce "hr" e
1150  let html e = unsafeCoerce "html" e
1151  let iframe e = unsafeCoerce "iframe" e
1152  let img e = unsafeCoerce "img" e
1153  let input e = unsafeCoerce "input" e
1154  let ins e = unsafeCoerce "ins" e
1155  let label e = unsafeCoerce "label" e
1156  let legend e = unsafeCoerce "legend" e
1157  let li e = unsafeCoerce "li" e
1158  let link e = unsafeCoerce "link" e
1159  let map e = unsafeCoerce "map" e
1160  let meta e = unsafeCoerce "meta" e
1161  let _object e = unsafeCoerce "object" e
1162  let ol e = unsafeCoerce "ol" e
1163  let optgroup e = unsafeCoerce "optgroup" e
1164  let option e = unsafeCoerce "option" e
1165  let p e = unsafeCoerce "p" e
1166  let param e = unsafeCoerce "param" e
1167  let pre e = unsafeCoerce "pre" e
1168  let q e = unsafeCoerce "q" e
1169  let script e = unsafeCoerce "script" e
1170  let select e = unsafeCoerce "select" e
1171  let style e = unsafeCoerce "style" e
1172  let table e = unsafeCoerce "table" e
1173  let tbody e = unsafeCoerce "tbody" e
1174  let td e = unsafeCoerce "td" e
1175  let textarea e = unsafeCoerce "textarea" e
1176  let tfoot e = unsafeCoerce "tfoot" e
1177  let th e = unsafeCoerce "th" e
1178  let thead e = unsafeCoerce "thead" e
1179  let title e = unsafeCoerce "title" e
1180  let tr e = unsafeCoerce "tr" e
1181  let ul e = unsafeCoerce "ul" e
1182
1183  let unsafeCoerceEvent name (ev : #event t) =
1184    let constr = Js.Unsafe.variable name in
1185    if def constr != undefined && Js.instanceof ev constr then
1186      Js.some (Js.Unsafe.coerce ev)
1187    else Js.null
1188
1189  let mouseEvent ev = unsafeCoerceEvent "window.MouseEvent" ev
1190  let keyboardEvent ev = unsafeCoerceEvent "window.KeyboardEvent" ev
1191  let wheelEvent ev = unsafeCoerceEvent "window.WheelEvent" ev
1192  let mouseScrollEvent ev = unsafeCoerceEvent "window.MouseScrollEvent" ev
1193  let popStateEvent ev = unsafeCoerceEvent "window.PopStateEvent" ev
1194
1195end
1196
1197(****)
1198
1199let eventTarget (e : #event t) =
1200  let target =
1201    Optdef.get (e##target) (fun () ->
1202    Optdef.get (e##srcElement) (fun () -> assert false))
1203  in
1204  (* Workaround for Safari bug *)
1205  if target##nodeType == Dom.TEXT then
1206    Js.Unsafe.coerce (Opt.get (target##parentNode) (fun () -> assert false))
1207  else
1208    target
1209
1210let eventRelatedTarget (e : #mouseEvent t) =
1211  Optdef.get (e##relatedTarget) (fun () ->
1212  match Js.to_string (e##_type) with
1213    "mouseover" -> Optdef.get (e##fromElement) (fun () -> assert false)
1214  | "mouseout"  -> Optdef.get (e##toElement) (fun () -> assert false)
1215  | _           -> Js.null)
1216
1217let eventAbsolutePosition' (e : #mouseEvent t) =
1218  let body = document##body in
1219  let html = document##documentElement in
1220  (e##clientX + body##scrollLeft + html##scrollLeft,
1221   e##clientY + body##scrollTop + html##scrollTop)
1222
1223let eventAbsolutePosition (e : #mouseEvent t) =
1224  Optdef.case (e##pageX) (fun () -> eventAbsolutePosition' e) (fun x ->
1225  Optdef.case (e##pageY) (fun () -> eventAbsolutePosition' e) (fun y ->
1226  (x, y)))
1227
1228let elementClientPosition (e : #element t) =
1229  let r = e##getBoundingClientRect () in
1230  let body = document##body in
1231  let html = document##documentElement in
1232  (truncate (Js.to_float r##left) - body##clientLeft - html##clientLeft,
1233   truncate (Js.to_float r##top) - body##clientTop - html##clientTop)
1234
1235let getDocumentScroll () =
1236  let body = document##body in
1237  let html = document##documentElement in
1238  (body##scrollLeft + html##scrollLeft, body##scrollTop + html##scrollTop)
1239
1240let buttonPressed (ev : #mouseEvent Js.t) =
1241  Js.Optdef.case (ev##which)
1242    (fun () ->
1243      match ev##button with
1244	| 1 -> Left_button
1245	| 2 -> Right_button
1246	| 4 -> Middle_button
1247	| _ -> No_button)
1248    (fun x -> x)
1249
1250let hasMousewheelEvents () =
1251  let d = createDiv document in
1252  d##setAttribute(Js.string "onmousewheel", Js.string "return;");
1253  Js.typeof (Js.Unsafe.get d (Js.string "onmousewheel")) ==
1254  Js.string "function"
1255
1256let addMousewheelEventListener e h capt =
1257  if hasMousewheelEvents () then
1258    addEventListener e Event.mousewheel
1259      (handler
1260         (fun (e : wheelEvent t) ->
1261            let dx = - Optdef.get (e##deltaX) (fun () -> 0) / 40 in
1262            let dy =
1263              - Optdef.get (e##deltaY) (fun () -> e##delta) / 40 in
1264            h (e :> mouseEvent t) ~dx ~dy))
1265      capt
1266  else
1267    addEventListener e Event._DOMMouseScroll
1268      (handler
1269         (fun (e : mouseScrollEvent t) ->
1270            let d = e##detail in
1271            if e##axis == e##_HORIZONTAL_AXIS then
1272              h (e :> mouseEvent t) ~dx:d ~dy:0
1273            else
1274              h (e :> mouseEvent t) ~dx:0 ~dy:d))
1275      capt
1276
1277type taggedElement =
1278  | A of anchorElement t
1279  | Area of areaElement t
1280  | Base of baseElement t
1281  | Blockquote of quoteElement t
1282  | Body of bodyElement t
1283  | Br of brElement t
1284  | Button of buttonElement t
1285  | Canvas of canvasElement t
1286  | Caption of tableCaptionElement t
1287  | Col of tableColElement t
1288  | Colgroup of tableColElement t
1289  | Del of modElement t
1290  | Div of divElement t
1291  | Dl of dListElement t
1292  | Fieldset of fieldSetElement t
1293  | Form of formElement t
1294  | Frameset of frameSetElement t
1295  | Frame of frameElement t
1296  | H1 of headingElement t
1297  | H2 of headingElement t
1298  | H3 of headingElement t
1299  | H4 of headingElement t
1300  | H5 of headingElement t
1301  | H6 of headingElement t
1302  | Head of headElement t
1303  | Hr of hrElement t
1304  | Html of htmlElement t
1305  | Iframe of iFrameElement t
1306  | Img of imageElement t
1307  | Input of inputElement t
1308  | Ins of modElement t
1309  | Label of labelElement t
1310  | Legend of legendElement t
1311  | Li of liElement t
1312  | Link of linkElement t
1313  | Map of mapElement t
1314  | Meta of metaElement t
1315  | Object of objectElement t
1316  | Ol of oListElement t
1317  | Optgroup of optGroupElement t
1318  | Option of optionElement t
1319  | P of paramElement t
1320  | Param of paramElement t
1321  | Pre of preElement t
1322  | Q of quoteElement t
1323  | Script of scriptElement t
1324  | Select of selectElement t
1325  | Style of styleElement t
1326  | Table of tableElement t
1327  | Tbody of tableSectionElement t
1328  | Td of tableColElement t
1329  | Textarea of textAreaElement t
1330  | Tfoot of tableSectionElement t
1331  | Th of tableColElement t
1332  | Thead of tableSectionElement t
1333  | Title of titleElement t
1334  | Tr of tableRowElement t
1335  | Ul of uListElement t
1336  | Other of element t
1337
1338let tagged (e : #element t) =
1339  match Js.to_string (e##tagName##toLowerCase()) with
1340  | "a" -> A (Js.Unsafe.coerce e)
1341  | "area" -> Area (Js.Unsafe.coerce e)
1342  | "base" -> Base (Js.Unsafe.coerce e)
1343  | "blockquote" -> Blockquote (Js.Unsafe.coerce e)
1344  | "body" -> Body (Js.Unsafe.coerce e)
1345  | "br" -> Br (Js.Unsafe.coerce e)
1346  | "button" -> Button (Js.Unsafe.coerce e)
1347  | "canvas" -> Canvas (Js.Unsafe.coerce e)
1348  | "caption" -> Caption (Js.Unsafe.coerce e)
1349  | "col" -> Col (Js.Unsafe.coerce e)
1350  | "colgroup" -> Colgroup (Js.Unsafe.coerce e)
1351  | "del" -> Del (Js.Unsafe.coerce e)
1352  | "div" -> Div (Js.Unsafe.coerce e)
1353  | "dl" -> Dl (Js.Unsafe.coerce e)
1354  | "fieldset" -> Fieldset (Js.Unsafe.coerce e)
1355  | "form" -> Form (Js.Unsafe.coerce e)
1356  | "frameset" -> Frameset (Js.Unsafe.coerce e)
1357  | "frame" -> Frame (Js.Unsafe.coerce e)
1358  | "h1" -> H1 (Js.Unsafe.coerce e)
1359  | "h2" -> H2 (Js.Unsafe.coerce e)
1360  | "h3" -> H3 (Js.Unsafe.coerce e)
1361  | "h4" -> H4 (Js.Unsafe.coerce e)
1362  | "h5" -> H5 (Js.Unsafe.coerce e)
1363  | "h6" -> H6 (Js.Unsafe.coerce e)
1364  | "head" -> Head (Js.Unsafe.coerce e)
1365  | "hr" -> Hr (Js.Unsafe.coerce e)
1366  | "html" -> Html (Js.Unsafe.coerce e)
1367  | "iframe" -> Iframe (Js.Unsafe.coerce e)
1368  | "img" -> Img (Js.Unsafe.coerce e)
1369  | "input" -> Input (Js.Unsafe.coerce e)
1370  | "ins" -> Ins (Js.Unsafe.coerce e)
1371  | "label" -> Label (Js.Unsafe.coerce e)
1372  | "legend" -> Legend (Js.Unsafe.coerce e)
1373  | "li" -> Li (Js.Unsafe.coerce e)
1374  | "link" -> Link (Js.Unsafe.coerce e)
1375  | "map" -> Map (Js.Unsafe.coerce e)
1376  | "meta" -> Meta (Js.Unsafe.coerce e)
1377  | "object" -> Object (Js.Unsafe.coerce e)
1378  | "ol" -> Ol (Js.Unsafe.coerce e)
1379  | "optgroup" -> Optgroup (Js.Unsafe.coerce e)
1380  | "option" -> Option (Js.Unsafe.coerce e)
1381  | "p" -> P (Js.Unsafe.coerce e)
1382  | "param" -> Param (Js.Unsafe.coerce e)
1383  | "pre" -> Pre (Js.Unsafe.coerce e)
1384  | "q" -> Q (Js.Unsafe.coerce e)
1385  | "script" -> Script (Js.Unsafe.coerce e)
1386  | "select" -> Select (Js.Unsafe.coerce e)
1387  | "style" -> Style (Js.Unsafe.coerce e)
1388  | "table" -> Table (Js.Unsafe.coerce e)
1389  | "tbody" -> Tbody (Js.Unsafe.coerce e)
1390  | "td" -> Td (Js.Unsafe.coerce e)
1391  | "textarea" -> Textarea (Js.Unsafe.coerce e)
1392  | "tfoot" -> Tfoot (Js.Unsafe.coerce e)
1393  | "th" -> Th (Js.Unsafe.coerce e)
1394  | "thead" -> Thead (Js.Unsafe.coerce e)
1395  | "title" -> Title (Js.Unsafe.coerce e)
1396  | "tr" -> Tr (Js.Unsafe.coerce e)
1397  | "ul" -> Ul (Js.Unsafe.coerce e)
1398  | _   -> Other (e : #element t :> element t)
1399
1400let opt_tagged e = Opt.case e (fun () -> None) (fun e -> Some (tagged e))
1401
1402type taggedEvent =
1403  | MouseEvent of mouseEvent t
1404  | KeyboardEvent of keyboardEvent t
1405  | WheelEvent of wheelEvent t
1406  | MouseScrollEvent of mouseScrollEvent t
1407  | PopStateEvent of popStateEvent t
1408  | OtherEvent of event t
1409
1410let taggedEvent (ev : #event Js.t) =
1411  Js.Opt.case (CoerceTo.mouseEvent ev)
1412    (fun () -> Js.Opt.case (CoerceTo.keyboardEvent ev)
1413      (fun () -> Js.Opt.case (CoerceTo.wheelEvent ev)
1414	(fun () -> Js.Opt.case (CoerceTo.mouseScrollEvent ev)
1415	  (fun () -> Js.Opt.case (CoerceTo.popStateEvent ev)
1416	    (fun () -> OtherEvent (ev :> event t))
1417	    (fun ev -> PopStateEvent ev))
1418	  (fun ev -> MouseScrollEvent ev))
1419	(fun ev -> WheelEvent ev))
1420      (fun ev -> KeyboardEvent ev))
1421    (fun ev -> MouseEvent ev)
1422
1423let opt_taggedEvent ev = Opt.case ev (fun () -> None) (fun ev -> Some (taggedEvent ev))
1424
1425let stopPropagation ev =
1426  let e = Js.Unsafe.coerce ev in
1427  Optdef.case
1428    (e##stopPropagation)
1429    (fun () -> e##cancelBubble <- Js._true)
1430    (fun _ -> e##_stopPropagation())