open Tk

module Html = Html
module Dtd = Dtd
module ParseHTML = Html_eval

type fontInfo = Fonts.fontInfo =
   Family of string
 | Weight of string
 | Slant of string
 | FontIndex of int
 | FontDelta of int

type gattr = Htmlfmt.gattr =
     Margin of int
  |  Justification of string
  |  Font of fontInfo		        (* mostly size and face *)
  |  FgColor of string
  |  BgColor of string
  |  Underlined
  |  Striked
  |  Spacing of int
  |  Superscript
  |  Lowerscript


type objmap = Maps.t =
    ClientSide of Hyper.link		(* usemap link *)
  | ServerSide of Hyper.link		(* ismap *)
  | Direct of Hyper.link			(* inside an anchor *)
  | NoMap				(* no additionnal navigation *)
  | FormMap of (int * int -> Hyper.link)

type embobject = Embed.embobject = {
  embed_hlink : Hyper.link;               (* hyperlink to the object *)
  embed_frame : Widget.widget;  
     (* the frame where the viewers can do their stuff *)
  embed_context : Viewers.context;
  embed_map : objmap;                  (* associated map *)
  embed_alt : string
 }

class virtual imgloader (unit) =
  virtual add_image : embobject -> unit	 (* add one image *)
  virtual flush_images : unit	         (* flush when document is loaded *)
  virtual load_images : unit		 (* manual flush *)
end

class virtual extracontext (unit) =
  virtual set_title : string -> unit
  virtual add_link : string -> Hyper.link -> unit
end

type formatter = Htmlfmt.formatter = {
  (* Text primitives of the device *)
  new_paragraph: unit -> unit;  	(* Open a new paragraph *)
    (* make sure the following text will start on a new line *)
  close_paragraph: unit -> unit;  	(* Close a paragraph *)
    (* make sure there is an eol after the current text *)
  print_newline : bool -> unit;		(* Force a line break *)
  print_verbatim : string -> unit;	(* Print as-is *)
  format_string : string -> unit;	(* Line wrap, newlines don't count *)
  flush : unit -> unit;			(* Flush the device *)
  (* Predefined Images *)
  hr : unit -> unit;		(* could be embedded ? *)
  bullet : string -> unit;
  (* Graphical attributes *)
  set_defaults : gattr list -> unit;     (* bg, fg, links *)
  push_attr : gattr list -> unit;
  pop_attr : gattr list -> unit;
  (* Structure primitives *)
  isindex : string -> string -> unit;		(* <ISINDEX> *)
  start_anchor : unit -> unit;
  end_anchor : Hyper.link -> unit;
  add_mark : string -> unit;
  (* Embedding primitives *)
  create_embedded : 
     string -> int option -> int option -> Widget.widget;
       (* [create_embedded align w h ]: 
          returns a widget that we can pass as target to the embed manager.
          Should respect background color ?
        *)
  cell_formatter : Widget.widget -> Htmlfmt.formatter;
  (* Re-centering on a fragment *)
  see_frag : string option -> unit
  }

class virtual machine (unit) =
  virtual formatter : formatter
  virtual imgmanager : imgloader
  virtual tcontext : extracontext
  virtual base : string
  virtual ctx : Viewers.context
  virtual add_tag :
    string -> (formatter -> Html.tag -> unit) -> (formatter -> unit) -> unit
  virtual remove_tag : string -> unit
  virtual push_action : (string -> unit) -> unit
  virtual pop_action : unit
  virtual push_formatter : formatter -> unit
  virtual pop_formatter : unit
  virtual send : Html.token -> unit
end


open Nav
open Document
open Capabilities
module Get(C: sig val capabilities: t end) = 
  struct

let ask = ask C.capabilities

(* Enhancements of the navigator *)
let add_html_display_hook f =
  if ask HTMLDisplay then Html_disp.add_hook (f :> machine -> unit)
  else raise (Sys_error (I18n.sprintf "Permission denied"))

let add_object = Embed.add


let add_user_navigation = Nav.add_user_navigation
let add_user_menu = Mmm.add_user_menu

(* Navigation *)
type navigator = Nav.t
let new_window = Mmm.navigator false
let destroy_window nav =
  destroy (Winfo.toplevel nav.nav_viewer_frame)
let follow_link nav h = Nav.follow_link nav h

(* Support for "external" windows *)
let get_global_widget () = 
  Frame.create Widget.default_toplevel [] 

let add_embedded_viewer s f =
  let real_f parms w ctx doc = 
    if ask (DocumentR (Url.string_of doc.document_address)) then
      f parms w ctx (Cache.make_embed_handle doc)
    else
      raise Denied in
  Embed.add_viewer s real_f
      

end
