xchar
view release on metacpan or search on metacpan
#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;
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
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
} 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;
# ----------------------------------------------------------------------
#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,
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 $
( run in 2.022 seconds using v1.01-cache-2.11-cpan-98e64b0badf )