#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Button.tcl,v $
# $Date: 2001/07/10 15:36:10 $
# $Revision: 1.18.1.16 $
#
# ----------------------------------------------------------------------
#   AUTHOR:  Lindsay Marshall <lindsay.marshall@newcastle.ac.uk>
# ----------------------------------------------------------------------
# Copyright 2000 The University of Newcastle upon Tyne (see COPYRIGHT)
# ======================================================================
#
#
package provide zircon 1.18
#
proc mbproc {name op arg} {
    switch cget $op {
	switch -- [lindex $arg 0] {
	    -menu { return $name.menu }
	    -indicatoron { return 0 }
	    -direction { return below }
	}
    }
    return [eval mb$name $op $arg]
}
#
proc buttonmenu {name args} {
    eval button $name $args
    rename $name mb$name
    proc $name {unusedop args} "return \[mbproc $name \$unusedop \$args\]"
    bindtags $name "$name ButtonMenu . all"
    return $name
} 
#
proc addImage {w name prnt col net} {
    global zircon button1 bbc fbc
    if {[$net images]} {
	$w configure -image $button1 \
	  -width [image width $button1] -height [image height $button1] \
	  -borderwidth 0 -relief flat -highlightthickness 0 \
	  -padx 0 -pady 0 -activebackground $fbc -background $fbc
	grid columnconfigure $prnt $col -weight 1
	grid $w -in $prnt -row 0 -column $col -sticky ew
	set lb [label $w@l -text [trans $name] -bg $bbc]
	foreach x [bind [set typ [lindex [bindtags $w] 1]]] {
	    regsub -all {%W} [bind $typ $x] $w bnd
	    bind $lb $x $bnd
	}
	foreach x [bind $w] {
	    regsub -all {%W} [bind $w $x] $w bnd
	    bind $lb $x $bnd
	}
	bind $lb <Enter> "
	    %W configure -foreground red
	    [bind $lb <Enter>]
	"
	grid $lb -in $prnt -row 0 -column $col
	bind $w <Enter> {%W@l configure -foreground red ; continue}
	bind $w <Leave> {%W@l configure -foreground black ; continue}
    } {
	grid $w -in $prnt -row 0 -column $col -sticky ew
	grid columnconfigure $prnt $col -weight 1
    }
}
