1# twind.tcl -- 2# 3# This demonstration script creates a text widget with a bunch of 4# embedded windows. 5# 6# RCS: @(#) $Id$ 7 8if {![info exists widgetDemo]} { 9 error "This script should be run from the \"widget\" demo." 10} 11 12package require Tk 13 14set w .twind 15catch {destroy $w} 16toplevel $w 17wm title $w "Text Demonstration - Embedded Windows and Other Features" 18wm iconname $w "Embedded Windows" 19positionWindow $w 20 21## See Code / Dismiss buttons 22set btns [addSeeDismiss $w.buttons $w] 23pack $btns -side bottom -fill x 24 25frame $w.f -highlightthickness 1 -borderwidth 1 -relief sunken 26set t $w.f.text 27text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \ 28 -height 35 -wrap word -highlightthickness 0 -borderwidth 0 29pack $t -expand yes -fill both 30scrollbar $w.scroll -command "$t yview" 31pack $w.scroll -side right -fill y 32panedwindow $w.pane 33pack $w.pane -expand yes -fill both 34$w.pane add $w.f 35# Import to raise given creation order above 36raise $w.f 37 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 41 42button $t.on -text "Turn On" -command "textWindOn $w" \ 43 -cursor top_left_arrow 44button $t.off -text "Turn Off" -command "textWindOff $w" \ 45 -cursor top_left_arrow 46 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" 52 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" 64 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} 69 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 78} 79$t insert end " the plot again.\n\n" 80 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 98$t insert end " \n\n" 99 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" 103 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" 116 117button $t.default -text Default -command "embDefBg $t" \ 118 -cursor top_left_arrow 119$t window create end -window $t.default -padx 3 120global embToggle 121set embToggle Short 122checkbutton $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 126set i 1 127foreach 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 134 incr i 135} 136$t tag add buttons $t.default end 137 138button $t.bigB -text "Big borders" -command "textWindBigB $t" \ 139 -cursor top_left_arrow 140button $t.smallB -text "Small borders" -command "textWindSmallB $t" \ 141 -cursor top_left_arrow 142button $t.bigH -text "Big highlight" -command "textWindBigH $t" \ 143 -cursor top_left_arrow 144button $t.smallH -text "Small highlight" -command "textWindSmallH $t" \ 145 -cursor top_left_arrow 146button $t.bigP -text "Big pad" -command "textWindBigP $t" \ 147 -cursor top_left_arrow 148button $t.smallP -text "Small pad" -command "textWindSmallP $t" \ 149 -cursor top_left_arrow 150 151set text_normal(border) [$t cget -borderwidth] 152set text_normal(highlight) [$t cget -highlightthickness] 153set text_normal(pad) [$t cget -padx] 154 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 163 164$t insert end "\n\nFinally, images fit comfortably in text widgets too:" 165 166$t image create end -image \ 167 [image create bitmap -file [file join $tk_demoDirectory images face.xbm]] 168 169 170proc textWindBigB w { 171 $w configure -borderwidth 15 172} 173 174proc textWindBigH w { 175 $w configure -highlightthickness 15 176} 177 178proc textWindBigP w { 179 $w configure -padx 15 -pady 15 180} 181 182proc textWindSmallB w { 183 $w configure -borderwidth $::text_normal(border) 184} 185 186proc textWindSmallH w { 187 $w configure -highlightthickness $::text_normal(highlight) 188} 189 190proc textWindSmallP w { 191 $w configure -padx $::text_normal(pad) -pady $::text_normal(pad) 192} 193 194 195proc textWindOn w { 196 catch {destroy $w.scroll2} 197 set t $w.f.text 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 201} 202 203proc textWindOff w { 204 catch {destroy $w.scroll2} 205 set t $w.f.text 206 $t configure -xscrollcommand {} -wrap word 207} 208 209proc textWindPlot t { 210 set c $t.c 211 if {[winfo exists $c]} { 212 return 213 } 214 215 while {[string first [$t get plot] " \t\n"] >= 0} { 216 $t delete plot 217 } 218 $t insert plot "\n" 219 220 $t window create plot -create {createPlot %W} 221 $t tag add center plot 222 $t insert plot "\n" 223} 224 225proc createPlot {t} { 226 set c $t.c 227 228 canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow 229 230 set font {Helvetica 18} 231 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 235 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 240 } 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 245 } 246 247 foreach point { 248 {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223} 249 } { 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 \ 254 -fill SkyBlue2] 255 $c addtag point withtag $item 256 } 257 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" 263 return $c 264} 265 266set embPlot(lastX) 0 267set embPlot(lastY) 0 268 269proc embPlotDown {w x y} { 270 global embPlot 271 $w dtag selected 272 $w addtag selected withtag current 273 $w raise current 274 set embPlot(lastX) $x 275 set embPlot(lastY) $y 276} 277 278proc embPlotMove {w x y} { 279 global embPlot 280 $w move selected [expr {$x-$embPlot(lastX)}] [expr {$y-$embPlot(lastY)}] 281 set embPlot(lastX) $x 282 set embPlot(lastY) $y 283} 284 285proc textWindDel t { 286 if {[winfo exists $t.c]} { 287 $t delete $t.c 288 while {[string first [$t get plot] " \t\n"] >= 0} { 289 $t delete plot 290 } 291 $t insert plot " " 292 } 293} 294 295proc embDefBg t { 296 $t configure -background [lindex [$t configure -background] 3] 297} 298 299proc textMakePeer {parent} { 300 set n 1 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 311} 312 313proc textSplitWindow {textW} { 314 if {$textW eq ".twind.f.text"} { 315 if {[winfo exists .twind.peer]} { 316 destroy .twind.peer 317 } else { 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"] 322 $w.pane add $t 323 } 324 } else { 325 return 326 } 327} 328