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
|
#! /bin/sh /usr/share/dpatch/dpatch-run
## 05_font-menu.dpatch by <maxy@gnuservers.com.ar>
##
## DP: Fix font menu
@DPATCH@
diff -urNad tkman-2.2~/prefs.tcl tkman-2.2/prefs.tcl
--- tkman-2.2~/prefs.tcl 2003-04-01 20:31:38.000000000 -0300
+++ tkman-2.2/prefs.tcl 2008-04-14 10:53:15.000000000 -0300
@@ -4,6 +4,38 @@
#
#--------------------------------------------------
+# See http://wiki.tcl.tk/17387
+proc tk_optionCascade2 {path varName value args} {
+ upvar #0 $varName v
+ if {![info exists v]} {
+ set v $value
+ }
+ set m [tk_optionMenu $path $varName $v]
+ tk_optionCascade2_menu $m $varName [linsert $args 0 $value]
+ return $m
+}
+
+proc tk_optionCascade2_menu {m varName argl} {
+ $m delete 0 end
+ set next [menu $m.n -tearoff 0]
+ $m add cascade -label "More" -menu $next
+ set index 0
+ set len [llength $argl]
+ set height [winfo screenheight $m]
+ foreach arg $argl {
+ $m insert $index radiobutton -label $arg -variable $varName
+ incr index
+ update idletasks
+ if {[winfo reqheight $m] > $height && $index < $len} {
+ incr index -1
+ $m delete $index
+ tk_optionCascade2_menu $next $varName [lrange $argl $index end]
+ return
+ }
+ }
+ $m delete end
+}
+
proc manPreferencesMake {{w0 ""}} {
global prefedit manx man bozo
# don't do global man here
@@ -44,7 +76,7 @@
pack $f.l -side left -fill x
pack $f.style -side right -padx 2
if {![string match diff* $var]} {
- [eval tk_optionMenu $f.family prefedit($var-family) $manx(fontfamilies)] configure -tearoff no
+ [eval tk_optionCascade2 $f.family prefedit($var-family) $manx(fontfamilies)] configure -tearoff no
[eval tk_optionMenu $f.points prefedit($var-points) $manx(sizes)] configure -tearoff no
pack $f.points $f.family -after $f.style -side right -padx 2
|
