ch17.htm

《Perl 5 Unreleased》

17            Income
for an activity <BR>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;that
is not a passive activity - IRS Form 8583);<BR>
18 foreach (@items) {<BR>
19&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$w_list-&gt;insert(&quot;end&quot;,
$_);<BR>
20 }<BR>
21 #<BR>
22 # Create the scrollbar<BR>
23 #<BR>
24 $w_scroll = $main-&gt;Scrollbar(-command =&gt; ['yview', $w_list]
<BR>
25&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)-&gt;pack(-side
=&gt; 'right', -fill =&gt; 'y');<BR>
26 #<BR>
27 # Now tie the scrollbar to&nbsp;&nbsp;listbox.<BR>
28 #<BR>
29 $w_list-&gt;configure( -yscrollcommand =&gt; ['set', $w_scroll]);
<BR>
30 #<BR>
31 # show the listbox.<BR>
32 #<BR>
33 $w_list-&gt;pack(-fill =&gt; 'y');<BR>
34 MainLoop;</FONT></TT>
</BLOCKQUOTE>
<HR>
<P>
Scrollbars are commonly used to update the items shown in <TT><FONT FACE="Courier">Listbox</FONT></TT>,
<TT><FONT FACE="Courier">Canvas</FONT></TT>, or <TT><FONT FACE="Courier">Text</FONT></TT>
widgets when the slider of the scrollbar is moved by the user.
In Listing 17.9 (line 24), the scrollbar is created with the <TT><FONT FACE="Courier">yview</FONT></TT>
option. For a horizontal scrollbar, use the <TT><FONT FACE="Courier">xview</FONT></TT>
option. In line 29, the listbox is tied to the scrollbar to perform
the scrolling action in the <I>y</I> direction.
<P>
Note also how the <TT><FONT FACE="Courier">label</FONT></TT>,
<TT><FONT FACE="Courier">Listbox</FONT></TT>, and <TT><FONT FACE="Courier">Scrollbar</FONT></TT>
are packed in the window. Had the <TT><FONT FACE="Courier">-fill</FONT></TT>
option not been used, the widgets would not be shown in the entire
height or width of the window.
<P>
To allow more than one listbox to contain a &quot;selection&quot;
(or at least a highlighted item), specify this configuration option:
<BLOCKQUOTE>
<TT><FONT FACE="Courier">-exportselection =&gt; 0</FONT></TT>
</BLOCKQUOTE>
<H3><A NAME="UsingTextWidgets">Using <TT><FONT SIZE=4 FACE="Courier">Text</FONT></TT><FONT SIZE=4>
Widgets</FONT></A></H3>
<P>
The <TT><FONT FACE="Courier">Text</FONT></TT> widget is simply
a widget that enables user entry. The default way to create a
<TT><FONT FACE="Courier">Text</FONT></TT> widget is shown here:
<BLOCKQUOTE>
<TT><FONT FACE="Courier">#!/usr/bin/perl -w<BR>
use Tk;<BR>
<BR>
my $mw = MainWindow-&gt;new();<BR>
$txt = $mw-&gt;Text(-width =&gt; '80', -height =&gt; '100') -&gt;
pack;<BR>
MainLoop;</FONT></TT>
</BLOCKQUOTE>
<P>
Note that the default size of a <TT><FONT FACE="Courier">Text</FONT></TT>
widget is very big for most screens. You might want to limit the
size with the <TT><FONT FACE="Courier">-height</FONT></TT> and
<TT><FONT FACE="Courier">-width</FONT></TT> options to set the
same size. The values are given in the number of characters, not
the number of pixels.
<P>
Using the code in the <TT><FONT FACE="Courier">Scrollbar</FONT></TT>
and <TT><FONT FACE="Courier">Listbox</FONT></TT> examples, you
can attach scrollbars to create fairly sophisticated editors very
quickly using <TT><FONT FACE="Courier">Perl/Tk</FONT></TT>.
<H3><A NAME="SpecifyingFontsforTextandOtherWidg">Specifying Fonts
for Text and Other Widgets</A></H3>
<P>
To specify the font configuration option of your widget, use the
<TT><FONT FACE="Courier">-font</FONT></TT> option. See the following
example:
<BLOCKQUOTE>
<TT><FONT FACE="Courier">my $mw = MainWindow-&gt;new();<BR>
$txt = $mw-&gt;Text(-width =&gt; '40', -height =&gt; '20', -font
=&gt; 'fixed') -&gt; pack;</FONT></TT>
</BLOCKQUOTE>
<P>
The <TT><FONT FACE="Courier">'fixed'</FONT></TT> value is the
name of the font. You can check your <TT><FONT FACE="Courier">fonts.alias</FONT></TT>
file for more font names to use or look at the output from the
<TT><FONT FACE="Courier">xlsfont</FONT></TT> command.
<H3><A NAME="TextEntryWidgets"><TT><FONT SIZE=4 FACE="Courier">Text
Entry</FONT></TT><FONT SIZE=4> Widgets</FONT></A></H3>
<P>
You want to call the <TT><FONT FACE="Courier">get()</FONT></TT>
function on the return value of the widget itself. Here is how
it may be used in a simplified version of Example 1.1 from the
<TT><FONT FACE="Courier">Tk::UserGuide</FONT></TT>, where a <TT><FONT FACE="Courier">Button</FONT></TT>
is set up to call a sub where the call to <TT><FONT FACE="Courier">get</FONT></TT>
lies. Check the POD file, UserGuide.pod, in the distribution for
more information. The output is shown in Figure 17.10.<P>
<A HREF="f17-10.gif" tppabs="http://www.mcp.com/815097600/0-672/0-672-30891-6/f17-10.gif"><B>Figure 17.10 :</B><I>Using the <FONT FACE="Courier"> Text Entry </FONT> widget.</I></A>
<HR>
<BLOCKQUOTE>
<B>Listing 17.10. Using the </B><TT><B><FONT FACE="Courier">Text
Entry</FONT></B></TT><B> widget.<BR>
</B>
</BLOCKQUOTE>
<BLOCKQUOTE>
<TT><FONT FACE="Courier">&nbsp;1 #!/usr/bin/perl -w<BR>
&nbsp;2 <BR>
&nbsp;3&nbsp;&nbsp;&nbsp;&nbsp; use Tk;<BR>
&nbsp;4 <BR>
&nbsp;5&nbsp;&nbsp;&nbsp;&nbsp; my $mw = MainWindow -&gt; new();
<BR>
&nbsp;6&nbsp;&nbsp;&nbsp;&nbsp; my $entry = $mw -&gt; Entry();
<BR>
&nbsp;7&nbsp;&nbsp;&nbsp;&nbsp; $entry -&gt; pack;<BR>
&nbsp;8 <BR>
&nbsp;9&nbsp;&nbsp;&nbsp;&nbsp; $txt = $mw-&gt;Text(-width =&gt;
'10', -height =&gt; '10')-&gt;pack;<BR>
10 <BR>
11&nbsp;&nbsp;&nbsp;&nbsp; $mw-&gt;Button(-text =&gt; 'Dino',
<BR>
12&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
-command =&gt; sub{Echo($entry, $txt)}<BR>
13&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
)-&gt;pack;<BR>
14&nbsp;&nbsp;&nbsp;&nbsp; MainLoop;<BR>
15 <BR>
16&nbsp;&nbsp;&nbsp;&nbsp; sub Echo {<BR>
17&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my ($widget,
$txt) = @_;<BR>
18 <BR>
19&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
#<BR>
20&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
# Show the values of the Text Entry widget<BR>
21&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
#<BR>
22&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $entered
= $widget -&gt; get(); # Get the input<BR>
23&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print
&quot;The string \&quot;$entered\&quot; was entered.\n&quot;;
<BR>
24 <BR>
25&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
#<BR>
26&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
# Show the values of the Text widget<BR>
27&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
#<BR>
28&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my $text
= $txt -&gt;Contents(); # Get the input<BR>
29&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print
&quot;The Text \&quot;$text\&quot; was entered.\n&quot;;<BR>
30&nbsp;&nbsp;&nbsp;&nbsp; }</FONT></TT>
</BLOCKQUOTE>
<HR>
<P>
For collecting passwords, set the value of the <TT><FONT FACE="Courier">-show</FONT></TT>
option to zero: 
<BLOCKQUOTE>
<TT><FONT FACE="Courier">(-show =&gt; 0);</FONT></TT>
</BLOCKQUOTE>
<H2><A NAME="HandlingtheKeyboardwithKeyBindings"><FONT SIZE=5 COLOR=#FF0000>Handling
the Keyboard with Key Bindings</FONT></A></H2>
<P>
Using the pointer interface is not the only way to collect input
in your <TT><FONT FACE="Courier">Perl/Tk</FONT></TT> programs.
There are many default key bindings built into the widgets of
<TT><FONT FACE="Courier">Perl/Tk</FONT></TT>. Making proper use
of them often involves setting up the right callback. Read the
documentation in <TT><FONT FACE="Courier">BindTable.pod</FONT></TT>
in the <TT><FONT FACE="Courier">Tk</FONT></TT> package for more
detailed help with this subject.
<P>
The way to bind a key to a widget is to use
<BLOCKQUOTE>
<TT><FONT FACE="Courier">$widget -&gt; bind('&lt;keyname&gt;'
=&gt; action);</FONT></TT>
</BLOCKQUOTE>
<P>
where <TT><FONT FACE="Courier">$widget</FONT></TT> is the object
to which the keys are bound. For global bindings you have to bind
to <TT><FONT FACE="Courier">&lt;All&gt;</FONT></TT>. For specific
bindings you need to bind to each widget.
<P>
Use the following script on each <TT><FONT FACE="Courier">.pm</FONT></TT>
file for which you want to find key bindings:
<BLOCKQUOTE>
<TT><FONT FACE="Courier">#!/usr/bin/perl<BR>
while (&lt;&gt;) {<BR>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;print
if s/.*(&lt;[^&gt;]*&gt;).*/$1/g;<BR>
}</FONT></TT>
</BLOCKQUOTE>
<P>
When run on the <TT><FONT FACE="Courier">Listbox.pm</FONT></TT>
file, this script reveals a lot of key bindings. Some modules
even show <TT><FONT FACE="Courier">&lt;HANDLE&gt;</FONT></TT>
and <TT><FONT FACE="Courier">&lt;ARGV&gt;</FONT></TT>, so you
have to know what to ignore. Also, bound keys are inherited, so
listing one module's bindings may not be complete if any properties
are inherited from other sources. The output from the <TT><FONT FACE="Courier">Listbox.pm</FONT></TT>
file is as follows:
<BLOCKQUOTE>
<TT><FONT FACE="Courier">&lt;1&gt;<BR>
&lt;B1-Motion&gt;<BR>
&lt;ButtonRelease-1&gt;<BR>
&lt;Shift-1&gt;<BR>
&lt;Control-1&gt;<BR>
&lt;B1-Leave&gt;<BR>
&lt;B1-Enter&gt;<BR>
&lt;Up&gt;<BR>
&lt;Shift-Up&gt;<BR>
&lt;Down&gt;<BR>
&lt;Shift-Down&gt;<BR>
&lt;Control-Home&gt;<BR>
&lt;Shift-Control-Home&gt;<BR>
&lt;Control-End&gt;<BR>
&lt;Shift-Control-End&gt;<BR>
&lt;space&gt;<BR>
&lt;Select&gt;<BR>
&lt;Control-Shift-space&gt;<BR>
&lt;Shift-Select&gt;<BR>
&lt;Escape&gt;<BR>
&lt;Control-slash&gt;<BR>
&lt;Control-backslash&gt;<BR>
&lt;2&gt;<BR>
&lt;B2-Motion&gt;<BR>
<P>
Note the &lt;1&gt; and &lt;2&gt; in the output.<BR>
</FONT></TT>
</BLOCKQUOTE>
<CENTER>
<TABLE BORDERCOLOR=#000000 BORDER=1 WIDTH=80%>
<TR VALIGN=TOP><TD ><B>Tip</B></TD></TR>
<TR VALIGN=TOP><TD >
<BLOCKQUOTE>
Do not use  the <TT><FONT FACE="Courier">%k</FONT></TT> symbols for <TT><FONT FACE="Courier">Tcl/Tk</FONT></TT> in Perl scripts. The <TT><FONT FACE="Courier">%k</FONT></TT> symbols will be misinterpreted as nonexistent Perl hashes.
</BLOCKQUOTE>

</TD></TR>
</TABLE></CENTER>
<P>
<P>
Listing 17.11 illustrates how to read the button and key bindings
from <TT><FONT FACE="Courier">Xevents</FONT></TT>.
<HR>
<BLOCKQUOTE>
<B>Listing 17.11. A sample key bindings display program.<BR>
</B>
</BLOCKQUOTE>
<BLOCKQUOTE>
<TT><FONT FACE="Courier">&nbsp;1 #!/usr/bin/perl -w<BR>
&nbsp;2 use Tk;<BR>
&nbsp;3 <BR>
&nbsp;4&nbsp;&nbsp;&nbsp;&nbsp; $mw = MainWindow-&gt;new();<BR>
&nbsp;5&nbsp;&nbsp;&nbsp;&nbsp; $frame = $mw-&gt;Frame( -height
=&gt; '6c', -width =&gt; '6c',<BR>
&nbsp;6&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-background
=&gt; 'black');<BR>
&nbsp;7&nbsp;&nbsp;&nbsp;&nbsp; $frame-&gt;pack;&nbsp;&nbsp;#
show the frame<BR>
&nbsp;8&nbsp;&nbsp;&nbsp;&nbsp; $mw-&gt;bind( '&lt;Any-KeyPress&gt;'
=&gt; \&amp;echo);&nbsp;&nbsp;# for all keys<BR>
&nbsp;9&nbsp;&nbsp;&nbsp;&nbsp; $mw-&gt;bind( '&lt;ButtonPress&gt;'
=&gt; \&amp;echoPress);&nbsp;&nbsp;# for all keys<BR>
10&nbsp;&nbsp;&nbsp;&nbsp; $mw-&gt;bind( '&lt;ButtonRelease&gt;'
=&gt; \&amp;echoRel);&nbsp;&nbsp;# for all keys<BR>
11 <BR>
12&nbsp;&nbsp;&nbsp