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