1# ------------------------------------------------------------------------------ 2# label.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: label.tcl,v 1.12 2009/10/25 20:55:36 oberdorfer Exp $ 5# ------------------------------------------------------------------------------ 6# Index of commands: 7# - Label::create 8# - Label::configure 9# - Label::cget 10# - Label::setfocus 11# - Label::_drag_cmd 12# - Label::_drop_cmd 13# - Label::_over_cmd 14# ------------------------------------------------------------------------------ 15 16namespace eval Label { 17 Widget::define Label label DragSite DropSite DynamicHelp 18 19 Widget::tkinclude Label label .l \ 20 remove { -foreground -text -textvariable -underline } 21 22 Widget::declare Label { 23 {-name String "" 0} 24 {-text String "" 0} 25 {-textvariable String "" 0} 26 {-underline Int -1 0 "%d >= -1"} 27 {-focus String "" 0} 28 {-foreground Color "SystemWindowText" 0} 29 {-background Color "SystemWindowFrame" 0} 30 {-disabledforeground Color "SystemDisabledText" 0} 31 {-state Enum normal 0 {normal disabled}} 32 {-fg Synonym -foreground} 33 } 34 35 DynamicHelp::include Label balloon 36 DragSite::include Label "" 1 37 DropSite::include Label { 38 TEXT {move {}} 39 IMAGE {move {}} 40 BITMAP {move {}} 41 FGCOLOR {move {}} 42 BGCOLOR {move {}} 43 COLOR {move {}} 44 } 45 46 Widget::syncoptions Label "" .l {-text {} -underline {}} 47 48 bind BwLabel <FocusIn> [list Label::setfocus %W] 49 bind BwLabel <Destroy> [list Label::_destroy %W] 50} 51 52 53# ------------------------------------------------------------------------------ 54# Command Label::create 55# ------------------------------------------------------------------------------ 56proc Label::create { path args } { 57 array set maps [list Label {} .l {}] 58 array set maps [Widget::parseArgs Label $args] 59 60 BWidget::wrap frame $path \ 61 -class Label -borderwidth 0 -highlightthickness 0 -relief flat 62 63 Widget::initFromODB Label $path $maps(Label) 64 65 eval [list label $path.l] $maps(.l) 66 67 if { [Widget::cget $path -state] == "normal" } { 68 set fg [Widget::cget $path -foreground] 69 } else { 70 set fg [Widget::cget $path -disabledforeground] 71 } 72 73 set var [Widget::cget $path -textvariable] 74 if { $var == "" && 75 [Widget::cget $path -image] == "" && 76 [Widget::cget $path -bitmap] == ""} { 77 set desc [BWidget::getname [Widget::cget $path -name]] 78 if { $desc != "" } { 79 set text [lindex $desc 0] 80 set under [lindex $desc 1] 81 } else { 82 set text [Widget::cget $path -text] 83 set under [Widget::cget $path -underline] 84 } 85 } else { 86 set under -1 87 set text "" 88 } 89 90 $path.l configure -text $text -textvariable $var \ 91 -underline $under -foreground $fg 92 93 set accel [string tolower [string index $text $under]] 94 if { $accel != "" } { 95 bind [winfo toplevel $path] <Alt-$accel> "Label::setfocus $path" 96 } 97 98 bindtags $path [list BwLabel [winfo toplevel $path] all] 99 bindtags $path.l [list $path.l $path Label [winfo toplevel $path] all] 100 pack $path.l -expand yes -fill both 101 102 set dragendcmd [Widget::cget $path -dragendcmd] 103 DragSite::setdrag $path $path.l Label::_init_drag_cmd $dragendcmd 1 104 DropSite::setdrop $path $path.l Label::_over_cmd Label::_drop_cmd 1 105 DynamicHelp::sethelp $path $path.l 1 106 107 return [Widget::create Label $path] 108} 109 110 111# ------------------------------------------------------------------------------ 112# Command Label::configure 113# ------------------------------------------------------------------------------ 114proc Label::configure { path args } { 115 set oldunder [$path.l cget -underline] 116 if { $oldunder != -1 } { 117 set oldaccel [string tolower [string index [$path.l cget -text] $oldunder]] 118 } else { 119 set oldaccel "" 120 } 121 set res [Widget::configure $path $args] 122 123 set cfg [Widget::hasChanged $path -foreground fg] 124 set cdfg [Widget::hasChanged $path -disabledforeground dfg] 125 set cst [Widget::hasChanged $path -state state] 126 127 if { $cst || $cfg || $cdfg } { 128 if { $state == "normal" } { 129 $path.l configure -fg $fg 130 } else { 131 $path.l configure -fg $dfg 132 } 133 } 134 135 set cv [Widget::hasChanged $path -textvariable var] 136 set cb [Widget::hasChanged $path -image img] 137 set ci [Widget::hasChanged $path -bitmap bmp] 138 set cn [Widget::hasChanged $path -name name] 139 set ct [Widget::hasChanged $path -text text] 140 set cu [Widget::hasChanged $path -underline under] 141 142 if { $cv || $cb || $ci || $cn || $ct || $cu } { 143 if { $var == "" && $img == "" && $bmp == "" } { 144 set desc [BWidget::getname $name] 145 if { $desc != "" } { 146 set text [lindex $desc 0] 147 set under [lindex $desc 1] 148 } 149 } else { 150 set under -1 151 set text "" 152 } 153 set top [winfo toplevel $path] 154 if { $oldaccel != "" } { 155 bind $top <Alt-$oldaccel> {} 156 } 157 set accel [string tolower [string index $text $under]] 158 if { $accel != "" } { 159 bind $top <Alt-$accel> [list Label::setfocus $path] 160 } 161 $path.l configure -text $text -underline $under -textvariable $var 162 } 163 164 set force [Widget::hasChanged $path -dragendcmd dragend] 165 DragSite::setdrag $path $path.l Label::_init_drag_cmd $dragend $force 166 DropSite::setdrop $path $path.l Label::_over_cmd Label::_drop_cmd 167 DynamicHelp::sethelp $path $path.l 168 169 return $res 170} 171 172 173# ------------------------------------------------------------------------------ 174# Command Label::cget 175# ------------------------------------------------------------------------------ 176proc Label::cget { path option } { 177 return [Widget::cget $path $option] 178} 179 180 181# ------------------------------------------------------------------------------ 182# Command Label::setfocus 183# ------------------------------------------------------------------------------ 184proc Label::setfocus { path } { 185 if { [string equal [Widget::cget $path -state] "normal"] } { 186 set w [Widget::cget $path -focus] 187 if { [winfo exists $w] && [Widget::focusOK $w] } { 188 focus $w 189 } 190 } 191} 192 193 194# ------------------------------------------------------------------------------ 195# Command Label::_init_drag_cmd 196# ------------------------------------------------------------------------------ 197proc Label::_init_drag_cmd { path X Y top } { 198 set path [winfo parent $path] 199 if { [set cmd [Widget::cget $path -draginitcmd]] != "" } { 200 return [uplevel \#0 $cmd [list $path $X $Y $top]] 201 } 202 if { [set data [$path.l cget -image]] != "" } { 203 set type "IMAGE" 204 pack [label $top.l -image $data] 205 } elseif { [set data [$path.l cget -bitmap]] != "" } { 206 set type "BITMAP" 207 pack [label $top.l -bitmap $data] 208 } else { 209 set data [$path.l cget -text] 210 set type "TEXT" 211 } 212 set usertype [Widget::getoption $path -dragtype] 213 if { $usertype != "" } { 214 set type $usertype 215 } 216 return [list $type {copy} $data] 217} 218 219 220# ------------------------------------------------------------------------------ 221# Command Label::_drop_cmd 222# ------------------------------------------------------------------------------ 223proc Label::_drop_cmd { path source X Y op type data } { 224 set path [winfo parent $path] 225 if { [set cmd [Widget::cget $path -dropcmd]] != "" } { 226 return [uplevel \#0 $cmd [list $path $source $X $Y $op $type $data]] 227 } 228 if { $type == "COLOR" || $type == "FGCOLOR" } { 229 configure $path -foreground $data 230 } elseif { $type == "BGCOLOR" } { 231 configure $path -background $data 232 } else { 233 set text "" 234 set image "" 235 set bitmap "" 236 switch -- $type { 237 IMAGE {set image $data} 238 BITMAP {set bitmap $data} 239 default { 240 set text $data 241 if { [set var [$path.l cget -textvariable]] != "" } { 242 configure $path -image "" -bitmap "" 243 GlobalVar::setvar $var $data 244 return 245 } 246 } 247 } 248 configure $path -text $text -image $image -bitmap $bitmap 249 } 250 return 1 251} 252 253 254# ------------------------------------------------------------------------------ 255# Command Label::_over_cmd 256# ------------------------------------------------------------------------------ 257proc Label::_over_cmd { path source event X Y op type data } { 258 set path [winfo parent $path] 259 if { [set cmd [Widget::cget $path -dropovercmd]] != "" } { 260 return [uplevel \#0 $cmd [list $path $source $event $X $Y $op $type $data]] 261 } 262 if { [Widget::getoption $path -state] == "normal" || 263 $type == "COLOR" || $type == "FGCOLOR" || $type == "BGCOLOR" } { 264 DropSite::setcursor based_arrow_down 265 return 1 266 } 267 DropSite::setcursor dot 268 return 0 269} 270 271 272proc Label::_destroy { path } { 273 Widget::destroy $path 274} 275