source: trunk/BWidget-1.2.1/label.tcl

Last change on this file was 931, checked in by toby, 11 years ago

include rest of files

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