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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
### Copyright (C) 1995-1997 Jesper K. Pedersen
### This program is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software
### Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
proc indexList {path prefix name minWidth} {
global elements __widgetArgs __editInfo __scrollBar
catch "unset __elements"
set function $__editInfo(name)
if {![regexp {^(.*)_(.*[^0-9])[0-9]+$} $prefix all superPrefix superName ]} {
error "Internal error: couldn't parse \"$prefix\""
}
if {![regexp "^(.*)\\._$superName\\.row\[0-9\]+\\._$name\$" \
$path all superPath]} {
error "Internal error: could't parse \"$path\""
}
### collecting the key elements
set prefix ${superPrefix}_$superName
set count [lindex $__scrollBar($prefix) 1]
set elements {}
for {set i 0} {$i < $count} {incr i} {
upvar \#0 ${prefix}${i}_$name elm
lappend elements $elm
}
set viewable $__widgetArgs(${function}__${superName}__count)
set top [lindex $__scrollBar($prefix) 0]
global ${prefix}${top}_$name
set index [popUpComboBox $path $elements 25 $minWidth "" [set ${prefix}${top}_$name]]
if {$index > -1} {
if {[expr $count-$viewable] < $index} {
set index [expr $count-$viewable]
}
scroll $superPath $superPrefix $superName $index
}
}
proc popUpComboBox {path elements count minWidth name val} {
global __Combo
set w .combo
toplevel $w -class Dialog -cursor arrow
wm overrideredirect $w 1
set bindings [bind all <1>]
bind all <1> "after cancel \$tkPriv(afterId);if {\"%W\" != \"$w.bar\"} {comboExit $w}"
### create the listbox and the scrollbar
listbox $w.box -cursor left_ptr \
-height [min $count [llength $elements]]
if {$count < [llength $elements]} {
scrollbar $w.bar -command "$w.box yview" -cursor left_ptr
$w.box configure -yscrollcommand "$w.bar set"
pack $w.box -side left -fill both -expand 1
pack $w.bar -fill y -expand 1
} else {
pack $w.box -expand 1 -fill both
}
### binding help
if {$name != ""} {
bind $w.box <3> "listbox_help $w $name %y $path;break"
}
foreach elm $elements {
$w.box insert end $elm
}
set index [lsearch -exact $elements $val]
$w.box yview $index
bind $w.box <ButtonRelease-1> "after cancel \$tkPriv(afterId);comboReturn $w %y;break"
bind $w.box <ButtonPress-1> "after cancel \$tkPriv(afterId);comboReturn $w %y;break"
wm withdraw $w
update idletasks
### calculate the start y coordinate for the window
set y [winfo rooty $path.2]
incr y [winfo height $path.2]
incr y 3
### calculate the reqheight be the widget.
set bd [$w cget -bd]
incr bd [$w cget -highlightthickness]
set height [expr [winfo reqheight $w.box] + 2*$bd]
### calculate the width of the widget
set x1 [winfo rootx $path.2]
set x2 [winfo rootx $path.combo]
incr x2 [winfo width $path.combo]
set width [max $minWidth [expr $x2 - $x1]]
### calculate the with we will give the window
set reqwidth [winfo reqwidth $w]
if {$reqwidth < $width} {
set reqwidth $width
} else {
if {$reqwidth > [winfo vrootwidth .]} {
set reqwidth [winfo vrootwidth .]
}
}
set width $reqwidth
### If the listbox is too far right, pull it back to the left
set scrwidth [winfo vrootwidth .]
if {[expr $x1 + $width] > $scrwidth} {
set x1 [expr $scrwidth - $width]
}
### If the listbox is too far left, pull it back to the right
### I geues this can only happend if you use a virtual window manager.
if {$x1 < 0} {
set x1 0
}
### If the listbox is below bottom of screen, put it upwards
set scrheight [winfo vrootheight .]
set bottom [expr $y+$height]
if {$bottom > $scrheight} {
set y [expr $y-$height-[winfo height $path.2]-5]
}
### show the window
wm geometry $w $reqwidth\x$height+$x1+$y
wm deiconify $w
grabSet -global $w
### Wait for the window to disappear
tkwait window $w
set index $__Combo
unset __Combo
bind all <1> $bindings
return $index
}
proc comboReturn {w y} {
global __Combo
set __Combo [$w.box nearest $y]
grab release $w
destroy $w
update
}
proc comboExit {w} {
global __Combo
set __Combo -1
grab release $w
destroy $w
}
|
