text widget 'peer' subcommand -- TIP#169 implementation

3 files changed, 123 insertions, 56 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
+    }
+}
diff --git a/library/demos/widget b/library/demos/widget
index 8c59d6c..67d3b6a 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -11,10 +11,10 @@ exec wish "$0" "$@"
 # ".tcl" files is this directory, which are sourced by this script
 # as needed.
 #
-# RCS: @(#) $Id: widget,v 1.23 2004/03/17 18:15:45 das Exp $
+# RCS: @(#) $Id: widget,v 1.24 2004/09/10 12:13:43 vincentdarley Exp $
 
-package require Tcl	8.4
-package require Tk	8.4
+package require Tcl	8.5
+package require Tk	8.5
 package require msgcat
 
 eval destroy [winfo child .]
diff --git a/library/text.tcl b/library/text.tcl
index fde0a16..fc40aeb 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -3,7 +3,7 @@
 # This file defines the default bindings for Tk text widgets and provides
 # procedures that help in implementing the bindings.
 #
-# RCS: @(#) $Id: text.tcl,v 1.32 2004/08/26 18:03:30 hobbs Exp $
+# RCS: @(#) $Id: text.tcl,v 1.33 2004/09/10 12:13:42 vincentdarley Exp $
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -222,10 +222,10 @@ bind Text <BackSpace> {
 }
 
 bind Text <Control-space> {
-    %W mark set anchor insert
+    %W mark set tk::anchor%W insert
 }
 bind Text <Select> {
-    %W mark set anchor insert
+    %W mark set tk::anchor%W insert
 }
 bind Text <Control-Shift-space> {
     set tk::Priv(selectMode) char
@@ -520,14 +520,14 @@ proc ::tk::TextButton1 {w x y} {
     set Priv(mouseMoved) 0
     set Priv(pressX) $x
     $w mark set insert [TextClosestGap $w $x $y]
-    $w mark set anchor insert
+    $w mark set tk::anchor$w insert
     # Set the anchor mark's gravity depending on the click position
     # relative to the gap
-    set bbox [$w bbox [$w index anchor]]
+    set bbox [$w bbox [$w index tk::anchor$w]]
     if {$x > [lindex $bbox 0]} {
-	$w mark gravity anchor right
+	$w mark gravity tk::anchor$w right
     } else {
-	$w mark gravity anchor left
+	$w mark gravity tk::anchor$w left
     }
     # Allow focus in any case on Windows, because that will let the
     # selection be displayed even for state disabled text widgets.
@@ -543,6 +543,11 @@ proc ::tk::TextButton1 {w x y} {
 # ignores mouse motions initially until the mouse has moved from
 # one character to another or until there have been multiple clicks.
 #
+# Note that the 'anchor' is implemented programmatically using
+# a text widget mark, and uses a name that will be unique for each
+# text widget (even when there are multiple peers).  Currently the
+# anchor is considered private to Tk, hence the name 'tk::anchor$w'.
+#
 # Arguments:
 # w -		The text window in which the button was pressed.
 # x -		Mouse x position.
@@ -553,31 +558,31 @@ proc ::tk::TextSelectTo {w x y {extend 0}} {
     variable ::tk::Priv
 
     set cur [TextClosestGap $w $x $y]
-    if {[catch {$w index anchor}]} {
-	$w mark set anchor $cur
+    if {[catch {$w index tk::anchor$w}]} {
+	$w mark set tk::anchor$w $cur
     }
-    set anchor [$w index anchor]
+    set anchor [$w index tk::anchor$w]
     if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
 	set Priv(mouseMoved) 1
     }
     switch -- $Priv(selectMode) {
 	char {
-	    if {[$w compare $cur < anchor]} {
+	    if {[$w compare $cur < tk::anchor$w]} {
 		set first $cur
-		set last anchor
+		set last tk::anchor$w
 	    } else {
-		set first anchor
+		set first tk::anchor$w
 		set last $cur
 	    }
 	}
 	word {
 	    # Set initial range based only on the anchor (1 char min width)
-	    if {[string equal [$w mark gravity anchor] "right"]} {
-		set first "anchor"
-		set last "anchor + 1c"
+	    if {[string equal [$w mark gravity tk::anchor$w] "right"]} {
+		set first "tk::anchor$w"
+		set last "tk::anchor$w + 1c"
 	    } else {
-		set first "anchor - 1c"
-		set last "anchor"
+		set first "tk::anchor$w - 1c"
+		set last "tk::anchor$w"
 	    }
 	    # Extend range (if necessary) based on the current point
 	    if {[$w compare $cur < $first]} {
@@ -592,8 +597,8 @@ proc ::tk::TextSelectTo {w x y {extend 0}} {
 	}
 	line {
 	    # Set initial range based only on the anchor
-	    set first "anchor linestart" 
-	    set last "anchor lineend"
+	    set first "tk::anchor$w linestart" 
+	    set last "tk::anchor$w lineend"
 
 	    # Extend range (if necessary) based on the current point
 	    if {[$w compare $cur < $first]} {
@@ -626,15 +631,15 @@ proc ::tk::TextSelectTo {w x y {extend 0}} {
 proc ::tk::TextKeyExtend {w index} {
 
     set cur [$w index $index]
-    if {[catch {$w index anchor}]} {
-	$w mark set anchor $cur
+    if {[catch {$w index tk::anchor$w}]} {
+	$w mark set tk::anchor$w $cur
     }
-    set anchor [$w index anchor]
-    if {[$w compare $cur < anchor]} {
+    set anchor [$w index tk::anchor$w]
+    if {[$w compare $cur < tk::anchor$w]} {
 	set first $cur
-	set last anchor
+	set last tk::anchor$w
     } else {
-	set first anchor
+	set first tk::anchor$w
 	set last $cur
     }
     $w tag remove sel 0.0 $first
@@ -735,13 +740,13 @@ proc ::tk::TextKeySelect {w new} {
 	} else {
 	    $w tag add sel insert $new
 	}
-	$w mark set anchor insert
+	$w mark set tk::anchor$w insert
     } else {
-	if {[$w compare $new < anchor]} {
+	if {[$w compare $new < tk::anchor$w]} {
 	    set first $new
-	    set last anchor
+	    set last tk::anchor$w
 	} else {
-	    set first anchor
+	    set first tk::anchor$w
 	    set last $new
 	}
 	$w tag remove sel 1.0 $first
@@ -780,11 +785,11 @@ proc ::tk::TextResetAnchor {w index} {
     set b [$w index sel.first]
     set c [$w index sel.last]
     if {[$w compare $a < $b]} {
-	$w mark set anchor sel.last
+	$w mark set tk::anchor$w sel.last
 	return
     }
     if {[$w compare $a > $c]} {
-	$w mark set anchor sel.first
+	$w mark set tk::anchor$w sel.first
 	return
     }
     scan $a "%d.%d" lineA chA
@@ -796,16 +801,16 @@ proc ::tk::TextResetAnchor {w index} {
 	    return
 	}
 	if {[string length [$w get $b $a]] < ($total/2)} {
-	    $w mark set anchor sel.last
+	    $w mark set tk::anchor$w sel.last
 	} else {
-	    $w mark set anchor sel.first
+	    $w mark set tk::anchor$w sel.first
 	}
 	return
     }
     if {($lineA-$lineB) < ($lineC-$lineA)} {
-	$w mark set anchor sel.last
+	$w mark set tk::anchor$w sel.last
     } else {
-	$w mark set anchor sel.first
+	$w mark set tk::anchor$w sel.first
     }
 }