diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Term/ReadKey.pm')
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Term/ReadKey.pm | 572 |
1 files changed, 572 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Term/ReadKey.pm b/Master/tlpkg/tlperl0/lib/Term/ReadKey.pm new file mode 100755 index 00000000000..92a2c22ec8f --- /dev/null +++ b/Master/tlpkg/tlperl0/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__; |