# $Id: bwidget_workarounds.tcl 1429 2008-05-18 12:36:02Z sergei $

##########################################################################
auto_load Button
rename Button::create Button::create_old

proc Button::create {path args} {

    set new_args {}
    foreach {attr val} $args {
        switch -- $attr {
            -background { }
            default { lappend new_args $attr $val }
        }
    }

    eval [list Button::create_old $path] $new_args
}

##########################################################################
rename menu menu_old

proc menu {path args} {

    set new_args {}
    foreach {attr val} $args {
        switch -- $attr {
            -background { }
            default { lappend new_args $attr $val }
        }
    }

    eval [list menu_old $path] $new_args
}

##########################################################################
if {[info tclversion] >= 8.4} {

    rename frame frame_old

    proc frame {path args} {

	set new_args {}
	foreach {attr val} $args {
	    switch -- $attr {
		-class { 
		    lappend new_args $attr $val 
		    if {$val == "Tree"} {
			lappend new_args -padx 0
		    }
		}
		default { lappend new_args $attr $val }
	    }
	}
    
	eval [list frame_old $path] $new_args
    }
}

##########################################################################
auto_load Tree

proc Tree::_see {path idn {side "none"}} {
    set bbox [$path.c bbox $idn]
    set scrl [$path.c cget -scrollregion]

    set ymax [lindex $scrl 3]
    set dy   [$path.c cget -yscrollincrement]
    set yv   [$path yview]
    set yv0  [expr {round([lindex $yv 0]*$ymax/$dy)}]
    set yv1  [expr {int([lindex $yv 1]*$ymax/$dy + 0.1)}]
    set y    [expr {int([lindex [$path.c coords $idn] 1]/$dy)}]
    if { $y < $yv0 } {
        $path.c yview scroll [expr {$y-$yv0}] units
    } elseif { $y >= $yv1 } {
        $path.c yview scroll [expr {$y-$yv1+1}] units
    }

    set xmax [lindex $scrl 2]
    set dx   [$path.c cget -xscrollincrement]
    set xv   [$path xview]
    if { ![string compare $side "none"] } {
	set x0   [expr {int([lindex $bbox 0]/$dx)}]
	set xv0  [expr {round([lindex $xv 0]*$xmax/$dx)}]
	set xv1  [expr {round([lindex $xv 1]*$xmax/$dx)}]
	if { $x0 >= $xv1 || $x0 < $xv0 } {
	    $path.c xview scroll [expr {$x0-$xv0}] units
	}
    } elseif { ![string compare $side "right"] } {
        set xv1 [expr {round([lindex $xv 1]*$xmax/$dx)}]
        set x1  [expr {int([lindex $bbox 2]/$dx)}]
        if { $x1 >= $xv1 } {
            $path.c xview scroll [expr {$x1-$xv1+1}] units
        }
    } else {
        set xv0 [expr {round([lindex $xv 0]*$xmax/$dx)}]
        set x0  [expr {int([lindex $bbox 0]/$dx)}]
        if { $x0 < $xv0 } {
            $path.c xview scroll [expr {$x0-$xv0}] units
        }
    }
}

rename Tree::create Tree::create:old

proc Tree::create {path args} {
    eval [list Tree::create:old $path] $args

    Tree::bindText  $path <Control-Button-1> [list $path selection set]
    Tree::bindImage $path <Control-Button-1> [list $path selection set]

    return $path
}

##########################################################################
if {0 && [info tclversion] >= 8.5} {

    proc PanedWin {path args} {
	set newargs [list -showhandle 0]
	set pad 0
	foreach {key val} $args {
	    switch -- $key {
		-side {
		    switch -- $val {
			left -
			right {
			    lappend newargs -orient vertical
			}
			top -
			bottom {
			    lappend newargs -orient horizontal
			}
		    }
		}
		-pad {
		    set pad [expr {$pad + $val}]
		}
		-width {
		    set pad [expr {$pad + ($val >> 2)}]
		}
	    }
	}

	if {$pad > 0} {
	    lappend newargs -sashpad $pad
	}

	return [eval [list panedwindow $path] $newargs]
    }

    proc PanedWinAdd {path args} {
	set newargs {}
	foreach {key val} $args {
	    switch -- $key {
		-minsize {
		    lappend newargs -minsize $val
		}
		-weight {
		    if {$val == 0} {
			lappend newargs -stretch never
		    } else {
			lappend newargs -stretch always
		    }
		}
	    }
	}
	set idx [llength [$path panes]]
	set f [frame $path.frame$idx]
	eval [list $path add $f] $newargs
	return $f
    }

    proc PanedWinConf {path index args} {
	lassign $args key val
	set f [lindex [$path panes] $index]
	switch -- [llength $args] {
	    1 {
		switch -- $key {
		    -width {
			return [$path panecget $f -width]
		    }
		    default {
			return -code error "PanedWinConf: Unknown option $key"
		    }
		}
	    }
	    2 {
		switch -- $key {
		    -width {
			puts "$index $f $val"
			$path paneconfigure $f -width $val
		    }
		    default {
			return -code error "PanedWinConf: Unknown option $key"
		    }
		}
	    }
	    default {
		return -code error "PanedWinConf: Illegal number of arguments"
	    }
	}
    }

} else {

    proc PanedWin {path args} {
	if {[catch {
		 eval [list PanedWindow $path] $args -activator line
	     } res]} {
	    return [eval [list PanedWindow $path] $args]
	} else {
	    return $res
	}
    }

    proc PanedWinAdd {path args} {
	set res [eval [list $path add] $args]
	catch {
	    set activator [Widget::getoption $path -activator]
	    if {$activator == ""} {
		if { $::tcl_platform(platform) != "windows" } {
		    set activator button
		} else {
		    set activator line
		}
	    }

	    if {$activator == "line"} {
		set side [Widget::getoption $path -side]
		set num $PanedWindow::_panedw($path,nbpanes)
		incr num -1
		if {$num > 0} {
		    $path.sash$num.sep configure -relief flat
		    if {$side == "top" || $side == "bottom"} {
			place configure $path.sash$num.sep -width 4
		    } else {
			place configure $path.sash$num.sep -height 4
		    }
		}
	    }
	}
	return $res
    }

    proc PanedWinConf {path index args} {
	lassign $args key val
	set f [winfo parent [$path getframe $index]]
	switch -- [llength $args] {
	    1 {
		switch -- $key {
		    -width {
			return [$f cget -width]
		    }
		    default {
			return -code error "PanedWinConf: Unknown option $key"
		    }
		}
	    }
	    2 {
		switch -- $key {
		    -width {
			$f configure -width $val
		    }
		    default {
			return -code error "PanedWinConf: Unknown option $key"
		    }
		}
	    }
	    default {
		return -code error "PanedWinConf: Illegal number of arguments"
	    }
	}
    }

}

##########################################################################
auto_load ComboBox

option add *ComboBox.listRelief ridge widgetDefault
option add *ComboBox.listBorder 2 widgetDefault

rename ComboBox::_create_popup ComboBox::_create_popup_old

proc ComboBox::_create_popup {path args} {

    eval [list ComboBox::_create_popup_old $path] $args
    $path.shell configure \
	    -relief [option get $path listRelief ComboBox] \
	    -border [option get $path listBorder ComboBox]
}

rename ComboBox::create ComboBox::create_old

proc ComboBox::create {path args} {
    set hlthick $::tk_highlightthickness
    foreach {opt arg} $args {
	if {[cequal $opt "-highlightthickness"]} {
	    set hlthick $arg
	}
    }
    eval [list ComboBox::create_old $path] $args -highlightthickness 0
    $path:cmd configure -highlightthickness $hlthick

    return $path
}

##########################################################################
auto_load NoteBook

if {![catch { rename NoteBook::_get_page_name NoteBook::_get_page_name:old }]} {
    proc NoteBook::_get_page_name { path {item current} {tagindex end-1} } {
	set pagename [NoteBook::_get_page_name:old $path $item $tagindex]
	if {[catch { NoteBook::_test_page $path $pagename }]} {
	    return [string range [lindex [$path.c gettags $item] 1] 2 end]
	} else {
	    return $pagename
	}
    }
}

##########################################################################
if {($::tcl_platform(platform) != "unix") || ($::aquaP)} {
    auto_load SelectFont

    rename SelectFont::create SelectFont::create:old

    proc SelectFont::create {path args} {
	eval [list SelectFont::create:old $path] $args

	foreach style {bold italic underline overstrike} {
	    if {![catch { set bd [option get $path.$style \
				      borderWidth Button] }]} {
		if {$bd != ""} {
		    $path.$style configure -bd $bd
		}
	    }
	}
	return $path
    }
}

##########################################################################
proc BWidget::bindMouseWheel {widget} {}

##########################################################################
auto_load Dialog

rename Dialog::create Dialog::create:old

proc Dialog::create {path args} {
    toplevel $path
    wm withdraw $path
    set parent [winfo parent $path]
    destroy $path
    set transient 1
    set newargs {}
    foreach {key val} $args {
	switch -- $key {
	    -parent { set parent $val ; lappend newargs -parent $val }
	    -transient { set transient $val }
	    default { lappend newargs $key $val }
	}
    }
    # Do not make a dialog window transient if its parent isn't vewable.
    # Otherwise it leads to hang of a whole application.
    if {$parent == ""} {
	set parent .
    }
    if {![winfo viewable [winfo toplevel $parent]] } {
	set transient 0
    }
    eval {Dialog::create:old $path -transient $transient} $newargs
}

##########################################################################

