3 # This demonstration script creates a text widget with a bunch of
6 if {![info exists widgetDemo
]} {
7 error "This script should be run from the \"widget\" demo."
15 wm title
$w "Text Demonstration - Embedded Windows and Other Features"
16 wm iconname
$w "Embedded Windows"
19 ## See Code / Dismiss buttons
20 set btns
[addSeeDismiss
$w.buttons
$w]
21 pack $btns -side bottom
-fill x
23 frame $w.f
-highlightthickness 1 -borderwidth 1 -relief sunken
25 text $t -yscrollcommand "$w.scroll set" -setgrid true
-font $font -width 70 \
26 -height 35 -wrap word
-highlightthickness 0 -borderwidth 0
27 pack $t -expand yes
-fill both
28 scrollbar $w.scroll
-command "$t yview"
29 pack $w.scroll
-side right
-fill y
31 pack $w.pane
-expand yes
-fill both
33 # Import to raise given creation order above
36 $t tag configure center
-justify center
-spacing1 5m
-spacing3 5m
37 $t tag configure buttons
-lmargin1 1c
-lmargin2 1c
-rmargin 1c
\
38 -spacing1 3m
-spacing2 0 -spacing3 0
40 button $t.on
-text "Turn On" -command "textWindOn $w" \
41 -cursor top_left_arrow
42 button $t.off
-text "Turn Off" -command "textWindOff $w" \
43 -cursor top_left_arrow
45 $t insert end
"A text widget can contain many different kinds of items, "
46 $t insert end
"both active and passive. It can lay these out in various "
47 $t insert end
"ways, with wrapping, tabs, centering, etc. In addition, "
48 $t insert end
"when the contents are too big for the window, smooth "
49 $t insert end
"scrolling in all directions is provided.\n\n"
51 $t insert end
"A text widget can contain other widgets embedded "
52 $t insert end
"it. These are called \"embedded windows\", "
53 $t insert end
"and they can consist of arbitrary widgets. "
54 $t insert end
"For example, here are two embedded button "
55 $t insert end
"widgets. You can click on the first button to "
56 $t window create end
-window $t.on
57 $t insert end
" horizontal scrolling, which also turns off "
58 $t insert end
"word wrapping. Or, you can click on the second "
59 $t insert end
"button to\n"
60 $t window create end
-window $t.off
61 $t insert end
" horizontal scrolling and turn back on word wrapping.\n\n"
63 $t insert end
"Or, here is another example. If you "
64 $t window create end
-create {
65 button %W.click
-text "Click Here" -command "textWindPlot %W" \
66 -cursor top_left_arrow
}
68 $t insert end
" a canvas displaying an x-y plot will appear right here."
69 $t mark
set plot insert
70 $t mark gravity plot left
71 $t insert end
" You can drag the data points around with the mouse, "
72 $t insert end
"or you can click here to "
73 $t window create end
-create {
74 button %W.delete
-text "Delete" -command "textWindDel %W" \
75 -cursor top_left_arrow
77 $t insert end
" the plot again.\n\n"
79 $t insert end
"You can also create multiple text widgets each of which "
80 $t insert end
"display the same underlying text. Click this button to "
81 $t window create end
\
82 -create {button %W.peer
-text "Make A Peer" -command "textMakePeer %W" \
83 -cursor top_left_arrow
} -padx 3
84 $t insert end
" widget. Notice how peer widgets can have different "
85 $t insert end
"font settings, and by default contain all the images "
86 $t insert end
"of the 'parent', but many of the embedded windows, "
87 $t insert end
"such as buttons will not be there. The easiest way "
88 $t insert end
"to ensure they are in all peers is to use '-create' "
89 $t insert end
"embedded window creation scripts "
90 $t insert end
"(the plot above and the 'Make A Peer' button are "
91 $t insert end
"designed to show up in all peers). A good use of "
92 $t insert end
"peers is for "
93 $t window create end
\
94 -create {button %W.
split -text "Split Windows" -command "textSplitWindow %W" \
95 -cursor top_left_arrow
} -padx 3
98 $t insert end
"Users of previous versions of Tk will also be interested "
99 $t insert end
"to note that now cursor movement is now by visual line by "
100 $t insert end
"default, and that all scrolling of this widget is by pixel.\n\n"
102 $t insert end
"You may also find it useful to put embedded windows in "
103 $t insert end
"a text without any actual text. In this case the "
104 $t insert end
"text widget acts like a geometry manager. For "
105 $t insert end
"example, here is a collection of buttons laid out "
106 $t insert end
"neatly into rows by the text widget. These buttons "
107 $t insert end
"can be used to change the background color of the "
108 $t insert end
"text widget (\"Default\" restores the color to "
109 $t insert end
"its default). If you click on the button labeled "
110 $t insert end
"\"Short\", it changes to a longer string so that "
111 $t insert end
"you can see how the text widget automatically "
112 $t insert end
"changes the layout. Click on the button again "
113 $t insert end
"to restore the short string.\n"
115 button $t.
default -text Default
-command "embDefBg $t" \
116 -cursor top_left_arrow
117 $t window create end
-window $t.
default -padx 3
120 checkbutton $t.toggle
-textvariable embToggle
-indicatoron 0 \
121 -variable embToggle
-onvalue "A much longer string" \
122 -offvalue "Short" -cursor top_left_arrow
-pady 5 -padx 2
123 $t window create end
-window $t.toggle
-padx 3 -pady 2
125 foreach color
{AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4
126 SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 LightBlue1
127 DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1
128 Yellow1 IndianRed1 IndianRed2 Tan1 Tan4
} {
129 button $t.color
$i -text $color -cursor top_left_arrow
-command \
130 "$t configure -bg $color"
131 $t window create end
-window $t.color
$i -padx 3 -pady 2
134 $t tag add buttons
$t.
default end
136 button $t.bigB
-text "Big borders" -command "textWindBigB $t" \
137 -cursor top_left_arrow
138 button $t.smallB
-text "Small borders" -command "textWindSmallB $t" \
139 -cursor top_left_arrow
140 button $t.bigH
-text "Big highlight" -command "textWindBigH $t" \
141 -cursor top_left_arrow
142 button $t.smallH
-text "Small highlight" -command "textWindSmallH $t" \
143 -cursor top_left_arrow
144 button $t.bigP
-text "Big pad" -command "textWindBigP $t" \
145 -cursor top_left_arrow
146 button $t.smallP
-text "Small pad" -command "textWindSmallP $t" \
147 -cursor top_left_arrow
149 set text_normal
(border
) [$t cget
-borderwidth]
150 set text_normal
(highlight
) [$t cget
-highlightthickness]
151 set text_normal
(pad
) [$t cget
-padx]
153 $t insert end
"\nYou can also change the usual border width and "
154 $t insert end
"highlightthickness and padding.\n"
155 $t window create end
-window $t.bigB
156 $t window create end
-window $t.smallB
157 $t window create end
-window $t.bigH
158 $t window create end
-window $t.smallH
159 $t window create end
-window $t.bigP
160 $t window create end
-window $t.smallP
162 $t insert end
"\n\nFinally, images fit comfortably in text widgets too:"
164 $t image create end
-image \
165 [image create
bitmap -file [file join $tk_demoDirectory images face.xbm
]]
168 proc textWindBigB w
{
169 $w configure
-borderwidth 15
172 proc textWindBigH w
{
173 $w configure
-highlightthickness 15
176 proc textWindBigP w
{
177 $w configure
-padx 15 -pady 15
180 proc textWindSmallB w
{
181 $w configure
-borderwidth $::text_normal(border
)
184 proc textWindSmallH w
{
185 $w configure
-highlightthickness $::text_normal(highlight
)
188 proc textWindSmallP w
{
189 $w configure
-padx $::text_normal(pad
) -pady $::text_normal(pad
)
194 catch {destroy $w.scroll2
}
196 scrollbar $w.scroll2
-orient horizontal
-command "$t xview"
197 pack $w.scroll2
-after $w.buttons
-side bottom
-fill x
198 $t configure
-xscrollcommand "$w.scroll2 set" -wrap none
202 catch {destroy $w.scroll2
}
204 $t configure
-xscrollcommand {} -wrap word
207 proc textWindPlot t
{
209 if {[winfo exists
$c]} {
213 while {[string first
[$t get plot
] " \t\n"] >= 0} {
218 $t window create plot
-create {createPlot
%W
}
219 $t tag add center plot
223 proc createPlot
{t
} {
226 canvas $c -relief sunken
-width 450 -height 300 -cursor top_left_arrow
228 set font {Helvetica
18}
230 $c create line
100 250 400 250 -width 2
231 $c create line
100 250 100 50 -width 2
232 $c create
text 225 20 -text "A Simple Plot" -font $font -fill brown
234 for {set i
0} {$i <= 10} {incr i
} {
235 set x
[expr {100 + ($i*30)}]
236 $c create line
$x 250 $x 245 -width 2
237 $c create
text $x 254 -text [expr {10*$i}] -anchor n
-font $font
239 for {set i
0} {$i <= 5} {incr i
} {
240 set y
[expr {250 - ($i*40)}]
241 $c create line
100 $y 105 $y -width 2
242 $c create
text 96 $y -text [expr {$i*50}].0 -anchor e
-font $font
246 {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223}
248 set x
[expr {100 + (3*[lindex $point 0])}]
249 set y
[expr {250 - (4*[lindex $point 1])/5}]
250 set item
[$c create oval
[expr {$x-6}] [expr {$y-6}] \
251 [expr {$x+6}] [expr {$y+6}] -width 1 -outline black
\
253 $c addtag point withtag
$item
256 $c bind point
<Any-Enter
> "$c itemconfig current -fill red"
257 $c bind point
<Any-Leave
> "$c itemconfig current -fill SkyBlue2"
258 $c bind point
<1> "embPlotDown $c %x %y"
259 $c bind point
<ButtonRelease-1
> "$c dtag selected"
260 bind $c <B1-Motion
> "embPlotMove $c %x %y"
267 proc embPlotDown
{w x y
} {
270 $w addtag selected withtag current
272 set embPlot
(lastX
) $x
273 set embPlot
(lastY
) $y
276 proc embPlotMove
{w x y
} {
278 $w move selected
[expr {$x-$embPlot(lastX
)}] [expr {$y-$embPlot(lastY
)}]
279 set embPlot
(lastX
) $x
280 set embPlot
(lastY
) $y
284 if {[winfo exists
$t.c
]} {
286 while {[string first
[$t get plot
] " \t\n"] >= 0} {
294 $t configure
-background [lindex [$t configure
-background] 3]
297 proc textMakePeer
{parent
} {
299 while {[winfo exists .peer
$n]} { incr n
}
300 set w
[toplevel .peer
$n]
301 wm title
$w "Text Peer #$n"
302 frame $w.f
-highlightthickness 1 -borderwidth 1 -relief sunken
303 set t
[$parent peer create
$w.f.
text -yscrollcommand "$w.scroll set" \
304 -borderwidth 0 -highlightthickness 0]
305 pack $t -expand yes
-fill both
306 scrollbar $w.scroll
-command "$t yview"
307 pack $w.scroll
-side right
-fill y
308 pack $w.f
-expand yes
-fill both
311 proc textSplitWindow
{textW
} {
312 if {$textW eq
".twind.f.text"} {
313 if {[winfo exists .twind.peer
]} {
316 set parent
[winfo parent
$textW]
317 set w
[winfo parent
$parent]
318 set t
[$textW peer create
$w.peer
\
319 -yscrollcommand "$w.scroll set"]