summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Term/ReadKey.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Term/ReadKey.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Term/ReadKey.pm572
1 files changed, 572 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Term/ReadKey.pm b/Master/tlpkg/tlperl/lib/Term/ReadKey.pm
new file mode 100755
index 00000000000..92a2c22ec8f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Term/ReadKey.pm
@@ -0,0 +1,572 @@
+#
+# $Id: ReadKey.pm,v 2.23 2005/01/11 21:16:31 jonathan Exp $
+#
+
+=head1 NAME
+
+Term::ReadKey - A perl module for simple terminal control
+
+=head1 SYNOPSIS
+
+ use Term::ReadKey;
+ ReadMode 4; # Turn off controls keys
+ while (not defined ($key = ReadKey(-1))) {
+ # No key yet
+ }
+ print "Get key $key\n";
+ ReadMode 0; # Reset tty mode before exiting
+
+=head1 DESCRIPTION
+
+Term::ReadKey is a compiled perl module dedicated to providing simple
+control over terminal driver modes (cbreak, raw, cooked, etc.,) support for
+non-blocking reads, if the architecture allows, and some generalized handy
+functions for working with terminals. One of the main goals is to have the
+functions as portable as possible, so you can just plug in "use
+Term::ReadKey" on any architecture and have a good likelyhood of it working.
+
+Version 2.30.01:
+Added handling of arrows, page up/down, home/end, insert/delete keys
+under Win32. These keys emit xterm-compatible sequences.
+Works with Term::ReadLine::Perl.
+
+=over 8
+
+=item ReadMode MODE [, Filehandle]
+
+Takes an integer argument, which can currently be one of the following
+values:
+
+ 0 Restore original settings.
+ 1 Change to cooked mode.
+ 2 Change to cooked mode with echo off.
+ (Good for passwords)
+ 3 Change to cbreak mode.
+ 4 Change to raw mode.
+ 5 Change to ultra-raw mode.
+ (LF to CR/LF translation turned off)
+
+ Or, you may use the synonyms:
+
+ restore
+ normal
+ noecho
+ cbreak
+ raw
+ ultra-raw
+
+These functions are automatically applied to the STDIN handle if no
+other handle is supplied. Modes 0 and 5 have some special properties
+worth mentioning: not only will mode 0 restore original settings, but it
+cause the next ReadMode call to save a new set of default settings. Mode
+5 is similar to mode 4, except no CR/LF translation is performed, and if
+possible, parity will be disabled (only if not being used by the terminal,
+however. It is no different from mode 4 under Windows.)
+
+If you are executing another program that may be changing the terminal mode,
+you will either want to say
+
+ ReadMode 1
+ system('someprogram');
+ ReadMode 1;
+
+which resets the settings after the program has run, or:
+
+ $somemode=1;
+ ReadMode 0;
+ system('someprogram');
+ ReadMode 1;
+
+which records any changes the program may have made, before resetting the
+mode.
+
+=item ReadKey MODE [, Filehandle]
+
+Takes an integer argument, which can currently be one of the following
+values:
+
+ 0 Perform a normal read using getc
+ -1 Perform a non-blocked read
+ >0 Perform a timed read
+
+(If the filehandle is not supplied, it will default to STDIN.) If there is
+nothing waiting in the buffer during a non-blocked read, then undef will be
+returned. Note that if the OS does not provide any known mechanism for
+non-blocking reads, then a C<ReadKey -1> can die with a fatal error. This
+will hopefully not be common.
+
+If MODE is greater then zero, then ReadKey will use it as a timeout value in
+seconds (fractional seconds are allowed), and won't return C<undef> until
+that time expires. (Note, again, that some OS's may not support this timeout
+behaviour.) If MODE is less then zero, then this is treated as a timeout
+of zero, and thus will return immediately if no character is waiting. A MODE
+of zero, however, will act like a normal getc.
+
+There are currently some limitations with this call under Windows. It may be
+possible that non-blocking reads will fail when reading repeating keys from
+more then one console.
+
+=item ReadLine MODE [, Filehandle]
+
+Takes an integer argument, which can currently be one of the following
+values:
+
+ 0 Perform a normal read using scalar(<FileHandle>)
+ -1 Perform a non-blocked read
+ >0 Perform a timed read
+
+If there is nothing waiting in the buffer during a non-blocked read, then
+undef will be returned. Note that if the OS does not provide any known
+mechanism for non-blocking reads, then a C<ReadLine 1> can die with a fatal
+error. This will hopefully not be common. Note that a non-blocking test is
+only performed for the first character in the line, not the entire line.
+This call will probably B<not> do what you assume, especially with
+ReadMode's higher then 1. For example, pressing Space and then Backspace
+would appear to leave you where you started, but any timeouts would now
+be suspended.
+
+This call is currently not available under Windows.
+
+=item GetTerminalSize [Filehandle]
+
+Returns either an empty array if this operation is unsupported, or a four
+element array containing: the width of the terminal in characters, the
+height of the terminal in character, the width in pixels, and the height in
+pixels. (The pixel size will only be valid in some environments.)
+
+Under Windows, this function must be called with an "output" filehandle,
+such as STDOUT, or a handle opened to CONOUT$.
+
+=item SetTerminalSize WIDTH,HEIGHT,XPIX,YPIX [, Filehandle]
+
+Return -1 on failure, 0 otherwise. Note that this terminal size is only for
+B<informative> value, and changing the size via this mechanism will B<not>
+change the size of the screen. For example, XTerm uses a call like this when
+it resizes the screen. If any of the new measurements vary from the old, the
+OS will probably send a SIGWINCH signal to anything reading that tty or pty.
+
+This call does not work under Windows.
+
+=item GetSpeeds [, Filehandle]
+
+Returns either an empty array if the operation is unsupported, or a two
+value array containing the terminal in and out speeds, in B<decimal>. E.g,
+an in speed of 9600 baud and an out speed of 4800 baud would be returned as
+(9600,4800). Note that currently the in and out speeds will always be
+identical in some OS's. No speeds are reported under Windows.
+
+=item GetControlChars [, Filehandle]
+
+Returns an array containing key/value pairs suitable for a hash. The pairs
+consist of a key, the name of the control character/signal, and the value
+of that character, as a single character. This call does nothing under Windows.
+
+Each key will be an entry from the following list:
+
+ DISCARD
+ DSUSPEND
+ EOF
+ EOL
+ EOL2
+ ERASE
+ ERASEWORD
+ INTERRUPT
+ KILL
+ MIN
+ QUIT
+ QUOTENEXT
+ REPRINT
+ START
+ STATUS
+ STOP
+ SUSPEND
+ SWITCH
+ TIME
+
+Thus, the following will always return the current interrupt character,
+regardless of platform.
+
+ %keys = GetControlChars;
+ $int = $keys{INTERRUPT};
+
+=item SetControlChars [, Filehandle]
+
+Takes an array containing key/value pairs, as a hash will produce. The pairs
+should consist of a key that is the name of a legal control
+character/signal, and the value should be either a single character, or a
+number in the range 0-255. SetControlChars will die with a runtime error if
+an invalid character name is passed or there is an error changing the
+settings. The list of valid names is easily available via
+
+ %cchars = GetControlChars();
+ @cnames = keys %cchars;
+
+This call does nothing under Windows.
+
+=back
+
+=head1 AUTHOR
+
+Kenneth Albanowski <kjahds@kjahds.com>
+
+Currently maintained by Jonathan Stowe <jns@gellyfish.com>
+
+=cut
+
+package Term::ReadKey;
+
+$VERSION = '2.30.01';
+
+require Exporter;
+require AutoLoader;
+require DynaLoader;
+use Carp;
+
+@ISA = qw(Exporter AutoLoader DynaLoader);
+
+# Items to export into callers namespace by default
+# (move infrequently used names to @EXPORT_OK below)
+
+@EXPORT = qw(
+ ReadKey
+ ReadMode
+ ReadLine
+ GetTerminalSize
+ SetTerminalSize
+ GetSpeed
+ GetControlChars
+ SetControlChars
+);
+
+@EXPORT_OK = qw();
+
+bootstrap Term::ReadKey;
+
+# Preloaded methods go here. Autoload methods go after __END__, and are
+# processed by the autosplit program.
+
+# Should we use LINES and COLUMNS to try and get the terminal size?
+# Change this to zero if you have systems where these are commonly
+# set to erroneous values. (But if either are nero zero, they won't be
+# used anyhow.)
+
+$UseEnv = 1;
+
+$CurrentMode = 0;
+
+%modes = (
+ original => 0,
+ restore => 0,
+ normal => 1,
+ noecho => 2,
+ cbreak => 3,
+ raw => 4,
+ 'ultra-raw' => 5
+);
+
+sub ReadMode
+{
+ my ($mode) = $modes{ $_[0] };
+ my ($fh) = normalizehandle( ( @_ > 1 ? $_[1] : \*STDIN ) );
+ if ( defined($mode) ) { $CurrentMode = $mode }
+ elsif ( $_[0] =~ /^\d/ ) { $CurrentMode = $_[0] }
+ else { croak("Unknown terminal mode `$_[0]'"); }
+ SetReadMode($CurrentMode, $fh);
+}
+
+sub normalizehandle
+{
+ my ($file) = @_;
+
+ # print "Handle = $file\n";
+ if ( ref($file) ) { return $file; } # Reference is fine
+
+ # if($file =~ /^\*/) { return $file; } # Type glob is good
+ if ( ref( \$file ) eq 'GLOB' ) { return $file; } # Glob is good
+
+ # print "Caller = ",(caller(1))[0],"\n";
+ return \*{ ( ( caller(1) )[0] ) . "::$file" };
+}
+
+sub GetTerminalSize
+{
+ my ($file) = normalizehandle( ( @_ > 1 ? $_[1] : \*STDOUT ) );
+ my (@results) = ();
+ my (@fail);
+
+ if ( &termsizeoptions() & 1 ) # VIO
+ {
+ @results = GetTermSizeVIO($file);
+ push( @fail, "VIOGetMode call" );
+ }
+ elsif ( &termsizeoptions() & 2 ) # GWINSZ
+ {
+ @results = GetTermSizeGWINSZ($file);
+ push( @fail, "TIOCGWINSZ ioctl" );
+ }
+ elsif ( &termsizeoptions() & 4 ) # GSIZE
+ {
+ @results = GetTermSizeGSIZE($file);
+ push( @fail, "TIOCGSIZE ioctl" );
+ }
+ elsif ( &termsizeoptions() & 8 ) # WIN32
+ {
+ @results = GetTermSizeWin32($file);
+ push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
+ }
+ else
+ {
+ @results = ();
+ }
+
+ if ( @results < 4 and $UseEnv )
+ {
+ my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
+ my ($L) = defined( $ENV{LINES} ) ? $ENV{LINES} : 0;
+ if ( ( $C >= 2 ) and ( $L >= 2 ) )
+ {
+ @results = ( $C + 0, $L + 0, 0, 0 );
+ }
+ push( @fail, "COLUMNS and LINES environment variables" );
+ }
+
+ if ( @results < 4 )
+ {
+ my ($prog) = "resize";
+
+ # Workaround for Solaris path sillyness
+ if ( -f "/usr/openwin/bin/resize" ) {
+ $prog = "/usr/openwin/bin/resize";
+ }
+
+ my ($resize) = scalar(`$prog 2>/dev/null`);
+ if (
+ defined $resize
+ and ( $resize =~ /COLUMNS\s*=\s*(\d+)/
+ or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
+ )
+ {
+ $results[0] = $1;
+ if ( $resize =~ /LINES\s*=\s*(\d+)/
+ or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
+ {
+ $results[1] = $1;
+ @results[ 2, 3 ] = ( 0, 0 );
+ }
+ else
+ {
+ @results = ();
+ }
+ }
+ else
+ {
+ @results = ();
+ }
+ push( @fail, "resize program" );
+ }
+
+ if ( @results < 4 )
+ {
+ die "Unable to get Terminal Size."
+ . join( "", map( " The $_ didn't work.", @fail ) );
+ }
+
+ @results;
+}
+
+if ( &blockoptions() & 1 ) # Use nodelay
+{
+ if ( &blockoptions() & 2 ) #poll
+ {
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if (defined $_[0] && $_[0] > 0) {
+ if ($_[0]) {
+ return undef if &pollfile($File,$_[0]) == 0;
+ }
+ }
+ if (defined $_[0] && $_[0] < 0) {
+ &setnodelay($File,1);
+ }
+ my ($value) = getc $File;
+ if (defined $_[0] && $_[0] < 0) {
+ &setnodelay($File,0);
+ }
+ $value;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+
+ if (defined $_[0] && $_[0] > 0) {
+ if ($_[0]) {
+ return undef if &pollfile($File,$_[0]) == 0;
+ }
+ }
+ if (defined $_[0] && $_[0] < 0) {
+ &setnodelay($File,1)
+ };
+ my ($value) = scalar(<$File>);
+ if ( defined $_[0] && $_[0]<0 ) {
+ &setnodelay($File,0)
+ };
+ $value;
+ }
+DONE
+ }
+ elsif ( &blockoptions() & 4 ) #select
+ {
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0]>0) {
+ if($_[0]) {return undef if &selectfile($File,$_[0])==0}
+ }
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
+ my($value) = getc $File;
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
+ $value;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0]>0) {
+ if($_[0]) {return undef if &selectfile($File,$_[0])==0}
+ }
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
+ my($value)=scalar(<$File>);
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
+ $value;
+ }
+DONE
+ }
+ else
+ { #nothing
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0]>0) {
+ # Nothing better seems to exist, so I just use time-of-day
+ # to timeout the read. This isn't very exact, though.
+ $starttime=time;
+ $endtime=$starttime+$_[0];
+ &setnodelay($File,1);
+ my($value)=undef;
+ while(time<$endtime) { # This won't catch wraparound!
+ $value = getc $File;
+ last if defined($value);
+ }
+ &setnodelay($File,0);
+ return $value;
+ }
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
+ my($value) = getc $File;
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
+ $value;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0]>0) {
+ # Nothing better seems to exist, so I just use time-of-day
+ # to timeout the read. This isn't very exact, though.
+ $starttime=time;
+ $endtime=$starttime+$_[0];
+ &setnodelay($File,1);
+ my($value)=undef;
+ while(time<$endtime) { # This won't catch wraparound!
+ $value = scalar(<$File>);
+ last if defined($value);
+ }
+ &setnodelay($File,0);
+ return $value;
+ }
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
+ my($value)=scalar(<$File>);
+ if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
+ $value;
+ }
+DONE
+ }
+}
+elsif ( &blockoptions() & 2 ) # Use poll
+{
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0] != 0) {
+ return undef if &pollfile($File,$_[0]) == 0
+ }
+ getc $File;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0]!=0) {
+ return undef if &pollfile($File,$_[0]) == 0;
+ }
+ scalar(<$File>);
+ }
+DONE
+}
+elsif ( &blockoptions() & 4 ) # Use select
+{
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0] !=0 ) {
+ return undef if &selectfile($File,$_[0])==0
+ }
+ getc $File;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if(defined $_[0] && $_[0] != 0) {
+ return undef if &selectfile($File,$_[0]) == 0;
+ }
+ scalar(<$File>);
+ }
+DONE
+}
+elsif ( &blockoptions() & 8 ) # Use Win32
+{
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if ($_[0] || $CurrentMode >= 3) {
+ Win32PeekChar($File, $_[0]);
+ } else {
+ getc $File;
+ }
+ #if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
+ #getc $File;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ #if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
+ #scalar(<$File>);
+ if($_[0])
+ {croak("Non-blocking ReadLine is not supported on this architecture")}
+ scalar(<$File>);
+ }
+DONE
+}
+else
+{
+ eval <<'DONE';
+ sub ReadKey {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if($_[0])
+ {croak("Non-blocking ReadKey is not supported on this architecture")}
+ getc $File;
+ }
+ sub ReadLine {
+ my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
+ if($_[0])
+ {croak("Non-blocking ReadLine is not supported on this architecture")}
+ scalar(<$File>);
+ }
+DONE
+}
+
+package Term::ReadKey; # return to package ReadKey so AutoSplit is happy
+1;
+
+__END__;