← Back to branch summary

~ubuntu-branches/ubuntu/vivid/gcl/vivid

« back to all changes in this revision

Viewing changes to gcl-tk/demos/mkTextBind.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2002-03-04 14:29:59 UTC
  • Revision ID: james.westby@ubuntu.com-20020304142959-dey14w08kr7lldu3
Tags: upstream-2.5.0.cvs20020219
Import upstream version 2.5.0.cvs20020219

Show diffs side-by-side

added added

removed removed

Lines of Context:
gcl-tk/demos/mkTextBind.tcl
 
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 $w.ok -side bottom -fill x
 
21
    pack $w.s -side right -fill y
 
22
    pack $w.t -expand yes -fill both
 
23
 
 
24
    # Set up display styles
 
25
 
 
26
    if {[tk colormodel $w] == "color"} {
 
27
        set bold "-foreground red"
 
28
        set normal "-foreground {}"
 
29
    } else {
 
30
        set bold "-foreground white -background black"
 
31
        set normal "-foreground {} -background {}"
 
32
    }
 
33
    $w.t insert 0.0 {\
 
34
The same tag mechanism that controls display styles in text
 
35
widgets can also be used to associate Tcl commands with regions
 
36
of text, so that mouse or keyboard actions on the text cause
 
37
particular Tcl commands to be invoked.  For example, in the
 
38
text below the descriptions of the canvas demonstrations have
 
39
been tagged.  When you move the mouse over a demo description
 
40
the description lights up, and when you press button 3 over a
 
41
description then that particular demonstration is invoked.
 
42
 
 
43
This demo package contains a number of demonstrations of Tk's
 
44
canvas widgets.  Here are brief descriptions of some of the
 
45
demonstrations that are available:
 
46
 
 
47
}
 
48
    insertWithTags $w.t \
 
49
{1. Samples of all the different types of items that can be
 
50
created in canvas widgets.} d1
 
51
    insertWithTags $w.t \n\n
 
52
    insertWithTags $w.t \
 
53
{2. A simple two-dimensional plot that allows you to adjust
 
54
the positions of the data points.} d2
 
55
    insertWithTags $w.t \n\n
 
56
    insertWithTags $w.t \
 
57
{3. Anchoring and justification modes for text items.} d3
 
58
    insertWithTags $w.t \n\n
 
59
    insertWithTags $w.t \
 
60
{4. An editor for arrow-head shapes for line items.} d4
 
61
    insertWithTags $w.t \n\n
 
62
    insertWithTags $w.t \
 
63
{5. A ruler with facilities for editing tab stops.} d5
 
64
    insertWithTags $w.t \n\n
 
65
    insertWithTags $w.t \
 
66
{6. A grid that demonstrates how canvases can be scrolled.} d6
 
67
 
 
68
    foreach tag {d1 d2 d3 d4 d5 d6} {
 
69
        $w.t tag bind $tag <Any-Enter> "$w.t tag configure $tag $bold"
 
70
        $w.t tag bind $tag <Any-Leave> "$w.t tag configure $tag $normal"
 
71
    }
 
72
    $w.t tag bind d1 <3> mkItems
 
73
    $w.t tag bind d2 <3> mkPlot
 
74
    $w.t tag bind d3 <3> mkCanvText
 
75
    $w.t tag bind d4 <3> mkArrow
 
76
    $w.t tag bind d5 <3> mkRuler
 
77
    $w.t tag bind d6 <3> mkScroll
 
78
 
 
79
    $w.t mark set insert 0.0
 
80
    bind $w <Any-Enter> "focus $w.t"
 
81
}
 
82
 
 
83
# The procedure below inserts text into a given text widget and
 
84
# applies one or more tags to that text.  The arguments are:
 
85
#
 
86
# w             Window in which to insert
 
87
# text          Text to insert (it's inserted at the "insert" mark)
 
88
# args          One or more tags to apply to text.  If this is empty
 
89
#               then all tags are removed from the text.
 
90
 
 
91
proc insertWithTags {w text args} {
 
92
    set start [$w index insert]
 
93
    $w insert insert $text
 
94
    foreach tag [$w tag names $start] {
 
95
        $w tag remove $tag $start insert
 
96
    }
 
97
    foreach i $args {
 
98
        $w tag add $i $start insert
 
99
    }
 
100
}