Return to mkTextBind.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tk / library / demos

Annotation of micropolis/src/tk/library/demos/mkTextBind.tcl, revision 1.1.1.1

1.1       root        1: # mkTextBind w
                      2: #
                      3: # Create a top-level window that illustrates how you can bind
                      4: # Tcl commands to regions of text in a text widget.
                      5: #
                      6: # Arguments:
                      7: #    w -       Name to use for new top-level window.
                      8: 
                      9: proc mkTextBind {{w .bindings}} {
                     10:     catch {destroy $w}
                     11:     toplevel $w
                     12:     dpos $w
                     13:     wm title $w "Text Demonstration - Tag Bindings"
                     14:     wm iconname $w "Text Bindings"
                     15:     button $w.ok -text OK -command "destroy $w"
                     16:     text $w.t -relief raised -bd 2 -yscrollcommand "$w.s set" -setgrid true \
                     17:            -width 60 -height 28 \
                     18:            -font "-Adobe-Helvetica-Bold-R-Normal-*-120-*"
                     19:     scrollbar $w.s -relief flat -command "$w.t yview"
                     20:     pack append $w $w.ok {bottom fillx} $w.s {right filly} $w.t {expand fill}
                     21: 
                     22:     # Set up display styles
                     23: 
                     24:     if {[winfo screendepth $w] > 4} {
                     25:        set bold "-foreground red"
                     26:        set normal "-foreground {}"
                     27:     } else {
                     28:        set bold "-foreground white -background black"
                     29:        set normal "-foreground {} -background {}"
                     30:     }
                     31:     $w.t insert 0.0 {\
                     32: The same tag mechanism that controls display styles in text
                     33: widgets can also be used to associate Tcl commands with regions
                     34: of text, so that mouse or keyboard actions on the text cause
                     35: particular Tcl commands to be invoked.  For example, in the
                     36: text below the descriptions of the canvas demonstrations have
                     37: been tagged.  When you move the mouse over a demo description
                     38: the description lights up, and when you press button 3 over a
                     39: description then that particular demonstration is invoked.
                     40: 
                     41: This demo package contains a number of demonstrations of Tk's
                     42: canvas widgets.  Here are brief descriptions of some of the
                     43: demonstrations that are available:
                     44: 
                     45: }
                     46:     insertWithTags $w.t \
                     47: {1. Samples of all the different types of items that can be
                     48: created in canvas widgets.} d1
                     49:     insertWithTags $w.t \n\n
                     50:     insertWithTags $w.t \
                     51: {2. A simple two-dimensional plot that allows you to adjust
                     52: the positions of the data points.} d2
                     53:     insertWithTags $w.t \n\n
                     54:     insertWithTags $w.t \
                     55: {3. Anchoring and justification modes for text items.} d3
                     56:     insertWithTags $w.t \n\n
                     57:     insertWithTags $w.t \
                     58: {4. An editor for arrow-head shapes for line items.} d4
                     59:     insertWithTags $w.t \n\n
                     60:     insertWithTags $w.t \
                     61: {5. A ruler with facilities for editing tab stops.} d5
                     62:     insertWithTags $w.t \n\n
                     63:     insertWithTags $w.t \
                     64: {6. A grid that demonstrates how canvases can be scrolled.} d6
                     65: 
                     66:     foreach tag {d1 d2 d3 d4 d5 d6} {
                     67:        $w.t tag bind $tag <Any-Enter> "$w.t tag configure $tag $bold"
                     68:        $w.t tag bind $tag <Any-Leave> "$w.t tag configure $tag $normal"
                     69:     }
                     70:     $w.t tag bind d1 <3> mkItems
                     71:     $w.t tag bind d2 <3> mkPlot
                     72:     $w.t tag bind d3 <3> mkCanvText
                     73:     $w.t tag bind d4 <3> mkArrow
                     74:     $w.t tag bind d5 <3> mkRuler
                     75:     $w.t tag bind d6 <3> mkScroll
                     76: 
                     77:     $w.t mark set insert 0.0
                     78:     bind $w <Any-Enter> "focus $w.t"
                     79: }
                     80: 
                     81: # The procedure below inserts text into a given text widget and
                     82: # applies one or more tags to that text.  The arguments are:
                     83: #
                     84: # w            Window in which to insert
                     85: # text         Text to insert (it's inserted at the "insert" mark)
                     86: # args         One or more tags to apply to text.  If this is empty
                     87: #              then all tags are removed from the text.
                     88: 
                     89: proc insertWithTags {w text args} {
                     90:     set start [$w index insert]
                     91:     $w insert insert $text
                     92:     foreach tag [$w tag names $start] {
                     93:        $w tag remove $tag $start insert
                     94:     }
                     95:     foreach i $args {
                     96:        $w tag add $i $start insert
                     97:     }
                     98: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.