#!/usr/local/bin/perl

use strict;

##
## termfix: fix termcap and execute command
##
## Copyright (c) 2001 Kazumasa Utashiro <utashiro@srekcah.org>
## Copyright (c) 1992-1993 Kazumasa Utashiro <utashiro@sra.co.jp>
##
## Original on 24 Mar 1992
##
my $rcsid = '$Id: termfix,v 2.0 2001/12/09 07:48:14 utashiro Exp $';#'
##
## EXAMPLES
##	termfix md@ man 5 termcap		# cancel "md"
##	termfix tite@ vipw			# cancel "ti" and "te"
##	termfix 'so=\E[7m' man 5 termcap	# set "so"
##	termfix usue=sose man 5 termcap		# set "us,ue" same as "so,se"
##	termfix usue^sose man 5 termcap		# exchange "us,ue" and "so,se"
##
;; my($myname) = ('termfix', split('/', $0));
;; my $usage = <<_;
Usage: $myname [xx=...] [xx=yy] [xx^yy] [xx\@] [command]
	xx=...		set xx to ...
	xx=yy		set xx to yy
	xx^yy		exchange xx and yy
	xx\@		cancel xx
$rcsid
_

use Getopt::Std;
our(%opt);
if (!getopts('dfhHv', \%opt) or $opt{'h'}) {
    print $usage;
    exit;
}
if ($opt{'H'}) {
    exec "perldoc $0";
    exit 1;
}
if ($opt{'v'}) {
    print "$rcsid\n";
    exit;
}

my($TERM, $TC);
if ($opt{'f'} || !($TC = $ENV{'TERMCAP'}) || $TC =~ m|^/|) {
    ($TERM, $TC) = split(/\s+/, scalar(`tset -IQS`), 2);
}
$TC =~ s/:\s*:/:/g;
my $OTC = $TC;
study $OTC;

my $re_tchar = qr/[a-zA-Z@%&*#!]/;
my $re_tcapcode = qr/$re_tchar$re_tchar|$re_tchar\d|\d$re_tchar/;

while (defined($_ = $ARGV[$[])) {

    if ($_ eq '') {
	;
    }
    elsif (/:/) {
	splice(@ARGV, 1, 0, split(/:/, $_));
    }
    elsif (/^(\w\w)\@$/) {
	$TC =~ s/:$1[^:]*:/:/;
    }
    elsif (($a, $b) = /^($re_tcapcode)=($re_tcapcode)$/) {
	if (my($new) = ($OTC =~ /$b[=#]([^:]*)/)) {
	    $TC =~ s/$a([=#])[^:]*/$a$1$new/;
	}
    }
    elsif (($a, $b) = /^($re_tcapcode)[=#](.*)$/) {
	unless ($TC =~ s/$a([=#])[^:]*/$a$1$b/) {
	    $TC =~ s/:?$/:$_:/;
	}
    }
    elsif (/^($re_tcapcode)\^($re_tcapcode)$/) {
	splice(@ARGV, 1, 0, "$1=$2", "$2=$1");
    }
    elsif (/^((?:$re_tcapcode){2,})([=\#\@\^])((?:$re_tcapcode)*)$/) {
	my($L, $R, $op, $r) = ($1, $3, $2, '');
	last if $op eq '@' && $R;
	splice(@ARGV, 1, 0,
	       grep((($R =~ s/^..//) && ($r = $&), s/$/$op$r/), $L =~ /../g));
    } else {
	last;
    }
    print STDERR $_, "\n" if $opt{'d'};
} continue {
    shift;
}

if (@ARGV) {
    $ENV{'TERMCAP'} = $TC;
    exec(@ARGV);
    die "$ARGV[0]: $!\n";
} else {
    print $TC;
    print "\n" unless $TC =~ /\n$/;
}
exit 0;

######################################################################

=head1 NAME

termfix - fix termcap and execute command

=head1 SYNOPSIS

B<termfix> I<options> [I<command>]

=head1 DESCRIPTION

I<Termfix> fixes current termcap temporarily and execute command
specified in arguments.  If no command is supplied, it just prints new
capability.

There are several different style options.

=over 5

=item I<xx=sequence>

Specify I<sequence> to capability I<xx>.  Next example sets sequence
``\eE[7m'' to I<so> and execute man command.

	termfix 'so=\eE[7m' man 5 termcap

Sequence should not be two alphabetic characters.

=item I<xx=yy>

This option sets I<xx> capability same as I<yy>'s.  So next example
sets I<md> capability same as I<so>.

	termfix md=so man 5 termcap

Referenced capability keeps original value after any operations.

=item I<xx^yy>

Exchange I<xx> and I<yy> capabilities.  Next example exchanges I<so>
and I<us> capabilities.

	termfix so^us man 5 termcap

=item I<xx@>

Disable I<xx> capability.  Next example disables I<te> capability.

	termfix ti@ te@ man 5 termcap

If you want to replace TERMCAP environment variable with new one, set
the output of I<termfix> to TERMCAP variable like this:

	setenv TERMCAP "`termfix te@`"

=back

Multiple capabilities can be set in one operation on every cases.

        termfix mdme=sose       (md=so me=se)
        termfix sose^usue       (so^us se^ue)
        termfix mdso=us mese=ue (md=us so=us me=ue se=ue)
        termfix tite@           (ti@ te@)

If number of right values are less than left values, last right value
is used repeatedly.

=head1 AUTHOR

Kazumasa Utashiro E<lt>F<utashiro@srekcah.org>E<gt>

http://www.srekcah.org/~utashiro/perl/scripts/termfix/

$Date: 2001/12/09 07:48:14 $

=head1 SEE ALSO

tset(1), termcap(5)

=cut