diff options
Diffstat (limited to 'library/demos/twind.tcl')
-rw-r--r-- | library/demos/twind.tcl | 96 |
1 files changed, 79 insertions, 17 deletions
diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index 48a0c20..91d7158 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget with a bunch of # embedded windows. # -# RCS: @(#) $Id: twind.tcl,v 1.5 2003/12/04 12:28:37 vincentdarley Exp $ +# RCS: @(#) $Id: twind.tcl,v 1.6 2004/09/10 12:13:43 vincentdarley Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -27,7 +27,12 @@ text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \ pack $t -expand yes -fill both scrollbar $w.scroll -command "$t yview" pack $w.scroll -side right -fill y -pack $w.f -expand yes -fill both +panedwindow $w.pane +pack $w.pane -expand yes -fill both +$w.pane add $w.f +# Import to raise given creation order above +raise $w.f + $t tag configure center -justify center -spacing1 5m -spacing3 5m $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \ -spacing1 3m -spacing2 0 -spacing3 0 @@ -36,10 +41,6 @@ button $t.on -text "Turn On" -command "textWindOn $w" \ -cursor top_left_arrow button $t.off -text "Turn Off" -command "textWindOff $w" \ -cursor top_left_arrow -button $t.click -text "Click Here" -command "textWindPlot $t" \ - -cursor top_left_arrow -button $t.delete -text "Delete" -command "textWindDel $w" \ - -cursor top_left_arrow $t insert end "A text widget can contain many different kinds of items, " $t insert end "both active and passive. It can lay these out in various " @@ -60,15 +61,40 @@ $t window create end -window $t.off $t insert end " horizontal scrolling and turn back on word wrapping.\n\n" $t insert end "Or, here is another example. If you " -$t window create end -window $t.click +$t window create end -create { + button %W.click -text "Click Here" -command "textWindPlot %W" \ + -cursor top_left_arrow} + $t insert end " a canvas displaying an x-y plot will appear right here." $t mark set plot insert $t mark gravity plot left $t insert end " You can drag the data points around with the mouse, " $t insert end "or you can click here to " -$t window create end -window $t.delete +$t window create end -create { + button %W.delete -text "Delete" -command "textWindDel %W" \ + -cursor top_left_arrow +} $t insert end " the plot again.\n\n" +$t insert end "You can also create multiple text widgets each of which " +$t insert end "display the same underlying text. Click this button to " +$t window create end \ + -create {button %W.peer -text "Make A Peer" -command "textMakePeer %W" \ + -cursor top_left_arrow} -padx 3 +$t insert end " widget. Notice how peer widgets can have different " +$t insert end "font settings, and by default contain all the images " +$t insert end "of the 'parent', but many of the embedded windows, " +$t insert end "such as buttons will not be there. The easiest way " +$t insert end "to ensure they are in all peers is to use '-create' " +$t insert end "embedded window creation scripts " +$t insert end "(the plot above and the 'Make A Peer' button are " +$t insert end "designed to show up in all peers). A good use of " +$t insert end "peers is for " +$t window create end \ + -create {button %W.split -text "Split Windows" -command "textSplitWindow %W" \ + -cursor top_left_arrow} -padx 3 +$t insert end " \n\n" + $t insert end "You may also find it useful to put embedded windows in " $t insert end "a text without any actual text. In this case the " $t insert end "text widget acts like a geometry manager. For " @@ -179,6 +205,20 @@ proc textWindPlot t { if {[winfo exists $c]} { return } + + while {[string first [$t get plot] " \t\n"] >= 0} { + $t delete plot + } + $t insert plot "\n" + + $t window create plot -create {createPlot %W} + $t tag add center plot + $t insert plot "\n" +} + +proc createPlot {t} { + set c $t.c + canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow set font {Helvetica 18} @@ -214,13 +254,7 @@ proc textWindPlot t { $c bind point <1> "embPlotDown $c %x %y" $c bind point <ButtonRelease-1> "$c dtag selected" bind $c <B1-Motion> "embPlotMove $c %x %y" - while {[string first [$t get plot] " \t\n"] >= 0} { - $t delete plot - } - $t insert plot "\n" - $t window create plot -window $c - $t tag add center plot - $t insert plot "\n" + return $c } set embPlot(lastX) 0 @@ -242,8 +276,7 @@ proc embPlotMove {w x y} { set embPlot(lastY) $y } -proc textWindDel w { - set t $w.f.text +proc textWindDel t { if {[winfo exists $t.c]} { $t delete $t.c while {[string first [$t get plot] " \t\n"] >= 0} { @@ -256,3 +289,32 @@ proc textWindDel w { proc embDefBg t { $t configure -background [lindex [$t configure -background] 3] } + +proc textMakePeer {parent} { + set n 1 + while {[winfo exists .peer$n]} { incr n } + set w [toplevel .peer$n] + wm title $w "Text Peer #$n" + frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken + set t [$parent peer create $w.f.text -yscrollcommand "$w.scroll set"] + pack $t -expand yes -fill both + scrollbar $w.scroll -command "$t yview" + pack $w.scroll -side right -fill y + pack $w.f -expand yes -fill both +} + +proc textSplitWindow {textW} { + if {$textW eq ".twind.f.text"} { + if {[winfo exists .twind.peer]} { + destroy .twind.peer + } else { + set parent [winfo parent $textW] + set w [winfo parent $parent] + set t [$textW peer create $w.peer \ + -yscrollcommand "$w.scroll set"] + $w.pane add $t + } + } else { + return + } +} |