Artifact c308452fdeab656eaa8e7c2f657a39a87eee1b69:
# ------------------------------------------------------------------------------
# label.tcl
# This file is part of Unifix BWidget Toolkit
# $Id: label.tcl,v 1.10.2.3 2011/04/26 08:24:28 oehhar Exp $
# ------------------------------------------------------------------------------
# Index of commands:
# - Label::create
# - Label::configure
# - Label::cget
# - Label::setfocus
# - Label::_drag_cmd
# - Label::_drop_cmd
# - Label::_over_cmd
# ------------------------------------------------------------------------------
namespace eval Label {
Widget::define Label label DragSite DropSite DynamicHelp
if {$::Widget::_theme} {
Widget::tkinclude Label label .l \
remove { -foreground -text -textvariable -underline -state}
} else {
Widget::tkinclude Label label .l \
remove { -foreground -text -textvariable -underline }
}
Widget::declare Label {
{-name String "" 0}
{-text String "" 0}
{-textvariable String "" 0}
{-underline Int -1 0 "%d >= -1"}
{-focus String "" 0}
{-foreground TkResource "" 0 label}
{-disabledforeground TkResource "" 0 button}
{-state Enum normal 0 {normal disabled}}
{-fg Synonym -foreground}
}
DynamicHelp::include Label balloon
DragSite::include Label "" 1
DropSite::include Label {
TEXT {move {}}
IMAGE {move {}}
BITMAP {move {}}
FGCOLOR {move {}}
BGCOLOR {move {}}
COLOR {move {}}
}
bind BwLabel <FocusIn> [list Label::setfocus %W]
bind BwLabel <Destroy> [list Label::_destroy %W]
}
# ------------------------------------------------------------------------------
# Command Label::create
# ------------------------------------------------------------------------------
proc Label::create { path args } {
array set maps [list Label {} .l {}]
array set maps [Widget::parseArgs Label $args]
frame $path -class Label -borderwidth 0 -highlightthickness 0 -relief flat -padx 0 -pady 0
Widget::initFromODB Label $path $maps(Label)
if {$::Widget::_theme} {
eval [list ttk::label $path.l] $maps(.l)
} else {
eval [list label $path.l] $maps(.l)
}
if {$::Widget::_theme} {
if { [Widget::cget $path -state] != "normal" } {
$path.l state disabled
}
} else {
if { [Widget::cget $path -state] == "normal" } {
set fg [Widget::cget $path -foreground]
} else {
set fg [Widget::cget $path -disabledforeground]
}
$path.l configure -foreground $fg
}
set var [Widget::cget $path -textvariable]
if { $var == "" &&
[Widget::cget $path -image] == "" &&
($::Widget::_theme || [Widget::cget $path -bitmap] == "")} {
set desc [BWidget::getname [Widget::cget $path -name]]
if { $desc != "" } {
set text [lindex $desc 0]
set under [lindex $desc 1]
} else {
set text [Widget::cget $path -text]
set under [Widget::cget $path -underline]
}
} else {
set under -1
set text ""
}
$path.l configure -text $text -textvariable $var \
-underline $under
set accel [string tolower [string index $text $under]]
if { $accel != "" } {
bind [winfo toplevel $path] <Alt-$accel> "Label::setfocus $path"
}
bindtags $path [list BwLabel [winfo toplevel $path] all]
bindtags $path.l [list $path.l $path Label [winfo toplevel $path] all]
pack $path.l -expand yes -fill both
set dragendcmd [Widget::cget $path -dragendcmd]
DragSite::setdrag $path $path.l Label::_init_drag_cmd $dragendcmd 1
DropSite::setdrop $path $path.l Label::_over_cmd Label::_drop_cmd 1
DynamicHelp::sethelp $path $path.l 1
return [Widget::create Label $path]
}
# ------------------------------------------------------------------------------
# Command Label::configure
# ------------------------------------------------------------------------------
proc Label::configure { path args } {
set oldunder [$path.l cget -underline]
if { $oldunder != -1 } {
set oldaccel [string tolower [string index [$path.l cget -text] $oldunder]]
} else {
set oldaccel ""
}
set res [Widget::configure $path $args]
set cfg [Widget::hasChanged $path -foreground fg]
set cst [Widget::hasChanged $path -state state]
if {$::Widget::_theme} {
if { $cfg } {
$path.l configure -foreground $fg
}
if { $cst } {
if { $state == "normal" } {
$path.l state !disabled
} else {
$path.l state disabled
}
}
} else {
set cdfg [Widget::hasChanged $path -disabledforeground dfg]
if { $cst || $cfg || $cdfg } {
if { $state == "normal" } {
$path.l configure -fg $fg
} else {
$path.l configure -fg $dfg
}
}
}
set cv [Widget::hasChanged $path -textvariable var]
set cb [Widget::hasChanged $path -image img]
if {$::Widget::_theme} {
set ci 0
set bmp ""
} else {
set ci [Widget::hasChanged $path -bitmap bmp]
}
set cn [Widget::hasChanged $path -name name]
set ct [Widget::hasChanged $path -text text]
set cu [Widget::hasChanged $path -underline under]
if { $cv || $cb || $ci || $cn || $ct || $cu } {
if { $var == "" && $img == "" && $bmp == "" } {
set desc [BWidget::getname $name]
if { $desc != "" } {
set text [lindex $desc 0]
set under [lindex $desc 1]
}
} else {
set under -1
set text ""
}
set top [winfo toplevel $path]
if { $oldaccel != "" } {
bind $top <Alt-$oldaccel> {}
}
set accel [string tolower [string index $text $under]]
if { $accel != "" } {
bind $top <Alt-$accel> [list Label::setfocus $path]
}
$path.l configure -text $text -underline $under -textvariable $var
}
set force [Widget::hasChanged $path -dragendcmd dragend]
DragSite::setdrag $path $path.l Label::_init_drag_cmd $dragend $force
DropSite::setdrop $path $path.l Label::_over_cmd Label::_drop_cmd
DynamicHelp::sethelp $path $path.l
return $res
}
# ------------------------------------------------------------------------------
# Command Label::cget
# ------------------------------------------------------------------------------
proc Label::cget { path option } {
return [Widget::cget $path $option]
}
# ----------------------------------------------------------------------------
# Command Label::identify
# ----------------------------------------------------------------------------
proc Label::identify { path args } {
eval $path.l identify $args
}
# ----------------------------------------------------------------------------
# Command Label::instate
# ----------------------------------------------------------------------------
proc Label::instate { path args } {
eval $path.l instate $args
}
# ----------------------------------------------------------------------------
# Command Label::state
# ----------------------------------------------------------------------------
proc Label::state { path args } {
eval $path.l state $args
}
# ------------------------------------------------------------------------------
# Command Label::setfocus
# ------------------------------------------------------------------------------
proc Label::setfocus { path } {
if { [string equal [Widget::cget $path -state] "normal"] } {
set w [Widget::cget $path -focus]
if { [winfo exists $w] && [Widget::focusOK $w] } {
focus $w
}
}
}
# ------------------------------------------------------------------------------
# Command Label::_init_drag_cmd
# ------------------------------------------------------------------------------
proc Label::_init_drag_cmd { path X Y top } {
set path [winfo parent $path]
if { [set cmd [Widget::cget $path -draginitcmd]] != "" } {
return [uplevel \#0 $cmd [list $path $X $Y $top]]
}
if { [set data [$path.l cget -image]] != "" } {
set type "IMAGE"
pack [label $top.l -image $data]
} elseif { [set data [$path.l cget -bitmap]] != "" } {
set type "BITMAP"
pack [label $top.l -bitmap $data]
} else {
set data [$path.l cget -text]
set type "TEXT"
}
set usertype [Widget::getoption $path -dragtype]
if { $usertype != "" } {
set type $usertype
}
return [list $type {copy} $data]
}
# ------------------------------------------------------------------------------
# Command Label::_drop_cmd
# ------------------------------------------------------------------------------
proc Label::_drop_cmd { path source X Y op type data } {
set path [winfo parent $path]
if { [set cmd [Widget::cget $path -dropcmd]] != "" } {
return [uplevel \#0 $cmd [list $path $source $X $Y $op $type $data]]
}
if { $type == "COLOR" || $type == "FGCOLOR" } {
configure $path -foreground $data
} elseif { $type == "BGCOLOR" } {
configure $path -background $data
} else {
set text ""
set image ""
set bitmap ""
switch -- $type {
IMAGE {set image $data}
BITMAP {set bitmap $data}
default {
set text $data
if { [set var [$path.l cget -textvariable]] != "" } {
configure $path -image "" -bitmap ""
GlobalVar::setvar $var $data
return
}
}
}
configure $path -text $text -image $image -bitmap $bitmap
}
return 1
}
# ------------------------------------------------------------------------------
# Command Label::_over_cmd
# ------------------------------------------------------------------------------
proc Label::_over_cmd { path source event X Y op type data } {
set path [winfo parent $path]
if { [set cmd [Widget::cget $path -dropovercmd]] != "" } {
return [uplevel \#0 $cmd [list $path $source $event $X $Y $op $type $data]]
}
if { [Widget::getoption $path -state] == "normal" ||
$type == "COLOR" || $type == "FGCOLOR" || $type == "BGCOLOR" } {
DropSite::setcursor based_arrow_down
return 1
}
DropSite::setcursor dot
return 0
}
proc Label::_destroy { path } {
Widget::destroy $path
}