summaryrefslogtreecommitdiffstats
path: root/library/demos/twind.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/demos/twind.tcl')
-rw-r--r--library/demos/twind.tcl96
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
+ }
+}