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

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

proc Frameset_Edit {{win {}}} {
    if {$win == {}} {
	return
    }
    upvar #0 Frame$win frame
    if {[winfo toplevel $win] == "."} {
	set top .fse
    } else {
	set top [winfo toplevel $win].fse
    }
    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
    }
    if {[winfo exists $win]} {
	FramesetBind $win $frame(master)
	FramesetHighlight $win $frame(master)
	Frameset_ViewSource $win
    }
}
proc FramesetBind {win parent} {
    foreach f [grid slaves $parent] {
	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 FramesetHighlight {win f} {
    upvar #0 Frame$win frame
    Stderr "FramesetHighlight $win $f"
    FramesetHighlightClear $win $frame(master)
    if [info exists frame(column,$f)] {
	set key column
    } else {
	set key row
    }
    upvar #0 Frame_$key F
    set spec $frame($key,$f)
    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]
	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]]
	Stderr "place $bar -$F(d) $d $F(args0) -in $f"
	eval {place $bar -$F(d) $d} $F(args0) {-in $f}
	eval {place $box -$F(d) $d -rel$F(d) -0.01} $F(boxargs) {-in $f}
	bind $bar <B1-Motion> \
	    [list FramesetDrag %W $box -$F(d) %$F(D) $f $bars $boxes $key]
	bind $bar <ButtonRelease-1> \
		[list FramesetDragStop %W $win $f $children $bars $key]
	incr i
    }
    FramespecFeedback $f $key $bars $boxes
}
proc FramesetHighlightClear {win f} {
    eval destroy [place slaves $f]
    foreach child [grid slaves $f] {
	FramesetHighlightClear $win $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 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 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 {
	grid ${key}configure $parent $i -minsize 0
	catch {unset frame($key,$parent,$i,size)}
	catch {unset frame($key,$parent,$i,weight)}
	catch {unset frame($key,$parent,$i,percent)}
	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 -$F(other) 0 -sticky news
	set newwin [Window_Frame $win $parent.f$i none 0 0]
	set frame($key,$parent,$i,frame) $f
    }
    eval [bind $parent <Configure>]
    if [info exists newwin] {
	FramesetHighlightClear $win $parent
    }
    catch {unset frameset(d)}
    Frameset_ViewSource $win
}
proc FramesetSpec {parent key bars} {
    upvar #0 Frame_$key F
    set coords 0
    foreach bar $bars {
	array set place [place info $bar]
	lappend coords $place(-$F(d))
    }
    set total [winfo $F(size) $parent]
    set last 0
    set fixed ""
    set percent ""
    foreach c [lrange $coords 1 end] {
	set delta [expr $c - $last]
	lappend fixed $delta
	lappend percent [format %2.0f%% [expr int(double($delta)*100.0/double($total))]]
	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
	lappend percent [format %2.0f%% [expr int(double($delta)*100.0/double($total))]]
    }
    return [list $fixed $percent]
}

proc Frameset_ViewSource {win} {
    upvar #0 Frame$win frame
    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(column,$f)] {
	set key column
    } else {
	set key row
    }
    set html "<frameset $key=$frame($key,$f)"
    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 [grid slaves $f] {
	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 <$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
    }
}
