diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/demos/twind.tcl | 96 | ||||
| -rw-r--r-- | library/demos/widget | 6 | ||||
| -rw-r--r-- | library/text.tcl | 77 |
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 } } |