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