(***********************************************************************)
(*                                                                     *)
(*                           Calves                                    *)
(*                                                                     *)
(*          Francois Rouaix, projet Cristal, INRIA Rocquencourt        *)
(*                                                                     *)
(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
(*  Automatique.  Distributed only by permission.                      *)
(*                                                                     *)
(***********************************************************************)

open Tk
open Dload
open Viewers

type applet_callback = Widget.widget -> context -> unit

(* Oups. This is defined in Dload *)
let register = Dload.register

(* Error in applet evaluation *)
let error frame msg =
  let t = I18n.sprintf "Applet Error: %s" msg in
  pack[Label.create frame [Text t]][]

(* [call table frame context]
   table: the table of functions for this applet invocation
*)
let call table frame ctx =
  try
   let fname = List.assoc "function" ctx.viewer_params in
     try
      let foo = Hashtbl.find table fname in
      (* destroy the alt window *)
      List.iter destroy (Winfo.children frame);
      try Printexc.print (foo frame) ctx
      with
	 e -> error frame 
		(I18n.sprintf "Applet function \"%s\" raised exception: %s"
		  fname (Stringexc.f e))
     with
      Not_found -> 
	error frame (I18n.sprintf "Applet function \"%s\" not found" fname)
  with
    Not_found ->
	error frame (I18n.sprintf "No function defined for this applet")


(* [invoke applet_url frame context]
   The context contains the embed/applet parameters
 *)
let invoke url frame ctx =
  try
    (* If the bytecode is in the cache, run the thing. *)
    match Dload.get url with
      None ->
	error frame (I18n.sprintf "%s was rejected" (Url.string_of url));
	false
    | Some cmo ->
	call cmo.module_functions frame ctx;
	false
  with
    Not_found ->
      (* Otherwise, queue it, knowing that at some point it will be invoked *)
      Dload.add_pending_applet url (fun ftable -> call ftable frame ctx)

