xchar
view release on metacpan or search on metacpan
#!/usr/bin/env perl
#!/usr/bin/perl -w
# $Source: /home/keck/gen/RCS/xterms,v $
# $Revision: 8.11 $$Date: 2007/07/05 17:00:30 $
# Contents
# 1 standard 4 args/1 7 config 10 display 13 notes
# 2 constants 5 screenname 8 args/2 11 xenvironemnt 14 perldoc
# 3 cmd 6 font 9 geometry 12 main 15 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 }
my $HOME = $ENV{HOME};
(my $user = `id`) =~ s/^[^(]*\(([^)]+)\).*\n/$1/;
chdir $HOME;
use X11::XTerms;
my $localhost = X11::XTerms->localhost;
use Data::Dumper;
# ----------------------------------------------------------------------
#2# constants
# see font/1, xenvironment
my $xterms = 'xterms';
# ----------------------------------------------------------------------
#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;
my $sleep;
my $u;
my $U;
my $xcmd = 'xterm';
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
$ENV{DISPLAY} = ':0' unless defined $ENV{DISPLAY};
use X11::Screens;
my $screen = X11::Screens->current; # croaks on failure
my $screenname = $screen->name;
quit("\$screen->name failed") unless $screenname;
# ----------------------------------------------------------------------
#6# font
# lots of notes in 7.3
# +vim +etc2
my $unicode = '-*-*-medium-r-*--8-*-*-*-c-50-iso10646-*';
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
if (defined $dotfile) {
quit("no such file: $dotfile") unless -f $dotfile;
} 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;
my @xterms;
for (@ARGV) {
my @places = ();
my @ichars = ();
my $last;
if (/^-+$/) {
@places = split '';
} elsif (/(.+)\.(.+)/) {
my @ranges = split '', $1; # position chars
my @iranges = split '', $2; # instance chars
while (@ranges) {
local $_ = shift @ranges;
push(@places, $_), $last = $_, next unless /-/;
$_ = shift @ranges;
my @extra = $last .. $_;
shift @extra;
push @places, @extra;
}
while (@iranges) {
local $_ = shift @iranges;
push(@ichars, $_), $last = $_, next unless /-/;
$_ = shift @iranges;
my @extra = $last .. $_;
shift @extra;
push @ichars, @extra;
}
quit("more places than names in '$_'") if @places > @ichars;
push(@places, $places[-1]) while @places < @ichars;
} else {
my @ranges = split('', $_);
while (@ranges) {
$_ = shift @ranges;
push(@places, $_), $last = $_, next unless /-/;
$_ = shift @ranges;
my @extra = $last .. $_;
shift @extra;
push @places, @extra;
}
}
for (@places) {
my $ichar = shift @ichars;
my $id = sprintf("%05d", $$) . sprintf("%02d", $i++);
my $xterm = {
place => $_,
id => $id,
instance => (
defined $name ? $name :
defined $remotehost ? $remotehost :
'xterm'
) . "/$ichar",
ichar => $ichar,
};
push @xterms, $xterm;
}
}
# print Dumper(\@xterms); exit;
# ----------------------------------------------------------------------
#9# geometry
my %clients = %{$screen->clients};
# ----------------------------------------------------------------------
#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,
'PATH=$PATH:/usr/local/bin:/usr/openwin/bin:/usr/X11R6/bin'
if $remote;
push @command, "XTERMID=$id"; # for scrollbuffer [+xterm]
push @command, $xcmd, qw(-ut -sl 8192);
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
# XX84-7
# +xdm +xwin/config +mandrake +erx +iplab/configs
# +etc2 +xterm2
# 1.3
# reduced '-title $remotehost -n $remotehost -name $iman' to '-name $iman '
# 1.4
# -k
# a-d
# 1.5
# -telnet, -TELNET, -font
# classes
# 1.12
# +abbreviation
# 1.17
# .bash/c works with telnet
# 2.1
# having got masquerading working
# dropped gen/readmes & gen/classes
# dropped -name
# can use rxosh with places
# +abb moved into place arguments
# works from ramidus to chook, not to laptop
# 2.3
# cleaned up
# laptop OK
# 2.5
# restored -name because 139.130.239.254 too long
# added '' keys to .xterms for defaults
# improved .xterms format
# improved .xterms processing
# iman internal rather than gen/iman (easier error handling)
# 2.6
# logic simplified
# usage much revised
# 2.8
# moved hardwired r => readme etc out into .xterms
# usage much changed
# 2.10
# redesigned .xterms
# iman explicit in .xterms rather than derived from variable name
# allowed for inboxes
# 2.12
# added 'between' for isp1
# 2.14
# added keck@ermintrude & 'user' for ermintrude
# 2.15
# passed XENVIRONMENT to remote host, adding /nfs/host if missing
# already done by gen/det, forgotten here
( run in 2.138 seconds using v1.01-cache-2.11-cpan-98e64b0badf )