]> git.zerfleddert.de Git - micropolis/blame - src/tk/library/demos/mkTextBind.tcl
Makefile: Micropolis build fixes for recent macOS
[micropolis] / src / tk / library / demos / mkTextBind.tcl
CommitLineData
6a5fa4e0
MG
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
9proc 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 {\
32The same tag mechanism that controls display styles in text
33widgets can also be used to associate Tcl commands with regions
34of text, so that mouse or keyboard actions on the text cause
35particular Tcl commands to be invoked. For example, in the
36text below the descriptions of the canvas demonstrations have
37been tagged. When you move the mouse over a demo description
38the description lights up, and when you press button 3 over a
39description then that particular demonstration is invoked.
40
41This demo package contains a number of demonstrations of Tk's
42canvas widgets. Here are brief descriptions of some of the
43demonstrations that are available:
44
45}
46 insertWithTags $w.t \
47{1. Samples of all the different types of items that can be
48created 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
52the 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
89proc 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}
Impressum, Datenschutz