# applet.tcl
# <applet> and <embed> tag support

proc HMtag_applet {win param text} {
    upvar #0 HM$win var
    set width [set height 30]
    set code Applet
    HMextract_param $param code
    HMextract_param $param width
    HMextract_param $param height
    set f [frame $win.applet$var(tags) -width $width -height $height \
	-relief ridge -bd 4]
    pack propagate $f false
    set l [label $f.label -text "Applet: $code"]
    pack $l -expand true -fill both
    bind $l <Button-1> [list AppletHit $win %W]
    Win_Install $win $f
    Text_TagAdd $win "H:applet $param" $f
    HMstack $win  [list listtags "H:applet $param"]
}
proc HMtag_/applet {win param text} {
    HMstack/ $win  [list listtags {}]
}
proc AppletHit {win label} {
    return	;# still broken
    if [Input_Edit $win] {
	set mark [$win index [winfo parent $label]]
	foreach tag [$win tag names $mark] {
	    if [regsub H:applet $tag applet htag] {
		break
	    }
	}
	if ![info exists htag] {
	    return
	}
	set spec "applet code=! width=! height=!"
	$label config -highlightthickness 2 -highlightbackground red
	set state [Dialog_Htag $win $spec $htag "Applet Tag" AppletHook]
	if [llength $state] {
	    Edit_ChangeTag $win H:$htag $mark H:[lindex $state 1]
	} else {
	    $label config -highlightthickness 0 -highlightbackground \
		[$label cget -background]
	}
    }
}
proc AppletHook {args} {}

proc Embed_Reset {win} {
    upvar #0 HM$win var
    if [info exists var(S_slaves)] {
	foreach slave $var(S_slaves) {
	    Stderr "Destroy $slave"
	    catch {$slave eval destroy .}
	    catch {interp delete $slave}
	}
    }
    set var(S_slaves) {}
}
proc HMtag_embed {win param text} {
    upvar #0 HM$win var
    set width [set height 30]
    set src ""
    HMextract_param $param src
    HMextract_param $param width
    HMextract_param $param height
    set f [frame $win.embed$var(tags) -width $width -height $height \
	-relief ridge -bd 4]
    pack propagate $f false

    Win_Install $win $f

    if {[file extension $src] != ".tcl"} {
	label $f.label -text "Embed $src\n$param"
	pack $f.label
	bind $f.label <Button-1> [list EmbedHit $win %W [Mark_Current $win]]
	return
    }

    #Download and run the Tcl applet.

    bind $f <Button-1> [list EmbedHit $win %W [Mark_Current $win]]
    set protocol [UrlResolve $var(S_url) src]	;# Side-effects src
    switch -regexp -- $protocol {
	(http|ftp) {
	    Status $win "fetching applet $src"
	    Http_get $src [list EmbedFetched $win $f $src $param] \
			    [list Url_Progress $win $src]
	}
	file {
	    upvar #0 $src data
	    set data(what) file
	    regsub ^file: $src {} data(file)
	    EmbedFetched $win $f $src $param
	}
    }

}
proc EmbedFetched {win f src param} {
    upvar #0 HM$win var
    upvar #0 $src data
    Stderr "EmbedFetched $src"
    if {$data(what) == "file"} {
	set slave [interp create]	;# -safe doesn't work
	lappend var(S_slaves) $slave
	$slave eval [list set argv [list -use [winfo id $f]]]
	$slave eval [list load {} Tk]
	$slave eval [list rename send {}]
	$slave eval [list rename exec {}]
	$slave eval [list rename socket {}]
	while {[string length $param]} {
	    if {[regexp {([^=]+)=([^"' ]+)} $param x key value]} {
		regsub {([^=]+)=([^"' ]+)} $param {} param
	    } elseif {[regexp {([^=]+)="([^"]+)"} $param x key value]} {
		regsub {([^=]+)="([^"]+)"} $param {} param
	    } elseif {[regexp {([^=]+)='([^']+)'} $param x key value]} {
		regsub {([^=]+)='([^']+)'} $param {} param
	    } elseif {[regexp {([^ ]+)} $param x key]} {
		set value ""
		regsub {([^ ]+)} $param {} param
	    } else {
		Stderr "EmbedFetched: Cannot parse $param"
		break
	    }
	    set param [string trim $param]
	    set embed_args($key) $value
	    if [regexp -nocase ^width$ $key] {
		set width $value
	    }
	    if [regexp -nocase ^height$ $key] {
		set height $value
	    }
	}
	$slave eval [list array set embed_args [array get embed_args]]
	catch {
	    $slave eval [list . config -width $width -height $height]
	}
	$slave eval [list wm title . "Unsafe Tcl Applet"]
	$slave eval [list source $data(file)]
	set title [$slave eval wm title .]
	regsub "Unsafe Tcl Applet" $title {} title
	if {[string length [string trim $title]]} {
	    $slave eval [list wm title . "Unsafe Tcl Applet: $title"]
	}
    } elseif {$data(what) == "error"} {
	$f config -bg black
    }
}
proc EmbedHit {win label mark} {
    if [Input_Edit $win] {
	set htag [Mark_Htag $win $mark]
	set spec "embed src=! width=! height=! language="
	$label config -highlightthickness 2 -highlightbackground red
	set state [Dialog_Htag $win $spec $htag "Embed Tag"]

	if [llength $state] {
	    Undo_Mark $win EmbedHit
	    Mark_Remove $win $mark
	    $win mark set insert [$win index $label]
	    $win delete $widget
	    Input_Html $win [lindex $state 1]
	    Undo_Mark $win EmbedHitEnd
	} else {
	    $label config -highlightthickness 0 -highlightbackground \
		[$label cget -background]
	}
    }
}
proc Embed_Create {win} {
    set spec "embed src=! width=! height=! language="
    set state [Dialog_Htag $win $spec "" "Embed Tag"]
    if [llength $state] {
	Undo_Mark $win EmbedHit
	Input_Html $win [lindex $state 1]
	Undo_Mark $win EmbedHitEnd
    }
}

