open Printf
open Hyper
open Www
open Html
open Htmlfmt


(*
 * Level 2 stuff (forms)
 *)

(* The behaviour of a form *)

class behaviour (base, fmethod, encoding, action) =

  val private mutable elem_value = ([] : (unit -> (string * string) list) list)
  val private mutable elem_reset = ([] : (unit -> unit) list)
  val private fmethod = fmethod
  val private encoding = encoding
  val private action = action
  val private base = base

  (* Contribute a value to the form *)
  method add_get f = elem_value <- f :: elem_value

  (* How to reset the element *)
  method add_reset f = elem_reset <- f :: elem_reset

  (* The link for a given submit activation *)
  method submit l = 
    let values = List.flatten (List.map (function f  -> f()) elem_value) in
    let values = l @ values in
    let evalues = Urlenc.form_encode (List.rev values) in
     match fmethod with
       "POST" -> {h_uri = action;
		  h_context = Some base;
		  h_method = POST evalues
                 }
     | _ -> 
       let uri = 
         let l = String.length action in 
         if l = 0 then sprintf "?%s" evalues
	 else if action.[l-1] = '?' then action ^ evalues
         else sprintf "%s?%s" action evalues
       in
            {h_uri = uri;
             h_context = Some base;
	     h_method = GET}

  (* Resetting the form *)
  method reset = List.iter (fun f -> f ()) elem_reset

end

module Make(G : GfxHTML)(FormDisplay : FormDisplay) = 
 struct
  open G
  open FormDisplay
(*
 * <!ELEMENT FORM - - %body.content -(FORM)>
 * <!ATTLIST FORM
 *         action %URL #REQUIRED -- server-side form handler --
 *         method (%HTTP-Method) GET -- see HTTP specification --
 *         enctype %Content-Type; "application/x-www-form-urlencoded"
 *         >
 *)


let init mach =
mach#add_tag "form"
 (fun fo tform ->
  let behav = new behaviour (mach#base,
                             get_attribute tform "method",
			     get_attribute tform "enctype",
                             try get_attribute tform "action" 
                             with Not_found -> mach#base)
  in
  let fm = FormDisplay.create mach#base behav mach#ctx in

  (* 8.1.2 Input Field : INPUT *)
  let open_input fo t =
    let inputtype = Mstring.uppercase (get_attribute t "type") in
    (* Special case for hidden, since there is no formatting *)
    if inputtype = "HIDDEN" then
      let name = get_attribute t "name" in
	begin try 
	  let v = get_attribute t "value" in
            behav#add_get (fun () -> [name, v])
	with
	  Not_found -> 
	     raise (Invalid_Html "missing VALUE in input HIDDEN")
        end
    else (* Other cases *)
      let fr = fo.create_embedded (get_attribute t "align") None None in
       match inputtype with
	  "TEXT" | "PASSWORD" ->  fm.text_input fr t
        | "CHECKBOX" -> fm.checkbox_input fr t
        | "RADIO" -> fm.radio_input fr t
        | "IMAGE" -> mach#imgmanager#add_image (fm.image_input fr t)
        | "SUBMIT" -> fm.submit_input fr t
        | "RESET" -> fm.reset_input fr t
	(* TODO: file *)
        | s -> raise (Invalid_Html ("Invalid INPUT TYPE="^s))
  in
  mach#add_tag "input" open_input (fun _ -> ());

  (* 8.1.3 Selection : SELECT *)
  (* the /SELECT does all the job, so we have to transmit the info ! *)
  let options = ref []       (* the components from which to select *)
  and tselect = ref {tag_name = "select"; attributes = []}
  in
  let open_select fo t =
    options := [];
    tselect := t;
    mach#add_tag "option"
       (fun fo tag ->
	  mach#push_action 
      	    (fun s ->
	       let s = beautify2 s in
	       (* the val is by default the "content" of the tag *)
               let va = try get_attribute tag "value" with Not_found -> s in
	       options := (va, s,
      	       	       	   has_attribute tag "selected") :: !options;
	       ))
       (fun _ -> mach#pop_action)
  and close_select fo =
    mach#remove_tag "option";
    let fr = fo.create_embedded (get_attribute !tselect "align") None None in
       fm.select fr (List.rev !options) !tselect
  in

  mach#add_tag "select" open_select close_select;

  (* 8.1.4 Text Area: TEXTAREA *)
  let textarea_initial = Ebuffer.create 128 
  and ttextarea = ref {tag_name = "textarea"; attributes = []} in
  let open_textarea fo tag =
    ttextarea := tag;
    Ebuffer.reset textarea_initial;
    mach#push_action (fun s -> Ebuffer.output_string textarea_initial s)
  and close_textarea fo =
    mach#pop_action;
    let name = get_attribute !ttextarea "name" in
    let fr = 
      fo.create_embedded (get_attribute !ttextarea "align") None None in
        fm.textarea fr (Ebuffer.get textarea_initial) !ttextarea

  in

  mach#add_tag "textarea" open_textarea  close_textarea
  )

(function fo -> List.iter mach#remove_tag ["input"; "select"; "textarea"])

end
