1# -*- perl -*-
2
3#
4# Author: Slaven Rezic
5#
6# Copyright (C) 2006,2008,2009,2012,2014,2015 Slaven Rezic. All rights reserved.
7# This program is free software; you can redistribute it and/or
8# modify it under the same terms as Perl itself.
9#
10# Mail: srezic@cpan.org
11# WWW:  http://www.rezic.de/eserte/
12#
13
14package XTerm::Conf;
15
16use 5.006; # qr, autovivified filehandles
17
18# Plethora of xterm control sequences:
19# http://rtfm.etla.org/xterm/ctlseq.html
20
21use strict;
22use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
23
24$VERSION = '0.10';
25
26require Exporter;
27@ISA = qw(Exporter);
28@EXPORT    = qw(xterm_conf);
29@EXPORT_OK = qw(xterm_conf_string terminal_is_supported);
30
31use Getopt::Long 2.24; # OO interface
32
33use constant BEL => "";
34use constant ESC => "";
35
36use constant IND   => ESC . "D"; # Index
37use constant IND_8   => chr 0x84;
38use constant NEL   => ESC . "E"; # Next Line
39use constant NEL_8   => chr 0x85;
40use constant HTS   => ESC . "H"; # Tab Set
41use constant HTS_8   => chr 0x88;
42use constant RI    => ESC . "M"; # Reverse Index
43use constant RI_8    => chr 0x8d;
44use constant SS2   => ESC . "N"; # Single Shift Select of G2 Character Set: affects next character only
45use constant SS2_8   => chr 0x8e;
46use constant SS3   => ESC . "O"; # Single Shift Select of G3 Character Set: affects next character only
47use constant SS3_8   => chr 0x8f;
48use constant DCS   => ESC . "P"; # Device Control String
49use constant DCS_8   => chr 0x90;
50use constant SPA   => ESC . "V"; # Start of Guarded Area
51use constant SPA_8   => chr 0x96;
52use constant EPA   => ESC . "W"; # End of Guarded Area
53use constant EPA_8   => chr 0x97;
54use constant SOS   => ESC . "X"; # Start of String
55use constant SOS_8   => chr 0x98;
56use constant DECID => ESC . "Z"; # Return Terminal ID Obsolete form of CSI c (DA).
57use constant DECID_8 => chr 0x9a;
58use constant CSI   => ESC . "["; # Control Sequence Introducer
59use constant CSI_8   => chr 0x9b;
60use constant ST    => ESC . "\\"; # String Terminator
61use constant ST_8    => chr 0x9c;
62use constant OSC   => ESC . "]";
63use constant OSC_8   => chr 0x9d;
64use constant PM    => ESC . "^"; # Privacy Message
65use constant PM_8    => chr 0x9e;
66use constant APC   => ESC . "_"; # Application Program Command
67use constant APC_8   => chr 0x9f;
68
69my %o;
70my $need_reset_terminal;
71
72sub xterm_conf_string {
73    local @ARGV = @_;
74
75    %o = ();
76
77    my $p = Getopt::Long::Parser->new;
78    $p->configure('no_ignore_case');
79    $p->getoptions(\%o,
80	       "iconname|n=s",
81	       "title|T=s",
82	       "fg|foreground=s",
83	       "bg|background=s",
84	       "textcursor|cr=s",
85	       "mousefg|mouseforeground|ms=s",
86	       "mousebg|mousebackground=s",
87	       "tekfg|tekforeground=s",
88	       "tekbg|tekbackground=s",
89	       "highlightcolor|hc=s",
90	       "bell",
91	       "cs=s",
92	       "fullreset",
93	       "softreset",
94	       "smoothscroll!", # no visual effect
95	       "reverse|reversevideo!",
96	       "origin!",
97	       "wraparound!",
98	       "autorepeat!",
99	       "formfeed!",
100	       "showcursor!",
101	       "showscrollbar!", # rxvt
102	       "tektronix!",
103	       "marginbell!",
104	       "reversewraparound!",
105	       "backsendsdelete!",
106	       "bottomscrolltty!", # rxvt
107	       "bottomscrollkey!", # rxvt
108	       "metasendsesc|metasendsescape!",
109	       "scrollregion=s",
110	       "deiconify",
111	       "iconify",
112	       "geometry=s",
113	       "raise",
114	       "lower",
115	       "refresh|x11refresh",
116	       "maximize",
117	       "unmaximize",
118	       "xproperty|x11property=s",
119	       "font=s",
120	       "nextfont",
121	       "prevfont",
122	       "report=s",
123	       "debugreport",
124	       "resize=i",
125	      )
126	or _usage();
127    die _usage() if (@ARGV);
128
129    my $rv = "";
130
131    $rv .= BEL if $o{bell};
132
133 CS_SWITCH: {
134	if (defined $o{cs}) {
135	    $rv .= (ESC . '%G'), last if $o{cs} =~ m{^utf-?8$}i;
136	    $rv .= (ESC . '%@'), last if $o{cs} =~ m{^(latin-?1|iso-?8859-?1)$}i;
137	    warn "Unhandled -cs parameter $o{cs}\n";
138	}
139    }
140
141    $rv .= ESC . "c" if $o{fullreset};
142
143    {
144	my %DECSET = qw(smoothscroll 4
145			reverse 5
146			origin 6
147			wraparound 7
148			autorepeat 8
149			formfeed 18
150			showcursor 25
151			showscrollbar 30
152			tektronix 38
153			marginbell 44
154			reversewraparound 45
155			backsendsdelete 67
156			bottomscrolltty 1010
157			bottomscrollkey 1011
158			metasendsesc 1036
159		      );
160	while(my($optname, $Pm) = each %DECSET) {
161	    if (defined $o{$optname}) {
162		my $onoff = $o{$optname} ? 'h' : 'l';
163		$rv .= CSI . '?' . $Pm . $onoff;
164	    }
165	}
166    }
167
168    $rv .= CSI . '!p' if $o{softreset};
169
170    if (defined $o{scrollregion}) {
171	if ($o{scrollregion} eq '' || $o{scrollregion} eq 'default') {
172	    $rv .= CSI . 'r';
173	} else {
174	    my($top,$bottom) = split /,/, $o{scrollregion};
175	    for ($top, $bottom) {
176		die "Not a number: $_\n" if !/^\d*$/;
177	    }
178	    $rv .=  CSI . $top . ";" . $bottom . "r";
179	}
180    }
181
182    $rv .= CSI . "1t" if $o{deiconify};
183    $rv .= CSI . "2t" if $o{iconify};
184
185    if (defined $o{geometry}) {
186	if (my($w,$h,$wc,$hc,$x,$y) = $o{geometry} =~ m{^(?:(\d+)x(\d+)|(\d+)cx(\d+)c)?(?:\+(\d+)\+(\d+))?$}) {
187	    $rv .=  CSI."3;".$x.";".$y."t" if defined $x;
188	    $rv .=  CSI."4;".$h.";".$w."t" if defined $h; # does not work?
189	    $rv .=  CSI."8;".$hc.";".$wc."t" if defined $hc; # does not work?
190	} else {
191	    die "Cannot parse geometry string, must be width x height+x+y\n";
192	}
193    }
194
195    $rv .= CSI . "5t" if $o{raise};
196    $rv .= CSI . "6t" if $o{lower};
197    $rv .= CSI . "7t" if $o{refresh};
198    $rv .= CSI . "9;0t" if $o{unmaximize}; # does not work?
199    $rv .= CSI . "9;1t" if $o{maximize}; # does not work?
200    if ($o{resize}) {
201	die "-resize parameter must be at least 24\n"
202	    if $o{resize} < 24 || $o{resize} !~ /^\d+$/;
203	$rv .= CSI . $o{resize} . 't';
204    }
205
206    $rv .= OSC .  "1;$o{iconname}" . BEL if defined $o{iconname};
207    $rv .= OSC .  "2;$o{title}" . BEL if defined $o{title};
208    $rv .= OSC .  "3;$o{xproperty}" . BEL if defined $o{xproperty};
209    $rv .= OSC . "10;$o{fg}" . BEL if defined $o{fg};
210    $rv .= OSC . "11;$o{bg}" . BEL if defined $o{bg};
211    $rv .= OSC . "12;$o{textcursor}" . BEL if defined $o{textcursor};
212    $rv .= OSC . "13;$o{mousefg}" . BEL if defined $o{mousefg};
213    $rv .= OSC . "14;$o{mousebg}" . BEL if defined $o{mousebg};
214    $rv .= OSC . "15;$o{tekfg}" . BEL if defined $o{tekfg};
215    $rv .= OSC . "16;$o{tekbg}" . BEL if defined $o{tekbg};
216    $rv .= OSC . "17;$o{highlightcolor}" . BEL if defined $o{highlightcolor};
217    $rv .= OSC . "50;#$o{font}" . BEL if defined $o{font};
218    $rv .= OSC . "50;#-" . BEL if $o{prevfont};
219    $rv .= OSC . "50;#+" . BEL if $o{nextfont};
220
221    if ($o{report}) {
222	if ($o{report} eq 'cgeometry') {
223	    my($h,$w) = _report_cgeometry();
224	    $rv .= $w."x".$h."\n";
225	} else {
226	    my $sub = "_report_" . $o{report};
227	    no strict 'refs';
228	    my(@args) = &$sub;
229	    $rv .= join(" ", @args) . "\n";
230	}
231    }
232
233    $rv;
234}
235
236sub xterm_conf {
237    # always call xterm_conf_string(), so option validation is done
238    my $rv = xterm_conf_string(@_);
239    if (terminal_is_supported()) {
240	local $| = 1;
241	print $rv;
242    }
243}
244
245sub terminal_is_supported {
246    my($term) = @_;
247    $term = $ENV{TERM} if !defined $term;
248    if (!$ENV{TERM}) {
249	0;
250    } elsif ($ENV{TERM} !~ m{^(xterm|rxvt)}) {
251	0;
252    } else {
253	1;
254    }
255}
256
257sub _report ($$) {
258    my($cmd, $rx) = @_;
259
260    require Term::ReadKey;
261    Term::ReadKey::ReadMode(5);
262
263    my @args;
264
265    eval {
266	require IO::Select;
267
268	my $debug = $o{debugreport};
269
270	open my $TTY, "+< /dev/tty" or die "Cannot open terminal /dev/tty: $!";
271	syswrite $TTY, $cmd;
272
273	my $sel = IO::Select->new;
274	$sel->add($TTY);
275
276	my $res = "";
277	while() {
278	    my(@ready) = $sel->can_read(5);
279	    if (!@ready) {
280		die "Cannot report, maybe allowWindowOps is set to false?";
281		last;
282	    }
283	    sysread $TTY, my $ch, 1 or die "Cannot sysread: $!";
284	    print STDERR ord($ch)." " if $debug;
285	    $res .= $ch;
286	    last if (@args = $res =~ $rx);
287	}
288
289	1;
290    };
291    my $err = $@;
292
293    Term::ReadKey::ReadMode(0);
294
295    if ($err) {
296	die "$err\n";
297    }
298    @args;
299}
300
301sub _report_status      { _report CSI.'5n', qr{0n} }
302sub _report_cursorpos   { _report CSI.'6n', qr{(\d+);(\d+)R} }
303sub _report_windowpos   { _report CSI.'13t', qr{;(\d+);(\d+)t} }
304sub _report_geometry    { _report CSI.'14t', qr{;(\d+);(\d+)t} }
305sub _report_cgeometry   { _report CSI.'18t', qr{;(\d+);(\d+)t} }
306sub _report_cscreengeom { _report CSI.'19t', qr{;(\d+);(\d+)t} }
307sub _report_iconname    { _report CSI.'20t', qr{L(.*?)(?:\Q@{[ST]}\E|\Q@{[ST_8]}\E)} }
308sub _report_title       { _report CSI.'21t', qr{l(.*?)(?:\Q@{[ST]}\E|\Q@{[ST_8]}\E)} }
309
310sub _usage {
311    die <<EOF;
312usage: $0 [-n|iconname string] [-T|title string] [-cr|textcursor color]
313        [-fg|-foreground color] [-bg|-background color color]
314        [-ms|mousefg|-mouseforeground color] [-mousebg|-mousebackground color]
315        [-tekfg|-tekforeground color] [-tekbg|-tekbackground color]
316        [-hc|highlightcolor color] [-bell] [-cs ...] [-fullreset] [-softreset]
317	[-[no]smoothscroll] [-[no]reverse|reversevideo], [-[no]origin]
318	[-[no]wraparound] [-[no]autorepeat] [-[no]formfeed] [-[no]showcursor]
319        [-[no]showscrollbar] [-[no]tektronix] [-[no]marginbell]
320	[-[no]reversewraparound] [-[no]backsendsdelete]
321        [-[no]bottomscrolltty] [-[no]bottomscrollkey]
322	[-[no]metasendsesc|metasendsescape] [-scrollregion ...]
323	[-deiconify] [-iconify] [-geometry x11geom] [-raise] [-lower]
324	[-refresh|x11refresh] [-maximize] [-unmaximize]
325	[-xproperty|x11property ...] [-font ...] [-nextfont] [-prevfont]
326	[-report ...] [-debugreport] [-resize ...]
327
328EOF
329}
330
331return 1 if caller;
332
333xterm_conf(@ARGV);
334
335__END__
336
337=head1 NAME
338
339XTerm::Conf - change configuration of a running xterm
340
341=head1 SYNOPSIS
342
343    use XTerm::Conf;
344    xterm_conf(-fg => "white", -bg => "black", -title => "Hello, world", ...);
345
346=head1 DESCRIPTION
347
348XTerm::Conf provides functions to change some aspects of a running
349L<xterm> and compatible terminal emulators (e.g. L<rxvt> or L<urxvt>).
350
351=head2 xterm_conf(I<options ...>)
352
353The xterm_conf function (exported by default) checks first if the
354current terminal looks like an xterm, rxvt or urxvt (by looking at the
355C<TERM> environment variable) and prints the escape sequences for the
356following options:
357
358=over
359
360=item C<-n I<string>>
361
362=item C<-iconname I<string>>
363
364Change name of the associated X11 icon.
365
366=item C<-T I<string>>
367
368=item C<-title I<string>>
369
370Change xterm's title name.
371
372=item C<-fg I<color>>
373
374=item C<-foreground I<color>>
375
376Change text color. You can use either X11 named colors or the
377C<#I<rrggbb>> notation.
378
379=item C<-bg I<color>>
380
381=item C<-background I<color>>
382
383Change background color.
384
385=item C<-cr I<color>>
386
387=item C<-textcursor I<color>>
388
389Change cursor color.
390
391=item C<-ms I<color>>
392
393=item C<-mousefg I<color>>
394
395=item C<-mouseforeground I<color>>
396
397Change the foreground color of the mouse pointer.
398
399=item C<-mousebg I<color>>
400
401=item C<-mousebackground I<color>>
402
403Change the background/border color of the mouse pointer.
404
405=item C<-tekfg I<color>>
406
407=item C<-tekforeground I<color>>
408
409Change foreground color of Tek window.
410
411=item C<-tekbg I<color>>
412
413=item C<-tekbackground I<color>>
414
415Change background color of Tek window.
416
417=item C<-highlightcolor I<color>>
418
419Change selection background color.
420
421=item C<-bell>
422
423Ring the bell (may be visual or audible, depending on configuration).
424
425=item C<-cs utf-8|iso-8859-1>
426
427Switch charset. Valid values are C<utf-8> and C<iso-8859-1>.
428
429=item C<-fullreset>
430
431Perform a full reset.
432
433=item C<-softreset>
434
435Perform a soft reset.
436
437=item C<-[no]smoothscroll>
438
439Turn smooth scrolling on or off (which is probably the opposite of
440jump scroll, see L<xterm(1)>).
441
442=item C<-[no]reverse>
443
444=item C<-[no]reversevideo>
445
446Turn reverse video on or off.
447
448=item C<-[no]origin>
449
450???
451
452=item C<-[no]wraparound>
453
454???
455
456=item C<-[no]autorepeat>
457
458Turn auto repeat on or off.
459
460=item C<-[no]formfeed>
461
462???
463
464=item C<-[no]showcursor>
465
466Show or hide the cursor.
467
468=item C<-[no]showscrollbar>
469
470rxvt only?
471
472=item C<-[no]tektronix>
473
474Show the Tek window and switch to Tek mode (XXX C<-notektronix> does not
475seem to work).
476
477=item C<-[no]marginbell>
478
479???
480
481=item C<-[no]reversewraparound>
482
483???
484
485=item C<-[no]backsendsdelete>
486
487???
488
489=item C<-[no]bottomscrolltty>
490
491rxvt only?
492
493=item C<-[no]bottomscrollkey>
494
495rxvt only?
496
497=item C<-[no]metasendsesc>
498
499=item C<-[no]metasendsescape>
500
501???
502
503=item C<-scrollregion I<...>>
504
505???
506
507=item C<-deiconify>
508
509Deiconify an iconified xterm window.
510
511=item C<-iconify>
512
513Iconify the xterm window.
514
515=item C<-geometry I<geometry>>
516
517Change the geometry of the xterm window. The geometry is in the usual
518X11 notation I<width>xI<height>+I<left>+I<top>. The numbers are in
519pixels. The width and height may be suffixed with a C<c>, which means
520that the numbers are interpreted as characters.
521
522=item C<-raise>
523
524Raise the xterm window.
525
526=item C<-lower>
527
528Lower the xterm window
529
530=item C<-refresh>
531
532=item C<-x11refresh>
533
534Force a X11 refresh.
535
536=item C<-maximize>
537
538Maximize the xterm window.
539
540=item C<-unmaximize>
541
542Restore to the state before maximization.
543
544=item C<-xproperty I<...>>
545
546=item C<-x11property I<...>>
547
548???
549
550=item C<-font I<number>>
551
552Change font. Number may be from 0 (default font) to 6 (usually the
553largest font, but this could be changed using Xdefaults).
554
555=item C<-nextfont>
556
557Use the next font in list.
558
559=item C<-prevfont>
560
561Use the previous font in list.
562
563=item C<-report I<what>>
564
565Report to C<STDOUT>:
566
567=over
568
569=item C<status>
570
571Return 1.
572
573=item C<cursorpos>
574
575The cursor position (I<line column>).
576
577=item C<windowpos>
578
579The XTerm window position (I<x y>).
580
581=item C<geometry>
582
583The geometry of the window in pixels (I<width> I<height>).
584
585=item C<cgeometry>
586
587The geometry of the window in characters (I<width>C<x>I<height>).
588
589=item C<cscreengeom>
590
591???
592
593=item C<iconname>
594
595The icon name. This may only be available if the allowWindowOps
596resource is set to true (e.g. using
597
598    xterm -xrm "*allowWindowOps:true"
599
600). On some operating systems and some terminal emulators (most notable
601C<rxvt> on Debian/Ubuntu systems) this operation may be forbidden
602completely.
603
604=item C<title>
605
606The title name. See L</iconname> for possible restrictions on
607availability.
608
609=back
610
611=item C<-debugreport>
612
613If set together with a C<-report ...> option, then print the returned
614escape sequence as numbers to C<STDOUT> (as an debugging aid).
615
616=item C<-resize I<integer>>
617
618???
619
620=back
621
622=head2 xterm_conf_string(I<options ...>)
623
624xterm_conf_string just returns a string with the escape sequences for
625the given options (same as in xterm_conf). No terminal check will be
626performed here.
627
628xterm_conf_string may be exported.
629
630=head2 terminal_is_supported(I<term>)
631
632Return a true value if the given I<term>, or if missing, the current
633terminal as given by C<$ENV{TERM}>, is supported.
634
635This function may be exported.
636
637=head1 AUTHOR
638
639Slaven ReziE<0x107>
640
641=head1 SEE ALSO
642
643L<xterm-conf>, L<xterm(1)>, L<rxvt(1)>, L<Term::Title>.
644
645=cut
646