Sophie: js_of_ocaml-doc-2.4.1-2.mga5 noarch

js_of_ocaml-doc-2.4.1-2.mga5.noarch.rpm

(* Js_of_ocaml example
 * http://www.ocsigen.org/js_of_ocaml/
 * Copyright (C) 2010 Dmitry Kosarev
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 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.
 *)

module Html = Dom_html

let (>>=) = Lwt.bind
let ( |> ) x f = f x
exception Break of bool

let is_visible_text s = 
  (* TODO: rewrite with regexps. *)
  let len = String.length s in
  let rec loop i =
    if i >= len then () else 
    if (s.[i] = '\\') && (i<len-1) && (s.[i+1]='\\') then loop (i+2)
    else match  s.[i] with
	| '\n' -> loop (i+1)
	| _   -> raise (Break true)	  
  in 
  try 
    loop 0;
    false
  with Break b -> b

open Dom

let rec html2wiki ?inH:(inH=false) body = 
  let ans = Buffer.create 10 in
  let add_str ?surr:(surr="") s = 
    if is_visible_text s then Buffer.add_string ans (surr^s^surr)
    else () in
  let childNodes = body##childNodes in
  for i=0 to childNodes##length-1 do
    Js.Opt.iter (childNodes##item (i)) (fun node ->
      match Js.to_string node##nodeName with
	| "B" -> let inner = html2wiki node in
		 add_str inner ~surr:"**"
	| "I" -> let inner = html2wiki node in
		 add_str inner ~surr:"//"
	| "#text" -> (match Js.Opt.to_option  node##nodeValue with
			 | Some x -> Buffer.add_string ans (Js.to_string x)
			 | None	-> ())
	| "P" -> let inner = html2wiki node in
		 add_str (inner ^ "\n\n")
	| "BR"  -> Buffer.add_string ans "\\\\"
	| "HR"  -> Buffer.add_string ans "----"
	| "DIV" -> let inner = html2wiki node in
		   Buffer.add_string ans inner		     
	| "A"   ->
	  let x  : element Js.t Js.opt = Js.some (Js.Unsafe.coerce node) in
	  let el = Js.Opt.get x (fun _ -> assert false)  in

	  Js.Opt.case (el##getAttribute (Js.string "wysitype"))
	    (fun () -> Buffer.add_string ans "^error_in_anchor^")
	    (fun s -> 
	      let url = Js.Opt.get (el##getAttribute (Js.string "href")) (fun _ -> assert false) 
		|> Js.to_string in
	      match Js.to_string s with
	      | "global" -> 
		let desc = html2wiki node in
		Buffer.add_string ans (String.concat "" ["[[";url;"|";desc;"]]"]) 
	      | "wiki"   -> String.concat "" ["[[";url;"]]"] |> Buffer.add_string ans 
	      | _        -> Buffer.add_string ans "^error2_in_anchor^"
	    )
	| ("H1" | "H2" | "H3") as hh ->
	  let n = int_of_char hh.[1] - (int_of_char '0') + 1 in
	  let prefix = String.make n '=' in
	  let inner = html2wiki node in
	  Buffer.add_string ans (prefix^inner^"\n\n")
	| _ as name -> 
	  Buffer.add_string ans ("^"^ name^"^")
    )
  done;
  Buffer.contents ans

let onload _ =
  let d = Html.document in
  let body =
    Js.Opt.get (d##getElementById (Js.string "wiki_demo"))
      (fun () -> assert false) in

  let iframe = Html.createIframe d in
  iframe##style##border <- Js.string "2px green solid";
  iframe##src <- Js.string "#";
  iframe##id  <- Js.string "wysiFrame";
  Dom.appendChild body iframe;

  Js.Opt.iter (iframe##contentDocument) (fun iDoc ->
    iDoc##open_ ();
    iDoc##write (Js.string "<html><body><p><b>Camelus</b><i>bactrianus</i></p></body></html>");
    iDoc##close ();
    iDoc##designMode <- Js.string "On";

    let iWin  = iframe##contentWindow in
    Dom.appendChild body (Html.createBr d);

    (* see http://www.quirksmode.org/dom/execCommand.html 
     * http://www.mozilla.org/editor/midas-spec.html
     *)
    let createButton ?show:(show=Js._false) ?value:(value=None) title action = 
      let but = Html.createInput ?_type:(Some (Js.string "submit")) d in
      but##value <- Js.string title;
      let wrap s = match s with
	| None -> Js.null | Some s -> Js.some (Js.string s) in
      
      but##onclick <- Html.handler 
	(fun _ -> 
	  iWin##focus ();
	  iDoc##execCommand (Js.string action, show, wrap value); 
	  Js._true);
      Dom.appendChild body but;
      but
    in

    ignore (createButton "hr" "inserthorizontalrule");
    ignore (createButton "remove format" "removeformat");
    ignore (createButton "B" "bold");
    ignore (createButton "I" "italic");
    Dom.appendChild body (Html.createBr d);
    ignore (createButton "p" "formatblock" ~value:(Some "p"));
    ignore (createButton "h1" "formatblock" ~value:(Some "h1"));
    ignore (createButton "h2" "formatblock" ~value:(Some "h2"));
    ignore (createButton "h3" "formatblock" ~value:(Some "h3"));

    let prompt query default =
      Js.Opt.get (iWin##prompt (Js.string query, Js.string default))
        (fun () -> Js.string default)
      |> Js.to_string
    in
    (createButton "link" "inserthtml")##onclick <- Html.handler (fun _ ->
      let link = prompt "Enter a link" "http://google.ru" in 
      let desc = prompt "Enter description" "desc" in
      let link = String.concat "" ["<a href=\""; link; "\" wysitype=\"global\">"; desc; "</a>"] in
      iWin##alert (Js.string link); 
      iDoc##execCommand (Js.string "inserthtml", Js._false, Js.some (Js.string link) );
      Js._true
     );
    (createButton "link2wiki" "inserthtml")##onclick <- Html.handler (fun _ ->
      let link = prompt "Enter a wikipage" "lololo" in
      let link = ["<a href=\""; link; "\" wysitype=\"wiki\">"; link; "</a>"] 
		 |> String.concat "" in
      iWin##alert (Js.string link); 
      iDoc##execCommand (Js.string "inserthtml", Js._false, Js.some (Js.string link) );
      Js._true
     );
    Dom.appendChild body (Html.createBr d);

    let preview = Html.createTextarea d in
    preview##readOnly <- Js._true;
    preview##cols <- 34;
    preview##rows <- 10;
    preview##style##border <- Js.string "1px black solid";
    preview##style##padding <- Js.string "5px";
    Dom.appendChild body preview;

    let wikiFrame = Html.createTextarea d in
    wikiFrame##id <- Js.string "wikiFrame";
    wikiFrame##readOnly <- Js._true;
    wikiFrame##cols <- 34;
    wikiFrame##rows <- 10;
    preview##style##border <- Js.string "2px blue solid";
    preview##style##padding <- Js.string "5px";
    Dom.appendChild body wikiFrame;

    let rec dyn_preview old_text n =
      let text = Js.to_string iDoc##body##innerHTML in
      let n =
	if text <> old_text then begin
	  begin try
		  preview##value <- Js.string text;
		  wikiFrame##value <- Js.string (html2wiki (iDoc##body :> Dom.node Js.t) )
	    with _ -> () end;
	  20
	end else
	  max 0 (n - 1)
      in
      Lwt_js.sleep (if n = 0 then 0.5 else 0.1) >>= fun () ->
      dyn_preview text n
    in
    ignore (dyn_preview "" 0)
  );
  Js._false

let _ = Html.window##onload <- Html.handler onload