source: trunk/BWidget-1.2.1/button.tcl

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

include rest of files

File size: 9.9 KB
Line 
1# ------------------------------------------------------------------------------
2#  button.tcl
3#  This file is part of Unifix BWidget Toolkit
4# ------------------------------------------------------------------------------
5#  Index of commands:
6#   Public commands
7#     - Button::create
8#     - Button::configure
9#     - Button::cget
10#     - Button::invoke
11#   Private commands (event bindings)
12#     - Button::_destroy
13#     - Button::_enter
14#     - Button::_leave
15#     - Button::_press
16#     - Button::_release
17#     - Button::_repeat
18# ------------------------------------------------------------------------------
19
20namespace eval Button {
21    Widget::tkinclude Button button :cmd \
22        remove {-command -relief -text -textvariable -underline}
23
24    Widget::declare Button {
25        {-name            String "" 0}
26        {-text            String "" 0}
27        {-textvariable    String "" 0}
28        {-underline       Int    -1 0 {=-1}}
29        {-armcommand      String "" 0}
30        {-disarmcommand   String "" 0}
31        {-command         String "" 0}
32        {-repeatdelay     Int    0  0 {=0 ""}}
33        {-repeatinterval  Int    0  0 {=0 ""}}
34        {-relief          Enum   raised  0 {raised sunken flat ridge solid groove link}}
35    }
36
37    DynamicHelp::include Button balloon
38
39    Widget::syncoptions Button "" :cmd {-text {} -underline {}}
40
41    variable _current ""
42    variable _pressed ""
43
44    bind BwButton <Enter>           {Button::_enter %W}
45    bind BwButton <Leave>           {Button::_leave %W}
46    bind BwButton <ButtonPress-1>   {Button::_press %W}
47    bind BwButton <ButtonRelease-1> {Button::_release %W}
48    bind BwButton <Key-space>       {Button::invoke %W; break}
49    bind BwButton <Return>          {Button::invoke %W; break}
50    bind BwButton <Destroy>         {Widget::destroy %W; rename %W {}}
51
52    proc ::Button { path args } { return [eval Button::create $path $args] }
53    proc use {} {}
54}
55
56
57# ------------------------------------------------------------------------------
58#  Command Button::create
59# ------------------------------------------------------------------------------
60proc Button::create { path args } {
61    Widget::init Button $path $args
62
63    set relief [Widget::getoption $path -relief]
64    if { ![string compare $relief "link"] } {
65        set relief "flat"
66    }
67
68    set var [Widget::getoption $path -textvariable]
69    if {  ![string length $var] } {
70        set desc [BWidget::getname [Widget::getoption $path -name]]
71        if { [llength $desc] } {
72            set text  [lindex $desc 0]
73            set under [lindex $desc 1]
74            Widget::setoption $path -text $text
75            Widget::setoption $path -underline $under
76        } else {
77            set text  [Widget::getoption $path -text]
78            set under [Widget::getoption $path -underline]
79        }
80    } else {
81        set under -1
82        set text  ""
83        Widget::setoption $path -underline $under
84    }
85
86    eval button $path [Widget::subcget $path :cmd] \
87        [list -relief $relief -text $text -underline $under -textvariable $var]
88    bindtags $path [list $path BwButton [winfo toplevel $path] all]
89
90    set accel [string tolower [string index $text $under]]
91    if { $accel != "" } {
92        bind [winfo toplevel $path] <Alt-$accel> "Button::invoke $path"
93    }
94
95    DynamicHelp::sethelp $path $path 1
96
97    rename $path ::$path:cmd
98    proc ::$path { cmd args } "return \[eval Button::\$cmd $path \$args\]"
99
100    return $path
101}
102
103
104# ------------------------------------------------------------------------------
105#  Command Button::configure
106# ------------------------------------------------------------------------------
107proc Button::configure { path args } {
108    set oldunder [$path:cmd cget -underline]
109    if { $oldunder != -1 } {
110        set oldaccel [string tolower [string index [$path:cmd cget -text] $oldunder]]
111    } else {
112        set oldaccel ""
113    }
114    set res [Widget::configure $path $args]
115
116    set rc [Widget::hasChanged $path -relief relief]
117    set sc [Widget::hasChanged $path -state  state]
118
119    if { $rc || $sc } {
120        if { ![string compare $relief "link"] } {
121            if { ![string compare $state "active"] } {
122                set relief "raised"
123            } else {
124                set relief "flat"
125            }
126        }
127        $path:cmd configure -relief $relief -state $state
128    }
129
130    set cv [Widget::hasChanged $path -textvariable var]
131    set cn [Widget::hasChanged $path -name name]
132    set ct [Widget::hasChanged $path -text text]
133    set cu [Widget::hasChanged $path -underline under]
134
135    if { $cv || $cn || $ct || $cu } {
136        if {  ![string length $var] } {
137            set desc [BWidget::getname $name]
138            if { [llength $desc] } {
139                set text  [lindex $desc 0]
140                set under [lindex $desc 1]
141            }
142        } else {
143            set under -1
144            set text  ""
145        }
146        set top [winfo toplevel $path]
147        bind $top <Alt-$oldaccel> {}
148        set accel [string tolower [string index $text $under]]
149        if { $accel != "" } {
150            bind $top <Alt-$accel> "Button::invoke $path"
151        }
152        $path:cmd configure -text $text -underline $under -textvariable $var
153    }
154    DynamicHelp::sethelp $path $path
155
156    return $res
157}
158
159
160# ------------------------------------------------------------------------------
161#  Command Button::cget
162# ------------------------------------------------------------------------------
163proc Button::cget { path option } {
164    return [Widget::cget $path $option]
165}
166
167
168# ------------------------------------------------------------------------------
169#  Command Button::invoke
170# ------------------------------------------------------------------------------
171proc Button::invoke { path } {
172    if { [string compare [$path:cmd cget -state] "disabled"] } {
173        $path:cmd configure -state active -relief sunken
174        update idletasks
175        if { [set cmd [Widget::getoption $path -armcommand]] != "" } {
176            uplevel \#0 $cmd
177        }
178        after 100
179        set relief [Widget::getoption $path -relief]
180        if { ![string compare $relief "link"] } {
181            set relief flat
182        }
183        $path:cmd configure \
184            -state  [Widget::getoption $path -state] \
185            -relief $relief
186        if { [set cmd [Widget::getoption $path -disarmcommand]] != "" } {
187            uplevel \#0 $cmd
188        }
189        if { [set cmd [Widget::getoption $path -command]] != "" } {
190            uplevel \#0 $cmd
191        }
192    }
193}
194
195
196# ------------------------------------------------------------------------------
197#  Command Button::_enter
198# ------------------------------------------------------------------------------
199proc Button::_enter { path } {
200    variable _current
201    variable _pressed
202
203    set _current $path
204    if { [string compare [$path:cmd cget -state] "disabled"] } {
205        $path:cmd configure -state active
206        if { $_pressed == $path } {
207            $path:cmd configure -relief sunken
208        } elseif { ![string compare [Widget::getoption $path -relief] "link"] } {
209            $path:cmd configure -relief raised
210        }
211    }
212}
213
214
215# ------------------------------------------------------------------------------
216#  Command Button::_leave
217# ------------------------------------------------------------------------------
218proc Button::_leave { path } {
219    variable _current
220    variable _pressed
221
222    set _current ""
223    if { [string compare [$path:cmd cget -state] "disabled"] } {
224        $path:cmd configure -state [Widget::getoption $path -state]
225        set relief [Widget::getoption $path -relief]
226        if { $_pressed == $path } {
227            if { ![string compare $relief "link"] } {
228                set relief raised
229            }
230            $path:cmd configure -relief $relief
231        } elseif { ![string compare $relief "link"] } {
232            $path:cmd configure -relief flat
233        }
234    }
235}
236
237
238# ------------------------------------------------------------------------------
239#  Command Button::_press
240# ------------------------------------------------------------------------------
241proc Button::_press { path } {
242    variable _pressed
243
244    if { [string compare [$path:cmd cget -state] "disabled"] } {
245        set _pressed $path
246        $path:cmd configure -relief sunken
247        if { [set cmd [Widget::getoption $path -armcommand]] != "" } {
248            uplevel \#0 $cmd
249            if { [set delay [Widget::getoption $path -repeatdelay]]    > 0 ||
250                 [set delay [Widget::getoption $path -repeatinterval]] > 0 } {
251                after $delay "Button::_repeat $path"
252            }
253        }
254    }
255}
256
257
258# ------------------------------------------------------------------------------
259#  Command Button::_release
260# ------------------------------------------------------------------------------
261proc Button::_release { path } {
262    variable _current
263    variable _pressed
264
265    if { $_pressed == $path } {
266        set _pressed ""
267        set relief [Widget::getoption $path -relief]
268        if { ![string compare $relief "link"] } {
269            set relief raised
270        }
271        $path:cmd configure -relief $relief
272        if { [set cmd [Widget::getoption $path -disarmcommand]] != "" } {
273            uplevel \#0 $cmd
274        }
275        if { $_current == $path &&
276             [string compare [$path:cmd cget -state] "disabled"] &&
277             [set cmd [Widget::getoption $path -command]] != "" } {
278            uplevel \#0 $cmd
279        }
280    }
281}
282
283
284# ------------------------------------------------------------------------------
285#  Command Button::_repeat
286# ------------------------------------------------------------------------------
287proc Button::_repeat { path } {
288    variable _current
289    variable _pressed
290
291    if { $_current == $path && $_pressed == $path &&
292         [string compare [$path:cmd cget -state] "disabled"] &&
293         [set cmd [Widget::getoption $path -armcommand]] != "" } {
294        uplevel \#0 $cmd
295    }
296    if { $_pressed == $path &&
297         ([set delay [Widget::getoption $path -repeatinterval]] > 0 ||
298          [set delay [Widget::getoption $path -repeatdelay]]    > 0) } {
299        after $delay "Button::_repeat $path"
300    }
301}
302
Note: See TracBrowser for help on using the repository browser.