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     ! 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.