open Safestd
open Safetk
open Safefrx
open Safeapplets
open Safemmm

(* This module demonstrates
    - how to add an user menu
    - how to call the HTML lexer
*)

module Provide = struct
  let capabilities = Capabilities.get()
  end

module IO = Safeio.Get(Provide)
module Net = Retrieval(Provide)
module Mmm = Safemmm.Get(Provide)

open Tk
open IO
open Net
open Html
open Document
open Feed
open Hyper
open Viewers

let images lexbuf =
  let uris = ref [] in
  try
    let lexer = ParseHTML.sgml_lexer Dtd.dtd32 in
    while true do
      try 
        let _,tokens,loc = lexer lexbuf in
	  List.iter (function
	     OpenTag {tag_name = "img"; attributes = attrs} ->
	       begin try
		uris := List.assoc "src" attrs :: !uris
	       with Not_found -> ()
	       end
	   | EOF -> raise End_of_file
	   | _ -> ())
          tokens
      with
        Html_Lexing _ -> ()
      | Invalid_Html _ -> ()
    done;
    !uris
  with
    End_of_file -> List.rev !uris

let show_images ctx l =
  let w = Mmm.get_global_widget() 
  and follow_link =
    List.assoc "goto" ctx.viewer_hyper 
  and base = Url.string_of (ctx.viewer_base.document_url)
  in
  Frx_req.open_list "Display Images" l
    (fun uri -> 
      let link = {h_uri = uri; h_context = Some base; h_method = GET} in
        follow_link.hyper_func link)
    (fun _ -> ())

let f ctx =
  let cont = {
    document_process = (fun dh ->
      let lexbuf = Lexing.from_function
	               (fun buf n -> dh.document_feed.feed_read buf 0 n) in
      (* this is not the way it should be written *)
      let l = images lexbuf in
        dclose true dh;
        show_images ctx l);
    document_finish = (fun _ -> ())
    } in
  let wr = Www.make {h_uri = Url.string_of ctx.viewer_base.document_url;
		     h_context = None;
		     h_method = GET} in

  Net.retrieve wr cont

let _ = Mmm.add_user_menu "In-lined images" f


