1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
#
# ButtonMenubutton
# act like a button for quick clicks
# act like a menu if hold down button
#
# 1997 July 22 by Tom Phelps (phelps@ACM.org),
# on top of Tk's button and menubutton bindings
# 2003 March 12 updated for Tk 8.4 (tkPriv => ::tk::Priv)
#
# To use, create a menubutton and pass it and the command to execute
# if it's invoked as a button to the proc "buttonmenubutton"
#
# To convert to button-only operation,
# <widget-name> configure -menu ""
# To convert to menu-only operation,
# set bmb(<widget-name>) to ""
# If you save the former value, you can reverse these conversions
# by restoring the former values.
# If you disable the original menubutton, both button and menubutton
# behaviors are disabled.
set bmb(menubutton-delay) 250
set bmb(type) ""
set bmb(after) ""
set bmb(relief) ""
set bmb(w) ""
set bmb(x) ""; set bmb(y) ""
#set bmb(<widget-name>) <button-command>
proc buttonmenubutton {mb {cmd ""}} {
global bmb
if {[winfo class $mb] ne "Menubutton"} {error "$mb must be a menubutton"}
# store commands
set bmb($mb) $cmd
# on Button-1, assume it's a click, correct later according to timer
bind $mb <Button-1> {if [catch {bmbB1Down %W %X %Y}] break}
bind $mb <B1-Motion> {if {$bmb(type) eq "button"} break}
bind $mb <ButtonRelease-1> {if [catch {bmbB1Up %W}] break}
}
proc bmbB1Down {w x y} {
global bmb
# would be nice if break and continue could be thrown as exceptions
# to be recognized in bindings
if {$::tk::Priv(postedMb) ne ""} {::tk::MbButtonUp $w; return -code break}
if {$bmb(type) ne ""} {return -code break}
set bmb(w) $w; set bmb(relief) [$w cget -relief]
set bmb(x) $x; set bmb(y) $y
# if no command, treat as a menu straight away
if {$bmb($w) eq ""} {set bmb(type) ""; return}; # continue with menubutton bindings
# pretend you're a button at first
set bmb(type) "button"
catch {[::tk::ButtonDown $w]}; # brute force: -repeatdelay on button only not menubutton
# if have a menu, possibility of converting to menubutton operation
if {[$w cget -menu] ne "" && [[$w cget -menu] index end] ne "none"} {
set bmb(after) [after $bmb(menubutton-delay) bmbConvert]
}
return -code break
}
proc bmbB1Up {w} {
global bmb
if {$bmb(type) eq "button"} {bmbButtonUp $w} else {::tk::MbButtonUp $w}
# clean up for button
set bmb(type) ""
if {$bmb(after) ne ""} {after cancel $bmb(after)}
set bmb(after) ""
$bmb(w) configure -relief $bmb(relief)
return -code break
}
proc bmbConvert {} {
global bmb
# if already finished as button, we're done
if {$bmb(type) eq ""} return
set ::tk::Priv(buttonWindow) ""; # clean up
set bmb(after) ""
$bmb(w) configure -relief $bmb(relief)
set bmb(type) ""; # give control over to the menu system
set ::tk::Priv(inMenubutton) $bmb(w)
::tk::MbPost $bmb(w) $bmb(x) $bmb(y)
$bmb(w) configure -relief sunken; # that's how Netscape does it
}
proc bmbButtonUp {w} {
global bmb
if {$w eq $::tk::Priv(buttonWindow)} {
set ::tk::Priv(buttonWindow) ""
if {[$w cget -state] ne "disabled"} {
uplevel #0 $bmb($w)
}
}
}
|
