# -*- perl -*-
#
# Author: Slaven Rezic
#
# Copyright (C) 2006,2008,2009,2012,2014,2015 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: srezic@cpan.org
# WWW: http://www.rezic.de/eserte/
#
package XTerm::Conf;
use 5.006; # qr, autovivified filehandles
# Plethora of xterm control sequences:
# http://rtfm.etla.org/xterm/ctlseq.html
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
$VERSION = '0.10';
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(xterm_conf);
@EXPORT_OK = qw(xterm_conf_string terminal_is_supported);
use Getopt::Long 2.24; # OO interface
use constant BEL => "";
use constant ESC => "";
use constant IND => ESC . "D"; # Index
use constant IND_8 => chr 0x84;
use constant NEL => ESC . "E"; # Next Line
use constant NEL_8 => chr 0x85;
use constant HTS => ESC . "H"; # Tab Set
use constant HTS_8 => chr 0x88;
use constant RI => ESC . "M"; # Reverse Index
use constant RI_8 => chr 0x8d;
use constant SS2 => ESC . "N"; # Single Shift Select of G2 Character Set: affects next character only
use constant SS2_8 => chr 0x8e;
use constant SS3 => ESC . "O"; # Single Shift Select of G3 Character Set: affects next character only
use constant SS3_8 => chr 0x8f;
use constant DCS => ESC . "P"; # Device Control String
use constant DCS_8 => chr 0x90;
use constant SPA => ESC . "V"; # Start of Guarded Area
use constant SPA_8 => chr 0x96;
use constant EPA => ESC . "W"; # End of Guarded Area
use constant EPA_8 => chr 0x97;
use constant SOS => ESC . "X"; # Start of String
use constant SOS_8 => chr 0x98;
use constant DECID => ESC . "Z"; # Return Terminal ID Obsolete form of CSI c (DA).
use constant DECID_8 => chr 0x9a;
use constant CSI => ESC . "["; # Control Sequence Introducer
use constant CSI_8 => chr 0x9b;
use constant ST => ESC . "\\"; # String Terminator
use constant ST_8 => chr 0x9c;
use constant OSC => ESC . "]";
use constant OSC_8 => chr 0x9d;
use constant PM => ESC . "^"; # Privacy Message
use constant PM_8 => chr 0x9e;
use constant APC => ESC . "_"; # Application Program Command
use constant APC_8 => chr 0x9f;
my %o;
my $need_reset_terminal;
sub xterm_conf_string {
local @ARGV = @_;
%o = ();
my $p = Getopt::Long::Parser->new;
$p->configure('no_ignore_case');
$p->getoptions(\%o,
"iconname|n=s",
"title|T=s",
"fg|foreground=s",
"bg|background=s",
"textcursor|cr=s",
"mousefg|mouseforeground|ms=s",
"mousebg|mousebackground=s",
"tekfg|tekforeground=s",
"tekbg|tekbackground=s",
"highlightcolor|hc=s",
"bell",
"cs=s",
"fullreset",
"softreset",
"smoothscroll!", # no visual effect
"reverse|reversevideo!",
"origin!",
"wraparound!",
"autorepeat!",
"formfeed!",
"showcursor!",
"showscrollbar!", # rxvt
"tektronix!",
"marginbell!",
"reversewraparound!",
"backsendsdelete!",
"bottomscrolltty!", # rxvt
"bottomscrollkey!", # rxvt
"metasendsesc|metasendsescape!",
"scrollregion=s",
"deiconify",
"iconify",
"geometry=s",
"raise",
"lower",
"refresh|x11refresh",
"maximize",
"unmaximize",
"xproperty|x11property=s",
"font=s",
"nextfont",
"prevfont",
"report=s",
"debugreport",
"resize=i",
)
or _usage();
die _usage() if (@ARGV);
my $rv = "";
$rv .= BEL if $o{bell};
CS_SWITCH: {
if (defined $o{cs}) {
$rv .= (ESC . '%G'), last if $o{cs} =~ m{^utf-?8$}i;
$rv .= (ESC . '%@'), last if $o{cs} =~ m{^(latin-?1|iso-?8859-?1)$}i;
warn "Unhandled -cs parameter $o{cs}\n";
}
}
$rv .= ESC . "c" if $o{fullreset};
{
my %DECSET = qw(smoothscroll 4
reverse 5
origin 6
wraparound 7
autorepeat 8
formfeed 18
showcursor 25
showscrollbar 30
tektronix 38
marginbell 44
reversewraparound 45
backsendsdelete 67
bottomscrolltty 1010
bottomscrollkey 1011
metasendsesc 1036
);
while(my($optname, $Pm) = each %DECSET) {
if (defined $o{$optname}) {
my $onoff = $o{$optname} ? 'h' : 'l';
$rv .= CSI . '?' . $Pm . $onoff;
}
}
}
$rv .= CSI . '!p' if $o{softreset};
if (defined $o{scrollregion}) {
if ($o{scrollregion} eq '' || $o{scrollregion} eq 'default') {
$rv .= CSI . 'r';
} else {
my($top,$bottom) = split /,/, $o{scrollregion};
for ($top, $bottom) {
die "Not a number: $_\n" if !/^\d*$/;
}
$rv .= CSI . $top . ";" . $bottom . "r";
}
}
$rv .= CSI . "1t" if $o{deiconify};
$rv .= CSI . "2t" if $o{iconify};
if (defined $o{geometry}) {
if (my($w,$h,$wc,$hc,$x,$y) = $o{geometry} =~ m{^(?:(\d+)x(\d+)|(\d+)cx(\d+)c)?(?:\+(\d+)\+(\d+))?$}) {
$rv .= CSI."3;".$x.";".$y."t" if defined $x;
$rv .= CSI."4;".$h.";".$w."t" if defined $h; # does not work?
$rv .= CSI."8;".$hc.";".$wc."t" if defined $hc; # does not work?
} else {
die "Cannot parse geometry string, must be width x height+x+y\n";
}
}
$rv .= CSI . "5t" if $o{raise};
$rv .= CSI . "6t" if $o{lower};
$rv .= CSI . "7t" if $o{refresh};
$rv .= CSI . "9;0t" if $o{unmaximize}; # does not work?
$rv .= CSI . "9;1t" if $o{maximize}; # does not work?
if ($o{resize}) {
die "-resize parameter must be at least 24\n"
if $o{resize} < 24 || $o{resize} !~ /^\d+$/;
$rv .= CSI . $o{resize} . 't';
}
$rv .= OSC . "1;$o{iconname}" . BEL if defined $o{iconname};
$rv .= OSC . "2;$o{title}" . BEL if defined $o{title};
$rv .= OSC . "3;$o{xproperty}" . BEL if defined $o{xproperty};
$rv .= OSC . "10;$o{fg}" . BEL if defined $o{fg};
$rv .= OSC . "11;$o{bg}" . BEL if defined $o{bg};
$rv .= OSC . "12;$o{textcursor}" . BEL if defined $o{textcursor};
$rv .= OSC . "13;$o{mousefg}" . BEL if defined $o{mousefg};
$rv .= OSC . "14;$o{mousebg}" . BEL if defined $o{mousebg};
$rv .= OSC . "15;$o{tekfg}" . BEL if defined $o{tekfg};
$rv .= OSC . "16;$o{tekbg}" . BEL if defined $o{tekbg};
$rv .= OSC . "17;$o{highlightcolor}" . BEL if defined $o{highlightcolor};
$rv .= OSC . "50;#$o{font}" . BEL if defined $o{font};
$rv .= OSC . "50;#-" . BEL if $o{prevfont};
$rv .= OSC . "50;#+" . BEL if $o{nextfont};
if ($o{report}) {
if ($o{report} eq 'cgeometry') {
my($h,$w) = _report_cgeometry();
$rv .= $w."x".$h."\n";
} else {
my $sub = "_report_" . $o{report};
no strict 'refs';
my(@args) = &$sub;
$rv .= join(" ", @args) . "\n";
}
}
$rv;
}
sub xterm_conf {
# always call xterm_conf_string(), so option validation is done
my $rv = xterm_conf_string(@_);
if (terminal_is_supported()) {
local $| = 1;
print $rv;
}
}
sub terminal_is_supported {
my($term) = @_;
$term = $ENV{TERM} if !defined $term;
if (!$ENV{TERM}) {
0;
} elsif ($ENV{TERM} !~ m{^(xterm|rxvt)}) {
0;
} else {
1;
}
}
sub _report ($$) {
my($cmd, $rx) = @_;
require Term::ReadKey;
Term::ReadKey::ReadMode(5);
my @args;
eval {
require IO::Select;
my $debug = $o{debugreport};
open my $TTY, "+< /dev/tty" or die "Cannot open terminal /dev/tty: $!";
syswrite $TTY, $cmd;
my $sel = IO::Select->new;
$sel->add($TTY);
my $res = "";
while() {
my(@ready) = $sel->can_read(5);
if (!@ready) {
die "Cannot report, maybe allowWindowOps is set to false?";
last;
}
sysread $TTY, my $ch, 1 or die "Cannot sysread: $!";
print STDERR ord($ch)." " if $debug;
$res .= $ch;
last if (@args = $res =~ $rx);
}
1;
};
my $err = $@;
Term::ReadKey::ReadMode(0);
if ($err) {
die "$err\n";
}
@args;
}
sub _report_status { _report CSI.'5n', qr{0n} }
sub _report_cursorpos { _report CSI.'6n', qr{(\d+);(\d+)R} }
sub _report_windowpos { _report CSI.'13t', qr{;(\d+);(\d+)t} }
sub _report_geometry { _report CSI.'14t', qr{;(\d+);(\d+)t} }
sub _report_cgeometry { _report CSI.'18t', qr{;(\d+);(\d+)t} }
sub _report_cscreengeom { _report CSI.'19t', qr{;(\d+);(\d+)t} }
sub _report_iconname { _report CSI.'20t', qr{L(.*?)(?:\Q@{[ST]}\E|\Q@{[ST_8]}\E)} }
sub _report_title { _report CSI.'21t', qr{l(.*?)(?:\Q@{[ST]}\E|\Q@{[ST_8]}\E)} }
sub _usage {
die <<EOF;
usage: $0 [-n|iconname string] [-T|title string] [-cr|textcursor color]
[-fg|-foreground color] [-bg|-background color color]
[-ms|mousefg|-mouseforeground color] [-mousebg|-mousebackground color]
[-tekfg|-tekforeground color] [-tekbg|-tekbackground color]
[-hc|highlightcolor color] [-bell] [-cs ...] [-fullreset] [-softreset]
[-[no]smoothscroll] [-[no]reverse|reversevideo], [-[no]origin]
[-[no]wraparound] [-[no]autorepeat] [-[no]formfeed] [-[no]showcursor]
[-[no]showscrollbar] [-[no]tektronix] [-[no]marginbell]
[-[no]reversewraparound] [-[no]backsendsdelete]
[-[no]bottomscrolltty] [-[no]bottomscrollkey]
[-[no]metasendsesc|metasendsescape] [-scrollregion ...]
[-deiconify] [-iconify] [-geometry x11geom] [-raise] [-lower]
[-refresh|x11refresh] [-maximize] [-unmaximize]
[-xproperty|x11property ...] [-font ...] [-nextfont] [-prevfont]
[-report ...] [-debugreport] [-resize ...]
EOF
}
return 1 if caller;
xterm_conf(@ARGV);
__END__
=head1 NAME
XTerm::Conf - change configuration of a running xterm
=head1 SYNOPSIS
use XTerm::Conf;
xterm_conf(-fg => "white", -bg => "black", -title => "Hello, world", ...);
=head1 DESCRIPTION
XTerm::Conf provides functions to change some aspects of a running
L<xterm> and compatible terminal emulators (e.g. L<rxvt> or L<urxvt>).
=head2 xterm_conf(I<options ...>)
The xterm_conf function (exported by default) checks first if the
current terminal looks like an xterm, rxvt or urxvt (by looking at the
C<TERM> environment variable) and prints the escape sequences for the
following options:
=over
=item C<-n I<string>>
=item C<-iconname I<string>>
Change name of the associated X11 icon.
=item C<-T I<string>>
=item C<-title I<string>>
Change xterm's title name.
=item C<-fg I<color>>
=item C<-foreground I<color>>
Change text color. You can use either X11 named colors or the
C<#I<rrggbb>> notation.
=item C<-bg I<color>>
=item C<-background I<color>>
Change background color.
=item C<-cr I<color>>
=item C<-textcursor I<color>>
Change cursor color.
=item C<-ms I<color>>
=item C<-mousefg I<color>>
=item C<-mouseforeground I<color>>
Change the foreground color of the mouse pointer.
=item C<-mousebg I<color>>
=item C<-mousebackground I<color>>
Change the background/border color of the mouse pointer.
=item C<-tekfg I<color>>
=item C<-tekforeground I<color>>
Change foreground color of Tek window.
=item C<-tekbg I<color>>
=item C<-tekbackground I<color>>
Change background color of Tek window.
=item C<-highlightcolor I<color>>
Change selection background color.
=item C<-bell>
Ring the bell (may be visual or audible, depending on configuration).
=item C<-cs utf-8|iso-8859-1>
Switch charset. Valid values are C<utf-8> and C<iso-8859-1>.
=item C<-fullreset>
Perform a full reset.
=item C<-softreset>
Perform a soft reset.
=item C<-[no]smoothscroll>
Turn smooth scrolling on or off (which is probably the opposite of
jump scroll, see L<xterm(1)>).
=item C<-[no]reverse>
=item C<-[no]reversevideo>
Turn reverse video on or off.
=item C<-[no]origin>
???
=item C<-[no]wraparound>
???
=item C<-[no]autorepeat>
Turn auto repeat on or off.
=item C<-[no]formfeed>
???
=item C<-[no]showcursor>
Show or hide the cursor.
=item C<-[no]showscrollbar>
rxvt only?
=item C<-[no]tektronix>
Show the Tek window and switch to Tek mode (XXX C<-notektronix> does not
seem to work).
=item C<-[no]marginbell>
???
=item C<-[no]reversewraparound>
???
=item C<-[no]backsendsdelete>
???
=item C<-[no]bottomscrolltty>
rxvt only?
=item C<-[no]bottomscrollkey>
rxvt only?
=item C<-[no]metasendsesc>
=item C<-[no]metasendsescape>
???
=item C<-scrollregion I<...>>
???
=item C<-deiconify>
Deiconify an iconified xterm window.
=item C<-iconify>
Iconify the xterm window.
=item C<-geometry I<geometry>>
Change the geometry of the xterm window. The geometry is in the usual
X11 notation I<width>xI<height>+I<left>+I<top>. The numbers are in
pixels. The width and height may be suffixed with a C<c>, which means
that the numbers are interpreted as characters.
=item C<-raise>
Raise the xterm window.
=item C<-lower>
Lower the xterm window
=item C<-refresh>
=item C<-x11refresh>
Force a X11 refresh.
=item C<-maximize>
Maximize the xterm window.
=item C<-unmaximize>
Restore to the state before maximization.
=item C<-xproperty I<...>>
=item C<-x11property I<...>>
???
=item C<-font I<number>>
Change font. Number may be from 0 (default font) to 6 (usually the
largest font, but this could be changed using Xdefaults).
=item C<-nextfont>
Use the next font in list.
=item C<-prevfont>
Use the previous font in list.
=item C<-report I<what>>
Report to C<STDOUT>:
=over
=item C<status>
Return 1.
=item C<cursorpos>
The cursor position (I<line column>).
=item C<windowpos>
The XTerm window position (I<x y>).
=item C<geometry>
The geometry of the window in pixels (I<width> I<height>).
=item C<cgeometry>
The geometry of the window in characters (I<width>C<x>I<height>).
=item C<cscreengeom>
???
=item C<iconname>
The icon name. This may only be available if the allowWindowOps
resource is set to true (e.g. using
xterm -xrm "*allowWindowOps:true"
). On some operating systems and some terminal emulators (most notable
C<rxvt> on Debian/Ubuntu systems) this operation may be forbidden
completely.
=item C<title>
The title name. See L</iconname> for possible restrictions on
availability.
=back
=item C<-debugreport>
If set together with a C<-report ...> option, then print the returned
escape sequence as numbers to C<STDOUT> (as an debugging aid).
=item C<-resize I<integer>>
???
=back
=head2 xterm_conf_string(I<options ...>)
xterm_conf_string just returns a string with the escape sequences for
the given options (same as in xterm_conf). No terminal check will be
performed here.
xterm_conf_string may be exported.
=head2 terminal_is_supported(I<term>)
Return a true value if the given I<term>, or if missing, the current
terminal as given by C<$ENV{TERM}>, is supported.
This function may be exported.
=head1 AUTHOR
Slaven ReziE<0x107>
=head1 SEE ALSO
L<xterm-conf>, L<xterm(1)>, L<rxvt(1)>, L<Term::Title>.
=cut