The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
# $Source: /home/keck/gen/RCS/mk.xtb,v $
# $Revision: 1.6 $$Date: 2007/07/06 17:00:18 $
# Contents
#   1 standard  2 args  3 main  4 notes  5 pod

# ----------------------------------------------------------------------

#1# standard

use strict;
use warnings;

(my $cmd = "$0") =~ s%.*/%%;

sub usage { print "Usage: $cmd -help\n"; }
sub quit { (@_) ? print STDERR "$cmd quitting: @_\n" : &usage; exit 1 }

sub perldoc {
  my ($perldoc, $less);
  for (split /:/, $ENV{PATH}) {
    $perldoc = "$_/perldoc" if -x "$_/perldoc";
    last if $perldoc; next if $less;
    $less = "$_/less" if -x "$_/less";
  }
  if ($perldoc) {
    $ENV{LESSCHARSET} = 'latin1';
    exec $perldoc, $0
  } elsif ($less) {
    exec $less, '+/^# Sorry.*', $0
  } else {
    print
      "Sorry, there's no perldoc(1) or even less(1) in your \$PATH\n" .
      "The documentation can be found at the end of $0\n";
    exit 1
  }
}

# ----------------------------------------------------------------------

#2# args

while (@ARGV) {
  $_ = shift;
  perldoc() if /^-+(man|h)/;
  unshift @ARGV, $_;
  last;
}

# ---------------------------------------------------------------------

#3# main

print "# example ~/.xtb file for xchar system\n";
print "# generated by $0 " . `date`;

print <<'ZZZ'

{ my @reserved;
  push @reserved, qw(x r s o h);
  push @reserved, qw(a c e f g j k t y z , . - =);
  my %reserved;
  $reserved{$_} = 1 for @reserved;
  my @spare;
  for ('a' .. 'z') { push(@spare, $_) unless $reserved{$_}; }

  { char => sub { # arg = instance name from WM_CLASS
      local $_ = shift;
      m-/(.)$-             ?  $1             :
      /acroread/i          ?  ['a', @spare]  :
      /xchat/              ?  ['c', @spare]  :
      /ethereal/           ?  ['e', @spare]  :
      /gecko|firefox-bin/  ?  ['f', @spare]  :
      /gv/i                ?  ['g', @spare]  :
      /sjphone/i           ?  ['j', @spare]  :
      /kaffeine/           ?  ['k', @spare]  :
      /TeXmacs/            ?  ['t', @spare]  :
      /skype/i             ?  ['y', @spare]  :
      /SWT/                ?  ['z', @spare]  : # azureus
      /xtb./               ?  [',', ';' ]    :
      /xtb/                ?  '.'            :
      /^$/                 ?  ['-', '=']     :
      /./                  ?  ['A' .. 'Z']   :
      undef;

    },
    order => [ # can repeat characters
      'a' .. 'z', '0' .. '9', 'A' .. 'Z'
    ],
  },
};

ZZZ

__END__

# ----------------------------------------------------------------------

#4# notes

# +taskbar9

# ----------------------------------------------------------------------

#5# pod

# Sorry, there's no perldoc in your $PATH, so here's the raw pod

=head1 NAME

mk.xtb - generate a sample configfile for the xchar taskbar

=head1 SYNOPSIS

 mk.xtb >~/.xtb

=head1 DESCRIPTION

mk.xtb outputs a sample configfile for the taskbar component xtb of the
xchar system.

=head1 SEE ALSO

xchar(1), xtb(1)

=head1 AUTHOR

Brian Keck E<lt>bwkeck@gmail.comE<gt>

=head1 VERSION

 $Source: /home/keck/gen/RCS/mk.xtb,v $
 $Revision: 1.6 $
 $Date: 2007/07/06 17:00:18 $
 xchar 0.2

=cut