#!/usr/bin/env perl
# xterm-set --- Set xterm display properties
# Author: Noah Friedman <friedman@splode.com>
# Created: 1991-06-26
# Public domain

# $Id: xterm-set,v 2.7 2011/03/03 07:34:28 friedman Exp $

# Commentary:

# This works by sending terminal escape sequences to the terminal.
# Not all options are implemented in every version of xterm; for example,
# some of the color options are only implemented in XFree86 3.3 and beyond.
# Other options, like scrollbar toggling, are only supported in XFree86 4.x.
# See also Thomas Dickey's releases at http://dickey.his.com/xterm/

# This command should work even if run from a shell inside a screen(1)
# session attached under xterm.

# Code:

use strict;

$^W = 1; # enable warnings

my $prog = $0;
$prog =~ s|.*/||;

###
# Parameters are: group/order sequence #, escape seq, param doc, description
my %ctlseq = (
 'vt100-mode'              => [ 101, "\e[?2h", "", ""],
 'tektronix-mode'          => [ 102, "\e[?38h", "", ""],

 'normal-cursor-keys'      => [ 201, "\e[?1l", "", ""],
 'application-cursor-keys' => [ 202, "\e[?1h", "", ""],

 'show-cursor'             => [ 211, "\e[?25h", "", "Display cursor"],
 'hide-cursor'             => [ 212, "\e[?25l", "", "Do not display cursor"],

 'blink-cursor'            => [ 221, "\e[?12h", "", "Start blinking cursor"],
 'no-blink-cursor'         => [ 222, "\e[?12l", "", "Stop blinking cursor"],

 'smooth-scroll'           => [ 301, "\e[?4h", "", "Set smooth scrolling"],
 'jump-scroll'             => [ 302, "\e[?4l", "", "Set jump scrolling"],

 'reverse-video'           => [ 401, "\e[?5h", "", "Set reverse video"],
 'normal-video'            => [ 402, "\e[?5l", "", "Restore normal video"],

 'origin-mode'             => [ 501, "\e[?6h", "", ""],
 'normal-cursor-mode'      => [ 502, "\e[?6l", "", ""],

 'wraparound'              => [ 601, "\e[?7h", "", "Wrap long lines to next line"],
 'no-wraparound'           => [ 602, "\e[?7l", "", "Truncate display of long lines"],

 #'autorepeat'             => [ 701, "\e[?8h", "", "(not implemented by xterm)"],
 #'no-autorepeat'          => [ 702, "\e[?8l", "", "(not implemented by xterm)"],

 # These are supported in XFree86 4.x xterm (or dickey xterm 1.48 and later)
 'scroll-bar'              => [ 711, "\e[?30h", "", "Show scroll bar"],
 'no-scroll-bar'           => [ 712, "\e[?30l", "", "Hide scroll bar"],

 'tool-bar'                => [ 711, "\e[?10h", "", "Show tool bar"],
 'no-tool-bar'             => [ 712, "\e[?10l", "", "Hide tool bar"],

 'allow80-132'             => [ 801, "\e[?40h", "", "Allow 80<->132 column switching"],
 'no-allow80-132'          => [ 802, "\e[?40l", "", "Do not allow 80<->132 column switching"],
 '132col'                  => [ 803, "\e[?3h", "", "Switch to 132 columns"],
 '80col'                   => [ 804, "\e[?3l", "", "Switch to 80 columns"],

 'width'                   => [ 805, "\e[8;;%st", "cols",  "Set window width in columns"],
 'height'                  => [ 806, "\e[8;%s;t", "lines", "Set window height in lines"],
 'geometry'                => [ 807, "\e[8;%s;%st", "height width", "Set window height and width in chars"],

 'xsize'                   => [ 810, "\e[4;;%st", "", "Set window width in pixels"],
 'ysize'                   => [ 811, "\e[4;%s;t", "", "Set window height in pixels"],

 'move'                    => [ 820, "\e[3;%s;%st", "xpos ypos", "Set upper left corner of windows's X,Y coordinates, in pixels"],

 'fixcurses'               => [ 901, "\e[?41h", "", "Work around curses bugs"],
 'no-fixcurses'            => [ 902, "\e[?41l", "", "Do not work around curses bugs"],

 'margin-bell'             => [1001, "\e[?44h", "", ""],
 'no-margin-bell'          => [1002, "\e[?44l", "", ""],

 'reverse-wrap'            => [1101, "\e[?45h", "", "Allow backing up past wraparound"],
 'no-reverse-wrap'         => [1102, "\e[?45l", "", "Do not allow backing up past wraparound"],

 'alternate-buffer'        => [1201, "\e[?47h", "", ""],
 'normal-buffer'           => [1202, "\e[?47l", "", ""],

 'char-normal'             => [1301, "\e[0m", "", ""],
 'char-blink'              => [1302, "\e[1m", "", ""],
 'char-underscore'         => [1303, "\e[4m", "", ""],
 'char-bold'               => [1304, "\e[5m", "", ""],
 'char-inverse'            => [1305, "\e[7m", "",  ""],

 'title'                   => [1401, "\e]0\;%s\a", "title", "Set icon and window title"],
 'icon-title'              => [1404, "\e]1\;%s\a", "title", "Set icon title only"],
 'window-title'            => [1405, "\e]2\;%s\a", "title", "Set window title only"],

 'logging'                 => [1501, "\e[?46h", "", "Enable logging transcript"],
 'no-logging'              => [1502, "\e[?46l", "", "Disable logging transcript"],
 'logfile-name'            => [1503, "\e]46\;%s\a", "file", "Set logging transcript file name"],

 # Roland McGrath memorial option
 'frobme-baby'             => [1601, "\e\(0\e\)0\e\*0\e+B", "", "Switch to graphic character set"],
 'unfrob'                  => [1602, "\e\(B\e\)B\e\*B\e+B", "", "Switch to ascii character set"],

 'iconify'                 => [1701, "\e[2t", "", "Iconify window"],
 'deiconify'               => [1702, "\e[1t", "", "Deiconify window"],

 # These might only work in XFree86 xterms
 'font'                    => [1801, "\e]50;%s\a", "font", "Change terminal font"],

 'background-color'        => [1901, "\e]10;%s\a", "color", ""],
 'foreground-color'        => [1902, "\e]11;%s\a", "color", ""],

 'cursor-color'            => [2001, "\e]12;%s\a", "color", ""],
 'highlight-color'         => [2002, "\e]17;%s\a", "color", ""],

 'mouse-foreground-color'  => [2101, "\e]13;%s\a", "color", ""],
 'mouse-background-color'  => [2102, "\e]14;%s\a", "color", ""],

 'tek-foreground-color'    => [2201, "\e]15;%s\a", "color", ""],
 'tek-background-color'    => [2202, "\e]16;%s\a", "color", ""],
);

# Aliases
$ctlseq{rows}           = 'height';
$ctlseq{cols}           = 'width';
$ctlseq{geom}           = 'geometry';
$ctlseq{wob}            = 'reverse-video';
$ctlseq{bow}            = 'normal-video';
$ctlseq{fg}             = 'foreground-color';
$ctlseq{bg}             = 'background-color';
$ctlseq{fn}             = 'font';
$ctlseq{scrollbar}      = 'scroll-bar';
$ctlseq{'no-scrollbar'} = 'no-scroll-bar';

###

sub xterm_send
{
  my ($seq, @arg) = @_;
  my $screen_encap = "\eP%s\e\\";

  $seq = sprintf ($seq, @arg) if @arg;
  $seq = sprintf ($screen_encap, $seq)
    if (exists $ENV{STY} || $ENV{TERM} =~ /^screen/o);
  print $seq;
}

# xterm sends answerback to tty, which we read from stdin.
# We must put the terminal in non-canonical mode so that we can read the
# string immediately and not subject it to (most) editing characters.
# However, we do want to leave control characters (INT, HUP, etc) enabled,
# so we cannot use raw mode.
#
# Example usage:
#	my $re = qr/\e\[8;(\d+);(\d+)t/;
#	xterm_send ("\e[18t");
#	my $result = xterm_read_response ($re);
#	$result =~ $re;
#	print "Geometry is $2x$1\n";
#
sub xterm_read_response
{
  my $re = shift;
  my $fn;

  my %trap_sigs = ( HUP  =>  1, INT  =>  2, QUIT =>  3, TERM => 15);
  my %sig_orig;
  my $restorefn = sub { &$fn if $fn;
                        my $signum = $trap_sigs{$_[0]};
                        # 7th bit set indicates lower 6 bits represent a
                        # signal number (0x80 == 2**7)
                        exit (0x80 | $signum);
                      };
  map { $sig_orig{$_} = $SIG{$_} || 'DEFAULT';
        $SIG{$_} = $restorefn
      } keys %trap_sigs;

  my $fh = *STDIN{IO};
  my $fd = fileno ($fh);
  if (-t $fd)
    {
      use POSIX qw(:termios_h);

      # Put tty in non-canonical mode and disable echo.
      my $fd = fileno ($fh);
      my $tty = POSIX::Termios->new;
      $tty->getattr ($fd);

      # Save original values
      my $c_lflag = $tty->getlflag;
      my @c_cc;
      $c_cc[VMIN]  = $tty->getcc (VMIN);
      $c_cc[VTIME] = $tty->getcc (VTIME);

      $tty->setlflag ($c_lflag & ~(ECHO | ICANON));
      $tty->setcc    (VMIN,  1);
      $tty->setcc    (VTIME, 0);
      $tty->setattr  ($fd);

      $fn = sub { $tty->setlflag ($c_lflag);
                  $tty->setcc (VMIN,  $c_cc[VMIN]);
                  $tty->setcc (VTIME, $c_cc[VTIME]);
                  $tty->setattr ($fd);
                };
    }
  else # reading from a pipe, presumably
    {
      my $orig_fh = select ($fh);
      my $bufferedp = $|;

      $| = 1;  # disable buffering
      select ($orig_fh);

      $fn = sub { $orig_fh = select ($fh);
                  $| = $bufferedp;
                  select ($orig_fh);
                };
    }

  local $_ = "";
  $_ .= getc ($fh) while (! /$re/);

  &$fn; # call restore thunk
  map { $SIG{$_} = $sig_orig{$_} } keys %trap_sigs;

  return $_;
}

sub ctlseq
{
  my $cmd = lc (shift);
  my $idx = (shift || 0);
  return undef unless (exists $ctlseq{$cmd});
  ref $ctlseq{$cmd} ? $ctlseq{$cmd}->[$idx] : $ctlseq{$ctlseq{$cmd}}->[$idx];
}

sub ctlseq_maxlen
{
  my $maxlen = 0;
  for my $cmd (keys %ctlseq)
    {
      my $len = length ($cmd) + length (ctlseq ($cmd, 2));
      $maxlen = $len if ($len > $maxlen);
    }
  return $maxlen;
}

sub ctlseq_numargs
{
  local $_ = shift;
  my $i = 0;

  $i++ while (/%[0-9.]*s/g);
  return $i;
}

sub usage
{
  use integer;
  my @cmds = sort { ctlseq ($a, 0) <=> ctlseq ($b, 0)
                      || (ref ($ctlseq{$a}) eq 'ARRAY' ? -1 : 1);
                  } keys %ctlseq;
  my $maxlen = ctlseq_maxlen() + 3;
  my $cmd_fmt = "%-${maxlen}s%s\n";
  my $alias_fmt = "%-${maxlen}s - alias for \`%s'\n";
  my $last_prio = 0;

  print "Usage: $prog [command {parameter}] ...\n\nCommands are:\n\n";

  for my $cmd (@cmds)
    {
      my $val = $ctlseq{$cmd};
      my $out;
      my $prio;

      if (ref $val)
        {
          my ($hprio, $ignore, $parm, $desc) = @$val;
          $cmd .= sprintf (" [%s]", $parm) if (defined $parm && $parm ne "");
          $desc = sprintf (" - %s", $desc) if (defined $desc && $desc ne "");
          $out = sprintf ($cmd_fmt, $cmd, $desc);
          $prio = $hprio;
        }
      else
        {
          $prio = $ctlseq{$ctlseq{$cmd}}->[0];
          $out = sprintf ($alias_fmt, $cmd, $val);
        }
      print "\n" if ($prio / 100 != $last_prio && $last_prio != 0);
      $last_prio = $prio / 100;

      $out =~ s/[ \t]+$//o;
      print $out;
    }
  exit (1);
}

sub main
{
  return usage() unless @_;

  my @cmdlist;
  while (@_)
    {
      my $cmd = shift @_;
      my $seq = ctlseq ($cmd, 1);

      if (!defined $seq)
        {
          print STDERR "$prog: $cmd: unrecognized command\n";
          exit (1);
        }

      my $numargs = ctlseq_numargs ($seq);
      my @arg = ($seq);
      map { my $new = shift @_;
            if (!defined $new || exists $ctlseq{$new})
              {
                print STDERR "$prog: $cmd: command requires $numargs argument(s)\n";
                exit (2);
              }
            push @arg, $new;
          } (1 .. $numargs) if $numargs;

      push @cmdlist, \@arg;
    }

  map { xterm_send (@$_) } @cmdlist;
}

main (@ARGV);

# local variables:
# mode: perl
# eval: (auto-fill-mode 1)
# end:

# xterm-set ends here.