xchar

 view release on metacpan or  search on metacpan

bin/xterms  view on Meta::CPAN

#3# cmd

(my $remotehost = $cmd) =~ tr/A-Z/a-z/ unless $cmd =~ /^$xterms$/i;
my $uppercase = $cmd =~ /[A-Z]/;

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

#4# args/1

my %prefs;

my $BIG;
my $C;
my $big;
my $dotfile;
my $display = 1;
my $list;
my $name;
my $scrollbar;
my $show;

bin/xterms  view on Meta::CPAN

while (@ARGV) {
  $_ = shift;
  &perldoc() if /^-+(man|help)/;
  $sleep = $1, next if /^-(\d+)/;
  $big = 1, next if /^-b/;
  $BIG = 1, next if /^-B/;
  $dotfile = shift, next if /^-c/;
  $C = '-C', next if /^-C/;
  $ENV{DISPLAY} = shift, next if /^-d/;
  $display = 0, next if /^-D/;
  $prefs{bold} = shift, next if /^-fb/;
  $prefs{normal} = shift, next if /^-f/;
  $prefs{height} = shift, next if /^-he/;
  $remotehost = shift, next if /^-h/;
  $list = 1, next if /^-l$/;
  $prefs{name} = shift, next if /^-n/;
  $prefs{rcmd} = 'rlogin', next if /^-rl/;
  $prefs{rcmd} = 'rsh', next if /^-rs/;
  $scrollbar = 1, next if /^-sc/;
  $show = 1, next if /^-sh/;
  $prefs{rcmd} = 'ssh', next if /^-ss/;
  $prefs{rcmd} = 'telnet', next if /^-t/;
  $prefs{rcmd} = 'TELNET', next if /^-T/;
  $u = 1, next if /^-u/;
  $U = 1, next if /^-U/;
  quit("illegal option: $_") if /^-/ && !/^-+$/;
  unshift @ARGV, $_;
  last;
}

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

#5# screenname

bin/xterms  view on Meta::CPAN

my $Unicode = '-*-*-medium-r-*--13-*-*-*-c-60-iso10646-*';

my $bigunicode =
  '-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso10646-1';

my $BIGunicode =
  '-sony-fixed-medium-r-normal--24-170-100-100-c-120-iso8859-1';

# bold not handled yet ...
unless (defined $prefs{normal}) {
  if ($u || $U || $screen->unicode) {
    $prefs{normal} =
      $BIG ? "$BIGunicode -u8" :
      $big ? "$bigunicode -u8" :
      $U ? "$Unicode -u8" :
      $u ? "$unicode -u8" :
      undef;
  } else {
    $prefs{normal} =
      $BIG ? '12x24' :
      $big ? '9x15' :
      undef;
  }
}

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

#7# config

bin/xterms  view on Meta::CPAN

} else {
  $dotfile = "$HOME/.$xterms";
}

if (-f $dotfile) {
  if ($list) {
    my $pager = $ENV{PAGER} ? $ENV{PAGER} : 'more';
    exec "$pager $dotfile";
  }
  my $config = X11::XTerms->new(file => $dotfile);
  %prefs = %{$config->prefs(\%prefs, $remotehost)};
}

# needs to stay '' if defined to be '' in .xterms (cu for ipaq) ...
my $loginhost =
  defined $prefs{address} ? $prefs{address} :
  defined $prefs{between} ? $prefs{between} :
  $remotehost;

if ($loginhost) {
  $loginhost = "$loginhost $prefs{port}" if $prefs{port};
  unless ($prefs{user}) {
    if ($loginhost =~ /(.*)@(.*)/) {
      $prefs{user} = $1;
      $loginhost = $2;
    } else {
      $prefs{user} = $user;
    }
  }
  $prefs{rcmd} = $uppercase ? 'SSH' : 'ssh' if !$prefs{rcmd};
  $prefs{rcmd} .= " -l $prefs{user}"
    if $prefs{rcmd} =~ /rsh|rlogin|ssh/;
}

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

#8# args/2

quit("no places specified") unless @ARGV;
# for ion, where -geometry ignored, allow '-', '--', etc

my $i = 0;

bin/xterms  view on Meta::CPAN

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

#10# display

# notes in 7.3

$ENV{DISPLAY} = "$localhost:$1" if
  defined $remotehost &&
  $ENV{DISPLAY} =~ /^:(.*)/ &&
  $prefs{rcmd} =~ /^rsh/;

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

#11# xenvironemnt

my $xenvironment =
  $prefs{noxenv} ? undef :
  $ENV{XENVIRONMENT} ? $ENV{XENVIRONMENT} :
  -f "$HOME/.Xdefaults.d/$screenname" ? "$HOME/.Xdefaults.d/$screenname" :
  undef;

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

#12# main

my $remote =
  defined $prefs{rcmd} && $prefs{rcmd} =~ /^rsh/; # xterm remote

for (@xterms) {
  my $place = $_->{place};
  my $client = $clients{$place}; # empty for $place eq '-'
  my %screen;
  $screen{font} = $screen->font;
  my %char;
  $char{geometry} = $client->geometry('chars');
  $char{normal} = $client->font('normal');
  $char{bold} = $client->font('bold');
  my $geometry = $char{geometry};
  $geometry =~ s/x\d+/x$prefs{height}/ if $prefs{height};
  my $normal =
    $prefs{normal} ? $prefs{normal} :
    $char{normal} ? $char{normal} :
    $screen{font} ? $screen{font} :
    undef;
  my $bold =
    $prefs{bold} ? $prefs{bold} :
    $char{bold} ? $char{bold} :
    $normal ? $normal :
    undef;
  my $id = $_->{id},
  my $instance = $_->{instance},
  my $ichar = $_->{ichar},
  my @command;
  push @command, "DISPLAY=$ENV{DISPLAY}" if $display && $remote;
  push @command, "XENVIRONMENT=$xenvironment" if defined $xenvironment;
  push @command,

bin/xterms  view on Meta::CPAN

  push @command, $C if $C;
  push @command, '-fn', $normal if $normal;
  push @command, '-sb', if $scrollbar;
  push @command, '-fb', $bold if $bold;
  push @command, '-name', $instance;
  push @command, '-geometry', $geometry if $geometry;
  my $command;
  if ($remote) {
    $command = join(' ', @command);
    quit "\$loginhost undefined" unless $loginhost;
    $command = qq{$prefs{rcmd} $loginhost '$command >/dev/null 2>&1 &'};
  } else {
    push @command, '-n', $remotehost if $remotehost;
    push @command, '-e', $prefs{rcmd} if defined $loginhost;
    push @command, $loginhost if $loginhost;
    $command = join(' ', @command, '&');
  }
  if ($show) { print $command, "\n" } else { system $command }
  sleep $sleep if $sleep;
}

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

#13# notes

lib/X11/XTerms.pm  view on Meta::CPAN

# $Source: /home/keck/lib/perl/X11/RCS/XTerms.pm,v $
# $Revision: 1.5 $$Date: 2007/07/04 17:00:32 $
# Contents
#   1 standard  2 new  3 localhost  4 prefs  5 notes  6 pod

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

#1# standard

use strict;
use warnings;

package X11::XTerms;

lib/X11/XTerms.pm  view on Meta::CPAN

my $localhost;

sub localhost {
  return $localhost if defined $localhost;
  ($localhost = &Sys::Hostname::hostname) =~ s/\..*//;
  $localhost;
}

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

#4# prefs

# perl -MData::Dumper -MX11::XTerms \
#   -e 'print Dumper (X11::XTerms->new->prefs)'

sub prefs {
  my $xterms = shift;
  my $inprefs = {};
  my $remotehost;
  for (@_) {
    if (ref) { $inprefs = $_ } else { $remotehost = $_ }
  }
  my %outprefs = %$inprefs;
  $localhost = localhost unless defined $localhost;
  if (
    defined $remotehost &&
    defined $xterms->{$localhost} &&
    defined $xterms->{$localhost}{$remotehost}
  ) {
    for my $key (keys %{$xterms->{$localhost}{$remotehost}}) {
      $outprefs{$key} = $xterms->{$localhost}{$remotehost}{$key}
        unless defined $outprefs{$key};
    }
  }
  if (
    defined $remotehost &&
    defined $xterms->{''} &&
    defined $xterms->{''}{$remotehost}
  ) {
    for my $key (keys %{$xterms->{''}{$remotehost}}) {
      $outprefs{$key} = $xterms->{''}{$remotehost}{$key}
        unless defined $outprefs{$key};
    }
  }
  if (
    defined $xterms->{$localhost} &&
    defined $xterms->{$localhost}{''}
  ) {
    for my $key (keys %{$xterms->{$localhost}{''}}) {
      $outprefs{$key} = $xterms->{$localhost}{''}{$key}
        unless defined $outprefs{$key};
    }
  }
  if (
    defined $xterms->{''} &&
    defined $xterms->{''}{''}
  ) {
    for my $key (keys %{$xterms->{''}{''}}) {
      $outprefs{$key} = $xterms->{''}{''}{$key}
        unless defined $outprefs{$key};
    }
  }
  \%outprefs;
}

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

1;
__END__

#5# notes

# 1.1

lib/X11/XTerms.pm  view on Meta::CPAN

=head1 NAME

X11::XTerms - find xterm attributes in ~/.xterms 

=head1 SYNOPSIS

 require X11::XTerms;
 $xterms = Xterms->new;
 $xterms = Xterms->new(file => 'somefile');

 $prefs = $xterms->prefs;
 $prefs = $xterms->prefs('somehost');
 $inprefs = { rcmd => 'telnet', user => 'bloggs', };
 $outprefs = $xterms->prefs($inprefs);
 $outprefs = $xterms->prefs($inprefs, 'somehost');

=head1 DESCRIPTION

=head1 AUTHOR

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

=head1 VERSION

 $Source: /home/keck/lib/perl/X11/RCS/XTerms.pm,v $