Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | |
2 | ||
3 | sub mkTextBind { | |
4 | ||
5 | # Create a top-level window that illustrates how you can bind Perl commands to regions of text in a text widget. | |
6 | ||
7 | $mkTextBind->destroy if Exists($mkTextBind); | |
8 | $mkTextBind = $top->Toplevel(); | |
9 | my $w = $mkTextBind; | |
10 | dpos $w; | |
11 | $w->title('Text Demonstration - Tag Bindings'); | |
12 | $w->iconname('Text Bindings'); | |
13 | my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]); | |
14 | my $w_t = $w->Text(-setgrid => 'true', -width => '60', -height => '28', | |
15 | -font => '-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*'); | |
16 | my $w_s = $w->Scrollbar(-command => ['yview', $w_t]); | |
17 | $w_t->configure(-yscrollcommand => ['set', $w_s]); | |
18 | $w_ok->pack(-side => 'bottom'); | |
19 | $w_s->pack(-side => 'right', -fill => 'y'); | |
20 | $w_t->pack(-expand => 'yes', -fill => 'both'); | |
21 | ||
22 | # Set up display styles | |
23 | ||
24 | my(@bold, @normal, $tags); | |
25 | if ($mkTextBind->depth > 1) { | |
26 | @bold = (-foreground => 'red'); | |
27 | @normal = (-foreground => undef); | |
28 | } else { | |
29 | @bold = (-foreground => 'white', -background => 'black'); | |
30 | @normal = (-foreground => undef, -background => undef); | |
31 | } | |
32 | ||
33 | $w_t->insert('0.0', 'The same tag mechanism that controls display styles in text | |
34 | widgets can also be used to associate Perl commands with regions | |
35 | of text, so that mouse or keyboard actions on the text cause | |
36 | particular Perl commands to be invoked. For example, in the | |
37 | text below the descriptions of the canvas demonstrations have | |
38 | been tagged. When you move the mouse over a demo description | |
39 | the description lights up, and when you press button 3 over a | |
40 | description then that particular demonstration is invoked. | |
41 | ||
42 | This demo package contains a number of demonstrations of Tk\'s | |
43 | canvas widgets. Here are brief descriptions of some of the | |
44 | demonstrations that are available:'); | |
45 | insert_with_tags($w_t, "\n\n1. Samples of all the different types of items that can be\ncreated in canvas widgets.", 'd1'); | |
46 | insert_with_tags($w_t, "\n\n2. A simple two-dimensional plot that allows you to adjust\n", 'd2'); | |
47 | insert_with_tags($w_t, 'the positions of the data points.', 'd2'); | |
48 | insert_with_tags($w_t, "\n\n3. Anchoring and justification modes for text items.", 'd3'); | |
49 | insert_with_tags($w_t, "\n\n4. An editor for arrow-head shapes for line items.", 'd4'); | |
50 | insert_with_tags($w_t, "\n\n5. A ruler with facilities for editing tab stops.", 'd5'); | |
51 | insert_with_tags($w_t, "\n\n6. A grid that demonstrates how canvases can be scrolled.", 'd6'); | |
52 | ||
53 | foreach $tag (qw(d1 d2 d3 d4 d5 d6)) { | |
54 | $w_t->tag('bind', $tag, '<Any-Enter>' => [sub {shift->tag('configure', shift, @_)}, $tag, @bold]); | |
55 | $w_t->tag('bind', $tag, '<Any-Leave>' => [sub {shift->tag('configure', shift, @_)}, $tag, @normal]); | |
56 | } | |
57 | $w_t->tag('bind', 'd1', '<3>', \&mkItems); | |
58 | $w_t->tag('bind', 'd2', '<3>', \&mkPlot); | |
59 | $w_t->tag('bind', 'd3', '<3>', \&mkCanvText); | |
60 | $w_t->tag('bind', 'd4', '<3>', \&mkArrow); | |
61 | $w_t->tag('bind', 'd5', '<3>', \&mkRuler); | |
62 | $w_t->tag('bind', 'd6', '<3>', \&mkScroll); | |
63 | ||
64 | $w_t->mark('set', 'insert', '0.0'); | |
65 | ||
66 | } # end mkTextBind | |
67 | ||
68 | ||
69 | 1; |