home *** CD-ROM | disk | FTP | other *** search
/ ftp.pasteur.org/FAQ/ / ftp-pasteur-org-FAQ.zip / FAQ / perl-faq / ptk-faq / part2 < prev    next >
Encoding:
Internet Message Format  |  1997-06-01  |  33.7 KB

  1. From: pvhp@lns62.lns.cornell.edu (Peter Prymmer)
  2. Newsgroups: comp.lang.perl.tk,comp.lang.perl.announce,comp.answers,news.answers
  3. Subject: comp.lang.perl.tk FAQ part2 of 5
  4. Followup-To: comp.lang.perl.tk
  5. Date: Sun, 01 Jun 1997 06:39:50 GMT
  6. Organization: Wilson Lab, Cornell U., Ithaca, NY, 14853
  7. Lines: 955
  8. Approved: pvhp@lns62.lns.cornell.edu (Peter Prymmer)
  9. Expires: Thu, 31 Jul 1997 06:39:11 GMT
  10. Message-ID: <009B51BD.8AA0BB50@lns62.lns.cornell.edu>
  11. Reply-To: PVHP@lns62.lns.cornell.edu
  12. NNTP-Posting-Host: lns62.lns.cornell.edu
  13. Path: senator-bedfellow.mit.edu!bloom-beacon.mit.edu!gatech!news1.mid-ga.com!nntp.mid-ga.com!news.oru.edu!news-spur1.maxwell.syr.edu!news.maxwell.syr.edu!news.cis.ohio-state.edu!nntp.sei.cmu.edu!bb3.andrew.cmu.edu!goldenapple.srv.cs.cmu.edu!rochester!cornellcs!newsstand.cit.cornell.edu!lnsnews.lns.cornell.edu!lns62.lns.cornell.edu!PVHP
  14. Xref: senator-bedfellow.mit.edu comp.lang.perl.tk:4656 comp.lang.perl.announce:640 comp.answers:26268 news.answers:103809
  15.  
  16. Summary: comp.lang.perl.tk Frequently Asked Questions.
  17. Archive-name: perl-faq/ptk-faq/part2
  18. Posting-Frequency: monthly
  19. Last-modified: Date: Sat May 31 16:48:37 1997
  20. URL: http://w4.lns.cornell.edu/~pvhp/ptk/ptkFAQ.html
  21. Version: 1.00_07
  22.  
  23. URL (Hypertext-split): http://w4.lns.cornell.edu/~pvhp/ptk/ptkTOC.html
  24. URL (Plaintext): http://w4.lns.cornell.edu/~pvhp/ptk/ptkFAQ.txt
  25. Image-supplement: http://w4.lns.cornell.edu/~pvhp/ptk/ptkIMG.html
  26. ftp-Archive: ftp://ftp.ccd.bnl.gov/pub/ptk/ptkFAQ.txt
  27. ftp-Archive: ftp://rtfm.mit.edu/pub/usenet/perl-faq/ptk-faq/
  28. e-mail-Archive: ptkfaq@pubweb.bnl.gov
  29.  
  30. Perl/Tk FAQ part 2 of 5 - Programming      
  31. ************************************* 
  32.  
  33.  
  34.  
  35.  ______________________________________________________________________
  36.  
  37.  
  38.  
  39.  10. How do I get widget X to do Y ? 
  40.  
  41.  There are a number of tasks that can be accomplished with perl/Tk widgets,
  42.  configurations, and bindings (a few that can't and a few that require specific
  43.  tricks). Beginners are encouraged to work through the examples in 
  44.  UserGuide.pod. Some examples from UserGuide.pod are addressed in
  45.  this document among those that follow. 
  46.  
  47.  Basically a widget can be "created" by simply calling the sub of the same name:
  48.  
  49.      my $main = new MainWindow;
  50.  
  51.  will set aside the necessary system memory etc. for a new MainWindow widget
  52.  (it does not appear until after the MainLoop; call). The object "created" is
  53.  then callable via the variable $main. So, for example, if you wanted a Button
  54.  in your MainWindow, then this: 
  55.  
  56.      $main->Button();
  57.  
  58.  would be a very basic example of a widget command. If you wanted to later call
  59.  this button widget you would need a "widget tag or ID" to "get a handle on it".
  60.  Instead of the above call try something like: 
  61.  
  62.      my $button = $main->Button();
  63.  
  64.  The variable $button is how you refer to the Button widget in subsequent
  65.  calls, such as when we call the pack routine: 
  66.  
  67.      $button -> pack;
  68.  
  69.  A complete script that incorporates these ideas to make a very plain button
  70.  would look like: 
  71.  
  72.      #!/usr/bin/perl -w
  73.      use Tk;
  74.      use strict;
  75.      my $main = new MainWindow;
  76.      my $button = $main -> Button();
  77.      $button -> pack;
  78.      MainLoop; 
  79.  
  80.  But who wants such a plain looking button? You can provide a number of
  81.  different widget configurations via calls to the configure routine as in: 
  82.  
  83.      #!/usr/bin/perl -w
  84.      use Tk;
  85.      use strict;
  86.      my $main = new MainWindow;
  87.      my $button = $main->Button();
  88.      $button -> configure(-text => 'Press me!');
  89.      $button -> pack;
  90.      MainLoop; 
  91.  
  92.  The Perl motto is "there is more than one way to do it." - perl/Tk remains
  93.  quite true to this motto as well. Note that the above script could have been
  94.  written quite succinctly without the use of either the $main or $button
  95.  variables as: 
  96.  
  97.      #!/usr/bin/perl -w
  98.      use Tk;
  99.      use strict;
  100.      new MainWindow -> Button(-text => 'Press me!') -> pack;
  101.      MainLoop; 
  102.  
  103.  But if you want your widgets to actually do things then you must set up
  104.  callback procedures as discussed later... 
  105.  
  106.  Do not overlook the - sign in front of some options (like -text in the above
  107.  example) Another commonly overlooked problem is that elements in a hash
  108.  are supposed to be strings hence a configuration option like -length +> 5,
  109.  really ought to be specified as either '-length' +> 5, or "-length" +>
  110.  5, etc., rather than perl's builtin length() function. 
  111.  
  112.  ______________________________________________________________________
  113.  
  114.  
  115.  
  116.  10.1. How do I get a Button to call a Perl subroutine? 
  117.  
  118.  You may specify the -command option in the call to create & pack the button
  119.  as in: 
  120.  
  121.      $main->Button(-text => 'Print',
  122.                     -command => sub{do_print($filename, $font)}
  123.                     )->pack;
  124.  
  125.  Where sub do_print { } is a subroutine that handles two arguments and
  126.  is declared elsewhere in the script. A full script example of the use of the
  127.  above code is presented in the second example(s) in UserGuide.pod 
  128.  
  129.  (Full source code for this and other examples from UserGuide.pod may be
  130.  found at http://w4.lns.cornell.edu/~pvhp/ptk/pod/. To load code from the web
  131.  save as a local file say ex1.pl, edit the first line to point to your perl
  132.  interpreter, then change permission: %chmod u+x ex1.pl, then execute the
  133.  script: %ex1.pl.) 
  134.  
  135.  The above method is called the "anonymous subroutine (closure)" method.
  136.  As discussed in Callback.pod one might have re-written that statement to
  137.  use the "reference to a sub" method thusly: 
  138.  
  139.      $main->Button(-text => 'Print',
  140.                     -command => [ \&do_print , $filename, $font ]
  141.                     )->pack;
  142.  
  143.  Note the backslash in front of \&do_print. This causes perl to generate a
  144.  reference to sub do_print rather than call it. (thanks Jim Stern :-) 
  145.  
  146.  ______________________________________________________________________
  147.  
  148.  
  149.  
  150.  10.2. How do I get a Button to actively change under my mouse pointer? 
  151.  
  152.  You should specify both an '-image' and an '-activeimage'
  153.  configuration option either when calling the ->Button() method or in a
  154.  later separate call to the ->configure() method. 
  155.  
  156.  Here is an example excerpted from the basic_demo script that comes with
  157.  the Tk kit: 
  158.  
  159.      #!/usr/local/bin/perl -w
  160.      
  161.      use Tk;
  162.      
  163.      $main = MainWindow->new;
  164.      
  165.      $QPBFile  = "demos/images/QuitPB.xpm";
  166.      $QPBaFile = "demos/images/QuitPBa.xpm";
  167.      
  168.      $QuitPB  = $main->Pixmap('-file' => Tk->findINC("$QPBFile"));
  169.      $QuitPBa = $main->Pixmap('-file' => Tk->findINC("$QPBaFile"));
  170.      
  171.      my $but  = $main->Button('-image'       => $QuitPB,
  172.                               '-activeimage' => $QuitPBa,
  173.                               '-command'     => sub { $main->destroy }
  174.                              ) -> pack;
  175.      
  176.      MainLoop;
  177.      
  178.      __END__
  179.      
  180.  
  181.  ______________________________________________________________________
  182.  
  183.  
  184.  
  185.  10.3. How do I arrange the layout of my widgets? 
  186.  
  187.  To control the layout and appearance of widgets in a window one makes use of
  188.  a geometry manager, as well as -padding, -fill, -expand, and -anchor options
  189.  of individual widgets. 
  190.  
  191.  A geometry manager is any Tk procedure for controlling the arrangement of
  192.  widgets in your application window. The predominant geometry manager used
  193.  in both Tcl/Tk and perl/Tk is pack also known informally as the "packer"
  194.  (other geometry managers are the "placer" and the canvas widget itself but
  195.  are much less popular. There is also Nick Ing-Simmon's Table widget
  196.  [discussed in a later question] and BLT_Table [which made it's way into
  197.  perl/Tk thanks to Guy Decoux - but is also discussed in a later question]. So
  198.  far tixForm is for Tcl/Tk only, but a perl/Tk version of Tix is in the works.
  199.  You can invoke pack at the time of widget creation via calls like: 
  200.  
  201.      $widget->pack;
  202.  
  203.  where widget can be any of the perl/Tk widget primitives. Widget option lists
  204.  are usually passed as an associative array (hash) in parentheses thusly: 
  205.  
  206.      $widget(-option0 => value0,-option1 => value1)->pack;
  207.  
  208.  pack is often used in conjunction with the frame container widget to arrange
  209.  your widgets much like a hiearchically arranged set of window panes
  210.  (ultimately in a rectangular "tiling" fashion of sorts). An example of this
  211.  would be: 
  212.  
  213.      my $top2 = $main->Toplevel;
  214.      my $frame = $top2->Frame;
  215.      $frame->pack;
  216.      $frame->Label(-text => 'Left2')->pack(-side => 'left');
  217.      $frame->Label(-text => 'Right2')->pack(-side => 'right');
  218.      $top2->Label(-text => 'Bottom2')->pack(-side => 'bottom');
  219.      MainLoop;
  220.  
  221.  Note that pack itself is given parameters in this example. The default
  222.  behavior for pack is equivalent to specifying -side => 'top' which can be
  223.  overridden as in the above example. 
  224.  
  225.  (Full source code for this and other examples from UserGuide.pod may be
  226.  found at http://w4.lns.cornell.edu/~pvhp/ptk/pod/. To load code from the web
  227.  save as a local file say ex2.pl, edit the first line to point to your perl
  228.  interpreter, change permission using: chmod u+x ex2.pl, then type the
  229.  name of your script: ex2.pl.) 
  230.  
  231.  One of the more helpful options to pass to pack when trying to get a given
  232.  widget layout "just right" is through padding: either -padx or -pady. The
  233.  details of the use of pad depend on which specific widget you are trying to 
  234.  pack. In fact you can often add the -pad in the call to create the widget rather
  235.  than in the call to pack. 
  236.  
  237.  There is also the -anchor configuration option for widgets. A good
  238.  introduction to the 9 possible -anchor (and -overanchor) values is given
  239.  by the popup demo in your perl/Tk build directory. 
  240.  
  241.  When setting a widget within a frame next to another widget one may wish to
  242.  make use of the -fill => 'style' (where style = none | x | y | both)
  243.  options of either pack or the widget itself. A typical situation where this is
  244.  used is in setting up the Scrollbar next to a Canvas or Text widget. 
  245.  
  246.  Another aspect to consider when laying out your widgets is their behavior
  247.  under resize operations (grabbing a part of the window frame and making it
  248.  bigger or smaller - details depend on your window manager). This may be
  249.  controlled by the -expand option of either pack or the widget itself. 
  250.  
  251.  ______________________________________________________________________
  252.  
  253.  
  254.  
  255.  10.4. How do I get a Popup to popup? 
  256.  
  257.  For things like a simple "are you sure?" dialog box you might want to take a
  258.  look at Dialog.pm which is discussed in a later question within this FAQ
  259.  [16.1]. 
  260.  
  261.  If you don't wish to require Tk::Dialog, you need something more complicated,
  262.  or you simply want to create your own independent window with widgets; you
  263.  must first setup a Toplevel in perl/Tk. The fourth example in UserGuide.pod
  264.  gives a simple example of how to call Toplevel. Quoting from that script: 
  265.  
  266.      my $main = new MainWindow;
  267.      fill_window($main, 'Main');
  268.      my $top1 = $main->Toplevel;
  269.  
  270.  Where sub fill_window is declared after the call to MainLoop;. When
  271.  running that script take careful note of which window pops up first, which
  272.  window has grabbed the active attention of your input device(s), and which
  273.  widget within the active window has the keyboard/mouse focus when all three
  274.  windows are open. 
  275.  
  276.  The use of Toplevels brings up the issue of grab - or which independent
  277.  window is presently "active" and which are activatable. To make a Toplevel
  278.  window active call grab thusly: 
  279.  
  280.      $Top_widget->grab(grab_option);
  281.  
  282.  where $Top_widget identifies the desired Toplevel (it would be either 
  283.  $top1 or $top2 in the sample script referred to above). grab_option
  284.  could be -global - but this is discouraged as a sign of "desparate
  285.  programming style". To give a Toplevel "local grab" you may simply say: 
  286.  
  287.      $Top_widget->grab;
  288.  
  289.  That is, without an argument. 
  290.  
  291.  The use of Toplevels may also bring up the issue of focus - or which window
  292.  - even which widget within a window - is presently "hot". You may call 
  293.  focus on an entire Toplevel: 
  294.  
  295.      $Top_widget->focus;
  296.  
  297.  However, focus is most often used with individual widgets rather than a
  298.  whole Toplevel. 
  299.  
  300.  To de-iconify a widget there is in fact a Popup function that may be called
  301.  thusly: 
  302.  
  303.      $Top_widget->Popup();
  304.  
  305.  ______________________________________________________________________
  306.  
  307.  
  308.  
  309.  10.5. How do I bind keyboard keys? 
  310.  
  311.  There are many default key bindings built in to the widgets of perl/Tk. Making
  312.  proper use of them often involves setting up the right callback. (You may wish
  313.  to consult the examples in BindTable.pod for help with this subject.) 
  314.  
  315.  The basic idea is: 
  316.  
  317.      $widget -> bind('<keyname>' => action);
  318.  
  319.  Where $widget is the tag or ID of the widget for which the bindings are to
  320.  hold (note for global bindings you have to bind to <All>, for semi-global
  321.  bindings you need to bind to all the relevant widgets in your application), '<
  322.  keyname>' can be things like: 
  323.  
  324.      <Key> or <KeyPress> or <Any-KeyPress>
  325.      <KeyRelease>
  326.      <Button> or <ButtonPress>
  327.      <ButtonRelease>
  328.      <Button-1> or <B1> 
  329.      <Double-1>
  330.      <Enter>
  331.      <Leave>
  332.      <Motion>
  333.  
  334.  To figure out what names perl/Tk uses for such <bindings> use the
  335.  "binder-finder" on a widget's .pm file. For example, you could find bindings
  336.  hidden inside of Button.pm by typing this at your shell prompt: 
  337.  
  338.      perl -ne 'print if s/.*(<[^>]*>).*/$1/g;' Button.pm
  339.  
  340.  while in the directory where Button.pm is located (and if you are not there
  341.  then simply specify the /path/to/Button.pm). Note that due to
  342.  inheritance (e.g.the type of script bindings that are being discussed here) what
  343.  the binder-finder turns up may not be the last word on a given widget's
  344.  behaviour. This may be especially true for a widget inside of a
  345.  compound/composite widget. Note also that the binder-finder will turn up
  346.  things like <FILEHANDLES> as well as honest <Bindings>. Discrimination
  347.  in its use is called for (and while your at it you could have just as easily used an
  348.  editor and actually examined the code directly now couldn't you?). 
  349.  
  350.  To get an idea of what the code is for a key that you are interested in try
  351.  running the xlib_demo that comes in your perl/Tk build directory. Hold your
  352.  mouse pointer over the window that appears and simply type the key that you
  353.  are interested in. The code should appear in the window. If you do not have
  354.  perl/Tk up and running yet try "xmodmap -pk" or look directly at the 
  355.  /usr/include/X11/keysymdef.h file where keysym names are given with
  356.  an XK_ pre-pended. Do not try things like the Tcl/Tk %k symbols in perl
  357.  scripts. %Ks will be mis-interpreted as non-existant perl hashes. Instead look
  358.  at the Xevent function. 
  359.  
  360.  Ali Corbin <corbin@adsw.fteil.ca.boeing.com> recently posted a great little
  361.  script for determining keyboard key bindings on a MainWindow: 
  362.  
  363.      #!/usr/local/bin/perl -w
  364.      use Tk;
  365.      $top = MainWindow->new();
  366.      $frame = $top->Frame( -height => '6c', -width => '6c',
  367.                              -background => 'black', -cursor => 'gobbler' );
  368.      $frame->pack;
  369.      $top->bind( '<Any-KeyPress>' => sub
  370.      {
  371.          my($c) = @_;
  372.          my $e = $c->XEvent;
  373.          my( $x, $y, $W, $K, $A ) = ( $e->x, $e->y, $e->K, $e->W, $e->A );
  374.  
  375.          print "A key was pressed:\n";
  376.          print "  x = $x\n";
  377.          print "  y = $y\n";
  378.          print "  W = $K\n";
  379.          print "  K = $W\n";
  380.          print "  A = $A\n";
  381.      } );
  382.      MainLoop();
  383.  
  384.  To bind the action of one widget to that of another try taking a look at the
  385.  .pm file for the widget of interest - is there a binding function already
  386.  defined? If so you may use it. An example would be the use of "Up" & "Down" 
  387.  Buttons for a Listbox: one could bind the Buttons to call 
  388.  Tk::Listbox::UpDown, however, Guy Decoux describes a much more
  389.  clever way to use the <Up> and <Down> already defined in Listbox.pm (this
  390.  does not work with Tk-b9.01): 
  391.  
  392.      #!/usr/local/bin/perl
  393.      use Tk;
  394.      $top = MainWindow->new;
  395.      $lb = $top->Listbox(-height => 10);
  396.      for($i=0; $i < 120; $i++) {
  397.        $lb->insert('end', $i);
  398.      }
  399.      $f = $top->Frame;
  400.      $up = $f->Button(
  401.             -text => "Up",
  402.             -command => [ $lb->bind(ref $lb, '<Up>'), $lb]
  403.             );
  404.      $down = $f->Button(
  405.               -text => "Down",
  406.               -command =>sub {&{$lb->bind(ref $lb, '<Down>')}($lb)}
  407.               );
  408.      $up->pack(-side => 'left');
  409.      $down->pack;
  410.      $f->pack;
  411.      $lb->pack;
  412.      MainLoop;
  413.  
  414.  ______________________________________________________________________
  415.  
  416.  
  417.  
  418.  10.6. How do I add bindings? 
  419.  
  420.  On Fri, 15 Sep 95 10:30:56 BST Nick Ing-Simmons
  421.  <Nick.Ing-Simmons@tiuk.ti.com> writes: 
  422.  
  423.  
  424.  Re: Multiple binds to a single widget?
  425.  **************************************
  426.  
  427.  On Thu, 14 Sep 1995 14:57:54 -0400
  428.  Alain St <astdenis@cmc.doe.CA> writes:
  429.  !In the tcl/tk doc I have, they say that prepending the script 
  430.  !with '+' appends the new binding to the current one.
  431.  !
  432.  !How do I do that in perlTk? 
  433.  !
  434.  
  435.   You cannot do that that way (yet?) - one issue is what it would mean to
  436.   prepend '+' to a perl/Tk callback : 
  437.  
  438.      $widget->bind('<A>','+',[\&subname,$arg]); 
  439.      # did not look right to me
  440.  
  441.   Other issue is that I would need to manage a list-of-callbacks in glue
  442.   code. 
  443.  
  444.   Bind your new command to a new tag: 
  445.  
  446.      $widget->bind('Extra',....);
  447.  
  448.   And add Extra to the widgets bindtags: 
  449.  
  450.      $widget->bindtags([ref($widget),$widget,'Extra',
  451.                          $widget->toplevel,'all']);
  452.  
  453.  ______________________________________________________________________
  454.  
  455.  
  456.  
  457.  10.7. How do I bind the action of a slider (sic) to ... ? 
  458.  
  459.  Technically speaking they are called Scrollbars (not sliders) and one must 
  460.  configure the action of the desired widget to call the Scrollbars (i.e. bind
  461.  is not involved here) 
  462.  
  463.  A common task using Scrollbars is to configure things like Canvas, 
  464.  Listbox, or a Text widgets to be updated (change appearance) when the
  465.  slider of the acompanying Scrollbar is moved by the user. 
  466.  
  467.  As an example consider the code that sets up a twelve element Listbox and
  468.  an accompanying vertical Scrollbar: 
  469.  
  470.      my $main = new MainWindow;
  471.      my $box = $main->Listbox(-relief => 'sunken', 
  472.                               -width => -1, # Shrink to fit
  473.                               -height => 5,
  474.                               -setgrid => 'yes');
  475.      my @items = qw(One Two Three Four Five Six Seven
  476.                     Eight Nine Ten Eleven Twelve);
  477.      foreach (@items) {
  478.         $box->insert('end', $_);
  479.      }
  480.      my $scroll = $main->Scrollbar(-command => ['yview', $box]);
  481.  
  482.  So far so good. But merely setting them up does not mean that the Listbox
  483.  even knows that the Scrollbar is lying next to it. Note that the scalar
  484.  variable $scroll is how we refer to the Scrollbar, thus, hooking the $box
  485.  up to handle $scroll events is a matter of configuration: 
  486.  
  487.   
  488.      $box->configure(-yscrollcommand => ['set', $scroll]);
  489.  
  490.  A complete script that makes use of this code (and adds the necessary calls to 
  491.  pack and MainLoop;) is given as the fifth example in UserGuide.pod (and
  492.  may be found at http://w4.lns.cornell.edu/~pvhp/ptk/pod/.) 
  493.  
  494.  There was an old Perl/Tk tendency to have a bunch of ScrlFoo widgets (such
  495.  as ScrlListbox). The use of such widgets is now deprecated in favor of a
  496.  new Scrolled class, as in: 
  497.  
  498.      $w = $patent->Scrolled('Text',...);
  499.  
  500.  The widgets that can be ->Scrolled() include: 
  501.  
  502.   o Canvas (::Axis) 
  503.   o Entry 
  504.   o Ghostview 
  505.   o HList 
  506.   o HTML (::Web) 
  507.   o Listbox 
  508.   o Pod 
  509.   o Text (::ROText) (::TextUndo) 
  510.   o Tiler 
  511.  
  512.  ______________________________________________________________________
  513.  
  514.  
  515.  
  516.  10.8. How do I configure a Scrollbar to scroll multiple widgets? 
  517.  
  518.  Note that the widget type that you wish to scroll can be important as a scroll
  519.  "unit" on a Text or Listbox may be a character (several pixels - depending
  520.  on font) whereas it would be an X "units" on a Canvas (could be pixel - but
  521.  you may also specify other units). 
  522.  
  523.  A concrete answer for scrolling 3 Listboxes comes courtesy of Frederick L.
  524.  Wagner <derf@ti.com>: 
  525.  
  526.   From a working example of multi-xscrolling: 
  527.  
  528.      sub multiscrollx
  529.      {  # multiscrollx
  530.       my ($sb,$wigs,@args) = @ARG;
  531.       my $w;
  532.       foreach $w (@$wigs)
  533.       {
  534.         $w->xview(@args);
  535.       }
  536.      }  # multiscrollx
  537.   
  538.      # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  539.   
  540.        $sh->configure( -command => [ \&multiscrollx, $sh,
  541.                           [$scratchrule,$ruleheader,$ruletable]]);
  542.        $ruletable->configure(  -xscrollcommand => [ 'set', $sh]);
  543.        $ruleheader->configure( -xscrollcommand => [ 'set', $sh]);
  544.        $scratchrule->configure(-xscrollcommand => [ 'set', $sh]);
  545.  
  546.   In this case,
  547.   $sh is a horizontal Scrollbar,
  548.   $ruletable and $scratchrule are Tables
  549.   $ruleheader is an Entry
  550.  
  551.   However, this approach is good for any widget with X-scrolling
  552.   capability, I think. So the Y counterpart should be: 
  553.  
  554.      sub multiscrolly
  555.      {  # multiscrolly
  556.       my ($sb,$wigs,@args) = @ARG;
  557.       my $w;
  558.       foreach $w (@$wigs)
  559.       {
  560.         $w->yview(@args);
  561.       }
  562.      }  # multiscrolly
  563.   
  564.      # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  565.   
  566.        $sv->configure( -command => [ \&multiscrolly, $sv,
  567.                                      [$l1,$l2,$l3]]);
  568.        $l1->configure( -yscrollcommand => [ 'set', $sv]);
  569.        $l2->configure( -yscrollcommand => [ 'set', $sv]);
  570.        $l3->configure( -yscrollcommand => [ 'set', $sv]);
  571.  
  572.   Hope that helps. 
  573.  
  574.  Greg VanSickle <vansickl@bnr.ca> points out that this little script snippet
  575.  does not provide for the binding of '<Button-2<' that he is accustomed to.
  576.  He wrote a package called DSListbox to address this binding issue. 
  577.  
  578.  Conversely, Jong Park asked how to setup multiple Scrollbars to scroll the
  579.  same widget. Nick Ing-Simmon's reply makes use of an anonymous sub and
  580.  can be summed up in a little script that scrolls a Text widget (to see the
  581.  scrolling in action type more than 20 lines of text into the widget):
  582.  
  583.      #!/usr/local/bin/perl -w
  584.      
  585.      use Tk;
  586.      my $mw = MainWindow->new();
  587.      
  588.      my $s1 = $mw->Scrollbar(-orient => 'vertical');
  589.      my $s2 = $mw->Scrollbar(-orient => 'vertical');
  590.      
  591.      $s1->pack(-side => 'left', -fill => 'y');
  592.      my $t = $mw->Text(
  593.          -yscrollcommand =>  sub{$s1->set(@_), $s2->set(@_)},
  594.          -wrap           => 'word',
  595.          -width          => 70,
  596.          -height         => 20, 
  597.          -font           => $font,
  598.          -setgrid        => 1,
  599.      )->pack(-side => 'left');
  600.      $s2->pack(-side => 'right', -fill => 'y');
  601.      $s1->configure(-command => [$t => 'yview']);
  602.      $s2->configure(-command => [$t => 'yview']);
  603.      
  604.      MainLoop;
  605.      
  606.      __END__
  607.  
  608.  ______________________________________________________________________
  609.  
  610.  
  611.  
  612.  10.9. How do I display a bitmap? 
  613.  
  614.  You can display X bitmaps on your widgets with the -bitmap configuration
  615.  option. Typically -bitmaps are configured into Label, Frame, Button, etc.
  616.  widgets (Canvas widgets are another story however see question [11.1] below).
  617.  In order to emphasize the bitmap option itself let us assume we were
  618.  specifying a bitmap for a Label with a call like: 
  619.  
  620.      $main->Label(-bitmap => 'bitmap-name')->pack;
  621.  
  622.  Where bitmap-name could be any of the built in Tk bitmaps: error, 
  623.  gray25, gray50, hourglass, info, question, questhead, warning (see
  624.  the widget demo for a full list). 
  625.  
  626.  In order to use some of the bitmaps in the perl5/Tk/demos/images/
  627.  directory you would specify a fuller path name like: 
  628.  
  629.      $main->Label(-bitmap => "\@$tk_library/demos/images/face")->pack;
  630.  
  631.  Note the escaped "\@" on the directory specification (as well as the use of the 
  632.  $tk_library variable imported by use Tk;). If you wanted to specify a file
  633.  called foobar.xbm in the directory where you were running the script then
  634.  either: 
  635.  
  636.      $main->Label(-bitmap => '@foobar.xbm')->pack;
  637.  #or
  638.      $main->Label(-bitmap => "\@foobar.xbm")->pack;
  639.  
  640.  should work just fine. In another directory however that would be a problem.
  641.  So something like: 
  642.  
  643.      $main->Label(-bitmap => "\@$ENV{'HOME'}/img/foobar.xbm")->pack;
  644.  
  645.  will help someone who has an img/foobar.xbm file in their $HOME
  646.  directory. If you don't mind the non-portability then hard-wiring in the full
  647.  path name will help as well. (Or if you have write access then put your files in 
  648.  Tk/demos/images/ e.g.) 
  649.  
  650.  ______________________________________________________________________
  651.  
  652.  
  653.  
  654.  10.10. How do I display an image? 
  655.  
  656.  You will want to get a "Photo" handle on the file as in the following example
  657.  where 'imggif' is the Photo handle for a gif file that is distributed with
  658.  perl/Tk: 
  659.  
  660.      #!/usr/bin/perl -w
  661.      use strict;
  662.      use Tk;
  663.      my $main = new MainWindow;
  664.  
  665.      $main ->Label(-text => 'Main')->pack;
  666.      $main -> Photo('imggif', 
  667.                     -file => "$Tk::tk_library/demos/images/earth.gif");
  668.      my $l = $main->Label('-image' => 'imggif')->pack;
  669.  
  670.      $main->Button(-text => 'close',
  671.                    -command => sub{destroy $main}
  672.                    )->pack(-side => 'left');
  673.      $main->Button(-text => 'exit',
  674.                    -command => [sub{exit}]
  675.                    )->pack(-side => 'right');
  676.      MainLoop;
  677.  
  678.  (Canvas widgets are another story however see question a later question
  679.  within this FAQ). 
  680.  
  681.  ______________________________________________________________________
  682.  
  683.  
  684.  
  685.  10.11. What Image types are available? 
  686.  
  687.  In addition to the Tk builtin bitmaps there is support for reading images
  688.  from files in formats such as: X11 Bitmaps (.xbm), X Pixmaps (.xpm), and
  689.  Graphics Inline Format (.gif). See the CrtPhImgFmt man page for more info
  690.  (if you have Tk 4.X installed). (In order to support other formats you might
  691.  also consider running through a netpbm filter.) 
  692.  
  693.  For perl generation of images see the question (later in this FAQ) on graphics
  694.  modules. 
  695.  
  696.  ______________________________________________________________________
  697.  
  698.  
  699.  
  700.  10.12. Is there any way to have more than one Listbox contain a selection? 
  701.  
  702.  To allow more than one Listbox to contain a "selection", (or at least a
  703.  highlighted item - which need not be the actual selection) specify the
  704.  configuration option: 
  705.  
  706.      -exportselection => 0
  707.  
  708.  which will dis-associate Listbox's selection from X selection (only one
  709.  window can have X selection at a time). 
  710.  
  711.  Here is a rather simple script that illustrates what happens when only one 
  712.  Listbox has -exportselection => 0 specified: 
  713.  
  714.      #!/usr/bin/perl -w
  715.      
  716.      use Tk;
  717.      
  718.      my $main = MainWindow->new;
  719.      
  720.      my @fruits = ('Apple','Banana','Cherry','Date','Elderberry','Fig');
  721.      my @nuts   = qw(Almond Brazil Chestnut Doughnut Elmnut Filbert);
  722.      
  723.      my $fruit_list = $main->Listbox();
  724.      for (@fruits) { $fruit_list -> insert('end',$_); }
  725.      $fruit_list->pack();
  726.      my $fruitprint_button = $main->Button(
  727.                                -text => "print selection",
  728.                                -command => sub{ printthem($fruit_list) }
  729.                                            )->pack;
  730.      
  731.      my $nut_list = $main->Listbox(
  732.                                    -selectmode => 'multiple',
  733.                                    -exportselection => 0,
  734.                                   )->pack;
  735.      for (@nuts) { $nut_list -> insert('end',$_); }
  736.      my $nutprint_button = $main->Button(
  737.                                -text => "print selection(s)",
  738.                                -command => sub{ printthem($nut_list) }
  739.                                            )->pack;
  740.      
  741.      my $quit_button = $main->Button(-text => "quit program", 
  742.                                      -command => sub{exit},
  743.                                      )->pack();
  744.      
  745.      MainLoop;
  746.      
  747.      sub printthem {
  748.          my $list = shift;
  749.          my @entries = $list->curselection;
  750.          for (@entries) { print $list -> get($_),"\n";}
  751.      }
  752.  
  753.  For a more extensive example of Listbox usage combined with some perl
  754.  data structure exploitation see the script at: 
  755.  
  756.      http://w4.lns.cornell.edu/~pvhp/ptk/etc/lb-constructor
  757.  
  758.  ______________________________________________________________________
  759.  
  760.  
  761.  
  762.  10.13. How do I select a range of tags in a Text widget? 
  763.  
  764.  A question arose concerning getting a range of selections from a Text widget. 
  765.  Nick Ing-Simmons' answer mentions several possibilities including: 
  766.  
  767.   Keyboard Copy/Paste 'is' implemented of course... 
  768.  
  769.  
  770.  Subj:   RE: $Text->tag('ranges', 'sel') - does this work?
  771.  
  772.  In <199512291957.OAA02609@ohm.nrl.navy.mil>
  773.  On Fri, 29 Dec 1995 14:57:42 -0500
  774.  Charles J Williams <chas@ohm.nrl.navy.mil> writes:
  775.  !I was writing a little tk perl today, and i decided to try to 
  776.  !implement a copy/paste using the 'sel' tag
  777.  !
  778.  !I enabled exportselection, and then try to probe the select 
  779.  !region with:
  780.  !
  781.  !    $buffer = $text->tag('ranges', 'sel');
  782.  !
  783.  !$buffer comes back with one entry, the end of the selection.
  784.  
  785.   That is to be expected - the scalar gets assigned the last element of the
  786.   list. 
  787.  
  788.  
  789.  !I tried:
  790.  !
  791.  !    @buffer = $text->tag('ranges', 'sel');
  792.  !
  793.  !same difference.
  794.  
  795.   This seems to work for me: 
  796.  
  797.      ($start,$end) = $text->tagRanges('sel');
  798.  
  799.   In perl/Tk ->tagRanges(...) is an alias for ->tag('ranges',...) 
  800.  
  801.   The following subroutine can also probe and print the tagRanges: 
  802.  
  803.      sub showsel  
  804.      { 
  805.       my $text = @_;
  806.       my @info = $text->tagRanges('sel');
  807.       if (@info)
  808.        {
  809.         print "start=$info[0] end=$info[1]\n" 
  810.        }
  811.      }
  812.  
  813.  ______________________________________________________________________
  814.  
  815.  
  816.  
  817.  10.14. How do I group Radiobuttons together? 
  818.  
  819.  Specify the -variable option on each one. Here is an example pulled from
  820.  the icon.pl demo script: 
  821.  
  822.       $letters = '';
  823.       my $w_frame_left_b3 = $w_frame_left->Radiobutton(
  824.           -bitmap   => "\@$tk_library/demos/images/letters",
  825.           -variable => \$letters,
  826.           -value    => 'full',
  827.       );
  828.       my $w_frame_left_b4 = $w_frame_left->Radiobutton(
  829.           -bitmap   => "\@$tk_library/demos/images/noletters",
  830.           -variable => \$letters,
  831.           -value    => 'empty',
  832.       );
  833.  
  834.  ______________________________________________________________________
  835.  
  836.  
  837.  
  838.  10.15. How do I specify fonts? 
  839.  
  840.  The quick answer is to specify the font configuration option of your widget as
  841.  in: 
  842.  
  843.      #!/usr/local/bin/perl -w
  844.      use Tk;
  845.      $main = MainWindow->new();
  846.      $labl = $main -> Label('-text' => "Foo", '-font' => "fixed");
  847.      $labl -> pack;
  848.      MainLoop;
  849.  
  850.  The long answer involves figuring out what fonts you have access to locally.
  851.  The Unix programs xlsfonts and xfontsel are useful in this regard. 
  852.  
  853.  The perl/Tk version of xfontsel was distributed as the font_test script in the
  854.  Tk build directory. 
  855.  
  856.  See also the later question (within this FAQ) on international fonts. 
  857.  
  858.  ______________________________________________________________________
  859.  
  860.  
  861.  
  862.  10.16. How do I get the entry in an Entry? 
  863.  
  864.  You want to call get on the return value of the widget itself. Here is how it
  865.  may be used in a simplified version of example 1.1 from the Tk::UserGuide
  866.  where a Button is set up to call a sub where the call to get lies: 
  867.  
  868.      #!/usr/bin/perl -w
  869.      use strict;
  870.      use Tk;
  871.  
  872.      my $main = MainWindow -> new();
  873.      my $entry = $main -> Entry();
  874.      $entry -> pack;
  875.      $main->Button(-text => 'Print', 
  876.                    -command => sub{do_print($entry)}
  877.                    )->pack;
  878.      MainLoop;
  879.  
  880.      sub do_print {
  881.          my ($widget) = @_;
  882.          my $entered = $widget -> get();
  883.          print "The string \"$entered\" was entered.\n";
  884.      }
  885.  
  886.  ______________________________________________________________________
  887.  
  888.  
  889.  
  890.  10.17. How do I hide a password Entry? 
  891.  
  892.  Set the -show option to zero, as in this example: 
  893.  
  894.      $entry = $form->Entry(-textvariable => \$user_entry, 
  895.                            -show => 0);
  896.  
  897.  ______________________________________________________________________
  898.  
  899.  
  900.  
  901.  10.18. How do I limit an Entry's insertion width? 
  902.  
  903.  Nick Ing-Simmons recommends writing a new Entry widget with the 
  904.  insert method appropriately overridden by one that does limit the width. His
  905.  code is avaialable as a separate package from: 
  906.  
  907.      http://w4.lns.cornell.edu/~pvhp/ptk/etc/LEntry-0_00.tar.gz
  908.  
  909.  Now Brent Powers points out a possible problem with that approach and
  910.  recommends an insert() method as follows: 
  911.  
  912.      Date: Thu, 22 Aug 1996 10:32:44 -0400
  913.      From: "Brent B. Powers" <powers@ml.com>
  914.      Subject: Re: How to set max characters for Entry widget
  915.      In-reply-to: <199608211445.PAA09248@pluto>
  916.      
  917.      Ummm, before we set this into the distribution or FAQ, maybe we should
  918.      make it work properly.  An example:  Imagine maxwidth configured to 8,
  919.      the user fills in ABCDEFGH, moves the cursor back 4 places, and types
  920.      I.  The SUPER::insert call sets the string to ABCDIEFGH, which this
  921.      code then modifies to ABCDIEFG.
  922.      
  923.      Hmmm, how about
  924.      
  925.      sub insert {
  926.        my($w, @args) = @_;
  927.        my($max) = $w->cget(-maxwidth);
  928.        my($sval) = $w->get;
  929.        if (length($sval) >= $max) {
  930.           $w->SUPER::insert(@args);
  931.           if (length($w->get) > length($sval) {
  932.          ## Reject it;
  933.          my($idx) = $w->index('insert'); #  get current cursor position
  934.              $w->delete(0, 'end');
  935.              $w->insert(0, $sval);
  936.              $w->icursor($idx);
  937.          $w->bell;
  938.        } else {
  939.           $w->SUPER::insert(@args);
  940.        }
  941.      }
  942.      
  943.      Of course, that still doesn't deal with the selection, but ... 
  944.  
  945.  To which Nick Ing-Simmons responded (Thu Aug 22 1996): 
  946.  
  947.      'paste' and <ButtonRelease-2> call insert method, what other selection
  948.      issues are there?
  949.  
  950.  ______________________________________________________________________
  951.  
  952.  
  953.  
  954.  10.19. How do I obtain Menus that do not tear off? 
  955.  
  956.  Nick Ing-Simmons outlined a couple of ways to achieve this result. The
  957.  critical feature being the -tearoff => 0 configuration option of the Menu.
  958.  In Nick's words: 
  959.  
  960.      my $mb = $parent->Menubutton(...);    # The button
  961.      my $menu = $mb->Menu(-tearoff => 0);  # Create a non-tearoff menu
  962.      $mb->configure(-menu => $menu);       # Tell button to use it.
  963.      $mb->command(....);
  964.  
  965.   Above is for clarity - you can loose $menu variable: 
  966.  
  967.      my $mb = $parent->Menubutton(...);  
  968.      $mb->configure(-menu => $mb->Menu(-tearoff => 0));  
  969.      $mb->command(....);
  970.  
  971.