home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / CmdLine.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  6.8 KB  |  300 lines
  1. package Tk::CmdLine;
  2. require Tk;
  3. use strict;
  4.  
  5. *motif = \$Tk::strictMotif;
  6.  
  7. use vars qw($synchronous %switch $iconic %options %methods @command %config);
  8.  
  9. $synchronous = 0;
  10. $iconic      = 0;
  11.  
  12. @command = ();
  13. %options = ();
  14. %config  = (-name => ($0 eq '-e' ? 'pTk' : $0));
  15. $config{'-name'}  =~ s#^.*/##; 
  16.  
  17. sub arg
  18. {
  19.  my $flag = shift;
  20.  die("Usage: $0 ... $flag <argument> ...\n") unless (@ARGV);
  21.  return shift(@ARGV);
  22. }
  23.  
  24. sub variable
  25. {
  26.  no strict 'refs';
  27.  my ($flag, $name) = @_;
  28.  my $val = arg($flag);
  29.  push(@command, $flag => $val );
  30.  ${$name} = $val;
  31. }
  32.  
  33. sub config
  34. {
  35.  my ($flag, $name) = @_;
  36.  my $val = arg($flag);
  37.  push(@command, $flag => $val );
  38.  $config{"-$name"} = $val;
  39. }
  40.  
  41. sub flag
  42. {
  43.  no strict 'refs';
  44.  my ($flag, $name) = @_;
  45.  push(@command, $flag );
  46.  ${$name} = 1;
  47. }
  48.  
  49. sub option
  50. {
  51.  my ($flag,$name) = @_;
  52.  my $val = arg($flag);
  53.  push(@command, $flag => $val );
  54.  $options{"*$name"} = $val;
  55. }
  56.  
  57. sub method
  58. {
  59.  my ($flag,$name) = @_;
  60.  my $val = arg($flag);
  61.  push(@command, $flag => $val );
  62.  $methods{$name} = $val;
  63. }
  64.  
  65. sub resource
  66. {
  67.  my ($flag,$name) = @_;
  68.  my $val = arg($flag);
  69.  push(@command, $flag => $val );
  70.  ($name,$val) = $val =~ /^([^:\s]+)*\s*:\s*(.*)$/;
  71.  $options{$name} = $val;
  72. }
  73.  
  74. %switch = ( synchronous  => \&flag,
  75.             screen       => \&config,
  76.             borderwidth  => \&config,
  77.             class        => \&config,
  78.             geometry     => \&method,
  79.             iconposition => \&method,
  80.             name         => \&config,
  81.             motif        => \&flag,
  82.             background   => \&option,
  83.             foreground   => \&option,
  84.             font         => \&option,
  85.             title        => \&config,
  86.             iconic       => \&flag,
  87.             'reverse'    => \&flag,
  88.             xrm          => \&resource,
  89.             bg           => 'background',
  90.             bw           => 'borderwidth',
  91.             fg           => 'foreground',
  92.             fn           => 'font',
  93.             rv           => 'reverse',
  94.             display      => 'screen',
  95.          );
  96.  
  97. #   -bd color, -bordercolor color
  98. #    -selectionTimeout
  99. #    -xnllanguage language[_territory][.codeset]
  100.  
  101. sub process
  102. {
  103.  my ($class) = @_;
  104.  while (@ARGV && $ARGV[0] =~ /^-(\w+)$/)
  105.   {
  106.    my $sw = $1;
  107.    my $kind = $switch{$sw};
  108.    last unless defined $kind;
  109.    $kind = $switch{$sw = $kind} unless ref $kind;
  110.    &$kind(shift(@ARGV),$sw); 
  111.   }
  112. }
  113.  
  114. sub CreateArgs
  115. {
  116.  process();
  117.  $config{'-class'} = "\u$config{'-name'}" unless exists $config{'-class'};
  118.  return \%config;
  119. }
  120.  
  121. sub Tk::MainWindow::apply_command_line
  122. {
  123.  my $mw = shift;
  124.  my $key;
  125.  foreach $key (keys %options)
  126.   {
  127.    $mw->optionAdd($key => $options{$key},'interactive');
  128.   }
  129.  foreach $key (keys %methods)
  130.   {
  131.    $mw->$key($methods{$key});
  132.   }
  133.  if (delete $methods{'geometry'})
  134.   {
  135.    $mw->positionfrom('user');
  136.    $mw->sizefrom('user'); 
  137.   }
  138.  $mw->Synchronize if $synchronous;
  139.  if ($iconic)
  140.   {
  141.    $mw->iconify; 
  142.    undef $iconic;
  143.   }
  144.  # 
  145.  # Both these are needed to reliably save state
  146.  # but 'hostname' is tricky to do portably.
  147.  # $mw->client(hostname());
  148.  # $mw->protocol('WM_SAVE_YOURSELF' => ['WMSaveYourself',$mw]);
  149.  $mw->command([$0,@command]);
  150. }
  151.  
  152. 1;
  153.  
  154. __END__
  155.  
  156. =head1 NAME
  157.  
  158. Tk::CmdLine - Process standard X11 command line options
  159.  
  160. =head1 SYNOPSIS
  161.  
  162. use Tk::CmdLine;
  163.  
  164. =head1 DESCRIPTION
  165.  
  166. The X11R5 man page for X11 says :
  167.  
  168. "Most X programs attempt to use the same  names  for  command
  169. line  options  and arguments.  All applications written with
  170. the X Toolkit Intrinsics automatically accept the  following
  171. options: ..."
  172.  
  173. This module implemements these command line options for perl/Tk 
  174. applications.
  175.  
  176. The options which are processed are :
  177.  
  178. =over 4
  179.  
  180. =item     -display display
  181.  
  182. This option specifies the name of the  X  server  to
  183. use.
  184.  
  185.  
  186. =item     -geometry geometry
  187.  
  188. This option specifies the initial size and  location
  189. of the I<first> MainWindow.
  190.  
  191. =item     -bg color, -background color
  192.  
  193. Either option specifies the color  to  use  for  the
  194. window background.
  195.  
  196. =item     -bd color, -bordercolor color
  197.  
  198. Either option specifies the color  to  use  for  the
  199. window border.
  200.  
  201. =item     -bw number, -borderwidth number
  202.  
  203. Either option specifies the width in pixels  of  the
  204. window border.
  205.  
  206. =item     -fg color, -foreground color
  207.  
  208. Either option specifies the color to use for text or
  209. graphics.
  210.  
  211. =item     -fn font, -font font
  212.  
  213. Either option specifies the font to use for display-
  214. ing text.
  215.  
  216. =item     -iconic
  217.  
  218. This option indicates that  the  user  would  prefer
  219. that  the  application's  windows  initially  not be
  220. visible as if the windows had be immediately  iconi-
  221. fied by the user.  Window managers may choose not to
  222. honor the application's request.
  223.  
  224. =item     -name
  225.  
  226. This option specifies the name under which resources
  227. for the application should be found.  This option is
  228. useful in shell aliases to distinguish between invo-
  229. cations  of  an  application,  without  resorting to
  230. creating links to alter the executable file name.
  231.  
  232. =item     -rv, -reverse
  233.  
  234. Either option  indicates  that  the  program  should
  235. simulate  reverse  video if possible, often by swap-
  236. ping the foreground and background colors.  Not  all
  237. programs  honor  this or implement it correctly.  It
  238. is usually only used on monochrome displays.
  239.  
  240. B<Tk::CmdLine Ignores this option.>
  241.  
  242. =item     +rv
  243.  
  244. This option indicates that the  program  should  not
  245. simulate reverse video. This is used to override any
  246. defaults since reverse  video  doesn't  always  work
  247. properly.
  248.  
  249. B<Tk::CmdLine Ignores this option.>
  250.  
  251. =item     -selectionTimeout
  252.  
  253. This option specifies the  timeout  in  milliseconds
  254. within  which  two  communicating  applications must
  255. respond to one another for a selection request.
  256.  
  257. B<Tk::CmdLine Ignores this option.>
  258.  
  259. =item     -synchronous
  260.  
  261. This option indicates that requests to the X  server
  262. should  be  sent synchronously, instead of asynchro-
  263. nously.  Since Xlib normally buffers requests to the
  264. server,  errors  do  not  necessarily  get  reported
  265. immediately after they occur.  This option turns off
  266. the   buffering  so  that  the  application  can  be
  267. debugged.  It should never be used  with  a  working
  268. program.
  269.  
  270. =item     -title string
  271.  
  272. This option specifies the title to be used for  this
  273. window.   This  information  is  sometimes used by a
  274. window manager to provide some sort of header  iden-
  275. tifying the window.
  276.  
  277. =item     -xnllanguage language[_territory][.codeset]
  278.  
  279. This option specifies the language,  territory,  and
  280. codeset  for  use  in  resolving  resource and other
  281. filenames.
  282.  
  283. B<Tk::CmdLine Ignores this option.>
  284.  
  285. =item     -xrm resourcestring
  286.  
  287. This option specifies a resource name and  value  to
  288. override  any  defaults.  It is also very useful for
  289. setting resources that don't have  explicit  command
  290. line arguments.
  291.  
  292. The I<resourcestring> is of the form C<name:value>, that is (the first) ':' 
  293. is the used to determine which part is name and which part is value.
  294. The name/value pair is entered into the options database with C<optionAdd>
  295. (for each MainWindow configd), with "interactive" priority.
  296.  
  297. =back 4
  298.  
  299. =cut
  300.