# frameset.tcl
# Edit HTML frames.
# See license.terms for copyright info.

array set FrameMap {
	frameset {frameset rows= cols=}
	frame {frame src= name= marginwidth= marginheight= scrolling= noresize=}
	noframes {}
}

proc Frameset_Edit {{win {}}} {
    global WebTk
    upvar #0 Frame$win frame
    if {[winfo toplevel $win] == "."} {
	set top .fse
    } else {
	set top [winfo toplevel $win].fse
    }
    if {![info exists frame(master) ]} {
	switch [DialogChoice $win .newframe "Start a new frameset with" \
		    [list Rows Columns Cancel]] {
	    0 {
		set template [file join $WebTk(html) template RowFS]
	    }
	    1 {
		set template [file join $WebTk(html) template ColFS]
	    }
	    2 {
		return
	    }
	}
	set win [Url_DisplayNew file:$template $win]
	File_SaveAs $win
	return [Frameset_Edit $win]
    }
    set frame(top) $top
    if {[winfo exists $top]} {
	raise $top
	wm deiconify $top
    } else {
	toplevel $top
	wm title $top "Frameset Info"
	frame $top.buttons -class Frameset
	pack $top.buttons -fill x
	Window_ButtonFrame $top.buttons

	entry $top.buttons.feedback -textvariable frameFeedback -width 0
	pack $top.buttons.feedback -side top
    }
    FramesetBind $win $frame(master)
    FramesetHighlight $win $frame(master)
    Frameset_ViewSource $win
}
proc FramesetBind {win parent} {
    foreach f [winfo children $parent] {
	if {[winfo class $f] == "Frame"} {
	    bind $f <1> [list FramesetHighlight $win $parent]
	    if [winfo exists $f.text] {
		set t $f.text
		bind $t <1> [list FramesetHighlight $win $parent]
	    }
	    FramesetBind $win $f
	}
    }
}
proc FramesetFrameEdit {win f} {
    upvar #0 Frame$win frame
    global FrameMap
    set params [lindex $frame(html,$f) 1]
    set info [Dialog_Htag $win $FrameMap(frame) $params "Frame spec"\
	    [list UrlChooseHook1 $win]]
    if {[llength $info] > 0} {
	foreach x [array names frame *,$f] {
	    unset frame($x)
	}
	eval destroy [winfo children $f]
	set frame(frameset) [list [list $f]]
	set param [lindex $info 1]
	HMtag_frame $win $param {}
	foreach cmd $frame(display) {
	    eval $cmd
	}
	set frame(display) []
	FramesetBind $win $frame(master)
	Frameset_ViewSource $win
	Input_Dirty $win
    }
}
proc FramesetHighlight {win f} {
    upvar #0 Frame$win frame
    FramesetHighlightClear $win $frame(master)
    if [info exists frame(cols,$f)] {
	set key cols
    } else {
	set key rows
    }
    upvar #0 Frame_$key F
    set spec $frame($key,$f)
    set i 0
    foreach child [winfo children $f] {
	if [winfo exists $child.text] {
	    # Insert handle to split this child
	    set foot [frame $frame(master).foot$i -width 3 -height 3 \
		-bg blue -cursor crosshair -class Foot]
	    eval {place $foot -in $child} $F(footargs)
	    bind $foot <B1-Motion> \
		[list FramesetDragFoot $foot -$F(dd) %$F(DD) $f $child $key]
	    bind $foot <ButtonRelease-1> \
		    [list FramesetFootStop $win $foot $f $child $F(other)]
	    set but [button $frame(master).button$i -highlightthickness 0 \
		-text Props \
		-command [list FramesetFrameEdit $win $frame($key,$f,$i,frame)]]
	    eval {place $but -in $child} $F(butargs)
	}
	incr i
    }
    set i 0
    foreach x [split $spec ,] {
	lappend children $frame($key,$f,$i,frame)
	lappend bars \
	    [frame $frame(master).bar$i -width 3 -height 3 \
		-bg red -cursor crosshair -class Bar]
	lappend boxes [label $frame(master).label$i -width 0]
	incr i
    }
    set i 0
    foreach child $children bar $bars box $boxes {
	set d [expr [winfo $F(d) $child] + [winfo $F(size) $child]]
	eval {place $bar -$F(d) $d} $F(barargs) {-in $f}
	eval {place $box -$F(d) $d -rel$F(d) -0.01} $F(boxargs) {-in $f}
	foreach w [list $box $bar] {
	    bind $w <B1-Motion> \
		[list FramesetDrag $bar $box -$F(d) %$F(D) $f $bars $boxes $key]
	    bind $w <ButtonRelease-1> \
		    [list FramesetDragStop $bar $win $f $children $bars $key]
	}
	incr i
    }
    FramespecFeedback $f $key $bars $boxes
}
proc FramesetHighlightClear {win f} {
    foreach child [winfo children $f] {
	if {[winfo class $child] == "Frame"} {
	    if {![winfo exists $child.text]} {
		FramesetHighlightClear $win $child
	    }
	} else {
	    destroy $child
	}
    }
}
proc FramesetDrag {bar box xy d parent bars boxes key} {
    upvar #0 Frameset$bar frameset
    global frameFeedback

    if ![info exists frameset(d)] {
	set frameset(d) $d
    } else {
	set delta [expr $d - $frameset(d)]
	foreach w [list $bar $box] {
	    array set place [place info $w]
	    set old $place($xy)
	    incr old $delta
	    place $w $xy $old
	}
	set frameset(d) $d
	FramespecFeedback $parent $key $bars $boxes
    }
}

proc FramesetDragFoot {foot xy d parent child key} {
    upvar #0 Frameset$foot frameset
    global frameFeedback

    if ![info exists frameset(dd)] {
	set frameset(dd) $d
    } else {
	set delta [expr $d - $frameset(dd)]
	foreach w [list $foot] {
	    array set place [place info $w]
	    set old $place($xy)
	    incr old $delta
	    place $w $xy $old
	}
	set frameset(dd) $d
    }
}

proc FramespecFeedback {parent key bars boxes} {
    global frameFeedback
    lassign {fixed percent} [FramesetSpec $parent $key $bars]
    foreach box $boxes d $fixed p $percent {
	if [winfo exists $box] {
	    $box config -text "$d\n$p"
	}
    }
    set frameFeedback "[join $fixed ,] [join $percent ,]"
}
proc FramesetSpec {parent key bars} {
    upvar #0 Frame_$key F
    set coords 0
    foreach bar $bars {
	array set place [place info $bar]
	if {$place(-rel$F(d)) > 0} {
	    # Sum relative and absolute placements
	    lappend coords [expr [winfo $F(size) $place(-in)] * $place(-rel$F(d)) + $place(-$F(d))]
	} else {
	    lappend coords $place(-$F(d))
	}
    }
    set total [winfo $F(size) $parent]
    set last 0
    set fixed ""
    set percent ""
    set totper 0
    foreach c [lrange $coords 1 end] {
	set delta [expr $c - $last]
	lappend fixed $delta
	set per [format %2.0f [expr int(double($delta)*100.0/double($total))]]
	lappend percent ${per}%
	incr totper $per
	set last $c
    }
    if {$total - $c > 5} {
	# User moved the last bar - signal for a new row or column
	set delta [expr $total - $c]
	lappend fixed $delta
	set per [format %2.0f [expr int(double($delta)*100.0/double($total))]]
	lappend percent ${per}%
	incr totper $per
    }
    set per [expr 100 - ($totper - $per)]
    set percent [lreplace $percent end end ${per}%]
    return [list $fixed $percent]
}

proc FramesetDragStop {bar win parent children bars key} {
    upvar #0 Frameset$bar frameset
    upvar #0 Frame$win frame
    upvar #0 Frame_$key F

    set i 0
    foreach child $children {
	place $child -$F(d) 0
#	grid ${key}configure $parent $i -minsize 0
	catch {unset frame($key,$parent,$i,size)}
	catch {unset frame($key,$parent,$i,mult)}
	catch {unset frame($key,$parent,$i,relsize)}
	incr i
    }
    lassign {fixed percent} [FramesetSpec $parent $key $bars]
    set frame($key,$parent) [join $percent ,]
    if {[llength $fixed] > [llength $bars]} {
	# User dragged last bar - add new row or column
	set f [frame $parent.f$i]
#	grid $f -in $parent -$key $i -$Fv(other) 0 -sticky news
	place $f -in $parent
	set newwin [Window_Frame $win $parent.f$i none 0 0]
	FramesetBind $win $parent
	set frame($key,$parent,$i,frame) $f
	set frame(html,$f) frame
    }
    eval [bind $parent <Configure>]
    if [info exists newwin] {
	FramesetHighlightClear $win $frame(master)
    }
    catch {unset frameset(d)}
    Frameset_ViewSource $win
    Input_Dirty $win
}

# Replace a frame with a frameset
proc FramesetFootStop {win foot parent child key} {
    upvar #0 Frame$win frame Frameset$foot frameset
    catch {unset frameset(dd)}
    set param [lindex $frame(html,$child) 1]
    foreach x [array names frame *,$child] {
	unset frame($x)
    }
    set spec [FramesetSpec $parent $key $foot]
    eval destroy [winfo children $child]
    set frame(frameset) [list [list $child]]
    set frame(level) -1
    HMtag_frameset $win "$key=[join [lindex $spec 1] ,]" {}
    HMtag_frame $win $param {}
    HMtag_frame $win {} {}
    HMtag_/frameset $win {} {}
    FrameSize $win $child $key
    FramesetBind $win $child
    Frameset_ViewSource $win
    FramesetHighlightClear $win $frame(master)
    Input_Dirty $win
}
proc Frameset_Output {win file} {
    if [catch {open $file w} out] {
	Status $win $out
	return 0
    }
    puts $out [Head_Output $win 1]
    puts $out [Frameset_Html $win]
    puts $out "</Head></Html>\n"
    close $out
    return 1
}

proc Frameset_ViewSource {win} {
    upvar #0 Frame$win frame
    if ![winfo exists $frame(top)] {
	return
    }
    set t $frame(top).text
    set s $frame(top).scroll
    if {[winfo exists $t]} {
	$t config -state normal
	$t delete 1.0 end
    } else {
	text $t -height 10 -yscrollcommand "$s set"
	scrollbar $s -command "$t yview" -orient vertical
	pack $s -side right -fill y
	pack $t -side left -fill both -expand true
    }
    $t insert 1.0 [Frameset_Html $win]
    $t config -state disabled
}
proc Frameset_Html {win {f {}} {indent 0}} {
    upvar #0 Frame$win frame
    if {$f == {}} {
	set f $frame(master)
    }
    if [info exists frame(cols,$f)] {
	set key cols
	set spec $frame(cols,$f)
    } else {
	set key rows
	set spec $frame(rows,$f)
    }
    set html "<frameset $key=$spec"
    if {[info exists frame(name,$f)] && 
	    [string compare $frame(name,$f) (noname)] != 0} {
	append html " name=$frame(name,f)"
    }
    if {[info exists frame(src,$f)] && 
	    [string compare $frame(src,$f) {}] != 0} {
	append html " src=$frame(src,f)"
    }
    append html ">\n"
    set pad [format %*s $indent " "]
    foreach child [winfo children $f] {
	if {[winfo class $child] != "Frame"} {
	    continue
	}
	if [winfo exists $child.text] {
	    append html $pad[Frame_Html $win $child]
	} else {
	    append html $pad[Frameset_Html $win $child [incr indent 4]]
	}
    }
    append html "$pad</frameset>\n"
}
proc Frame_Html {win f} {
    upvar #0 Frame$win frame
    return <[join $frame(html,$f) " "]>\n
}

proc Frameset_Close {top} {
    wm withdraw $top
}
proc FramesetClone {new old {color 0xFF}} {
    set i 0
    foreach child [place slaves $old] {
	set f [frame $new.f$i -background [format #%06x $color]]
	array set place [place info $child]
	set place(-in) $new
	eval place $f [array get place]
	set color [format 0x%x [expr ($color << 4) & 0xFFFFFF]]
	if {$color == "0xf00000"} {
	    set color 0xF0000C
	}
	if {$color == "0xc0"} {
	    set color 0xCC
	}
	FramesetClone $f $child $color
	incr i
    }
}
