[perl5.git] / cpan / Term-Cap / Cap.pm

package Term::Cap;

# Since the debugger uses Term::ReadLine which uses Term::Cap, we want
# to load as few modules as possible.  This includes Carp.pm.
sub carp
{
    require Carp;
    goto &Carp::carp;
}

sub croak
{
    require Carp;
    goto &Carp::croak;
}

use strict;

use vars qw($VERSION $VMS_TERMCAP);
use vars qw($termpat $state $first $entry);

$VERSION = '1.17';

# TODO:
# support Berkeley DB termcaps
# force $FH into callers package?
# keep $FH in object at Tgetent time?

=head1 NAME

Term::Cap - Perl termcap interface

=head1 SYNOPSIS

    require Term::Cap;
    $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
    $terminal->Trequire(qw/ce ku kd/);
    $terminal->Tgoto('cm', $col, $row, $FH);
    $terminal->Tputs('dl', $count, $FH);
    $terminal->Tpad($string, $count, $FH);

=head1 DESCRIPTION

These are low-level functions to extract and use capabilities from
a terminal capability (termcap) database.

More information on the terminal capabilities will be found in the
termcap manpage on most Unix-like systems.

=head2 METHODS

The output strings for B<Tputs> are cached for counts of 1 for performance.
B<Tgoto> and B<Tpad> do not cache.  C<$self-E<gt>{_xx}> is the raw termcap
data and C<$self-E<gt>{xx}> is the cached version.

    print $terminal->Tpad($self->{_xx}, 1);

B<Tgoto>, B<Tputs>, and B<Tpad> return the string and will also
output the string to $FH if specified.


=cut

# Preload the default VMS termcap.
# If a different termcap is required then the text of one can be supplied
# in $Term::Cap::VMS_TERMCAP before Tgetent is called.

if ( $^O eq 'VMS' )
{
    chomp( my @entry = <DATA> );
    $VMS_TERMCAP = join '', @entry;
}

# Returns a list of termcap files to check.

sub termcap_path
{    ## private
    my @termcap_path;

    # $TERMCAP, if it's a filespec
    push( @termcap_path, $ENV{TERMCAP} )
      if (
        ( exists $ENV{TERMCAP} )
        && (
            ( $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos' )
            ? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/is
            : $ENV{TERMCAP} =~ /^\//s
        )
      );
    if ( ( exists $ENV{TERMPATH} ) && ( $ENV{TERMPATH} ) )
    {

        # Add the users $TERMPATH
        push( @termcap_path, split( /(:|\s+)/, $ENV{TERMPATH} ) );
    }
    else
    {

        # Defaults
        push( @termcap_path,
            exists $ENV{'HOME'} ? $ENV{'HOME'} . '/.termcap' : undef,
            '/etc/termcap', '/usr/share/misc/termcap', );
    }

    # return the list of those termcaps that exist
    return grep { defined $_ && -f $_ } @termcap_path;
}

=over 4

=item B<Tgetent>

Returns a blessed object reference which the user can
then use to send the control strings to the terminal using B<Tputs>
and B<Tgoto>.

The function extracts the entry of the specified terminal
type I<TERM> (defaults to the environment variable I<TERM>) from the
database.

It will look in the environment for a I<TERMCAP> variable.  If
found, and the value does not begin with a slash, and the terminal
type name is the same as the environment string I<TERM>, the
I<TERMCAP> string is used instead of reading a termcap file.  If
it does begin with a slash, the string is used as a path name of
the termcap file to search.  If I<TERMCAP> does not begin with a
slash and name is different from I<TERM>, B<Tgetent> searches the
files F<$HOME/.termcap>, F</etc/termcap>, and F</usr/share/misc/termcap>,
in that order, unless the environment variable I<TERMPATH> exists,
in which case it specifies a list of file pathnames (separated by
spaces or colons) to be searched B<instead>.  Whenever multiple
files are searched and a tc field occurs in the requested entry,
the entry it names must be found in the same file or one of the
succeeding files.  If there is a C<:tc=...:> in the I<TERMCAP>
environment variable string it will continue the search in the
files as above.

The extracted termcap entry is available in the object
as C<$self-E<gt>{TERMCAP}>.

It takes a hash reference as an argument with two optional keys:

=over 2

=item OSPEED

The terminal output bit rate (often mistakenly called the baud rate)
for this terminal - if not set a warning will be generated
and it will be defaulted to 9600.  I<OSPEED> can be specified as
either a POSIX termios/SYSV termio speeds (where 9600 equals 9600) or
an old DSD-style speed ( where 13 equals 9600).


=item TERM

The terminal type whose termcap entry will be used - if not supplied it will
default to $ENV{TERM}: if that is not set then B<Tgetent> will croak.

=back

It calls C<croak> on failure.

=cut

sub Tgetent
{    ## public -- static method
    my $class = shift;
    my ($self) = @_;

    $self = {} unless defined $self;
    bless $self, $class;

    my ( $term, $cap, $search, $field, $max, $tmp_term, $TERMCAP );
    local ( $termpat, $state, $first, $entry );    # used inside eval
    local $_;

    # Compute PADDING factor from OSPEED (to be used by Tpad)
    if ( !$self->{OSPEED} )
    {
        if ($^W)
        {
            carp "OSPEED was not set, defaulting to 9600";
        }
        $self->{OSPEED} = 9600;
    }
    if ( $self->{OSPEED} < 16 )
    {

        # delays for old style speeds
        my @pad = (
            0,    200, 133.3, 90.9, 74.3, 66.7, 50, 33.3,
            16.7, 8.3, 5.5,   4.1,  2,    1,    .5, .2
        );
        $self->{PADDING} = $pad[ $self->{OSPEED} ];
    }
    else
    {
        $self->{PADDING} = 10000 / $self->{OSPEED};
    }

    unless ( $self->{TERM} )
    {
       if ( $ENV{TERM} )
       {
         $self->{TERM} =  $ENV{TERM} ;
       }
       else
       {
          if ( $^O eq 'MSWin32' )
          {
             $self->{TERM} =  'dumb';
          }
          else
          {
             croak "TERM not set";
          }
       }
    }

    $term = $self->{TERM};    # $term is the term type we are looking for

    # $tmp_term is always the next term (possibly :tc=...:) we are looking for
    $tmp_term = $self->{TERM};

    # protect any pattern metacharacters in $tmp_term
    $termpat = $tmp_term;
    $termpat =~ s/(\W)/\\$1/g;

    my $foo = ( exists $ENV{TERMCAP} ? $ENV{TERMCAP} : '' );

    # $entry is the extracted termcap entry
    if ( ( $foo !~ m:^/:s ) && ( $foo =~ m/(^|\|)${termpat}[:|]/s ) )
    {
        $entry = $foo;
    }

    my @termcap_path = termcap_path();

    if ( !@termcap_path && !$entry )
    {

        # last resort--fake up a termcap from terminfo
        local $ENV{TERM} = $term;

        if ( $^O eq 'VMS' )
        {
            $entry = $VMS_TERMCAP;
        }
        else
        {
            if ( grep { -x "$_/infocmp" } split /:/, $ENV{PATH} )
            {
                eval {
                    my $tmp = `infocmp -C 2>/dev/null`;
                    $tmp =~ s/^#.*\n//gm;    # remove comments
                    if (   ( $tmp !~ m%^/%s )
                        && ( $tmp =~ /(^|\|)${termpat}[:|]/s ) )
                    {
                        $entry = $tmp;
                    }
                };
                warn "Can't run infocmp to get a termcap entry: $@" if $@;
            }
            else
            {
               # this is getting desperate now
               if ( $self->{TERM} eq 'dumb' )
               {
                  $entry = 'dumb|80-column dumb tty::am::co#80::bl=^G:cr=^M:do=^J:sf=^J:';
               }
            }
        }
    }

    croak "Can't find a valid termcap file" unless @termcap_path || $entry;

    $state = 1;    # 0 == finished
                   # 1 == next file
                   # 2 == search again

    $first = 0;    # first entry (keeps term name)

    $max = 32;     # max :tc=...:'s

    if ($entry)
    {

        # ok, we're starting with $TERMCAP
        $first++;    # we're the first entry
                     # do we need to continue?
        if ( $entry =~ s/:tc=([^:]+):/:/ )
        {
            $tmp_term = $1;

            # protect any pattern metacharacters in $tmp_term
            $termpat = $tmp_term;
            $termpat =~ s/(\W)/\\$1/g;
        }
        else
        {
            $state = 0;    # we're already finished
        }
    }

    # This is eval'ed inside the while loop for each file
    $search = q{
	while (<TERMCAP>) {
	    next if /^\\t/ || /^#/;
	    if ($_ =~ m/(^|\\|)${termpat}[:|]/o) {
		chomp;
		s/^[^:]*:// if $first++;
		$state = 0;
		while ($_ =~ s/\\\\$//) {
		    defined(my $x = <TERMCAP>) or last;
		    $_ .= $x; chomp;
		}
		last;
	    }
	}
	defined $entry or $entry = '';
	$entry .= $_ if $_;
    };

    while ( $state != 0 )
    {
        if ( $state == 1 )
        {

            # get the next TERMCAP
            $TERMCAP = shift @termcap_path
              || croak "failed termcap lookup on $tmp_term";
        }
        else
        {

            # do the same file again
            # prevent endless recursion
            $max-- || croak "failed termcap loop at $tmp_term";
            $state = 1;    # ok, maybe do a new file next time
        }

        open( TERMCAP, "< $TERMCAP\0" ) || croak "open $TERMCAP: $!";
        eval $search;
        die $@ if $@;
        close TERMCAP;

        # If :tc=...: found then search this file again
        $entry =~ s/:tc=([^:]+):/:/ && ( $tmp_term = $1, $state = 2 );

        # protect any pattern metacharacters in $tmp_term
        $termpat = $tmp_term;
        $termpat =~ s/(\W)/\\$1/g;
    }

    croak "Can't find $term" if $entry eq '';
    $entry =~ s/:+\s*:+/:/g;    # cleanup $entry
    $entry =~ s/:+/:/g;         # cleanup $entry
    $self->{TERMCAP} = $entry;  # save it
                                # print STDERR "DEBUG: $entry = ", $entry, "\n";

    # Precompile $entry into the object
    $entry =~ s/^[^:]*://;
    foreach $field ( split( /:[\s:\\]*/, $entry ) )
    {
        if ( defined $field && $field =~ /^(\w{2,})$/ )
        {
            $self->{ '_' . $field } = 1 unless defined $self->{ '_' . $1 };

            # print STDERR "DEBUG: flag $1\n";
        }
        elsif ( defined $field && $field =~ /^(\w{2,})\@/ )
        {
            $self->{ '_' . $1 } = "";

            # print STDERR "DEBUG: unset $1\n";
        }
        elsif ( defined $field && $field =~ /^(\w{2,})#(.*)/ )
        {
            $self->{ '_' . $1 } = $2 unless defined $self->{ '_' . $1 };

            # print STDERR "DEBUG: numeric $1 = $2\n";
        }
        elsif ( defined $field && $field =~ /^(\w{2,})=(.*)/ )
        {

            # print STDERR "DEBUG: string $1 = $2\n";
            next if defined $self->{ '_' . ( $cap = $1 ) };
            $_ = $2;
            if ( ord('A') == 193 )
            {
               s/\\E/\047/g;
               s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg;
               s/\\n/\n/g;
               s/\\r/\r/g;
               s/\\t/\t/g;
               s/\\b/\b/g;
               s/\\f/\f/g;
               s/\\\^/\337/g;
               s/\^\?/\007/g;
               s/\^(.)/pack('c',ord($1) & 31)/eg;
               s/\\(.)/$1/g;
               s/\337/^/g;
            }
            else
            {
               s/\\E/\033/g;
               s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg;
               s/\\n/\n/g;
               s/\\r/\r/g;
               s/\\t/\t/g;
               s/\\b/\b/g;
               s/\\f/\f/g;
               s/\\\^/\377/g;
               s/\^\?/\177/g;
               s/\^(.)/pack('c',ord($1) & 31)/eg;
               s/\\(.)/$1/g;
               s/\377/^/g;
            }
            $self->{ '_' . $cap } = $_;
        }

        # else { carp "junk in $term ignored: $field"; }
    }
    $self->{'_pc'} = "\0" unless defined $self->{'_pc'};
    $self->{'_bc'} = "\b" unless defined $self->{'_bc'};
    $self;
}

# $terminal->Tpad($string, $cnt, $FH);

=item B<Tpad>

Outputs a literal string with appropriate padding for the current terminal.

It takes three arguments:

=over 2

=item B<$string>

The literal string to be output.  If it starts with a number and an optional
'*' then the padding will be increased by an amount relative to this number,
if the '*' is present then this amount will be multiplied by $cnt.  This part
of $string is removed before output/

=item B<$cnt>

Will be used to modify the padding applied to string as described above.

=item B<$FH>

An optional filehandle (or IO::Handle ) that output will be printed to.

=back

The padded $string is returned.

=cut

sub Tpad
{    ## public
    my $self = shift;
    my ( $string, $cnt, $FH ) = @_;
    my ( $decr, $ms );

    if ( defined $string && $string =~ /(^[\d.]+)(\*?)(.*)$/ )
    {
        $ms = $1;
        $ms *= $cnt if $2;
        $string = $3;
        $decr   = $self->{PADDING};
        if ( $decr > .1 )
        {
            $ms += $decr / 2;
            $string .= $self->{'_pc'} x ( $ms / $decr );
        }
    }
    print $FH $string if $FH;
    $string;
}

# $terminal->Tputs($cap, $cnt, $FH);

=item B<Tputs>

Output the string for the given capability padded as appropriate without
any parameter substitution.

It takes three arguments:

=over 2

=item B<$cap>

The capability whose string is to be output.

=item B<$cnt>

A count passed to Tpad to modify the padding applied to the output string.
If $cnt is zero or one then the resulting string will be cached.

=item B<$FH>

An optional filehandle (or IO::Handle ) that output will be printed to.

=back

The appropriate string for the capability will be returned.

=cut

sub Tputs
{    ## public
    my $self = shift;
    my ( $cap, $cnt, $FH ) = @_;
    my $string;

    $cnt = 0 unless $cnt;

    if ( $cnt > 1 )
    {
        $string = Tpad( $self, $self->{ '_' . $cap }, $cnt );
    }
    else
    {

        # cache result because Tpad can be slow
        unless ( exists $self->{$cap} )
        {
            $self->{$cap} =
              exists $self->{"_$cap"}
              ? Tpad( $self, $self->{"_$cap"}, 1 )
              : undef;
        }
        $string = $self->{$cap};
    }
    print $FH $string if $FH;
    $string;
}

# $terminal->Tgoto($cap, $col, $row, $FH);

=item B<Tgoto>

B<Tgoto> decodes a cursor addressing string with the given parameters.

There are four arguments:

=over 2

=item B<$cap>

The name of the capability to be output.

=item B<$col>

The first value to be substituted in the output string ( usually the column
in a cursor addressing capability )

=item B<$row>

The second value to be substituted in the output string (usually the row
in cursor addressing capabilities)

=item B<$FH>

An optional filehandle (or IO::Handle ) to which the output string will be
printed.

=back

Substitutions are made with $col and $row in the output string with the
following sprintf() line formats:

 %%   output `%'
 %d   output value as in printf %d
 %2   output value as in printf %2d
 %3   output value as in printf %3d
 %.   output value as in printf %c
 %+x  add x to value, then do %.

 %>xy if value > x then add y, no output
 %r   reverse order of two parameters, no output
 %i   increment by one, no output
 %B   BCD (16*(value/10)) + (value%10), no output

 %n   exclusive-or all parameters with 0140 (Datamedia 2500)
 %D   Reverse coding (value - 2*(value%16)), no output (Delta Data)

The output string will be returned.

=cut

sub Tgoto
{    ## public
    my $self = shift;
    my ( $cap, $code, $tmp, $FH ) = @_;
    my $string = $self->{ '_' . $cap };
    my $result = '';
    my $after  = '';
    my $online = 0;
    my @tmp    = ( $tmp, $code );
    my $cnt    = $code;

    while ( $string =~ /^([^%]*)%(.)(.*)/ )
    {
        $result .= $1;
        $code   = $2;
        $string = $3;
        if ( $code eq 'd' )
        {
            $result .= sprintf( "%d", shift(@tmp) );
        }
        elsif ( $code eq '.' )
        {
            $tmp = shift(@tmp);
            if ( $tmp == 0 || $tmp == 4 || $tmp == 10 )
            {
                if ($online)
                {
                    ++$tmp, $after .= $self->{'_up'} if $self->{'_up'};
                }
                else
                {
                    ++$tmp, $after .= $self->{'_bc'};
                }
            }
            $result .= sprintf( "%c", $tmp );
            $online = !$online;
        }
        elsif ( $code eq '+' )
        {
            $result .= sprintf( "%c", shift(@tmp) + ord($string) );
            $string = substr( $string, 1, 99 );
            $online = !$online;
        }
        elsif ( $code eq 'r' )
        {
            ( $code, $tmp ) = @tmp;
            @tmp = ( $tmp, $code );
            $online = !$online;
        }
        elsif ( $code eq '>' )
        {
            ( $code, $tmp, $string ) = unpack( "CCa99", $string );
            if ( $tmp[0] > $code )
            {
                $tmp[0] += $tmp;
            }
        }
        elsif ( $code eq '2' )
        {
            $result .= sprintf( "%02d", shift(@tmp) );
            $online = !$online;
        }
        elsif ( $code eq '3' )
        {
            $result .= sprintf( "%03d", shift(@tmp) );
            $online = !$online;
        }
        elsif ( $code eq 'i' )
        {
            ( $code, $tmp ) = @tmp;
            @tmp = ( $code + 1, $tmp + 1 );
        }
        else
        {
            return "OOPS";
        }
    }
    $string = Tpad( $self, $result . $string . $after, $cnt );
    print $FH $string if $FH;
    $string;
}

# $terminal->Trequire(qw/ce ku kd/);

=item B<Trequire>

Takes a list of capabilities as an argument and will croak if one is not
found.

=cut

sub Trequire
{    ## public
    my $self = shift;
    my ( $cap, @undefined );
    foreach $cap (@_)
    {
        push( @undefined, $cap )
          unless defined $self->{ '_' . $cap } && $self->{ '_' . $cap };
    }
    croak "Terminal does not support: (@undefined)" if @undefined;
}

=back

=head1 EXAMPLES

    use Term::Cap;

    # Get terminal output speed
    require POSIX;
    my $termios = new POSIX::Termios;
    $termios->getattr;
    my $ospeed = $termios->getospeed;

    # Old-style ioctl code to get ospeed:
    #     require 'ioctl.pl';
    #     ioctl(TTY,$TIOCGETP,$sgtty);
    #     ($ispeed,$ospeed) = unpack('cc',$sgtty);

    # allocate and initialize a terminal structure
    $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };

    # require certain capabilities to be available
    $terminal->Trequire(qw/ce ku kd/);

    # Output Routines, if $FH is undefined these just return the string

    # Tgoto does the % expansion stuff with the given args
    $terminal->Tgoto('cm', $col, $row, $FH);

    # Tputs doesn't do any % expansion.
    $terminal->Tputs('dl', $count = 1, $FH);

=head1 COPYRIGHT AND LICENSE

Copyright 1995-2015 (c) perl5 porters.

This software is free software and can be modified and distributed under
the same terms as Perl itself.

Please see the file README in the Perl source distribution for details of
the Perl license.

=head1 AUTHOR

This module is part of the core Perl distribution and is also maintained
for CPAN by Jonathan Stowe <jns@gellyfish.co.uk>.

The code is hosted on Github: https://github.com/jonathanstowe/Term-Cap
please feel free to fork, submit patches etc, etc there.

=head1 SEE ALSO

termcap(5)

=cut

# Below is a default entry for systems where there are terminals but no
# termcap
1;
__DATA__
vt220|vt200|DEC VT220 in vt100 emulation mode:
am:mi:xn:xo:
co#80:li#24:
RA=\E[?7l:SA=\E[?7h:
ac=kkllmmjjnnwwqquuttvvxx:ae=\E(B:al=\E[L:as=\E(0:
bl=^G:cd=\E[J:ce=\E[K:cl=\E[H\E[2J:cm=\E[%i%d;%dH:
cr=^M:cs=\E[%i%d;%dr:dc=\E[P:dl=\E[M:do=\E[B:
ei=\E[4l:ho=\E[H:im=\E[4h:
is=\E[1;24r\E[24;1H:
nd=\E[C:
kd=\E[B::kl=\E[D:kr=\E[C:ku=\E[A:le=^H:
mb=\E[5m:md=\E[1m:me=\E[m:mr=\E[7m:
kb=\0177:
r2=\E>\E[24;1H\E[?3l\E[?4l\E[?5l\E[?7h\E[?8h\E=:rc=\E8:
sc=\E7:se=\E[27m:sf=\ED:so=\E[7m:sr=\EM:ta=^I:
ue=\E[24m:up=\E[A:us=\E[4m:ve=\E[?25h:vi=\E[?25l:
Commit	Line	Data
a0d0e21e	1	package Term::Cap;
2ef86165	2
0ca33fed JS	3	# Since the debugger uses Term::ReadLine which uses Term::Cap, we want
0ca33fed JS	4	# to load as few modules as possible. This includes Carp.pm.
085f5cc4 RGS	5	sub carp
085f5cc4 RGS	6	{
0ca33fed JS	7	require Carp;
	8	goto &Carp::carp;
	9	}
	10
085f5cc4 RGS	11	sub croak
085f5cc4 RGS	12	{
0ca33fed JS	13	require Carp;
	14	goto &Carp::croak;
	15	}
	16
7cae2445	17	use strict;
85e6fe83	18
d2492938	19	use vars qw($VERSION $VMS_TERMCAP);
7cae2445	20	use vars qw($termpat $state $first $entry);
2ef86165	21
23a75734 CBW	22	$VERSION = '1.17';
23a75734 CBW	23
cb1a09d0 AD	24	# TODO:
cb1a09d0 AD	25	# support Berkeley DB termcaps
cb1a09d0 AD	26	# force $FH into callers package?
	27	# keep $FH in object at Tgetent time?
	28
	29	=head1 NAME
	30
	31	Term::Cap - Perl termcap interface
	32
	33	=head1 SYNOPSIS
	34
	35	require Term::Cap;
	36	$terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
	37	$terminal->Trequire(qw/ce ku kd/);
	38	$terminal->Tgoto('cm', $col, $row, $FH);
	39	$terminal->Tputs('dl', $count, $FH);
	40	$terminal->Tpad($string, $count, $FH);
	41
	42	=head1 DESCRIPTION
	43
	44	These are low-level functions to extract and use capabilities from
	45	a terminal capability (termcap) database.
	46
2ef86165 JS	47	More information on the terminal capabilities will be found in the
2ef86165 JS	48	termcap manpage on most Unix-like systems.
cb1a09d0	49
2ef86165	50	=head2 METHODS
cb1a09d0	51
cb1a09d0 AD	52	The output strings for B<Tputs> are cached for counts of 1 for performance.
	53	B<Tgoto> and B<Tpad> do not cache. C<$self-E<gt>{_xx}> is the raw termcap
	54	data and C<$self-E<gt>{xx}> is the cached version.
	55
	56	print $terminal->Tpad($self->{_xx}, 1);
	57
	58	B<Tgoto>, B<Tputs>, and B<Tpad> return the string and will also
	59	output the string to $FH if specified.
	60
cb1a09d0 AD	61
	62	=cut
	63
d2492938 JS	64	# Preload the default VMS termcap.
	65	# If a different termcap is required then the text of one can be supplied
	66	# in $Term::Cap::VMS_TERMCAP before Tgetent is called.
	67
085f5cc4 RGS	68	if ( $^O eq 'VMS' )
	69	{
	70	chomp( my @entry = <DATA> );
	71	$VMS_TERMCAP = join '', @entry;
d2492938 JS	72	}
d2492938 JS	73
cb1a09d0	74	# Returns a list of termcap files to check.
d2492938	75
085f5cc4 RGS	76	sub termcap_path
085f5cc4 RGS	77	{ ## private
cb1a09d0	78	my @termcap_path;
085f5cc4	79
cb1a09d0	80	# $TERMCAP, if it's a filespec
085f5cc4 RGS	81	push( @termcap_path, $ENV{TERMCAP} )
	82	if (
	83	( exists $ENV{TERMCAP} )
	84	&& (
	85	( $^O eq 'os2' \|\| $^O eq 'MSWin32' \|\| $^O eq 'dos' )
	86	? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/is
	87	: $ENV{TERMCAP} =~ /^\//s
	88	)
	89	);
	90	if ( ( exists $ENV{TERMPATH} ) && ( $ENV{TERMPATH} ) )
	91	{
	92
	93	# Add the users $TERMPATH
	94	push( @termcap_path, split( /(:\|\s+)/, $ENV{TERMPATH} ) );
cb1a09d0	95	}
085f5cc4 RGS	96	else
	97	{
	98
	99	# Defaults
	100	push( @termcap_path,
	101	exists $ENV{'HOME'} ? $ENV{'HOME'} . '/.termcap' : undef,
	102	'/etc/termcap', '/usr/share/misc/termcap', );
a687059c	103	}
d2492938	104
cb1a09d0	105	# return the list of those termcaps that exist
085f5cc4	106	return grep { defined $_ && -f $_ } @termcap_path;
748a9306 LW	107	}
748a9306 LW	108
c0e71a27 DH	109	=over 4
c0e71a27 DH	110
2ef86165 JS	111	=item B<Tgetent>
	112
	113	Returns a blessed object reference which the user can
	114	then use to send the control strings to the terminal using B<Tputs>
	115	and B<Tgoto>.
	116
	117	The function extracts the entry of the specified terminal
	118	type I<TERM> (defaults to the environment variable I<TERM>) from the
	119	database.
	120
	121	It will look in the environment for a I<TERMCAP> variable. If
	122	found, and the value does not begin with a slash, and the terminal
	123	type name is the same as the environment string I<TERM>, the
	124	I<TERMCAP> string is used instead of reading a termcap file. If
	125	it does begin with a slash, the string is used as a path name of
	126	the termcap file to search. If I<TERMCAP> does not begin with a
	127	slash and name is different from I<TERM>, B<Tgetent> searches the
	128	files F<$HOME/.termcap>, F</etc/termcap>, and F</usr/share/misc/termcap>,
	129	in that order, unless the environment variable I<TERMPATH> exists,
	130	in which case it specifies a list of file pathnames (separated by
	131	spaces or colons) to be searched B<instead>. Whenever multiple
	132	files are searched and a tc field occurs in the requested entry,
	133	the entry it names must be found in the same file or one of the
	134	succeeding files. If there is a C<:tc=...:> in the I<TERMCAP>
	135	environment variable string it will continue the search in the
	136	files as above.
	137
	138	The extracted termcap entry is available in the object
	139	as C<$self-E<gt>{TERMCAP}>.
	140
	141	It takes a hash reference as an argument with two optional keys:
	142
	143	=over 2
	144
	145	=item OSPEED
	146
	147	The terminal output bit rate (often mistakenly called the baud rate)
	148	for this terminal - if not set a warning will be generated
63dc8a94	149	and it will be defaulted to 9600. I<OSPEED> can be specified as
2ef86165 JS	150	either a POSIX termios/SYSV termio speeds (where 9600 equals 9600) or
	151	an old DSD-style speed ( where 13 equals 9600).
	152
	153
	154	=item TERM
	155
	156	The terminal type whose termcap entry will be used - if not supplied it will
	157	default to $ENV{TERM}: if that is not set then B<Tgetent> will croak.
	158
	159	=back
	160
	161	It calls C<croak> on failure.
	162
	163	=cut
	164
085f5cc4 RGS	165	sub Tgetent
085f5cc4 RGS	166	{ ## public -- static method
cb1a09d0	167	my $class = shift;
2ef86165 JS	168	my ($self) = @_;
	169
	170	$self = {} unless defined $self;
	171	bless $self, $class;
	172
085f5cc4 RGS	173	my ( $term, $cap, $search, $field, $max, $tmp_term, $TERMCAP );
085f5cc4 RGS	174	local ( $termpat, $state, $first, $entry ); # used inside eval
cb1a09d0 AD	175	local $_;
	176
	177	# Compute PADDING factor from OSPEED (to be used by Tpad)
085f5cc4 RGS	178	if ( !$self->{OSPEED} )
	179	{
	180	if ($^W)
	181	{
	182	carp "OSPEED was not set, defaulting to 9600";
d2492938	183	}
085f5cc4	184	$self->{OSPEED} = 9600;
cb1a09d0	185	}
085f5cc4 RGS	186	if ( $self->{OSPEED} < 16 )
	187	{
	188
	189	# delays for old style speeds
	190	my @pad = (
	191	0, 200, 133.3, 90.9, 74.3, 66.7, 50, 33.3,
	192	16.7, 8.3, 5.5, 4.1, 2, 1, .5, .2
	193	);
	194	$self->{PADDING} = $pad[ $self->{OSPEED} ];
cb1a09d0	195	}
085f5cc4 RGS	196	else
	197	{
	198	$self->{PADDING} = 10000 / $self->{OSPEED};
cb1a09d0 AD	199	}
cb1a09d0 AD	200
085f5cc4 RGS	201	unless ( $self->{TERM} )
	202	{
	203	if ( $ENV{TERM} )
	204	{
	205	$self->{TERM} = $ENV{TERM} ;
	206	}
	207	else
	208	{
63dc8a94	209	if ( $^O eq 'MSWin32' )
085f5cc4 RGS	210	{
	211	$self->{TERM} = 'dumb';
	212	}
	213	else
	214	{
	215	croak "TERM not set";
	216	}
	217	}
	218	}
	219
	220	$term = $self->{TERM}; # $term is the term type we are looking for
cb1a09d0 AD	221
	222	# $tmp_term is always the next term (possibly :tc=...:) we are looking for
	223	$tmp_term = $self->{TERM};
cb1a09d0	224
085f5cc4 RGS	225	# protect any pattern metacharacters in $tmp_term
	226	$termpat = $tmp_term;
	227	$termpat =~ s/(\W)/\\$1/g;
	228
	229	my $foo = ( exists $ENV{TERMCAP} ? $ENV{TERMCAP} : '' );
cb1a09d0 AD	230
cb1a09d0 AD	231	# $entry is the extracted termcap entry
085f5cc4 RGS	232	if ( ( $foo !~ m:^/:s ) && ( $foo =~ m/(^\|\\|)${termpat}[:\|]/s ) )
	233	{
	234	$entry = $foo;
cb1a09d0 AD	235	}
cb1a09d0 AD	236
2ef86165	237	my @termcap_path = termcap_path();
e66fb0c2	238
23a75734	239	if ( !@termcap_path && !$entry )
e66fb0c2	240	{
2ab0daaa	241
085f5cc4 RGS	242	# last resort--fake up a termcap from terminfo
	243	local $ENV{TERM} = $term;
	244
	245	if ( $^O eq 'VMS' )
	246	{
	247	$entry = $VMS_TERMCAP;
7cae2445	248	}
085f5cc4 RGS	249	else
	250	{
	251	if ( grep { -x "$_/infocmp" } split /:/, $ENV{PATH} )
	252	{
	253	eval {
	254	my $tmp = `infocmp -C 2>/dev/null`;
	255	$tmp =~ s/^#.*\n//gm; # remove comments
	256	if ( ( $tmp !~ m%^/%s )
	257	&& ( $tmp =~ /(^\|\\|)${termpat}[:\|]/s ) )
	258	{
	259	$entry = $tmp;
	260	}
	261	};
63dc8a94	262	warn "Can't run infocmp to get a termcap entry: $@" if $@;
085f5cc4 RGS	263	}
	264	else
	265	{
	266	# this is getting desperate now
	267	if ( $self->{TERM} eq 'dumb' )
	268	{
	269	$entry = 'dumb\|80-column dumb tty::am::co#80::bl=^G:cr=^M:do=^J:sf=^J:';
	270	}
	271	}
7cae2445	272	}
2f6e8d9f	273	}
e66fb0c2	274
cb1a09d0 AD	275	croak "Can't find a valid termcap file" unless @termcap_path \|\| $entry;
cb1a09d0 AD	276
085f5cc4 RGS	277	$state = 1; # 0 == finished
	278	# 1 == next file
	279	# 2 == search again
cb1a09d0	280
085f5cc4	281	$first = 0; # first entry (keeps term name)
cb1a09d0	282
085f5cc4	283	$max = 32; # max :tc=...:'s
cb1a09d0	284
085f5cc4 RGS	285	if ($entry)
	286	{
	287
	288	# ok, we're starting with $TERMCAP
	289	$first++; # we're the first entry
	290	# do we need to continue?
	291	if ( $entry =~ s/:tc=([^:]+):/:/ )
	292	{
	293	$tmp_term = $1;
	294
	295	# protect any pattern metacharacters in $tmp_term
	296	$termpat = $tmp_term;
	297	$termpat =~ s/(\W)/\\$1/g;
	298	}
	299	else
	300	{
	301	$state = 0; # we're already finished
	302	}
cb1a09d0 AD	303	}
	304
	305	# This is eval'ed inside the while loop for each file
	306	$search = q{
54310121	307	while (<TERMCAP>) {
cb1a09d0 AD	308	next if /^\\t/ \|\| /^#/;
	309	if ($_ =~ m/(^\|\\\|)${termpat}[:\|]/o) {
	310	chomp;
	311	s/^[^:]*:// if $first++;
	312	$state = 0;
54310121	313	while ($_ =~ s/\\\\$//) {
	314	defined(my $x = <TERMCAP>) or last;
	315	$_ .= $x; chomp;
	316	}
cb1a09d0	317	last;
748a9306	318	}
cb1a09d0	319	}
55497cff	320	defined $entry or $entry = '';
e14c93b3	321	$entry .= $_ if $_;
cb1a09d0	322	};
748a9306	323
085f5cc4 RGS	324	while ( $state != 0 )
	325	{
	326	if ( $state == 1 )
	327	{
	328
	329	# get the next TERMCAP
	330	$TERMCAP = shift @termcap_path
	331	\|\| croak "failed termcap lookup on $tmp_term";
	332	}
	333	else
	334	{
	335
	336	# do the same file again
	337	# prevent endless recursion
	338	$max-- \|\| croak "failed termcap loop at $tmp_term";
	339	$state = 1; # ok, maybe do a new file next time
	340	}
	341
	342	open( TERMCAP, "< $TERMCAP\0" ) \|\| croak "open $TERMCAP: $!";
	343	eval $search;
	344	die $@ if $@;
	345	close TERMCAP;
cb1a09d0	346
085f5cc4 RGS	347	# If :tc=...: found then search this file again
085f5cc4 RGS	348	$entry =~ s/:tc=([^:]+):/:/ && ( $tmp_term = $1, $state = 2 );
cb1a09d0	349
085f5cc4 RGS	350	# protect any pattern metacharacters in $tmp_term
	351	$termpat = $tmp_term;
	352	$termpat =~ s/(\W)/\\$1/g;
a687059c	353	}
cb1a09d0 AD	354
cb1a09d0 AD	355	croak "Can't find $term" if $entry eq '';
085f5cc4 RGS	356	$entry =~ s/:+\s*:+/:/g; # cleanup $entry
	357	$entry =~ s/:+/:/g; # cleanup $entry
	358	$self->{TERMCAP} = $entry; # save it
	359	# print STDERR "DEBUG: $entry = ", $entry, "\n";
a687059c	360
748a9306	361	# Precompile $entry into the object
cb1a09d0	362	$entry =~ s/^[^:]*://;
085f5cc4 RGS	363	foreach $field ( split( /:[\s:\\]*/, $entry ) )
085f5cc4 RGS	364	{
23a75734	365	if ( defined $field && $field =~ /^(\w{2,})$/ )
085f5cc4 RGS	366	{
	367	$self->{ '_' . $field } = 1 unless defined $self->{ '_' . $1 };
	368
	369	# print STDERR "DEBUG: flag $1\n";
	370	}
23a75734	371	elsif ( defined $field && $field =~ /^(\w{2,})\@/ )
085f5cc4 RGS	372	{
	373	$self->{ '_' . $1 } = "";
	374
	375	# print STDERR "DEBUG: unset $1\n";
	376	}
23a75734	377	elsif ( defined $field && $field =~ /^(\w{2,})#(.*)/ )
085f5cc4 RGS	378	{
	379	$self->{ '_' . $1 } = $2 unless defined $self->{ '_' . $1 };
	380
	381	# print STDERR "DEBUG: numeric $1 = $2\n";
	382	}
23a75734	383	elsif ( defined $field && $field =~ /^(\w{2,})=(.*)/ )
085f5cc4 RGS	384	{
	385
	386	# print STDERR "DEBUG: string $1 = $2\n";
	387	next if defined $self->{ '_' . ( $cap = $1 ) };
	388	$_ = $2;
305a762d JS	389	if ( ord('A') == 193 )
	390	{
	391	s/\\E/\047/g;
	392	s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg;
	393	s/\\n/\n/g;
	394	s/\\r/\r/g;
	395	s/\\t/\t/g;
	396	s/\\b/\b/g;
	397	s/\\f/\f/g;
	398	s/\\\^/\337/g;
	399	s/\^\?/\007/g;
	400	s/\^(.)/pack('c',ord($1) & 31)/eg;
	401	s/\\(.)/$1/g;
	402	s/\337/^/g;
	403	}
	404	else
	405	{
	406	s/\\E/\033/g;
	407	s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg;
	408	s/\\n/\n/g;
	409	s/\\r/\r/g;
	410	s/\\t/\t/g;
	411	s/\\b/\b/g;
	412	s/\\f/\f/g;
	413	s/\\\^/\377/g;
	414	s/\^\?/\177/g;
	415	s/\^(.)/pack('c',ord($1) & 31)/eg;
	416	s/\\(.)/$1/g;
	417	s/\377/^/g;
	418	}
085f5cc4 RGS	419	$self->{ '_' . $cap } = $_;
	420	}
	421
	422	# else { carp "junk in $term ignored: $field"; }
a687059c	423	}
cb1a09d0 AD	424	$self->{'_pc'} = "\0" unless defined $self->{'_pc'};
	425	$self->{'_bc'} = "\b" unless defined $self->{'_bc'};
	426	$self;
a687059c LW	427	}
a687059c LW	428
cb1a09d0	429	# $terminal->Tpad($string, $cnt, $FH);
2ef86165 JS	430
	431	=item B<Tpad>
	432
	433	Outputs a literal string with appropriate padding for the current terminal.
	434
	435	It takes three arguments:
	436
	437	=over 2
	438
	439	=item B<$string>
	440
	441	The literal string to be output. If it starts with a number and an optional
	442	'*' then the padding will be increased by an amount relative to this number,
63dc8a94	443	if the '*' is present then this amount will be multiplied by $cnt. This part
2ef86165 JS	444	of $string is removed before output/
	445
	446	=item B<$cnt>
	447
	448	Will be used to modify the padding applied to string as described above.
	449
	450	=item B<$FH>
	451
	452	An optional filehandle (or IO::Handle ) that output will be printed to.
	453
	454	=back
	455
	456	The padded $string is returned.
	457
	458	=cut
	459
085f5cc4 RGS	460	sub Tpad
085f5cc4 RGS	461	{ ## public
cb1a09d0	462	my $self = shift;
085f5cc4 RGS	463	my ( $string, $cnt, $FH ) = @_;
	464	my ( $decr, $ms );
	465
	466	if ( defined $string && $string =~ /(^[\d.]+)(\?)(.)$/ )
	467	{
	468	$ms = $1;
	469	$ms *= $cnt if $2;
	470	$string = $3;
	471	$decr = $self->{PADDING};
	472	if ( $decr > .1 )
	473	{
	474	$ms += $decr / 2;
	475	$string .= $self->{'_pc'} x ( $ms / $decr );
	476	}
a687059c LW	477	}
	478	print $FH $string if $FH;
	479	$string;
	480	}
	481
cb1a09d0	482	# $terminal->Tputs($cap, $cnt, $FH);
2ef86165 JS	483
	484	=item B<Tputs>
	485
	486	Output the string for the given capability padded as appropriate without
	487	any parameter substitution.
	488
	489	It takes three arguments:
	490
	491	=over 2
	492
	493	=item B<$cap>
	494
	495	The capability whose string is to be output.
	496
	497	=item B<$cnt>
	498
	499	A count passed to Tpad to modify the padding applied to the output string.
	500	If $cnt is zero or one then the resulting string will be cached.
	501
	502	=item B<$FH>
	503
	504	An optional filehandle (or IO::Handle ) that output will be printed to.
	505
	506	=back
	507
	508	The appropriate string for the capability will be returned.
	509
	510	=cut
	511
085f5cc4 RGS	512	sub Tputs
085f5cc4 RGS	513	{ ## public
cb1a09d0	514	my $self = shift;
085f5cc4	515	my ( $cap, $cnt, $FH ) = @_;
cb1a09d0	516	my $string;
748a9306	517
2ef86165 JS	518	$cnt = 0 unless $cnt;
2ef86165 JS	519
085f5cc4 RGS	520	if ( $cnt > 1 )
	521	{
	522	$string = Tpad( $self, $self->{ '_' . $cap }, $cnt );
	523	}
	524	else
	525	{
	526
	527	# cache result because Tpad can be slow
	528	unless ( exists $self->{$cap} )
	529	{
	530	$self->{$cap} =
	531	exists $self->{"_$cap"}
	532	? Tpad( $self, $self->{"_$cap"}, 1 )
	533	: undef;
	534	}
	535	$string = $self->{$cap};
748a9306 LW	536	}
	537	print $FH $string if $FH;
	538	$string;
	539	}
	540
cb1a09d0	541	# $terminal->Tgoto($cap, $col, $row, $FH);
2ef86165 JS	542
	543	=item B<Tgoto>
	544
	545	B<Tgoto> decodes a cursor addressing string with the given parameters.
	546
	547	There are four arguments:
	548
	549	=over 2
	550
	551	=item B<$cap>
	552
	553	The name of the capability to be output.
	554
	555	=item B<$col>
	556
	557	The first value to be substituted in the output string ( usually the column
	558	in a cursor addressing capability )
	559
	560	=item B<$row>
	561
	562	The second value to be substituted in the output string (usually the row
	563	in cursor addressing capabilities)
	564
	565	=item B<$FH>
	566
	567	An optional filehandle (or IO::Handle ) to which the output string will be
	568	printed.
	569
	570	=back
	571
	572	Substitutions are made with $col and $row in the output string with the
	573	following sprintf() line formats:
	574
	575	%% output `%'
	576	%d output value as in printf %d
	577	%2 output value as in printf %2d
	578	%3 output value as in printf %3d
	579	%. output value as in printf %c
	580	%+x add x to value, then do %.
	581
	582	%>xy if value > x then add y, no output
	583	%r reverse order of two parameters, no output
	584	%i increment by one, no output
	585	%B BCD (16*(value/10)) + (value%10), no output
	586
	587	%n exclusive-or all parameters with 0140 (Datamedia 2500)
	588	%D Reverse coding (value - 2*(value%16)), no output (Delta Data)
	589
	590	The output string will be returned.
	591
	592	=cut
	593
085f5cc4 RGS	594	sub Tgoto
085f5cc4 RGS	595	{ ## public
cb1a09d0	596	my $self = shift;
085f5cc4 RGS	597	my ( $cap, $code, $tmp, $FH ) = @_;
085f5cc4 RGS	598	my $string = $self->{ '_' . $cap };
cb1a09d0	599	my $result = '';
085f5cc4	600	my $after = '';
cb1a09d0	601	my $online = 0;
085f5cc4 RGS	602	my @tmp = ( $tmp, $code );
	603	my $cnt = $code;
	604
	605	while ( $string =~ /^([^%])%(.)(.)/ )
	606	{
	607	$result .= $1;
	608	$code = $2;
	609	$string = $3;
	610	if ( $code eq 'd' )
	611	{
	612	$result .= sprintf( "%d", shift(@tmp) );
	613	}
	614	elsif ( $code eq '.' )
	615	{
	616	$tmp = shift(@tmp);
	617	if ( $tmp == 0 \|\| $tmp == 4 \|\| $tmp == 10 )
	618	{
	619	if ($online)
	620	{
	621	++$tmp, $after .= $self->{'_up'} if $self->{'_up'};
	622	}
	623	else
	624	{
	625	++$tmp, $after .= $self->{'_bc'};
	626	}
	627	}
	628	$result .= sprintf( "%c", $tmp );
	629	$online = !$online;
	630	}
	631	elsif ( $code eq '+' )
	632	{
	633	$result .= sprintf( "%c", shift(@tmp) + ord($string) );
	634	$string = substr( $string, 1, 99 );
	635	$online = !$online;
	636	}
	637	elsif ( $code eq 'r' )
	638	{
	639	( $code, $tmp ) = @tmp;
	640	@tmp = ( $tmp, $code );
	641	$online = !$online;
	642	}
	643	elsif ( $code eq '>' )
	644	{
	645	( $code, $tmp, $string ) = unpack( "CCa99", $string );
63dc8a94	646	if ( $tmp[0] > $code )
085f5cc4	647	{
63dc8a94	648	$tmp[0] += $tmp;
085f5cc4 RGS	649	}
	650	}
	651	elsif ( $code eq '2' )
	652	{
	653	$result .= sprintf( "%02d", shift(@tmp) );
	654	$online = !$online;
	655	}
	656	elsif ( $code eq '3' )
	657	{
	658	$result .= sprintf( "%03d", shift(@tmp) );
	659	$online = !$online;
	660	}
	661	elsif ( $code eq 'i' )
	662	{
	663	( $code, $tmp ) = @tmp;
	664	@tmp = ( $code + 1, $tmp + 1 );
	665	}
	666	else
	667	{
	668	return "OOPS";
	669	}
a687059c	670	}
085f5cc4	671	$string = Tpad( $self, $result . $string . $after, $cnt );
748a9306 LW	672	print $FH $string if $FH;
	673	$string;
	674	}
	675
cb1a09d0	676	# $terminal->Trequire(qw/ce ku kd/);
2ef86165 JS	677
	678	=item B<Trequire>
	679
	680	Takes a list of capabilities as an argument and will croak if one is not
	681	found.
	682
	683	=cut
	684
085f5cc4 RGS	685	sub Trequire
085f5cc4 RGS	686	{ ## public
cb1a09d0	687	my $self = shift;
085f5cc4 RGS	688	my ( $cap, @undefined );
	689	foreach $cap (@_)
	690	{
	691	push( @undefined, $cap )
	692	unless defined $self->{ '_' . $cap } && $self->{ '_' . $cap };
748a9306	693	}
cb1a09d0	694	croak "Terminal does not support: (@undefined)" if @undefined;
a687059c LW	695	}
a687059c LW	696
2ef86165 JS	697	=back
	698
	699	=head1 EXAMPLES
	700
	701	use Term::Cap;
	702
	703	# Get terminal output speed
	704	require POSIX;
	705	my $termios = new POSIX::Termios;
	706	$termios->getattr;
	707	my $ospeed = $termios->getospeed;
	708
	709	# Old-style ioctl code to get ospeed:
	710	# require 'ioctl.pl';
	711	# ioctl(TTY,$TIOCGETP,$sgtty);
	712	# ($ispeed,$ospeed) = unpack('cc',$sgtty);
	713
	714	# allocate and initialize a terminal structure
	715	$terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
	716
	717	# require certain capabilities to be available
	718	$terminal->Trequire(qw/ce ku kd/);
	719
	720	# Output Routines, if $FH is undefined these just return the string
cb1a09d0	721
2ef86165 JS	722	# Tgoto does the % expansion stuff with the given args
	723	$terminal->Tgoto('cm', $col, $row, $FH);
	724
	725	# Tputs doesn't do any % expansion.
	726	$terminal->Tputs('dl', $count = 1, $FH);
	727
	728	=head1 COPYRIGHT AND LICENSE
	729
23a75734 CBW	730	Copyright 1995-2015 (c) perl5 porters.
	731
	732	This software is free software and can be modified and distributed under
	733	the same terms as Perl itself.
	734
	735	Please see the file README in the Perl source distribution for details of
	736	the Perl license.
2ef86165 JS	737
	738	=head1 AUTHOR
	739
	740	This module is part of the core Perl distribution and is also maintained
63dc8a94 CBW	741	for CPAN by Jonathan Stowe <jns@gellyfish.co.uk>.
	742
	743	The code is hosted on Github: https://github.com/jonathanstowe/Term-Cap
	744	please feel free to fork, submit patches etc, etc there.
2ef86165 JS	745
	746	=head1 SEE ALSO
	747
	748	termcap(5)
	749
	750	=cut
2ab0daaa JS	751
	752	# Below is a default entry for systems where there are terminals but no
	753	# termcap
	754	1;
a69e7784	755	__DATA__
2ab0daaa JS	756	vt220\|vt200\|DEC VT220 in vt100 emulation mode:
	757	am:mi:xn:xo:
	758	co#80:li#24:
	759	RA=\E[?7l:SA=\E[?7h:
	760	ac=kkllmmjjnnwwqquuttvvxx:ae=\E(B:al=\E[L:as=\E(0:
	761	bl=^G:cd=\E[J:ce=\E[K:cl=\E[H\E[2J:cm=\E[%i%d;%dH:
	762	cr=^M:cs=\E[%i%d;%dr:dc=\E[P:dl=\E[M:do=\E[B:
	763	ei=\E[4l:ho=\E[H:im=\E[4h:
	764	is=\E[1;24r\E[24;1H:
	765	nd=\E[C:
	766	kd=\E[B::kl=\E[D:kr=\E[C:ku=\E[A:le=^H:
	767	mb=\E[5m:md=\E[1m:me=\E[m:mr=\E[7m:
	768	kb=\0177:
	769	r2=\E>\E[24;1H\E[?3l\E[?4l\E[?5l\E[?7h\E[?8h\E=:rc=\E8:
	770	sc=\E7:se=\E[27m:sf=\ED:so=\E[7m:sr=\EM:ta=^I:
	771	ue=\E[24m:up=\E[A:us=\E[4m:ve=\E[?25h:vi=\E[?25l:
	772