summaryrefslogtreecommitdiffstats
path: root/contrib/perl5/lib/Term
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/perl5/lib/Term')
-rw-r--r--contrib/perl5/lib/Term/ANSIColor.pm351
-rw-r--r--contrib/perl5/lib/Term/Cap.pm410
-rw-r--r--contrib/perl5/lib/Term/Complete.pm154
-rw-r--r--contrib/perl5/lib/Term/ReadLine.pm369
4 files changed, 0 insertions, 1284 deletions
diff --git a/contrib/perl5/lib/Term/ANSIColor.pm b/contrib/perl5/lib/Term/ANSIColor.pm
deleted file mode 100644
index b61efcb..0000000
--- a/contrib/perl5/lib/Term/ANSIColor.pm
+++ /dev/null
@@ -1,351 +0,0 @@
-# Term::ANSIColor -- Color screen output using ANSI escape sequences.
-# $Id: ANSIColor.pm,v 1.3 2000/08/06 18:28:10 eagle Exp $
-#
-# Copyright 1996, 1997, 1998, 2000
-# by Russ Allbery <rra@stanford.edu> and Zenin <zenin@best.com>
-#
-# This program is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# Ah, September, when the sysadmins turn colors and fall off the trees....
-# -- Dave Van Domelen
-
-############################################################################
-# Modules and declarations
-############################################################################
-
-package Term::ANSIColor;
-require 5.001;
-
-use strict;
-use vars qw(@ISA @EXPORT %EXPORT_TAGS $VERSION $AUTOLOAD %attributes
- $AUTORESET $EACHLINE);
-
-use Exporter ();
-@ISA = qw(Exporter);
-@EXPORT = qw(color colored);
-%EXPORT_TAGS = (constants => [qw(CLEAR RESET BOLD UNDERLINE UNDERSCORE BLINK
- REVERSE CONCEALED BLACK RED GREEN YELLOW
- BLUE MAGENTA CYAN WHITE ON_BLACK ON_RED
- ON_GREEN ON_YELLOW ON_BLUE ON_MAGENTA
- ON_CYAN ON_WHITE)]);
-Exporter::export_ok_tags ('constants');
-
-# Don't use the CVS revision as the version, since this module is also in
-# Perl core and too many things could munge CVS magic revision strings.
-$VERSION = 1.03;
-
-
-############################################################################
-# Internal data structures
-############################################################################
-
-%attributes = ('clear' => 0,
- 'reset' => 0,
- 'bold' => 1,
- 'dark' => 2,
- 'underline' => 4,
- 'underscore' => 4,
- 'blink' => 5,
- 'reverse' => 7,
- 'concealed' => 8,
-
- 'black' => 30, 'on_black' => 40,
- 'red' => 31, 'on_red' => 41,
- 'green' => 32, 'on_green' => 42,
- 'yellow' => 33, 'on_yellow' => 43,
- 'blue' => 34, 'on_blue' => 44,
- 'magenta' => 35, 'on_magenta' => 45,
- 'cyan' => 36, 'on_cyan' => 46,
- 'white' => 37, 'on_white' => 47);
-
-
-############################################################################
-# Implementation (constant form)
-############################################################################
-
-# Time to have fun! We now want to define the constant subs, which are
-# named the same as the attributes above but in all caps. Each constant sub
-# needs to act differently depending on whether $AUTORESET is set. Without
-# autoreset:
-#
-# BLUE "text\n" ==> "\e[34mtext\n"
-#
-# If $AUTORESET is set, we should instead get:
-#
-# BLUE "text\n" ==> "\e[34mtext\n\e[0m"
-#
-# The sub also needs to handle the case where it has no arguments correctly.
-# Maintaining all of this as separate subs would be a major nightmare, as
-# well as duplicate the %attributes hash, so instead we define an AUTOLOAD
-# sub to define the constant subs on demand. To do that, we check the name
-# of the called sub against the list of attributes, and if it's an all-caps
-# version of one of them, we define the sub on the fly and then run it.
-sub AUTOLOAD {
- my $sub;
- ($sub = $AUTOLOAD) =~ s/^.*:://;
- my $attr = $attributes{lc $sub};
- if ($sub =~ /^[A-Z_]+$/ && defined $attr) {
- $attr = "\e[" . $attr . 'm';
- eval qq {
- sub $AUTOLOAD {
- if (\$AUTORESET && \@_) {
- '$attr' . "\@_" . "\e[0m";
- } else {
- ('$attr' . "\@_");
- }
- }
- };
- goto &$AUTOLOAD;
- } else {
- require Carp;
- Carp::croak ("undefined subroutine &$AUTOLOAD called");
- }
-}
-
-
-############################################################################
-# Implementation (attribute string form)
-############################################################################
-
-# Return the escape code for a given set of color attributes.
-sub color {
- my @codes = map { split } @_;
- my $attribute = '';
- foreach (@codes) {
- $_ = lc $_;
- unless (defined $attributes{$_}) {
- require Carp;
- Carp::croak ("Invalid attribute name $_");
- }
- $attribute .= $attributes{$_} . ';';
- }
- chop $attribute;
- ($attribute ne '') ? "\e[${attribute}m" : undef;
-}
-
-# Given a string and a set of attributes, returns the string surrounded by
-# escape codes to set those attributes and then clear them at the end of the
-# string. The attributes can be given either as an array ref as the first
-# argument or as a list as the second and subsequent arguments. If
-# $EACHLINE is set, insert a reset before each occurrence of the string
-# $EACHLINE and the starting attribute code after the string $EACHLINE, so
-# that no attribute crosses line delimiters (this is often desirable if the
-# output is to be piped to a pager or some other program).
-sub colored {
- my ($string, @codes);
- if (ref $_[0]) {
- @codes = @{+shift};
- $string = join ('', @_);
- } else {
- $string = shift;
- @codes = @_;
- }
- if (defined $EACHLINE) {
- my $attr = color (@codes);
- join '',
- map { $_ && $_ ne $EACHLINE ? $attr . $_ . "\e[0m" : $_ }
- split (/(\Q$EACHLINE\E)/, $string);
- } else {
- color (@codes) . $string . "\e[0m";
- }
-}
-
-
-############################################################################
-# Module return value and documentation
-############################################################################
-
-# Ensure we evaluate to true.
-1;
-__END__
-
-=head1 NAME
-
-Term::ANSIColor - Color screen output using ANSI escape sequences
-
-=head1 SYNOPSIS
-
- use Term::ANSIColor;
- print color 'bold blue';
- print "This text is bold blue.\n";
- print color 'reset';
- print "This text is normal.\n";
- print colored ("Yellow on magenta.\n", 'yellow on_magenta');
- print "This text is normal.\n";
- print colored ['yellow on_magenta'], "Yellow on magenta.\n";
-
- use Term::ANSIColor qw(:constants);
- print BOLD, BLUE, "This text is in bold blue.\n", RESET;
-
- use Term::ANSIColor qw(:constants);
- $Term::ANSIColor::AUTORESET = 1;
- print BOLD BLUE "This text is in bold blue.\n";
- print "This text is normal.\n";
-
-=head1 DESCRIPTION
-
-This module has two interfaces, one through color() and colored() and the
-other through constants.
-
-color() takes any number of strings as arguments and considers them to be
-space-separated lists of attributes. It then forms and returns the escape
-sequence to set those attributes. It doesn't print it out, just returns
-it, so you'll have to print it yourself if you want to (this is so that
-you can save it as a string, pass it to something else, send it to a file
-handle, or do anything else with it that you might care to).
-
-The recognized attributes (all of which should be fairly intuitive) are
-clear, reset, dark, bold, underline, underscore, blink, reverse,
-concealed, black, red, green, yellow, blue, magenta, on_black, on_red,
-on_green, on_yellow, on_blue, on_magenta, on_cyan, and on_white. Case is
-not significant. Underline and underscore are equivalent, as are clear
-and reset, so use whichever is the most intuitive to you. The color alone
-sets the foreground color, and on_color sets the background color.
-
-Note that not all attributes are supported by all terminal types, and some
-terminals may not support any of these sequences. Dark, blink, and
-concealed in particular are frequently not implemented.
-
-Attributes, once set, last until they are unset (by sending the attribute
-"reset"). Be careful to do this, or otherwise your attribute will last
-after your script is done running, and people get very annoyed at having
-their prompt and typing changed to weird colors.
-
-As an aid to help with this, colored() takes a scalar as the first
-argument and any number of attribute strings as the second argument and
-returns the scalar wrapped in escape codes so that the attributes will be
-set as requested before the string and reset to normal after the string.
-Alternately, you can pass a reference to an array as the first argument,
-and then the contents of that array will be taken as attributes and color
-codes and the remainder of the arguments as text to colorize.
-
-Normally, colored() just puts attribute codes at the beginning and end of
-the string, but if you set $Term::ANSIColor::EACHLINE to some string,
-that string will be considered the line delimiter and the attribute will
-be set at the beginning of each line of the passed string and reset at the
-end of each line. This is often desirable if the output is being sent to
-a program like a pager that can be confused by attributes that span lines.
-Normally you'll want to set $Term::ANSIColor::EACHLINE to C<"\n"> to use
-this feature.
-
-Alternately, if you import C<:constants>, you can use the constants CLEAR,
-RESET, BOLD, DARK, UNDERLINE, UNDERSCORE, BLINK, REVERSE, CONCEALED,
-BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, ON_BLACK, ON_RED, ON_GREEN,
-ON_YELLOW, ON_BLUE, ON_MAGENTA, ON_CYAN, and ON_WHITE directly. These are
-the same as color('attribute') and can be used if you prefer typing:
-
- print BOLD BLUE ON_WHITE "Text\n", RESET;
-
-to
-
- print colored ("Text\n", 'bold blue on_white');
-
-When using the constants, if you don't want to have to remember to add the
-C<, RESET> at the end of each print line, you can set
-$Term::ANSIColor::AUTORESET to a true value. Then, the display mode will
-automatically be reset if there is no comma after the constant. In other
-words, with that variable set:
-
- print BOLD BLUE "Text\n";
-
-will reset the display mode afterwards, whereas:
-
- print BOLD, BLUE, "Text\n";
-
-will not.
-
-The subroutine interface has the advantage over the constants interface in
-that only two subroutines are exported into your namespace, versus
-twenty-two in the constants interface. On the flip side, the constants
-interface has the advantage of better compile time error checking, since
-misspelled names of colors or attributes in calls to color() and colored()
-won't be caught until runtime whereas misspelled names of constants will
-be caught at compile time. So, polute your namespace with almost two
-dozen subroutines that you may not even use that often, or risk a silly
-bug by mistyping an attribute. Your choice, TMTOWTDI after all.
-
-=head1 DIAGNOSTICS
-
-=over 4
-
-=item Invalid attribute name %s
-
-(F) You passed an invalid attribute name to either color() or colored().
-
-=item Name "%s" used only once: possible typo
-
-(W) You probably mistyped a constant color name such as:
-
- print FOOBAR "This text is color FOOBAR\n";
-
-It's probably better to always use commas after constant names in order to
-force the next error.
-
-=item No comma allowed after filehandle
-
-(F) You probably mistyped a constant color name such as:
-
- print FOOBAR, "This text is color FOOBAR\n";
-
-Generating this fatal compile error is one of the main advantages of using
-the constants interface, since you'll immediately know if you mistype a
-color name.
-
-=item Bareword "%s" not allowed while "strict subs" in use
-
-(F) You probably mistyped a constant color name such as:
-
- $Foobar = FOOBAR . "This line should be blue\n";
-
-or:
-
- @Foobar = FOOBAR, "This line should be blue\n";
-
-This will only show up under use strict (another good reason to run under
-use strict).
-
-=back
-
-=head1 RESTRICTIONS
-
-It would be nice if one could leave off the commas around the constants
-entirely and just say:
-
- print BOLD BLUE ON_WHITE "Text\n" RESET;
-
-but the syntax of Perl doesn't allow this. You need a comma after the
-string. (Of course, you may consider it a bug that commas between all the
-constants aren't required, in which case you may feel free to insert
-commas unless you're using $Term::ANSIColor::AUTORESET.)
-
-For easier debuging, you may prefer to always use the commas when not
-setting $Term::ANSIColor::AUTORESET so that you'll get a fatal compile
-error rather than a warning.
-
-=head1 NOTES
-
-Jean Delvare provided the following table of different common terminal
-emulators and their support for the various attributes:
-
- clear bold dark under blink reverse conceal
- ------------------------------------------------------------------------
- xterm yes yes no yes bold yes yes
- linux yes yes yes bold yes yes no
- rxvt yes yes no yes bold/black yes no
- dtterm yes yes yes yes reverse yes yes
- teraterm yes reverse no yes rev/red yes no
- aixterm kinda normal no yes no yes yes
-
-Where the entry is other than yes or no, that emulator interpret the given
-attribute as something else instead. Note that on an aixterm, clear
-doesn't reset colors; you have to explicitly set the colors back to what
-you want. More entries in this table are welcome.
-
-=head1 AUTHORS
-
-Original idea (using constants) by Zenin (zenin@best.com), reimplemented
-using subs by Russ Allbery (rra@stanford.edu), and then combined with the
-original idea by Russ with input from Zenin.
-
-=cut
diff --git a/contrib/perl5/lib/Term/Cap.pm b/contrib/perl5/lib/Term/Cap.pm
deleted file mode 100644
index 0954000..0000000
--- a/contrib/perl5/lib/Term/Cap.pm
+++ /dev/null
@@ -1,410 +0,0 @@
-package Term::Cap;
-use Carp;
-
-# Last updated: Thu Dec 14 20:02:42 CST 1995 by sanders@bsdi.com
-
-# TODO:
-# support Berkeley DB termcaps
-# should probably be a .xs module
-# 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.
-
-The B<Tgetent> 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.
-
-I<OSPEED> is the terminal output bit rate (often mistakenly called
-the baud rate). I<OSPEED> can be specified as either a POSIX
-termios/SYSV termio speeds (where 9600 equals 9600) or an old
-BSD-style speeds (where 13 equals 9600).
-
-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>. It calls C<croak> on failure.
-
-B<Tgoto> decodes a cursor addressing string with the given parameters.
-
-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.
-
-The extracted termcap entry is available in the object
-as C<$self-E<gt>{TERMCAP}>.
-
-=head1 EXAMPLES
-
- # 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);
-
-=cut
-
-# 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,
- $ENV{'HOME'} . '/.termcap',
- '/etc/termcap',
- '/usr/share/misc/termcap',
- );
- }
- # return the list of those termcaps that exist
- grep(-f, @termcap_path);
-}
-
-sub Tgetent { ## public -- static method
- my $class = shift;
- my $self = bless shift, $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}) {
- 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};
- }
-
- $self->{TERM} = ($self->{TERM} || $ENV{TERM} || 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;
- 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 .= $_;
- };
-
- 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 ($field =~ /^(\w\w)$/) {
- $self->{'_' . $field} = 1 unless defined $self->{'_' . $1};
- # print STDERR "DEBUG: flag $1\n";
- }
- elsif ($field =~ /^(\w\w)\@/) {
- $self->{'_' . $1} = "";
- # print STDERR "DEBUG: unset $1\n";
- }
- elsif ($field =~ /^(\w\w)#(.*)/) {
- $self->{'_' . $1} = $2 unless defined $self->{'_' . $1};
- # print STDERR "DEBUG: numeric $1 = $2\n";
- }
- elsif ($field =~ /^(\w\w)=(.*)/) {
- # print STDERR "DEBUG: string $1 = $2\n";
- next if defined $self->{'_' . ($cap = $1)};
- $_ = $2;
- 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);
-sub Tpad { ## public
- my $self = shift;
- my($string, $cnt, $FH) = @_;
- my($decr, $ms);
-
- if ($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);
-sub Tputs { ## public
- my $self = shift;
- my($cap, $cnt, $FH) = @_;
- my $string;
-
- if ($cnt > 1) {
- $string = Tpad($self, $self->{'_' . $cap}, $cnt);
- } else {
- # cache result because Tpad can be slow
- $string = defined $self->{$cap} ? $self->{$cap} :
- ($self->{$cap} = Tpad($self, $self->{'_' . $cap}, 1));
- }
- print $FH $string if $FH;
- $string;
-}
-
-# %% 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)
-#
-# $terminal->Tgoto($cap, $col, $row, $FH);
-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[$[] > $code) {
- $tmp[$[] += $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/);
-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;
-}
-
-1;
-
diff --git a/contrib/perl5/lib/Term/Complete.pm b/contrib/perl5/lib/Term/Complete.pm
deleted file mode 100644
index 445dfca..0000000
--- a/contrib/perl5/lib/Term/Complete.pm
+++ /dev/null
@@ -1,154 +0,0 @@
-package Term::Complete;
-require 5.000;
-require Exporter;
-
-@ISA = qw(Exporter);
-@EXPORT = qw(Complete);
-
-# @(#)complete.pl,v1.2 (me@anywhere.EBay.Sun.COM) 09/23/91
-
-=head1 NAME
-
-Term::Complete - Perl word completion module
-
-=head1 SYNOPSIS
-
- $input = Complete('prompt_string', \@completion_list);
- $input = Complete('prompt_string', @completion_list);
-
-=head1 DESCRIPTION
-
-This routine provides word completion on the list of words in
-the array (or array ref).
-
-The tty driver is put into raw mode using the system command
-C<stty raw -echo> and restored using C<stty -raw echo>.
-
-The following command characters are defined:
-
-=over 4
-
-=item E<lt>tabE<gt>
-
-Attempts word completion.
-Cannot be changed.
-
-=item ^D
-
-Prints completion list.
-Defined by I<$Term::Complete::complete>.
-
-=item ^U
-
-Erases the current input.
-Defined by I<$Term::Complete::kill>.
-
-=item E<lt>delE<gt>, E<lt>bsE<gt>
-
-Erases one character.
-Defined by I<$Term::Complete::erase1> and I<$Term::Complete::erase2>.
-
-=back
-
-=head1 DIAGNOSTICS
-
-Bell sounds when word completion fails.
-
-=head1 BUGS
-
-The completion character E<lt>tabE<gt> cannot be changed.
-
-=head1 AUTHOR
-
-Wayne Thompson
-
-=cut
-
-CONFIG: {
- $complete = "\004";
- $kill = "\025";
- $erase1 = "\177";
- $erase2 = "\010";
-}
-
-sub Complete {
- my($prompt, @cmp_list, $cmp, $test, $l, @match);
- my ($return, $r) = ("", 0);
-
- $return = "";
- $r = 0;
-
- $prompt = shift;
- if (ref $_[0] || $_[0] =~ /^\*/) {
- @cmp_lst = sort @{$_[0]};
- }
- else {
- @cmp_lst = sort(@_);
- }
-
- system('stty raw -echo');
- LOOP: {
- print($prompt, $return);
- while (($_ = getc(STDIN)) ne "\r") {
- CASE: {
- # (TAB) attempt completion
- $_ eq "\t" && do {
- @match = grep(/^$return/, @cmp_lst);
- unless ($#match < 0) {
- $l = length($test = shift(@match));
- foreach $cmp (@match) {
- until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
- $l--;
- }
- }
- print("\a");
- print($test = substr($test, $r, $l - $r));
- $r = length($return .= $test);
- }
- last CASE;
- };
-
- # (^D) completion list
- $_ eq $complete && do {
- print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
- redo LOOP;
- };
-
- # (^U) kill
- $_ eq $kill && do {
- if ($r) {
- $r = 0;
- $return = "";
- print("\r\n");
- redo LOOP;
- }
- last CASE;
- };
-
- # (DEL) || (BS) erase
- ($_ eq $erase1 || $_ eq $erase2) && do {
- if($r) {
- print("\b \b");
- chop($return);
- $r--;
- }
- last CASE;
- };
-
- # printable char
- ord >= 32 && do {
- $return .= $_;
- $r++;
- print;
- last CASE;
- };
- }
- }
- }
- system('stty -raw echo');
- print("\n");
- $return;
-}
-
-1;
-
diff --git a/contrib/perl5/lib/Term/ReadLine.pm b/contrib/perl5/lib/Term/ReadLine.pm
deleted file mode 100644
index fc78d7b..0000000
--- a/contrib/perl5/lib/Term/ReadLine.pm
+++ /dev/null
@@ -1,369 +0,0 @@
-=head1 NAME
-
-Term::ReadLine - Perl interface to various C<readline> packages. If
-no real package is found, substitutes stubs instead of basic functions.
-
-=head1 SYNOPSIS
-
- use Term::ReadLine;
- $term = new Term::ReadLine 'Simple Perl calc';
- $prompt = "Enter your arithmetic expression: ";
- $OUT = $term->OUT || STDOUT;
- while ( defined ($_ = $term->readline($prompt)) ) {
- $res = eval($_), "\n";
- warn $@ if $@;
- print $OUT $res, "\n" unless $@;
- $term->addhistory($_) if /\S/;
- }
-
-=head1 DESCRIPTION
-
-This package is just a front end to some other packages. At the moment
-this description is written, the only such package is Term-ReadLine,
-available on CPAN near you. The real target of this stub package is to
-set up a common interface to whatever Readline emerges with time.
-
-=head1 Minimal set of supported functions
-
-All the supported functions should be called as methods, i.e., either as
-
- $term = new Term::ReadLine 'name';
-
-or as
-
- $term->addhistory('row');
-
-where $term is a return value of Term::ReadLine-E<gt>Init.
-
-=over 12
-
-=item C<ReadLine>
-
-returns the actual package that executes the commands. Among possible
-values are C<Term::ReadLine::Gnu>, C<Term::ReadLine::Perl>,
-C<Term::ReadLine::Stub Exporter>.
-
-=item C<new>
-
-returns the handle for subsequent calls to following
-functions. Argument is the name of the application. Optionally can be
-followed by two arguments for C<IN> and C<OUT> filehandles. These
-arguments should be globs.
-
-=item C<readline>
-
-gets an input line, I<possibly> with actual C<readline>
-support. Trailing newline is removed. Returns C<undef> on C<EOF>.
-
-=item C<addhistory>
-
-adds the line to the history of input, from where it can be used if
-the actual C<readline> is present.
-
-=item C<IN>, $C<OUT>
-
-return the filehandles for input and output or C<undef> if C<readline>
-input and output cannot be used for Perl.
-
-=item C<MinLine>
-
-If argument is specified, it is an advice on minimal size of line to
-be included into history. C<undef> means do not include anything into
-history. Returns the old value.
-
-=item C<findConsole>
-
-returns an array with two strings that give most appropriate names for
-files for input and output using conventions C<"E<lt>$in">, C<"E<gt>out">.
-
-=item Attribs
-
-returns a reference to a hash which describes internal configuration
-of the package. Names of keys in this hash conform to standard
-conventions with the leading C<rl_> stripped.
-
-=item C<Features>
-
-Returns a reference to a hash with keys being features present in
-current implementation. Several optional features are used in the
-minimal interface: C<appname> should be present if the first argument
-to C<new> is recognized, and C<minline> should be present if
-C<MinLine> method is not dummy. C<autohistory> should be present if
-lines are put into history automatically (maybe subject to
-C<MinLine>), and C<addhistory> if C<addhistory> method is not dummy.
-
-If C<Features> method reports a feature C<attribs> as present, the
-method C<Attribs> is not dummy.
-
-=back
-
-=head1 Additional supported functions
-
-Actually C<Term::ReadLine> can use some other package, that will
-support reacher set of commands.
-
-All these commands are callable via method interface and have names
-which conform to standard conventions with the leading C<rl_> stripped.
-
-The stub package included with the perl distribution allows some
-additional methods:
-
-=over 12
-
-=item C<tkRunning>
-
-makes Tk event loop run when waiting for user input (i.e., during
-C<readline> method).
-
-=item C<ornaments>
-
-makes the command line stand out by using termcap data. The argument
-to C<ornaments> should be 0, 1, or a string of a form
-C<"aa,bb,cc,dd">. Four components of this string should be names of
-I<terminal capacities>, first two will be issued to make the prompt
-standout, last two to make the input line standout.
-
-=item C<newTTY>
-
-takes two arguments which are input filehandle and output filehandle.
-Switches to use these filehandles.
-
-=back
-
-One can check whether the currently loaded ReadLine package supports
-these methods by checking for corresponding C<Features>.
-
-=head1 EXPORTS
-
-None
-
-=head1 ENVIRONMENT
-
-The environment variable C<PERL_RL> governs which ReadLine clone is
-loaded. If the value is false, a dummy interface is used. If the value
-is true, it should be tail of the name of the package to use, such as
-C<Perl> or C<Gnu>.
-
-As a special case, if the value of this variable is space-separated,
-the tail might be used to disable the ornaments by setting the tail to
-be C<o=0> or C<ornaments=0>. The head should be as described above, say
-
-If the variable is not set, or if the head of space-separated list is
-empty, the best available package is loaded.
-
- export "PERL_RL=Perl o=0" # Use Perl ReadLine without ornaments
- export "PERL_RL= o=0" # Use best available ReadLine without ornaments
-
-(Note that processing of C<PERL_RL> for ornaments is in the discretion of the
-particular used C<Term::ReadLine::*> package).
-
-=cut
-
-package Term::ReadLine::Stub;
-@ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap';
-
-$DB::emacs = $DB::emacs; # To peacify -w
-*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set;
-
-sub ReadLine {'Term::ReadLine::Stub'}
-sub readline {
- my $self = shift;
- my ($in,$out,$str) = @$self;
- my $prompt = shift;
- print $out $rl_term_set[0], $prompt, $rl_term_set[1], $rl_term_set[2];
- $self->register_Tk
- if not $Term::ReadLine::registered and $Term::ReadLine::toloop
- and defined &Tk::DoOneEvent;
- #$str = scalar <$in>;
- $str = $self->get_line;
- $str =~ s/^\s*\Q$prompt\E// if ($^O eq 'MacOS');
- print $out $rl_term_set[3];
- # bug in 5.000: chomping empty string creats length -1:
- chomp $str if defined $str;
- $str;
-}
-sub addhistory {}
-
-sub findConsole {
- my $console;
-
- if ($^O eq 'MacOS') {
- $console = "Dev:Console";
- } elsif (-e "/dev/tty") {
- $console = "/dev/tty";
- } elsif (-e "con" or $^O eq 'MSWin32') {
- $console = "con";
- } else {
- $console = "sys\$command";
- }
-
- if (($^O eq 'amigaos') || ($^O eq 'beos') || ($^O eq 'epoc')) {
- $console = undef;
- }
- elsif ($^O eq 'os2') {
- if ($DB::emacs) {
- $console = undef;
- } else {
- $console = "/dev/con";
- }
- }
-
- $consoleOUT = $console;
- $console = "&STDIN" unless defined $console;
- if (!defined $consoleOUT) {
- $consoleOUT = defined fileno(STDERR) ? "&STDERR" : "&STDOUT";
- }
- ($console,$consoleOUT);
-}
-
-sub new {
- die "method new called with wrong number of arguments"
- unless @_==2 or @_==4;
- #local (*FIN, *FOUT);
- my ($FIN, $FOUT, $ret);
- if (@_==2) {
- ($console, $consoleOUT) = findConsole;
-
- open(FIN, "<$console");
- open(FOUT,">$consoleOUT");
- #OUT->autoflush(1); # Conflicts with debugger?
- $sel = select(FOUT);
- $| = 1; # for DB::OUT
- select($sel);
- $ret = bless [\*FIN, \*FOUT];
- } else { # Filehandles supplied
- $FIN = $_[2]; $FOUT = $_[3];
- #OUT->autoflush(1); # Conflicts with debugger?
- $sel = select($FOUT);
- $| = 1; # for DB::OUT
- select($sel);
- $ret = bless [$FIN, $FOUT];
- }
- if ($ret->Features->{ornaments}
- and not ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/)) {
- local $Term::ReadLine::termcap_nowarn = 1;
- $ret->ornaments(1);
- }
- return $ret;
-}
-
-sub newTTY {
- my ($self, $in, $out) = @_;
- $self->[0] = $in;
- $self->[1] = $out;
- my $sel = select($out);
- $| = 1; # for DB::OUT
- select($sel);
-}
-
-sub IN { shift->[0] }
-sub OUT { shift->[1] }
-sub MinLine { undef }
-sub Attribs { {} }
-
-my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1);
-sub Features { \%features }
-
-package Term::ReadLine; # So late to allow the above code be defined?
-
-my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
-if ($which) {
- if ($which =~ /\bgnu\b/i){
- eval "use Term::ReadLine::Gnu;";
- } elsif ($which =~ /\bperl\b/i) {
- eval "use Term::ReadLine::Perl;";
- } else {
- eval "use Term::ReadLine::$which;";
- }
-} elsif (defined $which and $which ne '') { # Defined but false
- # Do nothing fancy
-} else {
- eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1";
-}
-
-#require FileHandle;
-
-# To make possible switch off RL in debugger: (Not needed, work done
-# in debugger).
-
-if (defined &Term::ReadLine::Gnu::readline) {
- @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
-} elsif (defined &Term::ReadLine::Perl::readline) {
- @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
-} else {
- @ISA = qw(Term::ReadLine::Stub);
-}
-
-package Term::ReadLine::TermCap;
-
-# Prompt-start, prompt-end, command-line-start, command-line-end
-# -- zero-width beautifies to emit around prompt and the command line.
-@rl_term_set = ("","","","");
-# string encoded:
-$rl_term_set = ',,,';
-
-sub LoadTermCap {
- return if defined $terminal;
-
- require Term::Cap;
- $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
-}
-
-sub ornaments {
- shift;
- return $rl_term_set unless @_;
- $rl_term_set = shift;
- $rl_term_set ||= ',,,';
- $rl_term_set = 'us,ue,md,me' if $rl_term_set eq '1';
- my @ts = split /,/, $rl_term_set, 4;
- eval { LoadTermCap };
- unless (defined $terminal) {
- warn("Cannot find termcap: $@\n") unless $Term::ReadLine::termcap_nowarn;
- $rl_term_set = ',,,';
- return;
- }
- @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts;
- return $rl_term_set;
-}
-
-
-package Term::ReadLine::Tk;
-
-$count_handle = $count_DoOne = $count_loop = 0;
-
-sub handle {$giveup = 1; $count_handle++}
-
-sub Tk_loop {
- # Tk->tkwait('variable',\$giveup); # needs Widget
- $count_DoOne++, Tk::DoOneEvent(0) until $giveup;
- $count_loop++;
- $giveup = 0;
-}
-
-sub register_Tk {
- my $self = shift;
- $Term::ReadLine::registered++
- or Tk->fileevent($self->IN,'readable',\&handle);
-}
-
-sub tkRunning {
- $Term::ReadLine::toloop = $_[1] if @_ > 1;
- $Term::ReadLine::toloop;
-}
-
-sub get_c {
- my $self = shift;
- $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
- return getc $self->IN;
-}
-
-sub get_line {
- my $self = shift;
- $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
- my $in = $self->IN;
- local ($/) = "\n";
- return scalar <$in>;
-}
-
-1;
-
OpenPOWER on IntegriCloud