r1240 - in packages: . libterm-readline-gnu-perl
libterm-readline-gnu-perl/branches
libterm-readline-gnu-perl/branches/upstream
libterm-readline-gnu-perl/branches/upstream/current
libterm-readline-gnu-perl/branches/upstream/current/Gnu
libterm-readline-gnu-perl/branches/upstream/current/eg
libterm-readline-gnu-perl/branches/upstream/current/t
libterm-readline-gnu-perl/branches/upstream/current/t/comptest
Gunnar Wolf
gwolf at costa.debian.org
Tue Jul 12 18:06:56 UTC 2005
Author: gwolf
Date: 2005-07-12 18:06:55 +0000 (Tue, 12 Jul 2005)
New Revision: 1240
Added:
packages/libterm-readline-gnu-perl/
packages/libterm-readline-gnu-perl/branches/
packages/libterm-readline-gnu-perl/branches/upstream/
packages/libterm-readline-gnu-perl/branches/upstream/current/
packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu.pm
packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu.xs
packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu/
packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu/XS.pm
packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu/euc_jp.pm
packages/libterm-readline-gnu-perl/branches/upstream/current/INSTALL
packages/libterm-readline-gnu-perl/branches/upstream/current/MANIFEST
packages/libterm-readline-gnu-perl/branches/upstream/current/Makefile.PL
packages/libterm-readline-gnu-perl/branches/upstream/current/README
packages/libterm-readline-gnu-perl/branches/upstream/current/eg/
packages/libterm-readline-gnu-perl/branches/upstream/current/eg/fileman
packages/libterm-readline-gnu-perl/branches/upstream/current/eg/perlsh
packages/libterm-readline-gnu-perl/branches/upstream/current/eg/pftp
packages/libterm-readline-gnu-perl/branches/upstream/current/eg/ptksh+
packages/libterm-readline-gnu-perl/branches/upstream/current/ppport.h
packages/libterm-readline-gnu-perl/branches/upstream/current/t/
packages/libterm-readline-gnu-perl/branches/upstream/current/t/button.pl
packages/libterm-readline-gnu-perl/branches/upstream/current/t/callback.t
packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/
packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/0123
packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/012345
packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/023456
packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/README
packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/a_b
packages/libterm-readline-gnu-perl/branches/upstream/current/t/history.t
packages/libterm-readline-gnu-perl/branches/upstream/current/t/inputrc
packages/libterm-readline-gnu-perl/branches/upstream/current/t/readline.t
packages/libterm-readline-gnu-perl/branches/upstream/current/typemap
packages/libterm-readline-gnu-perl/tags/
Log:
[svn-inject] Installing original source of libterm-readline-gnu-perl
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu/XS.pm
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu/XS.pm 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu/XS.pm 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,521 @@
+#!/usr/local/bin/perl
+#
+# XS.pm : perl function definition for Term::ReadLine::Gnu
+#
+# $Id: XS.pm,v 1.20 2002-07-27 22:39:49-05 hiroo Exp $
+#
+# Copyright (c) 2002 Hiroo Hayashi. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Term::ReadLine::Gnu::XS;
+
+use Carp;
+use strict;
+use AutoLoader 'AUTOLOAD';
+
+# make aliases
+use vars qw(%Attribs);
+*Attribs = \%Term::ReadLine::Gnu::Attribs;
+
+use vars qw(*read_history);
+*read_history = \&read_history_range;
+
+# alias for 8 characters limitation imposed by AutoSplit
+use vars qw(*rl_unbind_key *rl_unbind_function *rl_unbind_command
+ *history_list *history_arg_extract);
+*rl_unbind_key = \&unbind_key;
+*rl_unbind_function = \&unbind_function;
+*rl_unbind_command = \&unbind_command;
+*history_list = \&hist_list;
+*history_arg_extract = \&hist_arg_extract;
+
+# For backward compatibility. Using these name (*_in_map) is deprecated.
+use vars qw(*rl_unbind_function_in_map *rl_unbind_command_in_map);
+*rl_unbind_function_in_map = \&unbind_function;
+*rl_unbind_command_in_map = \&unbind_command;
+
+rl_add_defun('history-expand-line', \&history_expand_line);
+# bind operate-and-get-next to \C-o by default for the compatibility
+# with bash and Term::ReadLine::Perl
+rl_add_defun('operate-and-get-next', \&operate_and_get_next, ord "\co");
+rl_add_defun('display-readline-version', \&display_readline_version);
+rl_add_defun('change-ornaments', \&change_ornaments);
+
+# for ornaments()
+
+# Prompt-start, prompt-end, command-line-start, command-line-end
+# -- zero-width beautifies to emit around prompt and the command line.
+# string encoded:
+my $rl_term_set = ',,,';
+
+# These variables are used by completion functions. Don't use for
+# other purpose.
+my $_i;
+my @_matches;
+my @_tstrs;
+my $_tstrs_init = 0;
+
+1;
+
+# Uncomment the following line to enable AutoSplit. If you are using
+# AutoLoader.pm distributed with Perl 5.004 or earlier, you must
+# update AutoLoader.pm due to its bug.
+
+#__END__
+
+
+#
+# Readline Library function wrappers
+#
+
+# Convert keymap name to Keymap if the argument is not reference to Keymap
+sub _str2map ($) {
+ return ref $_[0] ? $_[0]
+ : (rl_get_keymap_by_name($_[0]) || carp "unknown keymap name \`$_[0]\'\n");
+}
+
+# Convert function name to Function if the argument is not reference
+# to Function
+sub _str2fn ($) {
+ return ref $_[0] ? $_[0]
+ : (rl_named_function($_[0]) || carp "unknown function name \`$_[0]\'\n");
+}
+
+sub rl_copy_keymap ($) { return _rl_copy_keymap(_str2map($_[0])); }
+sub rl_discard_keymap ($) { return _rl_discard_keymap(_str2map($_[0])); }
+sub rl_set_keymap ($) { return _rl_set_keymap(_str2map($_[0])); }
+
+sub rl_bind_key ($$;$) {
+ if (defined $_[2]) {
+ return _rl_bind_key($_[0], _str2fn($_[1]), _str2map($_[2]));
+ } else {
+ return _rl_bind_key($_[0], _str2fn($_[1]));
+ }
+}
+
+# rl_unbind_key
+sub unbind_key ($;$) {
+ if (defined $_[1]) {
+ return _rl_unbind_key($_[0], _str2map($_[1]));
+ } else {
+ return _rl_unbind_key($_[0]);
+ }
+}
+
+# rl_unbind_function
+sub unbind_function ($;$) {
+ # libreadline.* in Debian GNU/Linux 2.0 tells wrong value as '2.1-bash'
+ my ($version) = $Attribs{library_version}
+ =~ /(\d+\.\d+)/;
+ if ($version < 2.2) {
+ carp "rl_unbind_function() is not supported. Ignored\n";
+ return;
+ }
+ if (defined $_[1]) {
+ return _rl_unbind_function($_[0], _str2map($_[1]));
+ } else {
+ return _rl_unbind_function($_[0]);
+ }
+}
+
+# rl_unbind_command
+sub unbind_command ($;$) {
+ my ($version) = $Attribs{library_version}
+ =~ /(\d+\.\d+)/;
+ if ($version < 2.2) {
+ carp "rl_unbind_command() is not supported. Ignored\n";
+ return;
+ }
+ if (defined $_[1]) {
+ return _rl_unbind_command($_[0], _str2map($_[1]));
+ } else {
+ return _rl_unbind_command($_[0]);
+ }
+}
+
+sub rl_set_key ($$;$) {
+ my ($version) = $Attribs{library_version}
+ =~ /(\d+\.\d+)/;
+ if ($version < 4.2) {
+ carp "rl_set_key() is not supported. Ignored\n";
+ return;
+ }
+ if (defined $_[2]) {
+ return _rl_set_key($_[0], _str2fn($_[1]), _str2map($_[2]));
+ } else {
+ return _rl_set_key($_[0], _str2fn($_[1]));
+ }
+}
+
+sub rl_macro_bind ($$;$) {
+ my ($version) = $Attribs{library_version}
+ =~ /(\d+\.\d+)/;
+ if (defined $_[2]) {
+ return _rl_macro_bind($_[0], $_[1], _str2map($_[2]));
+ } else {
+ return _rl_macro_bind($_[0], $_[1]);
+ }
+}
+
+sub rl_generic_bind ($$$;$) {
+ if ($_[0] == Term::ReadLine::Gnu::ISFUNC) {
+ if (defined $_[3]) {
+ _rl_generic_bind_function($_[1], _str2fn($_[2]), _str2map($_[3]));
+ } else {
+ _rl_generic_bind_function($_[1], _str2fn($_[2]));
+ }
+ } elsif ($_[0] == Term::ReadLine::Gnu::ISKMAP) {
+ if (defined $_[3]) {
+ _rl_generic_bind_keymap($_[1], _str2map($_[2]), _str2map($_[3]));
+ } else {
+ _rl_generic_bind_keymap($_[1], _str2map($_[2]));
+ }
+ } elsif ($_[0] == Term::ReadLine::Gnu::ISMACR) {
+ if (defined $_[3]) {
+ _rl_generic_bind_macro($_[1], $_[2], _str2map($_[3]));
+ } else {
+ _rl_generic_bind_macro($_[1], $_[2]);
+ }
+ } else {
+ carp("Term::ReadLine::Gnu::rl_generic_bind: invalid \`type\'\n");
+ }
+}
+
+sub rl_call_function ($;$$) {
+ if (defined $_[2]) {
+ return _rl_call_function(_str2fn($_[0]), $_[1], $_[2]);
+ } elsif (defined $_[1]) {
+ return _rl_call_function(_str2fn($_[0]), $_[1]);
+ } else {
+ return _rl_call_function(_str2fn($_[0]));
+ }
+}
+
+sub rl_invoking_keyseqs ($;$) {
+ if (defined $_[1]) {
+ return _rl_invoking_keyseqs(_str2fn($_[0]), _str2map($_[1]));
+ } else {
+ return _rl_invoking_keyseqs(_str2fn($_[0]));
+ }
+}
+
+sub rl_add_funmap_entry ($$) {
+ my ($version) = $Attribs{library_version}
+ =~ /(\d+\.\d+)/;
+ if ($version < 4.2) {
+ carp "rl_add_funmap_entry() is not supported. Ignored\n";
+ return;
+ }
+ return _rl_add_funmap_entry($_[0], _str2fn($_[1]));
+}
+
+sub rl_tty_set_default_bindings (;$) {
+ if (defined $_[0]) {
+ return _rl_tty_set_defaut_bindings(_str2map($_[1]));
+ } else {
+ return _rl_tty_set_defaut_bindings();
+ }
+}
+
+sub rl_message {
+ my $fmt = shift;
+ my $line = sprintf($fmt, @_);
+ _rl_message($line);
+}
+
+sub rl_completion_mode {
+ # libreadline.* in Debian GNU/Linux 2.0 tells wrong value as '2.1-bash'
+ my ($version) = $Attribs{library_version}
+ =~ /(\d+\.\d+)/;
+ if ($version < 4.3) {
+ carp "rl_completion_mode() is not supported. Ignored\n";
+ return;
+ }
+ return _rl_completion_mode(_str2fn($_[0]));
+}
+
+#
+# for compatibility with Term::ReadLine::Perl
+#
+sub rl_filename_list {
+ my ($text) = @_;
+
+ # lcd : lowest common denominator
+ my ($lcd, @matches) = rl_completion_matches($text,
+ \&rl_filename_completion_function);
+ return @matches ? @matches : $lcd;
+}
+
+#
+# History Library function wrappers
+#
+# history_list
+sub hist_list () {
+ my ($i, $history_base, $history_length, @d);
+ $history_base = $Attribs{history_base};
+ $history_length = $Attribs{history_length};
+ for ($i = $history_base; $i < $history_base + $history_length; $i++) {
+ push(@d, history_get($i));
+ }
+ @d;
+}
+
+# history_arg_extract
+sub hist_arg_extract ( ;$$$ ) {
+ my ($line, $first, $last) = @_;
+ $line = $_ unless defined $line;
+ $first = 0 unless defined $first;
+ $last = ord '$' unless defined $last; # '
+ $first = ord '$' if defined $first and $first eq '$'; # '
+ $last = ord '$' if defined $last and $last eq '$'; # '
+ &_history_arg_extract($line, $first, $last);
+}
+
+sub get_history_event ( $$;$ ) {
+ _get_history_event($_[0], $_[1], defined $_[2] ? ord $_[2] : 0);
+}
+
+#
+# Ornaments
+#
+
+# This routine originates in Term::ReadLine.pm.
+
+# Debian GNU/Linux discourages users from using /etc/termcap. A
+# subroutine ornaments() defined in Term::ReadLine.pm uses
+# Term::Caps.pm which requires /etc/termcap.
+
+# This module calls termcap (or its compatible) library, which the GNU
+# Readline Library already uses, instead of Term::Caps.pm.
+
+# Some terminals do not support 'ue' (underline end).
+use vars qw(%term_no_ue);
+%term_no_ue = ( kterm => 1 );
+
+sub ornaments {
+ return $rl_term_set unless @_;
+ $rl_term_set = shift;
+ $rl_term_set ||= ',,,';
+ $rl_term_set = $term_no_ue{$ENV{TERM}} ? 'us,me,,' : 'us,ue,,'
+ if $rl_term_set eq '1';
+ my @ts = split /,/, $rl_term_set, 4;
+ my @rl_term_set
+ = map {
+ # non-printing characters must be informed to readline
+ my $t;
+ ($_ and $t = tgetstr($_))
+ ? (Term::ReadLine::Gnu::RL_PROMPT_START_IGNORE
+ . $t
+ . Term::ReadLine::Gnu::RL_PROMPT_END_IGNORE)
+ : '';
+ } @ts;
+ $Attribs{term_set} = \@rl_term_set;
+ return $rl_term_set;
+}
+
+#
+# a sample custom function
+#
+
+# The equivalent of the Bash shell M-^ history-expand-line editing
+# command.
+
+# This routine was borrowed from bash.
+sub history_expand_line {
+ my ($count, $key) = @_;
+ my ($expanded, $new_line) = history_expand($Attribs{line_buffer});
+ if ($expanded > 0) {
+ rl_modifying(0, $Attribs{end}); # save undo information
+ $Attribs{line_buffer} = $new_line;
+ } elsif ($expanded < 0) {
+ my $OUT = $Attribs{outstream};
+ print $OUT "\n$new_line\n";
+ rl_on_new_line();
+ } # $expanded == 0 : no change
+}
+
+# The equivalent of the Korn shell C-o operate-and-get-next-history-line
+# editing command.
+
+# This routine was borrowed from bash.
+sub operate_and_get_next {
+ my ($count, $key) = @_;
+
+ my $saved_history_line_to_use = -1;
+ my $old_rl_startup_hook;
+
+ # Accept the current line.
+ rl_call_function('accept-line', 1, $key);
+
+ # Find the current line, and find the next line to use. */
+ my $where = where_history();
+ if ((history_is_stifled()
+ && ($Attribs{history_length} >= $Attribs{max_input_history}))
+ || ($where >= $Attribs{history_length} - 1)) {
+ $saved_history_line_to_use = $where;
+ } else {
+ $saved_history_line_to_use = $where + 1;
+ }
+ $old_rl_startup_hook = $Attribs{startup_hook};
+ $Attribs{startup_hook} = sub {
+ if ($saved_history_line_to_use >= 0) {
+ rl_call_function('previous-history',
+ $Attribs{history_length}
+ - $saved_history_line_to_use,
+ 0);
+ $Attribs{startup_hook} = $old_rl_startup_hook;
+ $saved_history_line_to_use = -1;
+ }
+ };
+}
+
+sub display_readline_version { # show version
+ my($count, $key) = @_; # ignored in this function
+ my $OUT = $Attribs{outstream};
+ print $OUT
+ ("\nTerm::ReadLine::Gnu version: $Term::ReadLine::Gnu::VERSION");
+ print $OUT
+ ("\nGNU Readline Library version: $Attribs{library_version}\n");
+ rl_on_new_line();
+}
+
+# sample function of rl_message()
+sub change_ornaments {
+ my($count, $key) = @_; # ignored in this function
+ rl_save_prompt;
+ rl_message("[S]tandout, [U]nderlining, [B]old, [R]everse, [V]isible bell: ");
+ my $c = chr rl_read_key;
+ if ($c =~ /s/i) {
+ ornaments('so,me,,');
+ } elsif ($c =~ /u/i) {
+ ornaments('us,me,,');
+ } elsif ($c =~ /b/i) {
+ ornaments('md,me,,');
+ } elsif ($c =~ /r/i) {
+ ornaments('mr,me,,');
+ } elsif ($c =~ /v/i) {
+ ornaments('vb,,,');
+ } else {
+ rl_ding;
+ }
+ rl_restore_prompt;
+ rl_clear_message;
+}
+
+#
+# for tkRunning
+#
+sub Tk_getc {
+ &Term::ReadLine::Tk::Tk_loop
+ if $Term::ReadLine::toloop && defined &Tk::DoOneEvent;
+ my $FILE = $Attribs{instream};
+ return rl_getc($FILE);
+}
+
+# redisplay function for secret input like password
+# usage:
+# $a->{redisplay_function} = $a->{shadow_redisplay};
+# $line = $t->readline("password> ");
+sub shadow_redisplay {
+ @_tstrs = _tgetstrs() unless $_tstrs_init;
+ # remove prompt start/end mark from prompt string
+ my $prompt = $Attribs{prompt}; my $s;
+ $s = Term::ReadLine::Gnu::RL_PROMPT_START_IGNORE; $prompt =~ s/$s//g;
+ $s = Term::ReadLine::Gnu::RL_PROMPT_END_IGNORE; $prompt =~ s/$s//g;
+ my $OUT = $Attribs{outstream};
+ my $oldfh = select($OUT); $| = 1; select($oldfh);
+ print $OUT ($_tstrs[0], # carriage return
+ $_tstrs[1], # clear to EOL
+ $prompt, '*' x length($Attribs{line_buffer}));
+ print $OUT ($_tstrs[2] # cursor left
+ x (length($Attribs{line_buffer}) - $Attribs{point}));
+ $oldfh = select($OUT); $| = 0; select($oldfh);
+}
+
+sub _tgetstrs {
+ my @s = (tgetstr('cr'), # carriage return
+ tgetstr('ce'), # clear to EOL
+ tgetstr('le')); # cursor left
+ warn <<"EOM" unless (defined($s[0]) && defined($s[1]) && defined($s[2]));
+Your terminal 'TERM=$ENV{TERM}' does not support enough function.
+Check if your environment variable 'TERM' is set correctly.
+EOM
+ # suppress warning "Use of uninitialized value in print at ..."
+ $s[0] = $s[0] || ''; $s[1] = $s[1] || ''; $s[2] = $s[2] || '';
+ $_tstrs_init = 1;
+ return @s;
+}
+
+# callback handler wrapper function for CallbackHandlerInstall method
+sub _ch_wrapper {
+ my $line = shift;
+
+ if (defined $line) {
+ if ($Attribs{do_expand}) {
+ my $result;
+ ($result, $line) = history_expand($line);
+ my $outstream = $Attribs{outstream};
+ print $outstream "$line\n" if ($result);
+
+ # return without adding line into history
+ if ($result < 0 || $result == 2) {
+ return ''; # don't return `undef' which means EOF.
+ }
+ }
+
+ # add to history buffer
+ add_history($line)
+ if ($Attribs{MinLength} > 0
+ && length($line) >= $Attribs{MinLength});
+ }
+ &{$Attribs{_callback_handler}}($line);
+}
+
+#
+# List Completion Function
+#
+sub list_completion_function ( $$ ) {
+ my($text, $state) = @_;
+
+ $_i = $state ? $_i + 1 : 0; # clear counter at the first call
+ my $cw = $Attribs{completion_word};
+ for (; $_i <= $#{$cw}; $_i++) {
+ return $cw->[$_i] if ($cw->[$_i] =~ /^\Q$text/);
+ }
+ return undef;
+}
+
+#
+# wrapper completion function of 'completion_function'
+# for compatibility with Term::ReadLine::Perl
+#
+sub _trp_completion_function ( $$ ) {
+ my($text, $state) = @_;
+
+ my $cf;
+ return undef unless defined ($cf = $Attribs{completion_function});
+
+ if ($state) {
+ $_i++;
+ } else {
+ # the first call
+ $_i = 0; # clear index
+ @_matches = &$cf($text,
+ $Attribs{line_buffer},
+ $Attribs{point} - length($text));
+ # return here since $#_matches is 0 instead of -1 when
+ # @_matches = undef
+ return undef unless defined $_matches[0];
+ }
+
+ for (; $_i <= $#_matches; $_i++) {
+ return $_matches[$_i] if ($_matches[$_i] =~ /^\Q$text/);
+ }
+ return undef;
+}
+
+1;
+
+__END__
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu/XS.pm
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu/euc_jp.pm
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu/euc_jp.pm 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu/euc_jp.pm 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,187 @@
+#!/usr/local/bin/perl
+#
+# euc_jp.pm : EUC Japanese Character Support Functions
+# This modules is experimental. API may be changed.
+#
+# $Id: euc_jp.pm,v 1.2 2001-04-22 22:35:41+09 hayashi Exp $
+#
+# Copyright (c) 2001 Hiroo Hayashi. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+
+package Term::ReadLine::Gnu::XS;
+
+use Carp;
+use strict;
+
+# make aliases
+use vars qw(%Attribs);
+*Attribs = \%Term::ReadLine::Gnu::Attribs;
+
+# enable Meta
+rl_prep_terminal(1);
+
+rl_add_defun('euc-jp-forward', \&ej_forward);
+rl_add_defun('euc-jp-backward', \&ej_backward);
+rl_add_defun('euc-jp-backward-delete-char', \&ej_rubout);
+rl_add_defun('euc-jp-delete-char', \&ej_delete);
+rl_add_defun('euc-jp-forward-backward-delete-char', \&ej_rubout_or_delete);
+rl_add_defun('euc-jp-transpose-chars', \&ej_transpose_chars);
+
+rl_bind_key(ord "\cf", 'euc-jp-forward');
+rl_bind_key(ord "\cb", 'euc-jp-backward');
+rl_bind_key(ord "\ch", 'euc-jp-backward-delete-char');
+#rl_bind_key(ord "\cd", 'euc-jp-delete-char');
+rl_bind_key(ord "\cd", 'euc-jp-forward-backward-delete-char');
+rl_bind_key(ord "\ct", 'euc-jp-transpose-chars');
+
+1;
+
+# An EUC Japanese character consists of two 8 bit characters.
+# And the MSBs (most significant bit) of both bytes are set.
+
+# To support Shift-JIS charactor set the following two functions
+# must be extended.
+sub ej_first_byte_p {
+ my ($p) = @_;
+ my $l = $Attribs{line_buffer};
+ return substr($l, $p, 1) =~ /[\x80-\xff]/
+ && substr($l, 0, $p) =~ /^([\x00-x7f]|([\x80-\xff][\x80-\xff]))*$/;
+}
+
+sub ej_second_byte_p {
+ my ($p) = @_;
+ my $l = $Attribs{line_buffer};
+ return $p > 0 && substr($l, $p, 1) =~ /[\x80-\xff]/
+ && substr($l, 0, $p) !~ /^([\x00-x7f]|([\x80-\xff][\x80-\xff]))*$/;
+}
+
+#forward-char
+sub ej_forward {
+ my($count, $key) = @_;
+ if ($count < 0) {
+ ej_backward(-$count, $key);
+ } else {
+ while ($count--) {
+ if (ej_first_byte_p($Attribs{point})) {
+ rl_call_function('forward-char', 2, $key);
+ } else {
+ rl_call_function('forward-char', 1, $key);
+ }
+ }
+ }
+ return 0;
+}
+
+#backward-char
+sub ej_backward {
+ my($count, $key) = @_;
+ if ($count < 0) {
+ ej_forward(-$count, $key);
+ } else {
+ while ($count--) {
+ if (ej_second_byte_p($Attribs{point})) {
+ rl_call_function('backward-char', 1, $key);
+ }
+ if (ej_second_byte_p($Attribs{point} - 1)) {
+ rl_call_function('backward-char', 2, $key);
+ } else {
+ rl_call_function('backward-char', 1, $key);
+ }
+ }
+ }
+ return 0;
+}
+
+#backward-delete-char
+sub ej_rubout {
+ my($count, $key) = @_;
+ if ($count < 0) {
+ ej_delete(-$count, $key);
+ } else {
+ if ($Attribs{point} <= 0) {
+ rl_ding();
+ return 1;
+ }
+ while ($count--) {
+ if (ej_second_byte_p($Attribs{point})) {
+ $Attribs{point}--;
+ }
+ if (ej_second_byte_p($Attribs{point} - 1)) {
+ rl_call_function('backward-delete-char', 2, $key);
+ } else {
+ rl_call_function('backward-delete-char', 1, $key);
+ }
+ }
+ }
+ return 0;
+}
+
+#delete-char
+sub ej_delete {
+ my($count, $key) = @_;
+ if ($count < 0) {
+ ej_rubout(-$count, $key);
+ } else {
+ while ($count--) {
+ if (ej_first_byte_p($Attribs{point})) {
+ rl_call_function('delete-char', 2, $key);
+ } elsif (ej_second_byte_p($Attribs{point})) {
+ rl_call_function('backward-delete-char', 1, $key);
+ rl_call_function('delete-char', 1, $key);
+ } else {
+ rl_call_function('delete-char', 1, $key);
+ }
+ }
+ }
+ return 0;
+}
+
+#forward-backward-delete-char
+sub ej_rubout_or_delete {
+ my($count, $key) = @_;
+ if ($Attribs{end} != 0 && $Attribs{point} == $Attribs{end}) {
+ return ej_rubout($count, $key);
+ } else {
+ return ej_delete($count, $key);
+ }
+}
+
+#transpose-chars
+sub ej_transpose_chars {
+ my($count, $key) = @_;
+
+ return 0 unless $count;
+
+ if (ej_second_byte_p($Attribs{point})) {
+ $Attribs{point}--;
+ }
+ if ($Attribs{point} == 0 # the beginning of the line
+ || ($Attribs{end} < 2) # only one ascii char
+ # only one EUC char
+ || ($Attribs{end} == 2 && ej_first_byte_p(0))) {
+ rl_ding();
+ return -1;
+ }
+ rl_begin_undo_group();
+ if ($Attribs{point} == $Attribs{end}) {
+ # If point is at the end of the line
+ ej_backward(1, $key);
+ $count = 1;
+ }
+ ej_backward(1, $key);
+ my $dummy;
+ if (ej_first_byte_p($Attribs{point})) {
+ $dummy = substr($Attribs{line_buffer}, $Attribs{point}, 2);
+ rl_delete_text($Attribs{point}, $Attribs{point} + 2);
+ } else {
+ $dummy = substr($Attribs{line_buffer}, $Attribs{point}, 1);
+ rl_delete_text($Attribs{point}, $Attribs{point} + 1);
+ }
+ ej_forward($count, $key);
+ rl_insert_text($dummy);
+ rl_end_undo_group();
+ return 0;
+}
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu/euc_jp.pm
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu.pm
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu.pm 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu.pm 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,1858 @@
+#
+# Gnu.pm --- The GNU Readline/History Library wrapper module
+#
+# $Id: Gnu.pm,v 1.92 2003-03-16 20:29:39-05 hiroo Exp $
+#
+# Copyright (c) 2001 Hiroo Hayashi. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+# Some of documentation strings in this file are cited from the
+# GNU Readline/History Library Manual.
+
+package Term::ReadLine::Gnu;
+
+=head1 NAME
+
+Term::ReadLine::Gnu - Perl extension for the GNU Readline/History Library
+
+=head1 SYNOPSIS
+
+ use Term::ReadLine;
+ $term = new Term::ReadLine 'ProgramName';
+ while ( defined ($_ = $term->readline('prompt>')) ) {
+ ...
+ }
+
+=head1 DESCRIPTION
+
+=head2 Overview
+
+This is an implementation of Term::ReadLine using the GNU
+Readline/History Library.
+
+For basic functions object oriented interface is provided. These are
+described in the section L<"Standard Methods"|"Standard Methods"> and
+L<"C<Term::ReadLine::Gnu> Functions"|"C<Term::ReadLine::Gnu> Functions">.
+
+This package also has the interface with the almost all functions and
+variables which are documented in the GNU Readline/History Library
+Manual. They are documented in the section
+L<"C<Term::ReadLine::Gnu> Functions"|"C<Term::ReadLine::Gnu> Functions">
+and
+L<"C<Term::ReadLine::Gnu> Variables"|"C<Term::ReadLine::Gnu> Variables">
+briefly. For more detail of the GNU Readline/History Library, see
+'GNU Readline Library Manual' and 'GNU History Library Manual'.
+
+The sample programs under C<eg/> directory and test programs under
+C<t/> directory in the C<Term::ReadLine::Gnu> distribution include
+many example of this module.
+
+=head2 Standard Methods
+
+These methods are standard methods defined by B<Term::ReadLine>.
+
+=cut
+
+use strict;
+use Carp;
+
+{
+ use Exporter ();
+ use DynaLoader;
+ use vars qw($VERSION @ISA @EXPORT_OK);
+
+ $VERSION = '1.14';
+
+ # Term::ReadLine::Gnu::AU makes a function in
+ # `Term::ReadLine::Gnu::XS' as a method.
+ # The namespace of Term::ReadLine::Gnu::AU is searched before ones
+ # of other classes
+ @ISA = qw(Term::ReadLine::Gnu::AU Term::ReadLine::Stub
+ Exporter DynaLoader);
+
+ @EXPORT_OK = qw(RL_PROMPT_START_IGNORE RL_PROMPT_END_IGNORE
+ NO_MATCH SINGLE_MATCH MULT_MATCH
+ ISFUNC ISKMAP ISMACR
+ UNDO_DELETE UNDO_INSERT UNDO_BEGIN UNDO_END
+ RL_STATE_NONE RL_STATE_INITIALIZING
+ RL_STATE_INITIALIZED RL_STATE_TERMPREPPED
+ RL_STATE_READCMD RL_STATE_METANEXT
+ RL_STATE_DISPATCHING RL_STATE_MOREINPUT
+ RL_STATE_ISEARCH RL_STATE_NSEARCH
+ RL_STATE_SEARCH RL_STATE_NUMERICARG
+ RL_STATE_MACROINPUT RL_STATE_MACRODEF
+ RL_STATE_OVERWRITE RL_STATE_COMPLETING
+ RL_STATE_SIGHANDLER RL_STATE_UNDOING
+ RL_STATE_DONE);
+
+ bootstrap Term::ReadLine::Gnu $VERSION; # DynaLoader
+}
+require Term::ReadLine::Gnu::XS;
+
+# Global Variables
+
+use vars qw(%Attribs %Features);
+
+# Each variable in the GNU Readline Library is tied to an entry of
+# this hash (%Attribs). By accessing the hash entry, you can read
+# and/or write the variable in the GNU Readline Library. See the
+# package definition of Term::ReadLine::Gnu::Var and following code
+# for more details.
+
+# Normal (non-tied) entries
+%Attribs = (
+ MinLength => 1,
+ do_expand => 0,
+ completion_word => [],
+ term_set => ['', '', '', ''],
+ );
+%Features = (
+ appname => 1, minline => 1, autohistory => 1,
+ getHistory => 1, setHistory => 1, addHistory => 1,
+ readHistory => 1, writeHistory => 1,
+ preput => 1, attribs => 1, newTTY => 1,
+ tkRunning => Term::ReadLine::Stub->Features->{'tkRunning'},
+ ornaments => Term::ReadLine::Stub->Features->{'ornaments'},
+ stiflehistory => 1,
+ );
+
+sub Attribs { \%Attribs; }
+sub Features { \%Features; }
+
+#
+# GNU Readline/History Library constant definition
+# These are included in @EXPORT_OK.
+
+# I can define these variables in XS code to use the value defined in
+# readline.h, etc. But it needs some calling convention change and
+# will cause compatiblity problem. I hope the definition of these
+# constant value will not be changed.
+
+# for non-printing characters in prompt string
+sub RL_PROMPT_START_IGNORE { "\001"; }
+sub RL_PROMPT_END_IGNORE { "\002"; }
+
+# for rl_filename_quoting_function
+sub NO_MATCH { 0; }
+sub SINGLE_MATCH { 1; }
+sub MULT_MATCH { 2; }
+
+# for rl_generic_bind, rl_function_of_keyseq
+sub ISFUNC { 0; }
+sub ISKMAP { 1; }
+sub ISMACR { 2; }
+
+# for rl_add_undo
+sub UNDO_DELETE { 0; }
+sub UNDO_INSERT { 1; }
+sub UNDO_BEGIN { 2; }
+sub UNDO_END { 3; }
+
+# for rl_readline_state
+sub RL_STATE_NONE { 0x00000; } # no state; before first call
+sub RL_STATE_INITIALIZING { 0x00001; } # initializing
+sub RL_STATE_INITIALIZED { 0x00002; } # initialization done
+sub RL_STATE_TERMPREPPED { 0x00004; } # terminal is prepped
+sub RL_STATE_READCMD { 0x00008; } # reading a command key
+sub RL_STATE_METANEXT { 0x00010; } # reading input after ESC
+sub RL_STATE_DISPATCHING { 0x00020; } # dispatching to a command
+sub RL_STATE_MOREINPUT { 0x00040; } # reading more input in a command function
+sub RL_STATE_ISEARCH { 0x00080; } # doing incremental search
+sub RL_STATE_NSEARCH { 0x00100; } # doing non-inc search
+sub RL_STATE_SEARCH { 0x00200; } # doing a history search
+sub RL_STATE_NUMERICARG { 0x00400; } # reading numeric argument
+sub RL_STATE_MACROINPUT { 0x00800; } # getting input from a macro
+sub RL_STATE_MACRODEF { 0x01000; } # defining keyboard macro
+sub RL_STATE_OVERWRITE { 0x02000; } # overwrite mode
+sub RL_STATE_COMPLETING { 0x04000; } # doing completion
+sub RL_STATE_SIGHANDLER { 0x08000; } # in readline sighandler
+sub RL_STATE_UNDOING { 0x10000; } # doing an undo
+sub RL_STATE_DONE { 0x80000; } # done; accepted line
+
+#
+# Methods Definition
+#
+
+=over 4
+
+=item C<ReadLine>
+
+returns the actual package that executes the commands. If you have
+installed this package, possible value is C<Term::ReadLine::Gnu>.
+
+=cut
+
+sub ReadLine { 'Term::ReadLine::Gnu'; }
+
+=item C<new(NAME,[IN[,OUT]])>
+
+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> file handles. These arguments
+should be globs.
+
+=cut
+
+# The origin of this function is Term::ReadLine::Perl.pm by Ilya Zakharevich.
+sub new {
+ my $this = shift; # Package
+ my $class = ref($this) || $this;
+
+ my $name = shift;
+
+ my $self = \%Attribs;
+ bless $self, $class;
+
+ # set rl_readline_name before .inputrc is read in rl_initialize()
+ $Attribs{readline_name} = $name;
+
+ # some version of Perl cause segmentation fault, if XS module
+ # calls setenv() before the 1st assignment to $ENV{}.
+ $ENV{_TRL_DUMMY} = '';
+
+ # initialize the GNU Readline Library and termcap library
+ $self->initialize();
+
+ # enable ornaments to be compatible with perl5.004_05(?)
+ unless ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/) {
+ local $^W = 0; # Term::ReadLine is not warning flag free
+ # Without the next line Term::ReadLine::Stub::ornaments is used.
+ # Why does Term::ReadLine::Gnu::AU selects it at first?!!!
+ # If you know why this happens, please let me know. Thanks.
+ undef &Term::ReadLine::Gnu::ornaments;
+ $self->ornaments(1);
+ }
+
+ if (!@_) {
+ my ($IN,$OUT) = $self->findConsole();
+ open(IN,"<$IN") || croak "Cannot open $IN for read";
+ open(OUT,">$OUT") || croak "Cannot open $OUT for write";
+ # borrowed from Term/ReadLine.pm
+ my $sel = select(OUT);
+ $| = 1; # for DB::OUT
+ select($sel);
+ $Attribs{instream} = \*IN;
+ $Attribs{outstream} = \*OUT;
+ } else {
+ $Attribs{instream} = shift;
+ $Attribs{outstream} = shift;
+ }
+
+ $self;
+}
+
+sub DESTROY {}
+
+=item C<readline(PROMPT[,PREPUT])>
+
+gets an input line, with actual C<GNU Readline> support. Trailing
+newline is removed. Returns C<undef> on C<EOF>. C<PREPUT> is an
+optional argument meaning the initial value of input.
+
+The optional argument C<PREPUT> is granted only if the value C<preput>
+is in C<Features>.
+
+C<PROMPT> may include some escape sequences. Use
+C<RL_PROMPT_START_IGNORE> to begin a sequence of non-printing
+characters, and C<RL_PROMPT_END_IGNORE> to end of such a sequence.
+
+=cut
+
+# to peacify -w
+$Term::ReadLine::registered = $Term::ReadLine::registered;
+
+sub readline { # should be ReadLine
+ my $self = shift;
+ my ($prompt, $preput) = @_;
+
+ # ornament support (now prompt only)
+ $prompt = ${$Attribs{term_set}}[0] . $prompt . ${$Attribs{term_set}}[1];
+
+ # `completion_function' support for compatibility with
+ # Term:ReadLine::Perl. Prefer $completion_entry_function, since a
+ # program which uses $completion_entry_function should know
+ # Term::ReadLine::Gnu and have better completion function using
+ # the variable.
+ $Attribs{completion_entry_function} = $Attribs{_trp_completion_function}
+ if (!defined $Attribs{completion_entry_function}
+ && defined $Attribs{completion_function});
+
+ # TkRunning support
+ if (not $Term::ReadLine::registered and $Term::ReadLine::toloop
+ and defined &Tk::DoOneEvent) {
+ $self->register_Tk;
+ $Attribs{getc_function} = $Attribs{Tk_getc};
+ }
+
+ # call readline()
+ my $line;
+ if (defined $preput) {
+ my $saved_startup_hook = $Attribs{startup_hook};
+ $Attribs{startup_hook} = sub {
+ $self->rl_insert_text($preput);
+ &$saved_startup_hook
+ if defined $saved_startup_hook;
+ };
+ $line = $self->rl_readline($prompt);
+ $Attribs{startup_hook} = $saved_startup_hook;
+ } else {
+ $line = $self->rl_readline($prompt);
+ }
+ return undef unless defined $line;
+
+ # history expansion
+ if ($Attribs{do_expand}) {
+ my $result;
+ ($result, $line) = $self->history_expand($line);
+ my $outstream = $Attribs{outstream};
+ print $outstream "$line\n" if ($result);
+
+ # return without adding line into history
+ if ($result < 0 || $result == 2) {
+ return ''; # don't return `undef' which means EOF.
+ }
+ }
+
+ # add to history buffer
+ $self->add_history($line)
+ if (defined $self->{MinLength} && $self->{MinLength} > 0
+ && length($line) >= $self->{MinLength});
+
+ return $line;
+}
+
+=item C<AddHistory(LINE1, LINE2, ...)>
+
+adds the lines to the history of input, from where it can be used if
+the actual C<readline> is present.
+
+=cut
+
+use vars '*addhistory';
+*addhistory = \&AddHistory; # for backward compatibility
+
+sub AddHistory {
+ my $self = shift;
+ foreach (@_) {
+ $self->add_history($_);
+ }
+}
+
+=item C<IN>, C<OUT>
+
+return the file handles for input and output or C<undef> if
+C<readline> input and output cannot be used for Perl.
+
+=cut
+
+sub IN { $Attribs{instream}; }
+sub OUT { $Attribs{outstream}; }
+
+=item C<MinLine([MAX])>
+
+If argument C<MAX> 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.
+
+=cut
+
+sub MinLine {
+ my $self = shift;
+ my $old_minlength = $self->{MinLength};
+ $self->{MinLength} = shift;
+ $old_minlength;
+}
+
+# findConsole is defined in ReadLine.pm.
+
+=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 C<Attribs>
+
+returns a reference to a hash which describes internal configuration
+(variables) of the package. Names of keys in this hash conform to
+standard conventions with the leading C<rl_> stripped.
+
+See section "Variables" for supported variables.
+
+=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.
+C<preput> means the second argument to C<readline> method is processed.
+C<getHistory> and C<setHistory> denote that the corresponding methods are
+present. C<tkRunning> denotes that a Tk application may run while ReadLine
+is getting input.
+
+=cut
+
+# Not tested yet. How do I use this?
+sub newTTY {
+ my ($self, $in, $out) = @_;
+ $Attribs{instream} = $in;
+ $Attribs{outstream} = $out;
+ my $sel = select($out);
+ $| = 1; # for DB::OUT
+ select($sel);
+}
+
+=back
+
+=cut
+
+# documented later
+sub CallbackHandlerInstall {
+ my $self = shift;
+ my ($prompt, $lhandler) = @_;
+
+ $Attribs{_callback_handler} = $lhandler;
+
+ # ornament support (now prompt only)
+ $prompt = ${$Attribs{term_set}}[0] . $prompt . ${$Attribs{term_set}}[1];
+
+ $Attribs{completion_entry_function} = $Attribs{_trp_completion_function}
+ if (!defined $Attribs{completion_entry_function}
+ && defined $Attribs{completion_function});
+
+ $self->rl_callback_handler_install($prompt,
+ \&Term::ReadLine::Gnu::XS::_ch_wrapper);
+}
+
+
+#
+# Additional Supported Methods
+#
+
+# Documentation is after '__END__' for efficiency.
+
+# for backward compatibility
+use vars qw(*AddDefun *BindKey *UnbindKey *ParseAndBind *StifleHistory);
+*AddDefun = \&add_defun;
+*BindKey = \&bind_key;
+*UnbindKey = \&unbind_key;
+*ParseAndBind = \&parse_and_bind;
+*StifleHistory = \&stifle_history;
+
+sub SetHistory {
+ my $self = shift;
+ $self->clear_history();
+ $self->AddHistory(@_);
+}
+
+sub GetHistory {
+ my $self = shift;
+ $self->history_list();
+}
+
+sub ReadHistory {
+ my $self = shift;
+ ! $self->read_history_range(@_);
+}
+
+sub WriteHistory {
+ my $self = shift;
+ ! $self->write_history(@_);
+}
+
+#
+# Access Routines for GNU Readline/History Library Variables
+#
+package Term::ReadLine::Gnu::Var;
+use Carp;
+use strict;
+use vars qw(%_rl_vars);
+
+%_rl_vars
+ = (
+ rl_line_buffer => ['S', 0],
+ rl_prompt => ['S', 1],
+ rl_library_version => ['S', 2],
+ rl_terminal_name => ['S', 3],
+ rl_readline_name => ['S', 4],
+ rl_basic_word_break_characters => ['S', 5],
+ rl_basic_quote_characters => ['S', 6],
+ rl_completer_word_break_characters => ['S', 7],
+ rl_completer_quote_characters => ['S', 8],
+ rl_filename_quote_characters => ['S', 9],
+ rl_special_prefixes => ['S', 10],
+ history_no_expand_chars => ['S', 11],
+ history_search_delimiter_chars => ['S', 12],
+ rl_executing_macro => ['S', 13], # GRL4.2
+ history_word_delimiters => ['S', 14], # GRL4.2
+
+ rl_point => ['I', 0],
+ rl_end => ['I', 1],
+ rl_mark => ['I', 2],
+ rl_done => ['I', 3],
+ rl_pending_input => ['I', 4],
+ rl_completion_query_items => ['I', 5],
+ rl_completion_append_character => ['C', 6],
+ rl_ignore_completion_duplicates => ['I', 7],
+ rl_filename_completion_desired => ['I', 8],
+ rl_filename_quoting_desired => ['I', 9],
+ rl_inhibit_completion => ['I', 10],
+ history_base => ['I', 11],
+ history_length => ['I', 12],
+ history_max_entries => ['I', 13],
+ max_input_history => ['I', 13], # before GRL 4.2
+ history_expansion_char => ['C', 14],
+ history_subst_char => ['C', 15],
+ history_comment_char => ['C', 16],
+ history_quotes_inhibit_expansion => ['I', 17],
+ rl_erase_empty_line => ['I', 18], # GRL 4.0
+ rl_catch_signals => ['I', 19], # GRL 4.0
+ rl_catch_sigwinch => ['I', 20], # GRL 4.0
+ rl_already_prompted => ['I', 21], # GRL 4.1
+ rl_num_chars_to_read => ['I', 22], # GRL 4.2
+ rl_dispatching => ['I', 23], # GRL 4.2
+ rl_gnu_readline_p => ['I', 24], # GRL 4.2
+ rl_readline_state => ['I', 25], # GRL 4.2
+ rl_explicit_arg => ['I', 26], # GRL 4.2
+ rl_numeric_arg => ['I', 27], # GRL 4.2
+ rl_editing_mode => ['I', 28], # GRL 4.2
+ rl_attempted_completion_over => ['I', 29], # GRL 4.2
+ rl_completion_type => ['I', 30], # GRL 4.2
+ rl_readline_version => ['I', 31], # GRL 4.2a
+ rl_completion_suppress_append => ['I', 32], # GRL 4.3
+ rl_completion_mark_symlink_dirs => ['I', 33], # GRL 4.3
+
+ rl_startup_hook => ['F', 0],
+ rl_event_hook => ['F', 1],
+ rl_getc_function => ['F', 2],
+ rl_redisplay_function => ['F', 3],
+ rl_completion_entry_function => ['F', 4],
+ rl_attempted_completion_function => ['F', 5],
+ rl_filename_quoting_function => ['F', 6],
+ rl_filename_dequoting_function => ['F', 7],
+ rl_char_is_quoted_p => ['F', 8],
+ rl_ignore_some_completions_function => ['F', 9],
+ rl_directory_completion_hook => ['F', 10],
+ history_inhibit_expansion_function => ['F', 11],
+ rl_pre_input_hook => ['F', 12], # GRL 4.0
+ rl_completion_display_matches_hook => ['F', 13], # GRL 4.0
+ rl_prep_term_function => ['F', 14], # GRL 4.2
+ rl_deprep_term_function => ['F', 15], # GRL 4.2
+
+ rl_instream => ['IO', 0],
+ rl_outstream => ['IO', 1],
+
+ rl_executing_keymap => ['K', 0],
+ rl_binding_keymap => ['K', 1],
+
+ rl_last_func => ['LF', 0],
+ );
+
+sub TIESCALAR {
+ my $class = shift;
+ my $name = shift;
+ return bless \$name, $class;
+}
+
+sub FETCH {
+ my $self = shift;
+ confess "wrong type" unless ref $self;
+
+ my $name = $$self;
+ if (! defined $_rl_vars{$name}) {
+ confess "Term::ReadLine::Gnu::Var::FETCH: Unknown variable name `$name'\n";
+ return undef ;
+ }
+
+ my ($type, $id) = @{$_rl_vars{$name}};
+ if ($type eq 'S') {
+ return _rl_fetch_str($id);
+ } elsif ($type eq 'I') {
+ return _rl_fetch_int($id);
+ } elsif ($type eq 'C') {
+ return chr(_rl_fetch_int($id));
+ } elsif ($type eq 'F') {
+ return _rl_fetch_function($id);
+ } elsif ($type eq 'IO') {
+ return _rl_fetch_iostream($id);
+ } elsif ($type eq 'K') {
+ return _rl_fetch_keymap($id);
+ } elsif ($type eq 'LF') {
+ return _rl_fetch_last_func();
+ } else {
+ carp "Term::ReadLine::Gnu::Var::FETCH: Illegal type `$type'\n";
+ return undef;
+ }
+}
+
+sub STORE {
+ my $self = shift;
+ confess "wrong type" unless ref $self;
+
+ my $name = $$self;
+ if (! defined $_rl_vars{$name}) {
+ confess "Term::ReadLine::Gnu::Var::STORE: Unknown variable name `$name'\n";
+ return undef ;
+ }
+
+ my $value = shift;
+ my ($type, $id) = @{$_rl_vars{$name}};
+ if ($type eq 'S') {
+ if ($name eq 'rl_line_buffer') {
+ return _rl_store_rl_line_buffer($value);
+ } else {
+ return _rl_store_str($value, $id);
+ }
+ } elsif ($type eq 'I') {
+ return _rl_store_int($value, $id);
+ } elsif ($type eq 'C') {
+ return chr(_rl_store_int(ord($value), $id));
+ } elsif ($type eq 'F') {
+ return _rl_store_function($value, $id);
+ } elsif ($type eq 'IO') {
+ return _rl_store_iostream($value, $id);
+ } elsif ($type eq 'K' || $type eq 'LF') {
+ carp "Term::ReadLine::Gnu::Var::STORE: read only variable `$name'\n";
+ return undef;
+ } else {
+ carp "Term::ReadLine::Gnu::Var::STORE: Illegal type `$type'\n";
+ return undef;
+ }
+}
+
+package Term::ReadLine::Gnu;
+use Carp;
+use strict;
+
+#
+# set value of %Attribs
+#
+
+# Tie all Readline/History variables
+foreach (keys %Term::ReadLine::Gnu::Var::_rl_vars) {
+ my $name;
+ ($name = $_) =~ s/^rl_//; # strip leading `rl_'
+ tie $Attribs{$name}, 'Term::ReadLine::Gnu::Var', $_;
+}
+
+# add reference to some functions
+{
+ my ($name, $fname);
+ no strict 'refs'; # allow symbolic reference
+ map {
+ ($name = $_) =~ s/^rl_//; # strip leading `rl_'
+ $fname = 'Term::ReadLine::Gnu::XS::' . $_;
+ $Attribs{$name} = \&$fname; # symbolic reference
+ } qw(rl_getc
+ rl_redisplay
+ rl_callback_read_char
+ rl_display_match_list
+ rl_filename_completion_function
+ rl_username_completion_function
+ list_completion_function
+ _trp_completion_function);
+ # auto-split subroutine cannot be processed in the map loop above
+ use strict 'refs';
+ $Attribs{shadow_redisplay} = \&Term::ReadLine::Gnu::XS::shadow_redisplay;
+ $Attribs{Tk_getc} = \&Term::ReadLine::Gnu::XS::Tk_getc;
+ $Attribs{list_completion_function} = \&Term::ReadLine::Gnu::XS::list_completion_function;
+}
+
+package Term::ReadLine::Gnu::AU;
+use Carp;
+no strict qw(refs vars);
+
+sub AUTOLOAD {
+ { $AUTOLOAD =~ s/.*:://; } # preserve match data
+ my $name;
+ if (exists $Term::ReadLine::Gnu::XS::{"rl_$AUTOLOAD"}) {
+ $name = "Term::ReadLine::Gnu::XS::rl_$AUTOLOAD";
+ } elsif (exists $Term::ReadLine::Gnu::XS::{"$AUTOLOAD"}) {
+ $name = "Term::ReadLine::Gnu::XS::$AUTOLOAD";
+ } else {
+ croak "Cannot do `$AUTOLOAD' in Term::ReadLine::Gnu";
+ }
+ local $^W = 0; # Why is this line necessary ?
+ *$AUTOLOAD = sub { shift; &$name(@_); };
+ goto &$AUTOLOAD;
+}
+1;
+__END__
+
+
+=head2 C<Term::ReadLine::Gnu> Functions
+
+All these GNU Readline/History Library functions are callable via
+method interface and have names which conform to standard conventions
+with the leading C<rl_> stripped.
+
+Almost methods have lower level functions in
+C<Term::ReadLine::Gnu::XS> package. To use them full qualified name
+is required. Using method interface is preferred.
+
+=over 4
+
+=item Readline Convenience Functions
+
+=over 4
+
+=item Naming Function
+
+=over 4
+
+=item C<add_defun(NAME, FUNC [,KEY=-1])>
+
+Add name to the Perl function C<FUNC>. If optional argument C<KEY> is
+specified, bind it to the C<FUNC>. Returns reference to
+C<FunctionPtr>.
+
+ Example:
+ # name name `reverse-line' to a function reverse_line(),
+ # and bind it to "\C-t"
+ $term->add_defun('reverse-line', \&reverse_line, ord "\ct");
+
+=back
+
+=item Selecting a Keymap
+
+=over 4
+
+=item C<make_bare_keymap>
+
+ Keymap rl_make_bare_keymap()
+
+=item C<copy_keymap(MAP)>
+
+ Keymap rl_copy_keymap(Keymap|str map)
+
+=item C<make_keymap>
+
+ Keymap rl_make_keymap()
+
+=item C<discard_keymap(MAP)>
+
+ Keymap rl_discard_keymap(Keymap|str map)
+
+=item C<get_keymap>
+
+ Keymap rl_get_keymap()
+
+=item C<set_keymap(MAP)>
+
+ Keymap rl_set_keymap(Keymap|str map)
+
+=item C<get_keymap_by_name(NAME)>
+
+ Keymap rl_get_keymap_by_name(str name)
+
+=item C<get_keymap_name(MAP)>
+
+ str rl_get_keymap_name(Keymap map)
+
+=back
+
+=item Binding Keys
+
+=over 4
+
+=item C<bind_key(KEY, FUNCTION [,MAP])>
+
+ int rl_bind_key(int key, FunctionPtr|str function,
+ Keymap|str map = rl_get_keymap())
+
+Bind C<KEY> to the C<FUNCTION>. C<FUNCTION> is the name added by the
+C<add_defun> method. If optional argument C<MAP> is specified, binds
+in C<MAP>. Returns non-zero in case of error.
+
+=item C<unbind_key(KEY [,MAP])>
+
+ int rl_unbind_key(int key, Keymap|str map = rl_get_keymap())
+
+Bind C<KEY> to the null function. Returns non-zero in case of error.
+
+=item C<unbind_function(FUNCTION [,MAP])>
+
+ int rl_unbind_function(FunctionPtr|str function,
+ Keymap|str map = rl_get_keymap())
+
+=item C<unbind_command(COMMAND [,MAP])>
+
+ int rl_unbind_command(str command,
+ Keymap|str map = rl_get_keymap())
+
+=item C<set_key(KEYSEQ, FUNCTION [,MAP])>
+
+ int rl_set_key(str keyseq, FunctionPtr|str function,
+ Keymap|str map = rl_get_keymap())
+
+=item C<generic_bind(TYPE, KEYSEQ, DATA, [,MAP])>
+
+ int rl_generic_bind(int type, str keyseq,
+ FunctionPtr|Keymap|str data,
+ Keymap|str map = rl_get_keymap())
+
+=item C<parse_and_bind(LINE)>
+
+ void rl_parse_and_bind(str line)
+
+Parse C<LINE> as if it had been read from the F<~/.inputrc> file and
+perform any key bindings and variable assignments found. For more
+detail see 'GNU Readline Library Manual'.
+
+=item C<read_init_file([FILENAME])>
+
+ int rl_read_init_file(str filename = '~/.inputrc')
+
+=back
+
+=item Associating Function Names and Bindings
+
+=over 4
+
+=item C<named_function(NAME)>
+
+ FunctionPtr rl_named_function(str name)
+
+=item C<get_function_name(FUNCTION)>
+
+ str rl_get_function_name(FunctionPtr function)
+
+=item C<function_of_keyseq(KEYMAP [,MAP])>
+
+ (FunctionPtr|Keymap|str data, int type)
+ rl_function_of_keyseq(str keyseq,
+ Keymap|str map = rl_get_keymap())
+
+=item C<invoking_keyseqs(FUNCTION [,MAP])>
+
+ (@str) rl_invoking_keyseqs(FunctionPtr|str function,
+ Keymap|str map = rl_get_keymap())
+
+=item C<function_dumper([READABLE])>
+
+ void rl_function_dumper(int readable = 0)
+
+=item C<list_funmap_names>
+
+ void rl_list_funmap_names()
+
+=item C<funmap_names>
+
+ (@str) rl_funmap_names()
+
+=item C<add_funmap_entry(NAME, FUNCTION)>
+
+ int rl_add_funmap_entry(char *name, FunctionPtr|str function)
+
+=back
+
+=item Allowing Undoing
+
+=over 4
+
+=item C<begin_undo_group>
+
+ int rl_begin_undo_group()
+
+=item C<end_undo_group>
+
+ int rl_end_undo_group()
+
+=item C<add_undo(WHAT, START, END, TEXT)>
+
+ int rl_add_undo(int what, int start, int end, str text)
+
+=item C<free_undo_list>
+
+ void rl_free_undo_list()
+
+=item C<do_undo>
+
+ int rl_do_undo()
+
+=item C<modifying([START [,END]])>
+
+ int rl_modifying(int start = 0, int end = rl_end)
+
+=back
+
+=item Redisplay
+
+=over 4
+
+=item C<redisplay>
+
+ void rl_redisplay()
+
+=item C<forced_update_display>
+
+ int rl_forced_update_display()
+
+=item C<on_new_line>
+
+ int rl_on_new_line()
+
+=item C<on_new_line_with_prompt>
+
+ int rl_on_new_line_with_prompt() # GRL 4.1
+
+=item C<reset_line_state>
+
+ int rl_reset_line_state()
+
+=item C<rl_show_char(C)>
+
+ int rl_show_char(int c)
+
+=item C<message(FMT[, ...])>
+
+ int rl_message(str fmt, ...)
+
+=item C<crlf>
+
+ int rl_crlf() # GRL 4.2
+
+=item C<clear_message>
+
+ int rl_clear_message()
+
+=item C<save_prompt>
+
+ void rl_save_prompt()
+
+=item C<restore_prompt>
+
+ void rl_restore_prompt()
+
+=item C<expand_prompt(PROMPT)>
+
+ int rl_expand_prompt(str prompt) # GRL 4.2
+
+=item C<set_prompt(PROMPT)>
+
+ int rl_set_prompt(const str prompt) # GRL 4.2
+
+=back
+
+=item Modifying Text
+
+=over 4
+
+=item C<insert_text(TEXT)>
+
+ int rl_insert_text(str text)
+
+=item C<delete_text([START [,END]])>
+
+ int rl_delete_text(int start = 0, int end = rl_end)
+
+=item C<copy_text([START [,END]])>
+
+ str rl_copy_text(int start = 0, int end = rl_end)
+
+=item C<kill_text([START [,END]])>
+
+ int rl_kill_text(int start = 0, int end = rl_end)
+
+=item C<push_macro_input(MACRO)>
+
+ int rl_push_macro_input(str macro)
+
+=back
+
+=item Character Input
+
+=over 4
+
+=item C<read_key>
+
+ int rl_read_key()
+
+=item C<getc(STREAM)>
+
+ int rl_getc(FILE *STREAM)
+
+=item C<stuff_char(C)>
+
+ int rl_stuff_char(int c)
+
+=item C<execute_next(C)>
+
+ int rl_execute_next(int c) # GRL 4.2
+
+=item C<clear_pending_input()>
+
+ int rl_clear_pending_input() # GRL 4.2
+
+=item C<set_keyboard_input_timeout(uSEC)>
+
+ int rl_set_keyboard_input_timeout(int usec) # GRL 4.2
+
+=back
+
+=item Terminal Management
+
+=over 4
+
+=item C<prep_terminal(META_FLAG)>
+
+ void rl_prep_terminal(int META_FLAG) # GRL 4.2
+
+=item C<deprep_terminal()>
+
+ void rl_deprep_terminal() # GRL 4.2
+
+=item C<tty_set_default_bindings(KMAP)>
+
+ void rl_tty_set_default_bindings([Keymap KMAP]) # GRL 4.2
+
+=item C<reset_terminal([TERMINAL_NAME])>
+
+ int rl_reset_terminal(str terminal_name = getenv($TERM)) # GRL 4.2
+
+=back
+
+=item Utility Functions
+
+=over 4
+
+=item C<replace_line(TEXT [,CLEAR_UNDO]>
+
+ int rl_replace_line(str text, int clear_undo) # GRL 4.3
+
+=item C<initialize>
+
+ int rl_initialize()
+
+=item C<ding>
+
+ int rl_ding()
+
+=item C<alphabetic(C)>
+
+ int rl_alphabetic(int C)
+
+=item C<display_match_list(MATCHES [,LEN [,MAX]])>
+
+ void rl_display_match_list(\@matches, len = $#maches, max) # GRL 4.0
+
+Since the first element of an array @matches as treated as a possible
+completion, it is not displayed. See the descriptions of
+C<completion_matches()>.
+
+When C<MAX> is ommited, the max length of an item in @matches is used.
+
+=back
+
+=item Miscellaneous Functions
+
+=over 4
+
+=item C<macro_bind(KEYSEQ, MACRO [,MAP])>
+
+ int rl_macro_bind(const str keyseq, const str macro, Keymap map)
+
+=item C<macro_dumper(READABLE)>
+
+ int rl_macro_dumper(int readline)
+
+=item C<variable_bind(VARIABLE, VALUE)>
+
+ int rl_variable_bind(const str variable, const str value)
+
+=item C<variable_dumper(READABLE)>
+
+ int rl_variable_dumper(int readline)
+
+=item C<set_paren_blink_timeout(uSEC)>
+
+ int rl_set_paren_blink_timeout(usec) # GRL 4.2
+
+=item C<get_termcap(cap)>
+
+ str rl_get_termcap(cap)
+
+=back
+
+=item Alternate Interface
+
+=over 4
+
+=item C<callback_handler_install(PROMPT, LHANDLER)>
+
+ void rl_callback_handler_install(str prompt, pfunc lhandler)
+
+=item C<callback_read_char>
+
+ void rl_callback_read_char()
+
+=item C<callback_handler_remove>
+
+ void rl_callback_handler_remove()
+
+=back
+
+=back
+
+=item Readline Signal Handling
+
+=over 4
+
+=item C<cleanup_after_signal>
+
+ void rl_cleanup_after_signal() # GRL 4.0
+
+=item C<free_line_state>
+
+ void rl_free_line_state() # GRL 4.0
+
+=item C<reset_after_signal>
+
+ void rl_reset_after_signal() # GRL 4.0
+
+=item C<resize_terminal>
+
+ void rl_resize_terminal() # GRL 4.0
+
+=item C<set_screen_size(ROWS, COLS)>
+
+ void rl_set_screen_size(int ROWS, int COLS) # GRL 4.2
+
+=item C<get_screen_size()>
+
+ (int rows, int cols) rl_get_screen_size() # GRL 4.2
+
+=item C<set_signals>
+
+ int rl_set_signals() # GRL 4.0
+
+=item C<clear_signals>
+
+ int rl_clear_signals() # GRL 4.0
+
+=back
+
+=item Completion Functions
+
+=over 4
+
+=item C<complete_internal([WHAT_TO_DO])>
+
+ int rl_complete_internal(int what_to_do = TAB)
+
+=item C<completion_mode(FUNCTION)>
+
+ int rl_completion_mode(FunctionPtr|str function)
+
+=item C<completion_matches(TEXT [,FUNC])>
+
+ (@str) rl_completion_matches(str text,
+ pfunc func = filename_completion_function)
+
+=item C<filename_completion_function(TEXT, STATE)>
+
+ str rl_filename_completion_function(str text, int state)
+
+=item C<username_completion_function(TEXT, STATE)>
+
+ str rl_username_completion_function(str text, int state)
+
+=item C<list_completion_function(TEXT, STATE)>
+
+ str list_completion_function(str text, int state)
+
+=back
+
+=item History Functions
+
+=over 4
+
+=item Initializing History and State Management
+
+=over 4
+
+=item C<using_history>
+
+ void using_history()
+
+=back
+
+=item History List Management
+
+=over 4
+
+=item C<addhistory(STRING[, STRING, ...])>
+
+ void add_history(str string)
+
+=item C<StifleHistory(MAX)>
+
+ int stifle_history(int max|undef)
+
+stifles the history list, remembering only the last C<MAX> entries.
+If C<MAX> is undef, remembers all entries. This is a replacement
+of unstifle_history().
+
+=item C<unstifle_history>
+
+ int unstifle_history()
+
+This is equivalent with 'stifle_history(undef)'.
+
+=item C<SetHistory(LINE1 [, LINE2, ...])>
+
+sets the history of input, from where it can be used if the actual
+C<readline> is present.
+
+=item C<remove_history(WHICH)>
+
+ str remove_history(int which)
+
+=item C<replace_history_entry(WHICH, LINE)>
+
+ str replace_history_entry(int which, str line)
+
+=item C<clear_history>
+
+ void clear_history()
+
+=item C<history_is_stifled>
+
+ int history_is_stifled()
+
+=back
+
+=item Information About the History List
+
+=over 4
+
+=item C<where_history>
+
+ int where_history()
+
+=item C<current_history>
+
+ str current_history()
+
+=item C<history_get(OFFSET)>
+
+ str history_get(offset)
+
+=item C<history_total_bytes>
+
+ int history_total_bytes()
+
+=item C<GetHistory>
+
+returns the history of input as a list, if actual C<readline> is present.
+
+=back
+
+=item Moving Around the History List
+
+=over 4
+
+=item C<history_set_pos(POS)>
+
+ int history_set_pos(int pos)
+
+=item C<previous_history>
+
+ str previous_history()
+
+=item C<next_history>
+
+ str next_history()
+
+=back
+
+=item Searching the History List
+
+=over 4
+
+=item C<history_search(STRING [,DIRECTION])>
+
+ int history_search(str string, int direction = -1)
+
+=item C<history_search_prefix(STRING [,DIRECTION])>
+
+ int history_search_prefix(str string, int direction = -1)
+
+=item C<history_search_pos(STRING [,DIRECTION [,POS]])>
+
+ int history_search_pos(str string,
+ int direction = -1,
+ int pos = where_history())
+
+=back
+
+=item Managing the History File
+
+=over 4
+
+=item C<ReadHistory([FILENAME [,FROM [,TO]]])>
+
+ int read_history(str filename = '~/.history',
+ int from = 0, int to = -1)
+
+ int read_history_range(str filename = '~/.history',
+ int from = 0, int to = -1)
+
+adds the contents of C<FILENAME> to the history list, a line at a
+time. If C<FILENAME> is false, then read from F<~/.history>. Start
+reading at line C<FROM> and end at C<TO>. If C<FROM> is omitted or
+zero, start at the beginning. If C<TO> is omitted or less than
+C<FROM>, then read until the end of the file. Returns true if
+successful, or false if not. C<read_history()> is an aliase of
+C<read_history_range()>.
+
+=item C<WriteHistory([FILENAME])>
+
+ int write_history(str filename = '~/.history')
+
+writes the current history to C<FILENAME>, overwriting C<FILENAME> if
+necessary. If C<FILENAME> is false, then write the history list to
+F<~/.history>. Returns true if successful, or false if not.
+
+
+=item C<append_history(NELEMENTS [,FILENAME])>
+
+ int append_history(int nelements, str filename = '~/.history')
+
+=item C<history_truncate_file([FILENAME [,NLINES]])>
+
+ int history_truncate_file(str filename = '~/.history',
+ int nlines = 0)
+
+=back
+
+=item History Expansion
+
+=over 4
+
+=item C<history_expand(LINE)>
+
+ (int result, str expansion) history_expand(str line)
+
+Note that this function returns C<expansion> in scalar context.
+
+=item C<get_history_event(STRING, CINDEX [,QCHAR])>
+
+ (str text, int cindex) = get_history_event(str string,
+ int cindex,
+ char qchar = '\0')
+
+=item C<history_tokenize(LINE)>
+
+ (@str) history_tokenize(str line)
+
+=item C<history_arg_extract(LINE, [FIRST [,LAST]])>
+
+ str history_arg_extract(str line, int first = 0, int last = '$')
+
+=back
+
+=back
+
+=back
+
+=head2 C<Term::ReadLine::Gnu> Variables
+
+Following GNU Readline/History Library variables can be accessed from
+Perl program. See 'GNU Readline Library Manual' and ' GNU History
+Library Manual' for each variable. You can access them with
+C<Attribs> methods. Names of keys in this hash conform to standard
+conventions with the leading C<rl_> stripped.
+
+Examples:
+
+ $attribs = $term->Attribs;
+ $v = $attribs->{library_version}; # rl_library_version
+ $v = $attribs->{history_base}; # history_base
+
+=over 4
+
+=item Readline Variables
+
+ str rl_line_buffer
+ int rl_point
+ int rl_end
+ int rl_mark
+ int rl_done
+ int rl_num_chars_to_read (GRL 4.2)
+ int rl_pending_input
+ int rl_dispatching (GRL 4.2)
+ int rl_erase_empty_line (GRL 4.0)
+ str rl_prompt (read only)
+ int rl_already_prompted (GRL 4.1)
+ str rl_library_version (read only)
+ int rl_readline_version (read only)
+ int rl_gnu_readline_p (GRL 4.2)
+ str rl_terminal_name
+ str rl_readline_name
+ filehandle rl_instream
+ filehandle rl_outstream
+ pfunc rl_startup_hook
+ pfunc rl_pre_input_hook (GRL 4.0)
+ pfunc rl_event_hook
+ pfunc rl_getc_function
+ pfunc rl_redisplay_function
+ pfunc rl_prep_term_function (GRL 4.2)
+ pfunc rl_deprep_term_function (GRL 4.2)
+ pfunc rl_last_func (GRL 4.2)
+ Keymap rl_executing_keymap (read only)
+ Keymap rl_binding_keymap (read only)
+ str rl_executing_macro (GRL 4.2)
+ int rl_readline_state (GRL 4.2)
+ int rl_explicit_arg (GRL 4.2)
+ int rl_numeric_arg (GRL 4.2)
+ int rl_editing_mode (GRL 4.2)
+
+=item Signal Handling Variables
+
+ int rl_catch_signals (GRL 4.0)
+ int rl_catch_sigwinch (GRL 4.0)
+
+=item Completion Variables
+
+ pfunc rl_completion_entry_function
+ pfunc rl_attempted_completion_function
+ pfunc rl_filename_quoting_function
+ pfunc rl_filename_dequoting_function
+ pfunc rl_char_is_quoted_p
+ int rl_completion_query_items
+ str rl_basic_word_break_characters
+ str rl_basic_quote_characters
+ str rl_completer_word_break_characters
+ str rl_completer_quote_characters
+ str rl_filename_quote_characters
+ str rl_special_prefixes
+ int rl_completion_append_character
+ int rl_completion_suppress_append (GRL 4.3)
+ int rl_completion_mark_symlink_dirs (GRL 4.3)
+ int rl_ignore_completion_duplicates
+ int rl_filename_completion_desired
+ int rl_filename_quoting_desired
+ int rl_attempted_completion_over (GRL 4.2)
+ int rl_completion_type (GRL 4.2)
+ int rl_inhibit_completion
+ pfunc rl_ignore_some_completion_function
+ pfunc rl_directory_completion_hook
+ pfunc rl_completion_display_matches_hook (GRL 4.0)
+
+=item History Variables
+
+ int history_base
+ int history_length
+ int history_max_entries (called `max_input_history'. read only)
+ char history_expansion_char
+ char history_subst_char
+ char history_comment_char
+ str history_word_delimiters (GRL 4.2)
+ str history_no_expand_chars
+ str history_search_delimiter_chars
+ int history_quotes_inhibit_expansion
+ pfunc history_inhibit_expansion_function
+
+=item Function References
+
+ rl_getc
+ rl_redisplay
+ rl_callback_read_char
+ rl_display_match_list
+ rl_filename_completion_function
+ rl_username_completion_function
+ list_completion_function
+ shadow_redisplay
+ Tk_getc
+
+=back
+
+=head2 Custom Completion
+
+In this section variables and functions for custom completion is
+described with examples.
+
+Most of descriptions in this section is cited from GNU Readline
+Library manual.
+
+=over 4
+
+=item C<rl_completion_entry_function>
+
+This variable holds reference refers to a generator function for
+C<completion_matches()>.
+
+A generator function is called repeatedly from
+C<completion_matches()>, returning a string each time. The arguments
+to the generator function are C<TEXT> and C<STATE>. C<TEXT> is the
+partial word to be completed. C<STATE> is zero the first time the
+function is called, allowing the generator to perform any necessary
+initialization, and a positive non-zero integer for each subsequent
+call. When the generator function returns C<undef> this signals
+C<completion_matches()> that there are no more possibilities left.
+
+If the value is undef, built-in C<filename_completion_function> is
+used.
+
+A sample generator function, C<list_completion_function>, is defined
+in Gnu.pm. You can use it as follows;
+
+ use Term::ReadLine;
+ ...
+ my $term = new Term::ReadLine 'sample';
+ my $attribs = $term->Attribs;
+ ...
+ $attribs->{completion_entry_function} =
+ $attribs->{list_completion_function};
+ ...
+ $attribs->{completion_word} =
+ [qw(reference to a list of words which you want to use for completion)];
+ $term->readline("custom completion>");
+
+See also C<completion_matches>.
+
+=item C<rl_attempted_completion_function>
+
+A reference to an alternative function to create matches.
+
+The function is called with C<TEXT>, C<LINE_BUFFER>, C<START>, and
+C<END>. C<LINE_BUFFER> is a current input buffer string. C<START>
+and C<END> are indices in C<LINE_BUFFER> saying what the boundaries of
+C<TEXT> are.
+
+If this function exists and returns null list or C<undef>, or if this
+variable is set to C<undef>, then an internal function
+C<rl_complete()> will call the value of
+C<$rl_completion_entry_function> to generate matches, otherwise the
+array of strings returned will be used.
+
+The default value of this variable is C<undef>. You can use it as follows;
+
+ use Term::ReadLine;
+ ...
+ my $term = new Term::ReadLine 'sample';
+ my $attribs = $term->Attribs;
+ ...
+ sub sample_completion {
+ my ($text, $line, $start, $end) = @_;
+ # If first word then username completion, else filename completion
+ if (substr($line, 0, $start) =~ /^\s*$/) {
+ return $term->completion_matches($text,
+ $attribs->{'username_completion_function'});
+ } else {
+ return ();
+ }
+ }
+ ...
+ $attribs->{attempted_completion_function} = \&sample_completion;
+
+=item C<completion_matches(TEXT, ENTRY_FUNC)>
+
+Returns an array of strings which is a list of completions for
+C<TEXT>. If there are no completions, returns C<undef>. The first
+entry in the returned array is the substitution for C<TEXT>. The
+remaining entries are the possible completions.
+
+C<ENTRY_FUNC> is a generator function which has two arguments, and
+returns a string. The first argument is C<TEXT>. The second is a
+state argument; it is zero on the first call, and non-zero on
+subsequent calls. C<ENTRY_FUNC> returns a C<undef> to the caller when
+there are no more matches.
+
+If the value of C<ENTRY_FUNC> is undef, built-in
+C<filename_completion_function> is used.
+
+C<completion_matches> is a Perl wrapper function of an internal
+function C<completion_matches()>. See also
+C<$rl_completion_entry_function>.
+
+=item C<completion_function>
+
+A variable whose content is a reference to a function which returns a
+list of candidates to complete.
+
+This variable is compatible with C<Term::ReadLine::Perl> and very easy
+to use.
+
+ use Term::ReadLine;
+ ...
+ my $term = new Term::ReadLine 'sample';
+ my $attribs = $term->Attribs;
+ ...
+ $attribs->{completion_function} = sub {
+ my ($text, $line, $start) = @_;
+ return qw(a list of candidates to complete);
+ }
+
+=item C<list_completion_function(TEXT, STATE)>
+
+A sample generator function defined by C<Term::ReadLine::Gnu>.
+Example code at C<rl_completion_entry_function> shows how to use this
+function.
+
+=back
+
+=head2 C<Term::ReadLine::Gnu> Specific Features
+
+=over 4
+
+=item C<Term::ReadLine::Gnu> Specific Functions
+
+=over 4
+
+=item C<CallbackHandlerInstall(PROMPT, LHANDLER)>
+
+This method provides the function C<rl_callback_handler_install()>
+with the following addtional feature compatible with C<readline>
+method; ornament feature, C<Term::ReadLine::Perl> compatible
+completion function, histroy expansion, and addition to history
+buffer.
+
+=item C<call_function(FUNCTION, [COUNT [,KEY]])>
+
+ int rl_call_function(FunctionPtr|str function, count = 1, key = -1)
+
+=item C<rl_get_all_function_names>
+
+Returns a list of all function names.
+
+=item C<shadow_redisplay>
+
+A redisplay function for password input. You can use it as follows;
+
+ $attribs->{redisplay_function} = $attribs->{shadow_redisplay};
+ $line = $term->readline("password> ");
+
+=item C<rl_filename_list>
+
+Returns candidates of filename to complete. This function can be used
+with C<completion_function> and is implemented for the compatibility
+with C<Term::ReadLine::Perl>.
+
+=item C<list_completion_function>
+
+See the description of section L<"Custom Completion"|"Custom Completion">.
+
+=back
+
+=item C<Term::ReadLine::Gnu> Specific Variables
+
+=over 4
+
+=item C<do_expand>
+
+When true, the history expansion is enabled. By default false.
+
+=item C<completion_function>
+
+See the description of section L<"Custom Completion"|"Custom Completion">.
+
+=item C<completion_word>
+
+A reference to a list of candidates to complete for
+C<list_completion_function>.
+
+=back
+
+=item C<Term::ReadLine::Gnu> Specific Commands
+
+=over 4
+
+=item C<history-expand-line>
+
+The equivalent of the Bash C<history-expand-line> editing command.
+
+=item C<operate-and-get-next>
+
+The equivalent of the Korn shell C<operate-and-get-next-history-line>
+editing command and the Bash C<operate-and-get-next>.
+
+This command is bound to C<\C-o> by default for the compatibility with
+the Bash and C<Term::ReadLine::Perl>.
+
+=item C<display-readline-version>
+
+Shows the version of C<Term::ReadLine::Gnu> and the one of the GNU
+Readline Library.
+
+=item C<change-ornaments>
+
+Change ornaments interactively.
+
+=back
+
+=back
+
+=head1 FILES
+
+=over 4
+
+=item F<~/.inputrc>
+
+Readline init file. Using this file it is possible that you would
+like to use a different set of key bindings. When a program which
+uses the Readline library starts up, the init file is read, and the
+key bindings are set.
+
+Conditional key binding is also available. The program name which is
+specified by the first argument of C<new> method is used as the
+application construct.
+
+For example, when your program call C<new> method like this;
+
+ ...
+ $term = new Term::ReadLine 'PerlSh';
+ ...
+
+your F<~/.inputrc> can define key bindings only for it as follows;
+
+ ...
+ $if PerlSh
+ Meta-Rubout: backward-kill-word
+ "\C-x\C-r": re-read-init-file
+ "\e[11~": "Function Key 1"
+ $endif
+ ...
+
+=back
+
+=head1 EXPORTS
+
+None.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item GNU Readline Library Manual
+
+=item GNU History Library Manual
+
+=item C<Term::ReadLine>
+
+=item C<Term::ReadLine::Perl> (Term-ReadLine-Perl-xx.tar.gz)
+
+=item F<eg/*> and F<t/*> in the Term::ReadLine::Gnu distribution
+
+=item Articles related to Term::ReadLine::Gnu
+
+=over 4
+
+=item effective perl programming
+
+ http://www.usenix.org/publications/login/2000-7/features/effective.html
+
+This article demonstrates how to integrate Term::ReadLine::Gnu into an
+interactive command line program.
+
+=item eijiro (Japanese)
+
+ http://bulknews.net/lib/columns/02_eijiro/column.html
+
+A command line interface to Eijiro, Japanese-English dictionary
+service on WWW.
+
+
+=back
+
+=item Works which use Term::ReadLine::Gnu
+
+=over 4
+
+=item Perl Debugger
+
+ perl -d
+
+=item The Perl Shell (psh)
+
+ http://www.focusresearch.com/gregor/psh/
+
+The Perl Shell is a shell that combines the interactive nature of a
+Unix shell with the power of Perl.
+
+A programmable completion feature compatible with bash is implemented.
+
+=item SPP (Synopsys Plus Perl)
+
+ http://www.stanford.edu/~jsolomon/SPP/
+
+SPP (Synopsys Plus Perl) is a Perl module that wraps around Synopsys'
+shell programs. SPP is inspired by the original dc_perl written by
+Steve Golson, but it's an entirely new implementation. Why is it
+called SPP and not dc_perl? Well, SPP was written to wrap around any
+of Synopsys' shells.
+
+=item PFM (Personal File Manager for Unix/Linux)
+
+ http://p-f-m.sourceforge.net/
+
+Pfm is a terminal-based file manager written in Perl, based on PFM.COM
+for MS-DOS (originally by Paul Culley and Henk de Heer).
+
+=item The soundgrab
+
+ http://rawrec.sourceforge.net/soundgrab/soundgrab.html
+
+soundgrab is designed to help you slice up a big long raw audio file
+(by default 44.1 kHz 2 channel signed sixteen bit little endian) and
+save your favorite sections to other files. It does this by providing
+you with a cassette player like command line interface.
+
+=item PDL (The Perl Data Language)
+
+ http://pdl.perl.org/index_en.html
+
+PDL (``Perl Data Language'') gives standard Perl the ability to
+compactly store and speedily manipulate the large N-dimensional data
+arrays which are the bread and butter of scientific computing.
+
+=item PIQT (Perl Interactive DBI Query Tool)
+
+ http://piqt.sourceforge.net/
+
+PIQT is an interactive query tool using the Perl DBI database
+interface. It supports ReadLine, provides a built in scripting language
+with a Lisp like syntax, an online help system, and uses wrappers to
+interface to the DBD modules.
+
+=item Ghostscript Shell
+
+ http://www.panix.com/~jdf/gshell/
+
+It provides a friendly way to play with the Ghostscript interpreter,
+including command history and auto-completion of Postscript font names
+and reserved words.
+
+=back
+
+If you know any other works which can be listed here, please let me
+know.
+
+=back
+
+=head1 AUTHOR
+
+Hiroo Hayashi C<E<lt>hiroo.hayashi at computer.orgE<gt>>
+
+C<http://www.perl.org/CPAN/authors/Hiroo_HAYASHI/>
+
+=head1 TODO
+
+GTK+ support in addition to Tk.
+
+=head1 BUGS
+
+C<rl_add_defun()> can define up to 16 functions.
+
+Ornament feature works only on prompt strings. It requires very hard
+hacking of C<display.c:rl_redisplay()> in GNU Readline library to
+ornament input line.
+
+C<newTTY()> is not tested yet.
+
+=cut
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu.pm
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu.xs
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu.xs 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu.xs 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,2644 @@
+/*
+ * Gnu.xs --- GNU Readline wrapper module
+ *
+ * $Id: Gnu.xs,v 1.104 2003-03-16 20:25:27-05 hiroo Exp $
+ *
+ * Copyright (c) 2002 Hiroo Hayashi. All rights reserved.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the same terms as Perl itself.
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "ppport.h"
+#ifdef __cplusplus
+}
+#endif
+
+#include <stdio.h>
+#ifdef __CYGWIN__
+#include <sys/termios.h>
+#endif /* __CYGWIN__ */
+#include <readline/readline.h>
+#include <readline/history.h>
+
+/*
+ * Perl 5.005 requires an ANSI C Compiler. Good news.
+ * But I should still support legacy C compilers now.
+ */
+/* Adapted from BSD /usr/include/sys/cdefs.h. */
+#if defined (__STDC__)
+# if !defined (PARAMS)
+# define PARAMS(protos) protos
+# endif
+#else /* !__STDC__ */
+# if !defined (PARAMS)
+# define PARAMS(protos) ()
+# endif
+#endif /* !__STDC__ */
+
+typedef char * t_xstr; /* string which must be xfreeed */
+
+/*
+ * compatibility definitions
+ */
+
+/* rl_last_func() is defined in rlprivate.h */
+extern Function *rl_last_func;
+
+/* features introduced by GNU Readline 4.0 */
+#if (RL_VERSION_MAJOR < 4)
+extern void rl_extend_line_buffer PARAMS((int));
+extern char **rl_funmap_names PARAMS((void));
+
+static int rl_erase_empty_line = 0;
+static int rl_catch_signals = 1;
+static int rl_catch_sigwinch = 1;
+static Function *rl_pre_input_hook;
+static VFunction *rl_completion_display_matches_hook;
+static VFunction *rl_prep_term_function;
+static VFunction *rl_deprep_term_function;
+
+static void rl_cleanup_after_signal(){};
+static void rl_free_line_state(){};
+static void rl_reset_after_signal(){};
+static void rl_resize_terminal(){};
+static void rl_prep_terminal(){};
+static void rl_deprep_terminal(){};
+/*
+ * Before GNU Readline Library Version 4.0, rl_save_prompt() was
+ * _rl_save_prompt and rl_restore_prompt() was _rl_restore_prompt().
+ */
+extern void _rl_save_prompt PARAMS((void));
+extern void _rl_restore_prompt PARAMS((void));
+static void rl_save_prompt() { _rl_save_prompt(); }
+static void rl_restore_prompt() { _rl_restore_prompt(); }
+#endif /* (RL_VERSION_MAJOR < 4) */
+
+/* features introduced by GNU Readline 4.1 */
+#if (RL_READLINE_VERSION < 0x0401)
+static int rl_already_prompted = 0;
+static int rl_num_chars_to_read = 0;
+static int rl_gnu_readline_p = 0;
+#endif /* (RL_READLINE_VERSION < 0x0401) */
+
+/* features introduced by GNU Readline 4.2 */
+#if (RL_READLINE_VERSION < 0x0402)
+/* Provide backwards-compatible entry points for old function names
+ which are rename from readline-4.2. */
+typedef int rl_command_func_t PARAMS((int, int));
+typedef char *rl_compentry_func_t PARAMS((const char *, int));
+
+static char *rl_executing_macro = NULL;
+static int rl_explicit_arg = 0;
+static int rl_numeric_arg = 0;
+static int rl_editing_mode = 0;
+static int rl_readline_state = 0;
+static Function *rl_directory_rewrite_hook = NULL;
+static char *history_word_delimiters = " \t\n;&()|<>";
+static void
+rl_free_undo_list ()
+{
+ free_undo_list ();
+}
+
+static int
+rl_crlf ()
+{
+ return crlf ();
+}
+
+#if (RL_VERSION_MAJOR >= 4)
+static void
+rl_tty_set_default_bindings (keymap)
+Keymap keymap;
+{
+ rltty_set_default_bindings (keymap);
+}
+#endif /* (RL_VERSION_MAJOR >= 4) */
+
+static int
+rl_ding ()
+{
+ return ding ();
+}
+
+static char **
+rl_completion_matches (s, f)
+ char *s;
+ rl_compentry_func_t *f;
+{
+ return completion_matches (s, (CPFunction *)f);
+}
+
+static char *
+rl_username_completion_function (s, i)
+ const char *s;
+ int i;
+{
+ return username_completion_function ((char *)s, i);
+}
+
+static char *
+rl_filename_completion_function (s, i)
+ const char *s;
+ int i;
+{
+ return filename_completion_function ((char *)s, i);
+}
+
+/*
+ * In Readline 4.2 many variables, function arguments, and function
+ * return values are now declared `const' where appropriate.
+ */
+#define CONST
+#else /* (RL_READLINE_VERSION >= 0x0402) */
+#define CONST const
+#endif /* (RL_READLINE_VERSION >= 0x0402) */
+
+#if (RL_READLINE_VERSION < 0x0403)
+/* features introduced by GNU Readline 4.2a */
+static int rl_readline_version = RL_READLINE_VERSION;
+extern char *rl_get_termcap PARAMS((const char *));
+
+/* features introduced by GNU Readline 4.3 */
+static int rl_completion_suppress_append;
+static int rl_completion_mark_symlink_dirs;
+#endif /* (RL_READLINE_VERSION < 0x0403) */
+
+/*
+ * utility/dummy functions
+ */
+/* from GNU Readline:xmalloc.c */
+extern char *xmalloc PARAMS((int));
+extern char *tgetstr PARAMS((const char *, char **));
+extern int tputs PARAMS((const char *, int, int (*)(int)));
+
+/*
+ * Using xfree() in GNU Readline Library causes problem with Solaris
+ * 2.5. It seems that the DLL mechanism of Solaris 2.5 links another
+ * xfree() that does not do NULL argument check.
+ * I choose this as default since some other OSs may have same problem.
+ * usemymalloc=n is required.
+ */
+#ifdef OS2_USEDLL
+/* from GNU Readline:xmalloc.c */
+extern char *xfree PARAMS((char *));
+
+#else /* not OS2_USEDLL */
+static void
+xfree (string)
+ char *string;
+{
+ if (string)
+ free (string);
+}
+#endif /* not OS2_USEDLL */
+
+static char *
+dupstr(s) /* duplicate string */
+ char *s;
+{
+ /*
+ * Use xmalloc(), because allocated block will be freed in the GNU
+ * Readline Library routine.
+ * Don't make a macro, because the variable 's' is evaluated twice.
+ */
+ int len = strlen(s) + 1;
+ char *d = xmalloc(len);
+ Copy(s, d, len, char); /* Is Copy() better than strcpy() in XS? */
+ return d;
+}
+
+/*
+ * for tputs XS routine
+ */
+static char *tputs_ptr;
+static int
+tputs_char(c)
+ int c;
+{
+ return *tputs_ptr++ = c;
+}
+
+/*
+ * return name of FUNCTION.
+ * I asked Chet Ramey to add this function in readline/bind.c. But he
+ * did not, since he could not find any reasonable excuse.
+ */
+static const char *
+rl_get_function_name (function)
+ rl_command_func_t *function;
+{
+ register int i;
+
+ rl_initialize_funmap ();
+
+ for (i = 0; funmap[i]; i++)
+ if (funmap[i]->function == function)
+ return ((const char *)funmap[i]->name); /* cast is for oldies */
+ return NULL;
+}
+
+/*
+ * from readline-4.0:complete.c
+ * Redefine here since the function defined as static in complete.c.
+ * This function is used for default vaule for rl_filename_quoting_function.
+ */
+static char * rl_quote_filename PARAMS((char *s, int rtype, char *qcp));
+
+static char *
+rl_quote_filename (s, rtype, qcp)
+ char *s;
+ int rtype;
+ char *qcp;
+{
+ char *r;
+
+ r = xmalloc (strlen (s) + 2);
+ *r = *rl_completer_quote_characters;
+ strcpy (r + 1, s);
+ if (qcp)
+ *qcp = *rl_completer_quote_characters;
+ return r;
+}
+
+/*
+ * string variable table for _rl_store_str(), _rl_fetch_str()
+ */
+
+static struct str_vars {
+ char **var;
+ int accessed;
+ int read_only;
+} str_tbl[] = {
+ /* When you change length of rl_line_buffer, you must call
+ rl_extend_line_buffer(). See _rl_store_rl_line_buffer() */
+ { &rl_line_buffer, 0, 0 }, /* 0 */
+ { &rl_prompt, 0, 1 }, /* 1 */
+ { (char **)&rl_library_version, 0, 1 }, /* 2 */
+ { (char **)&rl_terminal_name, 0, 0 }, /* 3 */
+ { (char **)&rl_readline_name, 0, 0 }, /* 4 */
+
+ { (char **)&rl_basic_word_break_characters, 0, 0 }, /* 5 */
+ { (char **)&rl_basic_quote_characters, 0, 0 }, /* 6 */
+ { (char **)&rl_completer_word_break_characters, 0, 0 }, /* 7 */
+ { (char **)&rl_completer_quote_characters, 0, 0 }, /* 8 */
+ { (char **)&rl_filename_quote_characters, 0, 0 }, /* 9 */
+ { (char **)&rl_special_prefixes, 0, 0 }, /* 10 */
+
+ { &history_no_expand_chars, 0, 0 }, /* 11 */
+ { &history_search_delimiter_chars, 0, 0 }, /* 12 */
+
+ { &rl_executing_macro, 0, 0 }, /* 13 */
+ { &history_word_delimiters, 0, 0 } /* 14 */
+};
+
+/*
+ * integer variable table for _rl_store_int(), _rl_fetch_int()
+ */
+
+static struct int_vars {
+ int *var;
+ int charp;
+ int read_only;
+} int_tbl[] = {
+ { &rl_point, 0, 0 }, /* 0 */
+ { &rl_end, 0, 0 }, /* 1 */
+ { &rl_mark, 0, 0 }, /* 2 */
+ { &rl_done, 0, 0 }, /* 3 */
+ { &rl_pending_input, 0, 0 }, /* 4 */
+
+ { &rl_completion_query_items, 0, 0 }, /* 5 */
+ { &rl_completion_append_character, 0, 0 }, /* 6 */
+ { &rl_ignore_completion_duplicates, 0, 0 }, /* 7 */
+ { &rl_filename_completion_desired, 0, 0 }, /* 8 */
+ { &rl_filename_quoting_desired, 0, 0 }, /* 9 */
+ { &rl_inhibit_completion, 0, 0 }, /* 10 */
+
+ { &history_base, 0, 0 }, /* 11 */
+ { &history_length, 0, 0 }, /* 12 */
+#if (RL_READLINE_VERSION >= 0x0402)
+ { &history_max_entries, 0, 1 }, /* 13 */
+#else /* (RL_READLINE_VERSION < 0x0402) */
+ { &max_input_history, 0, 1 }, /* 13 */
+#endif /* (RL_READLINE_VERSION < 0x0402) */
+ { (int *)&history_expansion_char, 1, 0 }, /* 14 */
+ { (int *)&history_subst_char, 1, 0 }, /* 15 */
+ { (int *)&history_comment_char, 1, 0 }, /* 16 */
+ { &history_quotes_inhibit_expansion, 0, 0 }, /* 17 */
+ { &rl_erase_empty_line, 0, 0 }, /* 18 */
+ { &rl_catch_signals, 0, 0 }, /* 19 */
+ { &rl_catch_sigwinch, 0, 0 }, /* 20 */
+ { &rl_already_prompted, 0, 0 }, /* 21 */
+ { &rl_num_chars_to_read, 0, 0 }, /* 22 */
+ { &rl_dispatching, 0, 0 }, /* 23 */
+ { &rl_gnu_readline_p, 0, 1 }, /* 24 */
+ { &rl_readline_state, 0, 0 }, /* 25 */
+ { &rl_explicit_arg, 0, 0 }, /* 26 */
+ { &rl_numeric_arg, 0, 0 }, /* 27 */
+ { &rl_editing_mode, 0, 0 }, /* 28 */
+ { &rl_attempted_completion_over, 0, 0 }, /* 29 */
+ { &rl_completion_type, 0, 0 }, /* 30 */
+ { &rl_readline_version, 0, 1 }, /* 31 */
+ { &rl_completion_suppress_append, 0, 0 }, /* 32 */
+ { &rl_completion_mark_symlink_dirs, 0, 0 } /* 33 */
+};
+
+/*
+ * function pointer variable table for _rl_store_function(),
+ * _rl_fetch_funtion()
+ */
+
+static int startup_hook_wrapper PARAMS((void));
+static int event_hook_wrapper PARAMS((void));
+static int getc_function_wrapper PARAMS((FILE *));
+static void redisplay_function_wrapper PARAMS((void));
+static char *completion_entry_function_wrapper PARAMS((const char *, int));;
+static char **attempted_completion_function_wrapper PARAMS((char *, int, int));
+static char *filename_quoting_function_wrapper PARAMS((char *text, int match_type,
+ char *quote_pointer));
+static char *filename_dequoting_function_wrapper PARAMS((char *text,
+ int quote_char));
+static int char_is_quoted_p_wrapper PARAMS((char *text, int index));
+static void ignore_some_completions_function_wrapper PARAMS((char **matches));
+static int directory_completion_hook_wrapper PARAMS((char **textp));
+static int history_inhibit_expansion_function_wrapper PARAMS((char *str, int i));
+static int pre_input_hook_wrapper PARAMS((void));
+static void completion_display_matches_hook_wrapper PARAMS((char **matches,
+ int len, int max));
+static int prep_term_function_wrapper PARAMS((int meta_flag));
+static int deprep_term_function_wrapper PARAMS((void));
+static int directory_rewrite_hook_wrapper PARAMS((char **));
+
+enum { STARTUP_HOOK, EVENT_HOOK, GETC_FN, REDISPLAY_FN,
+ CMP_ENT, ATMPT_COMP,
+ FN_QUOTE, FN_DEQUOTE, CHAR_IS_QUOTEDP,
+ IGNORE_COMP, DIR_COMP, HIST_INHIBIT_EXP,
+ PRE_INPUT_HOOK, COMP_DISP_HOOK, PREP_TERM, DEPREP_TERM, DIR_REWRITE
+};
+
+static struct fn_vars {
+ Function **rlfuncp; /* GNU Readline Library variable */
+ Function *defaultfn; /* default function */
+ Function *wrapper; /* wrapper function */
+ SV *callback; /* Perl function */
+} fn_tbl[] = {
+ { &rl_startup_hook, NULL, startup_hook_wrapper, NULL }, /* 0 */
+ { &rl_event_hook, NULL, event_hook_wrapper, NULL }, /* 1 */
+ { &rl_getc_function, rl_getc, getc_function_wrapper, NULL }, /* 2 */
+ {
+ (Function **)&rl_redisplay_function, /* 3 */
+ (Function *)rl_redisplay,
+ (Function *)redisplay_function_wrapper,
+ NULL
+ },
+ {
+ (Function **)&rl_completion_entry_function, /* 4 */
+ NULL,
+ (Function *)completion_entry_function_wrapper,
+ NULL
+ },
+ {
+ (Function **)&rl_attempted_completion_function, /* 5 */
+ NULL,
+ (Function *)attempted_completion_function_wrapper,
+ NULL
+ },
+ {
+ (Function **)&rl_filename_quoting_function, /* 6 */
+ (Function *)rl_quote_filename,
+ (Function *)filename_quoting_function_wrapper,
+ NULL
+ },
+ {
+ (Function **)&rl_filename_dequoting_function, /* 7 */
+ NULL,
+ (Function *)filename_dequoting_function_wrapper,
+ NULL
+ },
+ {
+ (Function **)&rl_char_is_quoted_p, /* 8 */
+ NULL,
+ (Function *)char_is_quoted_p_wrapper,
+ NULL
+ },
+ {
+ (Function **)&rl_ignore_some_completions_function, /* 9 */
+ NULL,
+ (Function *)ignore_some_completions_function_wrapper,
+ NULL
+ },
+ {
+ (Function **)&rl_directory_completion_hook, /* 10 */
+ NULL,
+ (Function *)directory_completion_hook_wrapper,
+ NULL
+ },
+ {
+ (Function **)&history_inhibit_expansion_function, /* 11 */
+ NULL,
+ (Function *)history_inhibit_expansion_function_wrapper,
+ NULL
+ },
+ { &rl_pre_input_hook, NULL, pre_input_hook_wrapper, NULL }, /* 12 */
+ {
+ (Function **)&rl_completion_display_matches_hook, /* 13 */
+ NULL,
+ (Function *)completion_display_matches_hook_wrapper,
+ NULL
+ },
+ {
+ (Function **)&rl_prep_term_function, /* 14 */
+ (Function *)rl_prep_terminal,
+ (Function *)prep_term_function_wrapper,
+ NULL
+ },
+ {
+ (Function **)&rl_deprep_term_function, /* 15 */
+ (Function *)rl_deprep_terminal,
+ (Function *)deprep_term_function_wrapper,
+ NULL
+ },
+ {
+ (Function **)&rl_directory_rewrite_hook, /* 16 */
+ NULL,
+ (Function *)directory_rewrite_hook_wrapper,
+ NULL
+ }
+};
+
+/*
+ * Perl function wrappers
+ */
+
+static int
+voidfunc_wrapper(type)
+ int type;
+{
+ dSP;
+ int count;
+ int ret;
+ SV *svret;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(sp);
+ count = perl_call_sv(fn_tbl[type].callback, G_SCALAR);
+ SPAGAIN;
+
+ if (count != 1)
+ croak("Gnu.xs:voidfunc_wrapper: Internal error\n");
+
+ svret = POPs;
+ ret = SvIOK(svret) ? SvIV(svret) : -1;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return ret;
+}
+
+static int
+vintfunc_wrapper(type, arg)
+ int type;
+ int arg;
+{
+ dSP;
+ int count;
+ int ret;
+ SV *svret;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(sp);
+ XPUSHs(sv_2mortal(newSViv(arg)));
+ PUTBACK;
+ count = perl_call_sv(fn_tbl[type].callback, G_SCALAR);
+ SPAGAIN;
+
+ if (count != 1)
+ croak("Gnu.xs:vintfunc_wrapper: Internal error\n");
+
+ svret = POPs;
+ ret = SvIOK(svret) ? SvIV(svret) : -1;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return ret;
+}
+
+static int
+icppfunc_wrapper(type, arg)
+ int type;
+ char **arg;
+{
+ dSP;
+ int count;
+ SV *sv;
+ int ret;
+ char *rstr;
+
+ ENTER;
+ SAVETMPS;
+
+ if (arg && *arg) {
+ sv = sv_2mortal(newSVpv(*arg, 0));
+ } else {
+ sv = &PL_sv_undef;
+ }
+
+ PUSHMARK(sp);
+ XPUSHs(sv);
+ PUTBACK;
+
+ count = perl_call_sv(fn_tbl[type].callback, G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1)
+ croak("Gnu.xs:icppfunc_wrapper: Internal error\n");
+
+ ret = POPi;
+
+ rstr = SvPV(sv, PL_na);
+ if (strcmp(*arg, rstr) != 0) {
+ xfree(*arg);
+ *arg = dupstr(rstr);
+ }
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ return ret;
+}
+
+static int
+startup_hook_wrapper() { return voidfunc_wrapper(STARTUP_HOOK); }
+static int
+event_hook_wrapper() { return voidfunc_wrapper(EVENT_HOOK); }
+
+static int
+getc_function_wrapper(fp)
+ FILE *fp;
+{
+ /*
+ * 'FILE *fp' is ignored. Use rl_instream instead in the getc_function.
+ * How can I pass 'FILE *fp'?
+ */
+ return voidfunc_wrapper(GETC_FN);
+}
+
+static void
+redisplay_function_wrapper() { voidfunc_wrapper(REDISPLAY_FN); }
+
+/*
+ * call a perl function as rl_completion_entry_function
+ */
+
+static char *
+completion_entry_function_wrapper(text, state)
+ const char *text;
+ int state;
+{
+ dSP;
+ int count;
+ SV *match;
+ char *str;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(sp);
+ if (text) {
+ XPUSHs(sv_2mortal(newSVpv(text, 0)));
+ } else {
+ XPUSHs(&PL_sv_undef);
+ }
+ XPUSHs(sv_2mortal(newSViv(state)));
+ PUTBACK;
+
+ count = perl_call_sv(fn_tbl[CMP_ENT].callback, G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1)
+ croak("Gnu.xs:completion_entry_function_wrapper: Internal error\n");
+
+ match = POPs;
+ str = SvOK(match) ? dupstr(SvPV(match, PL_na)) : NULL;
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return str;
+}
+
+/*
+ * call a perl function as rl_attempted_completion_function
+ */
+
+static char **
+attempted_completion_function_wrapper(text, start, end)
+ char *text;
+ int start;
+ int end;
+{
+ dSP;
+ int count;
+ char **matches;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(sp);
+ if (text) {
+ XPUSHs(sv_2mortal(newSVpv(text, 0)));
+ } else {
+ XPUSHs(&PL_sv_undef);
+ }
+ if (rl_line_buffer) {
+ XPUSHs(sv_2mortal(newSVpv(rl_line_buffer, 0)));
+ } else {
+ XPUSHs(&PL_sv_undef);
+ }
+ XPUSHs(sv_2mortal(newSViv(start)));
+ XPUSHs(sv_2mortal(newSViv(end)));
+ PUTBACK;
+
+ count = perl_call_sv(fn_tbl[ATMPT_COMP].callback, G_ARRAY);
+
+ SPAGAIN;
+
+ /* cf. ignore_some_completions_function_wrapper() */
+ if (count > 0) {
+ int i;
+ int dopack = -1;
+
+ /*
+ * The returned array may contain some undef items.
+ * Pack the array in such case.
+ */
+ matches = (char **)xmalloc (sizeof(char *) * (count + 1));
+ matches[count] = NULL;
+ for (i = count - 1; i >= 0; i--) {
+ SV *v = POPs;
+ if (SvOK(v)) {
+ matches[i] = dupstr(SvPV(v, PL_na));
+ } else {
+ matches[i] = NULL;
+ if (i != 0)
+ dopack = i; /* lowest index of hole */
+ }
+ }
+ /* pack undef items */
+ if (dopack > 0) { /* don't pack matches[0] */
+ int j = dopack;
+ for (i = dopack; i < count; i++) {
+ if (matches[i])
+ matches[j++] = matches[i];
+ }
+ matches[count = j] = NULL;
+ }
+ if (count == 2) { /* only one match */
+ xfree(matches[0]);
+ matches[0] = matches[1];
+ matches[1] = NULL;
+ } else if (count == 1 && !matches[0]) { /* in case of a list of undef */
+ xfree(matches);
+ matches = NULL;
+ }
+ } else {
+ matches = NULL;
+ }
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ return matches;
+}
+
+/*
+ * call a perl function as rl_filename_quoting_function
+ */
+
+static char *
+filename_quoting_function_wrapper(text, match_type, quote_pointer)
+ char *text;
+ int match_type;
+ char *quote_pointer;
+{
+ dSP;
+ int count;
+ SV *replacement;
+ char *str;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(sp);
+ if (text) {
+ XPUSHs(sv_2mortal(newSVpv(text, 0)));
+ } else {
+ XPUSHs(&PL_sv_undef);
+ }
+ XPUSHs(sv_2mortal(newSViv(match_type)));
+ if (quote_pointer) {
+ XPUSHs(sv_2mortal(newSVpv(quote_pointer, 0)));
+ } else {
+ XPUSHs(&PL_sv_undef);
+ }
+ PUTBACK;
+
+ count = perl_call_sv(fn_tbl[FN_QUOTE].callback, G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1)
+ croak("Gnu.xs:filename_quoting_function_wrapper: Internal error\n");
+
+ replacement = POPs;
+ str = SvOK(replacement) ? dupstr(SvPV(replacement, PL_na)) : NULL;
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return str;
+}
+
+/*
+ * call a perl function as rl_filename_dequoting_function
+ */
+
+static char *
+filename_dequoting_function_wrapper(text, quote_char)
+ char *text;
+ int quote_char;
+{
+ dSP;
+ int count;
+ SV *replacement;
+ char *str;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(sp);
+ if (text) {
+ XPUSHs(sv_2mortal(newSVpv(text, 0)));
+ } else {
+ XPUSHs(&PL_sv_undef);
+ }
+ XPUSHs(sv_2mortal(newSViv(quote_char)));
+ PUTBACK;
+
+ count = perl_call_sv(fn_tbl[FN_DEQUOTE].callback, G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1)
+ croak("Gnu.xs:filename_dequoting_function_wrapper: Internal error\n");
+
+ replacement = POPs;
+ str = SvOK(replacement) ? dupstr(SvPV(replacement, PL_na)) : NULL;
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return str;
+}
+
+/*
+ * call a perl function as rl_char_is_quoted_p
+ */
+
+static int
+char_is_quoted_p_wrapper(text, index)
+ char *text;
+ int index;
+{
+ dSP;
+ int count;
+ int ret;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(sp);
+ if (text) {
+ XPUSHs(sv_2mortal(newSVpv(text, 0)));
+ } else {
+ XPUSHs(&PL_sv_undef);
+ }
+ XPUSHs(sv_2mortal(newSViv(index)));
+ PUTBACK;
+
+ count = perl_call_sv(fn_tbl[CHAR_IS_QUOTEDP].callback, G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1)
+ croak("Gnu.xs:char_is_quoted_p_wrapper: Internal error\n");
+
+ ret = POPi; /* warns unless integer */
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return ret;
+}
+
+/*
+ * call a perl function as rl_ignore_some_completions_function
+ */
+
+static void
+ignore_some_completions_function_wrapper(matches)
+ char **matches;
+{
+ dSP;
+ int count, i, only_one_match;
+
+ only_one_match = matches[1] == NULL ? 1 : 0;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(sp);
+
+ /* matches[0] is the maximal matching substring. So it may NULL, even rest
+ * of matches[] has values. */
+ if (matches[0]) {
+ XPUSHs(sv_2mortal(newSVpv(matches[0], 0)));
+ /* xfree(matches[0]);*/
+ } else {
+ XPUSHs(&PL_sv_undef);
+ }
+ for (i = 1; matches[i]; i++) {
+ XPUSHs(sv_2mortal(newSVpv(matches[i], 0)));
+ xfree(matches[i]);
+ }
+ /*xfree(matches);*/
+ PUTBACK;
+
+ count = perl_call_sv(fn_tbl[IGNORE_COMP].callback, G_ARRAY);
+
+ SPAGAIN;
+
+ if (only_one_match) {
+ if (count == 0) { /* no match */
+ xfree(matches[0]);
+ matches[0] = NULL;
+ } /* else only one match */
+ } else if (count > 0) {
+ int i;
+ int dopack = -1;
+
+ /*
+ * The returned array may contain some undef items.
+ * Pack the array in such case.
+ */
+ matches[count] = NULL;
+ for (i = count - 1; i > 0; i--) { /* don't pop matches[0] */
+ SV *v = POPs;
+ if (SvOK(v)) {
+ matches[i] = dupstr(SvPV(v, PL_na));
+ } else {
+ matches[i] = NULL;
+ dopack = i; /* lowest index of undef */
+ }
+ }
+ /* pack undef items */
+ if (dopack > 0) { /* don't pack matches[0] */
+ int j = dopack;
+ for (i = dopack; i < count; i++) {
+ if (matches[i])
+ matches[j++] = matches[i];
+ }
+ matches[count = j] = NULL;
+ }
+ if (count == 1) { /* no match */
+ xfree(matches[0]);
+ matches[0] = NULL;
+ } else if (count == 2) { /* only one match */
+ xfree(matches[0]);
+ matches[0] = matches[1];
+ matches[1] = NULL;
+ }
+ } else { /* no match */
+ xfree(matches[0]);
+ matches[0] = NULL;
+ }
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+/*
+ * call a perl function as rl_directory_completion_hook
+ */
+
+static int
+directory_completion_hook_wrapper(textp)
+ char **textp;
+{
+ return icppfunc_wrapper(DIR_COMP, textp);
+}
+
+/*
+ * call a perl function as history_inhibit_expansion_function
+ */
+
+static int
+history_inhibit_expansion_function_wrapper(text, index)
+ char *text;
+ int index;
+{
+ dSP;
+ int count;
+ int ret;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(sp);
+ if (text) {
+ XPUSHs(sv_2mortal(newSVpv(text, 0)));
+ } else {
+ XPUSHs(&PL_sv_undef);
+ }
+ XPUSHs(sv_2mortal(newSViv(index)));
+ PUTBACK;
+
+ count = perl_call_sv(fn_tbl[HIST_INHIBIT_EXP].callback, G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1)
+ croak("Gnu.xs:history_inhibit_expansion_function_wrapper: Internal error\n");
+
+ ret = POPi; /* warns unless integer */
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return ret;
+}
+
+static int
+pre_input_hook_wrapper() { return voidfunc_wrapper(PRE_INPUT_HOOK); }
+
+#if (RL_VERSION_MAJOR >= 4)
+/*
+ * call a perl function as rl_completion_display_matches_hook
+ */
+
+static void
+completion_display_matches_hook_wrapper(matches, len, max)
+ char **matches;
+ int len;
+ int max;
+{
+ dSP;
+ int i;
+ AV *av_matches;
+
+ /* copy C matches[] array into perl array */
+ av_matches = newAV();
+
+ /* matches[0] is the maximal matching substring. So it may NULL, even rest
+ * of matches[] has values. */
+ if (matches[0]) {
+ av_push(av_matches, sv_2mortal(newSVpv(matches[0], 0)));
+ } else {
+ av_push(av_matches, &PL_sv_undef);
+ }
+
+ for (i = 1; matches[i]; i++)
+ if (matches[i]) {
+ av_push(av_matches, sv_2mortal(newSVpv(matches[i], 0)));
+ } else {
+ av_push(av_matches, &PL_sv_undef);
+ }
+
+ PUSHMARK(sp);
+ XPUSHs(sv_2mortal(newRV_inc((SV *)av_matches))); /* push reference of array */
+ XPUSHs(sv_2mortal(newSViv(len)));
+ XPUSHs(sv_2mortal(newSViv(max)));
+ PUTBACK;
+
+ perl_call_sv(fn_tbl[COMP_DISP_HOOK].callback, G_DISCARD);
+}
+#else /* (RL_VERSION_MAJOR < 4) */
+static void
+completion_display_matches_hook_wrapper(matches, len, max)
+ char **matches;
+ int len;
+ int max;
+{
+ /* dummy */
+}
+#endif /* (RL_VERSION_MAJOR < 4) */
+
+static int
+prep_term_function_wrapper(meta_flag)
+ int meta_flag;
+{
+ return vintfunc_wrapper(PREP_TERM, meta_flag);
+}
+
+static int
+deprep_term_function_wrapper() { return voidfunc_wrapper(DEPREP_TERM); }
+
+/*
+ * call a perl function as rl_directory_completion_hook
+ */
+static int
+directory_rewrite_hook_wrapper(dirname)
+ char **dirname;
+{
+ return icppfunc_wrapper(DIR_REWRITE, dirname);
+}
+
+/*
+ * If you need more custom functions, define more funntion_wrapper_xx()
+ * and add entry on fntbl[].
+ */
+
+static int function_wrapper PARAMS((int count, int key, int id));
+
+static int fw_00(c, k) int c; int k; { return function_wrapper(c, k, 0); }
+static int fw_01(c, k) int c; int k; { return function_wrapper(c, k, 1); }
+static int fw_02(c, k) int c; int k; { return function_wrapper(c, k, 2); }
+static int fw_03(c, k) int c; int k; { return function_wrapper(c, k, 3); }
+static int fw_04(c, k) int c; int k; { return function_wrapper(c, k, 4); }
+static int fw_05(c, k) int c; int k; { return function_wrapper(c, k, 5); }
+static int fw_06(c, k) int c; int k; { return function_wrapper(c, k, 6); }
+static int fw_07(c, k) int c; int k; { return function_wrapper(c, k, 7); }
+static int fw_08(c, k) int c; int k; { return function_wrapper(c, k, 8); }
+static int fw_09(c, k) int c; int k; { return function_wrapper(c, k, 9); }
+static int fw_10(c, k) int c; int k; { return function_wrapper(c, k, 10); }
+static int fw_11(c, k) int c; int k; { return function_wrapper(c, k, 11); }
+static int fw_12(c, k) int c; int k; { return function_wrapper(c, k, 12); }
+static int fw_13(c, k) int c; int k; { return function_wrapper(c, k, 13); }
+static int fw_14(c, k) int c; int k; { return function_wrapper(c, k, 14); }
+static int fw_15(c, k) int c; int k; { return function_wrapper(c, k, 15); }
+
+static struct fnnode {
+ Function *wrapper; /* C wrapper function */
+ SV *pfn; /* Perl function */
+} fntbl[] = {
+ { fw_00, NULL },
+ { fw_01, NULL },
+ { fw_02, NULL },
+ { fw_03, NULL },
+ { fw_04, NULL },
+ { fw_05, NULL },
+ { fw_06, NULL },
+ { fw_07, NULL },
+ { fw_08, NULL },
+ { fw_09, NULL },
+ { fw_10, NULL },
+ { fw_11, NULL },
+ { fw_12, NULL },
+ { fw_13, NULL },
+ { fw_14, NULL },
+ { fw_15, NULL }
+};
+
+static int
+function_wrapper(count, key, id)
+ int count;
+ int key;
+ int id;
+{
+ dSP;
+
+ PUSHMARK(sp);
+ XPUSHs(sv_2mortal(newSViv(count)));
+ XPUSHs(sv_2mortal(newSViv(key)));
+ PUTBACK;
+
+ perl_call_sv(fntbl[id].pfn, G_DISCARD);
+
+ return 0;
+}
+
+static SV *callback_handler_callback = NULL;
+
+static void
+callback_handler_wrapper(line)
+ char *line;
+{
+ dSP;
+
+ PUSHMARK(sp);
+ if (line) {
+ XPUSHs(sv_2mortal(newSVpv(line, 0)));
+ } else {
+ XPUSHs(&PL_sv_undef);
+ }
+ PUTBACK;
+
+ perl_call_sv(callback_handler_callback, G_DISCARD);
+}
+
+/*
+ * make separate name space for low level XS functions and there methods
+ */
+
+MODULE = Term::ReadLine::Gnu PACKAGE = Term::ReadLine::Gnu::XS
+
+ ########################################################################
+ #
+ # Gnu Readline Library
+ #
+ ########################################################################
+ #
+ # 2.1 Basic Behavior
+ #
+
+ # The function name "readline()" is reserved for a method name.
+
+t_xstr
+rl_readline(prompt = NULL)
+ CONST char * prompt
+ PROTOTYPE: ;$
+ CODE:
+ RETVAL = readline(prompt);
+ OUTPUT:
+ RETVAL
+
+ #
+ # 2.4 Readline Convenience Functions
+ #
+ #
+ # 2.4.1 Naming a Function
+ #
+rl_command_func_t *
+rl_add_defun(name, fn, key = -1)
+ const char * name
+ SV * fn
+ int key
+ PROTOTYPE: $$;$
+ CODE:
+ {
+ int i;
+ int nentry = sizeof(fntbl)/sizeof(struct fnnode);
+
+ /* search an empty slot */
+ for (i = 0; i < nentry; i++)
+ if (! fntbl[i].pfn)
+ break;
+
+ if (i >= nentry) {
+ warn("Gnu.xs:rl_add_defun: custom function table is full. The maximum number of custum function is %d.\n",
+ nentry);
+ XSRETURN_UNDEF;
+ }
+
+ fntbl[i].pfn = newSVsv(fn);
+
+ /* rl_add_defun() always returns 0. */
+ rl_add_defun(dupstr(name), fntbl[i].wrapper, key);
+ RETVAL = fntbl[i].wrapper;
+ }
+ OUTPUT:
+ RETVAL
+
+ #
+ # 2.4.2 Selection a Keymap
+ #
+Keymap
+rl_make_bare_keymap()
+ PROTOTYPE:
+
+Keymap
+_rl_copy_keymap(map)
+ Keymap map
+ PROTOTYPE: $
+ CODE:
+ RETVAL = rl_copy_keymap(map);
+ OUTPUT:
+ RETVAL
+
+Keymap
+rl_make_keymap()
+ PROTOTYPE:
+
+Keymap
+_rl_discard_keymap(map)
+ Keymap map
+ PROTOTYPE: $
+ CODE:
+ rl_discard_keymap(map);
+ RETVAL = map;
+ OUTPUT:
+ RETVAL
+
+Keymap
+rl_get_keymap()
+ PROTOTYPE:
+
+Keymap
+_rl_set_keymap(map)
+ Keymap map
+ PROTOTYPE: $
+ CODE:
+ rl_set_keymap(map);
+ RETVAL = map;
+ OUTPUT:
+ RETVAL
+
+Keymap
+rl_get_keymap_by_name(name)
+ CONST char * name
+ PROTOTYPE: $
+
+ # Do not free the string returned.
+char *
+rl_get_keymap_name(map)
+ Keymap map
+ PROTOTYPE: $
+
+ #
+ # 2.4.3 Binding Keys
+ #
+int
+_rl_bind_key(key, function, map = rl_get_keymap())
+ int key
+ rl_command_func_t * function
+ Keymap map
+ PROTOTYPE: $$;$
+ CODE:
+ RETVAL = rl_bind_key_in_map(key, function, map);
+ OUTPUT:
+ RETVAL
+
+int
+_rl_unbind_key(key, map = rl_get_keymap())
+ int key
+ Keymap map
+ PROTOTYPE: $;$
+ CODE:
+ RETVAL = rl_unbind_key_in_map(key, map);
+ OUTPUT:
+ RETVAL
+
+#if (RL_READLINE_VERSION >= 0x0202)
+
+ # rl_unbind_function_in_map() and rl_unbind_command_in_map() are introduced
+ # by readline-2.2.
+
+int
+_rl_unbind_function(function, map = rl_get_keymap())
+ rl_command_func_t * function
+ Keymap map
+ PROTOTYPE: $;$
+ CODE:
+ RETVAL = rl_unbind_function_in_map(function, map);
+ OUTPUT:
+ RETVAL
+
+int
+_rl_unbind_command(command, map = rl_get_keymap())
+ CONST char * command
+ Keymap map
+ PROTOTYPE: $;$
+ CODE:
+ RETVAL = rl_unbind_command_in_map(command, map);
+ OUTPUT:
+ RETVAL
+
+#endif /* (RL_READLINE_VERSION >= 0x0202) */
+
+#if (RL_READLINE_VERSION >= 0x0402)
+ # rl_set_key() is introduced by readline-4.2 and equivalent with
+ # rl_generic_bind(ISFUNC, keyseq, (char *)function, map).
+int
+_rl_set_key(keyseq, function, map = rl_get_keymap())
+ const char * keyseq
+ rl_command_func_t * function
+ Keymap map
+ PROTOTYPE: $$;$
+ CODE:
+ RETVAL = rl_set_key(keyseq, function, map);
+ OUTPUT:
+ RETVAL
+
+#endif /* (RL_READLINE_VERSION >= 0x0402) */
+
+int
+_rl_generic_bind_function(keyseq, function, map = rl_get_keymap())
+ CONST char * keyseq
+ rl_command_func_t * function
+ Keymap map
+ PROTOTYPE: $$;$
+ CODE:
+ RETVAL = rl_generic_bind(ISFUNC, keyseq, (char *)function, map);
+ OUTPUT:
+ RETVAL
+
+int
+_rl_generic_bind_keymap(keyseq, keymap, map = rl_get_keymap())
+ CONST char * keyseq
+ Keymap keymap
+ Keymap map
+ PROTOTYPE: $$;$
+ CODE:
+ RETVAL = rl_generic_bind(ISKMAP, keyseq, (char *)keymap, map);
+ OUTPUT:
+ RETVAL
+
+int
+_rl_generic_bind_macro(keyseq, macro, map = rl_get_keymap())
+ CONST char * keyseq
+ CONST char * macro
+ Keymap map
+ PROTOTYPE: $$;$
+ CODE:
+ RETVAL = rl_generic_bind(ISMACR, keyseq, dupstr(macro), map);
+ OUTPUT:
+ RETVAL
+
+void
+rl_parse_and_bind(line)
+ char * line
+ PROTOTYPE: $
+ CODE:
+ {
+ char *s = dupstr(line);
+ rl_parse_and_bind(s); /* Some NULs may be inserted in "s". */
+ xfree(s);
+ }
+
+int
+rl_read_init_file(filename = NULL)
+ CONST char * filename
+ PROTOTYPE: ;$
+
+ #
+ # 2.4.4 Associating Function Names and Bindings
+ #
+int
+_rl_call_function(function, count = 1, key = -1)
+ rl_command_func_t * function
+ int count
+ int key
+ PROTOTYPE: $;$$
+ CODE:
+ RETVAL = (*function)(count, key);
+ OUTPUT:
+ RETVAL
+
+rl_command_func_t *
+rl_named_function(name)
+ CONST char * name
+ PROTOTYPE: $
+
+ # Do not free the string returned.
+const char *
+rl_get_function_name(function)
+ rl_command_func_t * function
+ PROTOTYPE: $
+
+void
+rl_function_of_keyseq(keyseq, map = rl_get_keymap())
+ CONST char * keyseq
+ Keymap map
+ PROTOTYPE: $;$
+ PPCODE:
+ {
+ int type;
+ rl_command_func_t *p = rl_function_of_keyseq(keyseq, map, &type);
+ SV *sv;
+
+ if (p) {
+ sv = sv_newmortal();
+ switch (type) {
+ case ISFUNC:
+ sv_setref_pv(sv, "rl_command_func_tPtr", (void*)p);
+ break;
+ case ISKMAP:
+ sv_setref_pv(sv, "Keymap", (void*)p);
+ break;
+ case ISMACR:
+ if (p) {
+ sv_setpv(sv, (char *)p);
+ }
+ break;
+ default:
+ warn("Gnu.xs:rl_function_of_keyseq: illegal type `%d'\n", type);
+ XSRETURN_EMPTY; /* return NULL list */
+ }
+ EXTEND(sp, 2);
+ PUSHs(sv);
+ PUSHs(sv_2mortal(newSViv(type)));
+ } else
+ ; /* return NULL list */
+ }
+
+void
+_rl_invoking_keyseqs(function, map = rl_get_keymap())
+ rl_command_func_t * function
+ Keymap map
+ PROTOTYPE: $;$
+ PPCODE:
+ {
+ char **keyseqs;
+
+ keyseqs = rl_invoking_keyseqs_in_map(function, map);
+
+ if (keyseqs) {
+ int i, count;
+
+ /* count number of entries */
+ for (count = 0; keyseqs[count]; count++)
+ ;
+
+ EXTEND(sp, count);
+ for (i = 0; i < count; i++) {
+ PUSHs(sv_2mortal(newSVpv(keyseqs[i], 0)));
+ xfree(keyseqs[i]);
+ }
+ xfree((char *)keyseqs);
+ } else {
+ /* return null list */
+ }
+ }
+
+void
+rl_function_dumper(readable = 0)
+ int readable
+ PROTOTYPE: ;$
+
+void
+rl_list_funmap_names()
+ PROTOTYPE:
+
+ # return list of all function name. (Term::Readline::Gnu specific function)
+void
+rl_get_all_function_names()
+ PROTOTYPE:
+ PPCODE:
+ {
+ int i, count;
+ /* count number of entries */
+ for (count = 0; funmap[count]; count++)
+ ;
+
+ EXTEND(sp, count);
+ for (i = 0; i < count; i++) {
+ PUSHs(sv_2mortal(newSVpv(funmap[i]->name, 0)));
+ }
+ }
+
+void
+rl_funmap_names()
+ PROTOTYPE:
+ PPCODE:
+ {
+ const char **funmap;
+
+ /* don't free returned memory */
+ funmap = (const char **)rl_funmap_names();/* cast is for oldies */
+
+ if (funmap) {
+ int i, count;
+
+ /* count number of entries */
+ for (count = 0; funmap[count]; count++)
+ ;
+
+ EXTEND(sp, count);
+ for (i = 0; i < count; i++) {
+ PUSHs(sv_2mortal(newSVpv(funmap[i], 0)));
+ }
+ } else {
+ /* return null list */
+ }
+ }
+
+#if (RL_READLINE_VERSION >= 0x0402)
+ # rl_add_funmap_entry() is introduced by readline-4.2.
+int
+_rl_add_funmap_entry(name, function)
+ const char * name
+ rl_command_func_t * function
+ PROTOTYPE: $$
+ CODE:
+ RETVAL = rl_add_funmap_entry(name, function);
+ OUTPUT:
+ RETVAL
+
+#endif /* (RL_READLINE_VERSION >= 0x0402) */
+
+ #
+ # 2.4.5 Allowing Undoing
+ #
+int
+rl_begin_undo_group()
+ PROTOTYPE:
+
+int
+rl_end_undo_group()
+ PROTOTYPE:
+
+void
+rl_add_undo(what, start, end, text)
+ int what
+ int start
+ int end
+ char * text
+ PROTOTYPE: $$$$
+ CODE:
+ /* rl_free_undo_list will free the duplicated memory */
+ rl_add_undo((enum undo_code)what, start, end, dupstr(text));
+
+void
+rl_free_undo_list()
+ PROTOTYPE:
+
+int
+rl_do_undo()
+ PROTOTYPE:
+
+int
+rl_modifying(start = 0, end = rl_end)
+ int start
+ int end
+ PROTOTYPE: ;$$
+
+ #
+ # 2.4.6 Redisplay
+ #
+void
+rl_redisplay()
+ PROTOTYPE:
+
+int
+rl_forced_update_display()
+ PROTOTYPE:
+
+int
+rl_on_new_line()
+ PROTOTYPE:
+
+#if (RL_READLINE_VERSION >= 0x0401)
+int
+rl_on_new_line_with_prompt()
+ PROTOTYPE:
+
+#endif /* (RL_READLINE_VERSION >= 0x0401) */
+
+int
+rl_reset_line_state()
+ PROTOTYPE:
+
+int
+rl_show_char(i)
+ int i
+ PROTOTYPE: $
+
+int
+_rl_message(text)
+ const char * text
+ PROTOTYPE: $
+ CODE:
+ RETVAL = rl_message(text);
+ OUTPUT:
+ RETVAL
+
+int
+rl_crlf()
+ PROTOTYPE:
+
+int
+rl_clear_message()
+ PROTOTYPE:
+
+void
+rl_save_prompt()
+ PROTOTYPE:
+
+void
+rl_restore_prompt()
+ PROTOTYPE:
+
+int
+rl_expand_prompt(prompt)
+ # should be defined as 'const char *'
+ char * prompt
+
+#if (RL_READLINE_VERSION >= 0x0402)
+
+int
+rl_set_prompt(prompt)
+ const char * prompt
+
+#endif /* (RL_READLINE_VERSION >= 0x0402) */
+
+ #
+ # 2.4.7 Modifying Text
+ #
+int
+rl_insert_text(text)
+ CONST char * text
+ PROTOTYPE: $
+
+int
+rl_delete_text(start = 0, end = rl_end)
+ int start
+ int end
+ PROTOTYPE: ;$$
+
+t_xstr
+rl_copy_text(start = 0, end = rl_end)
+ int start
+ int end
+ PROTOTYPE: ;$$
+
+int
+rl_kill_text(start = 0, end = rl_end)
+ int start
+ int end
+ PROTOTYPE: ;$$
+
+ # rl_push_macro_input() is documented by readline-4.2 but it has been
+ # implemented from 2.2.1.
+
+void
+rl_push_macro_input(macro)
+ const char * macro
+ PROTOTYPE: $
+ CODE:
+ rl_push_macro_input(dupstr(macro));
+
+ #
+ # 2.4.8 Character Input
+ #
+int
+rl_read_key()
+ PROTOTYPE:
+
+int
+rl_getc(stream)
+ FILE * stream
+ PROTOTYPE: $
+
+int
+rl_stuff_char(c)
+ int c
+ PROTOTYPE: $
+
+#if (RL_VERSION_MAJOR >= 4)
+
+int
+rl_execute_next(c)
+ int c
+ PROTOTYPE: $
+
+#endif /* (RL_VERSION_MAJOR >= 4) */
+#if (RL_READLINE_VERSION >= 0x0402)
+
+int
+rl_clear_pending_input()
+ PROTOTYPE:
+
+int
+rl_set_keyboard_input_timeout(usec)
+ int usec
+ PROTOTYPE: $
+
+#endif /* (RL_READLINE_VERSION >= 0x0402) */
+
+ #
+ # 2.4.9 Terminal Management
+ #
+
+#if (RL_VERSION_MAJOR >= 4)
+
+void
+rl_prep_terminal(meta_flag)
+ int meta_flag
+ PROTOTYPE: $
+
+void
+rl_deprep_terminal()
+ PROTOTYPE:
+
+void
+_rl_tty_set_default_bindings(kmap = rl_get_keymap())
+ Keymap kmap
+ PROTOTYPE: ;$
+ CODE:
+ rl_tty_set_default_bindings(kmap);
+
+#endif /* (RL_VERSION_MAJOR >= 4) */
+
+int
+rl_reset_terminal(terminal_name = NULL)
+ CONST char * terminal_name
+ PROTOTYPE: ;$
+
+ #
+ # 2.4.10 Utility Functions
+ #
+#if (RL_READLINE_VERSION >= 0x0403)
+void
+rl_replace_line(text, clear_undo = 0)
+ const char *text
+ int clear_undo
+ PROTOTYPE: $$
+
+#endif /* (RL_READLINE_VERSION >= 0x0403) */
+
+int
+rl_initialize()
+ PROTOTYPE:
+
+int
+rl_ding()
+ PROTOTYPE:
+
+#if (RL_READLINE_VERSION >= 0x0402)
+
+int
+rl_alphabetic(c)
+ int c
+ PROTOTYPE: $
+
+#endif /* (RL_READLINE_VERSION >= 0x0402) */
+
+#if (RL_VERSION_MAJOR >= 4)
+
+void
+rl_display_match_list(pmatches, plen = -1, pmax = -1)
+ SV * pmatches
+ int plen
+ int pmax
+ PROTOTYPE: $;$$
+ CODE:
+ {
+ unsigned int len, max, i;
+ STRLEN l;
+ char **matches;
+ AV *av_matches;
+ SV **pvp;
+
+ if (SvTYPE(SvRV(pmatches)) != SVt_PVAV) {
+ warn("Gnu.xs:_rl_display_match_list: the 1st arguments must be a reference of an array\n");
+ return;
+ }
+ av_matches = (AV *)SvRV(ST(0));
+ /* index zero contains possible match and is ignored */
+ if ((len = av_len(av_matches) + 1 - 1) == 0)
+ return;
+ matches = (char **)xmalloc (sizeof(char *) * (len + 2));
+ max = 0;
+ for (i = 1; i <= len; i++) {
+ pvp = av_fetch(av_matches, i, 0);
+ if (SvPOKp(*pvp)) {
+ matches[i] = dupstr(SvPV(*pvp, l));
+ if (l > max)
+ max = l;
+ }
+ }
+ matches[len + 1] = NULL;
+
+ rl_display_match_list(matches,
+ plen < 0 ? len : plen,
+ pmax < 0 ? max : pmax);
+
+ for (i = 1; i <= len; i++)
+ xfree(matches[i]);
+ xfree(matches);
+ }
+
+#endif /* (RL_VERSION_MAJOR >= 4) */
+
+ #
+ # 2.4.11 Miscellaneous Functions
+ #
+
+ # rl_macro_bind() is documented by readline-4.2 but it has been implemented
+ # from 2.2.1.
+ # It is equivalent with
+ # rl_generic_bind(ISMACR, keyseq, (char *)macro_keys, map).
+int
+_rl_macro_bind(keyseq, macro, map = rl_get_keymap())
+ CONST char * keyseq
+ CONST char * macro
+ Keymap map
+ PROTOTYPE: $$;$
+ CODE:
+ RETVAL = rl_macro_bind(keyseq, macro, map);
+ OUTPUT:
+ RETVAL
+
+ # rl_macro_dumper is documented by Readline 4.2,
+ # but have been implemented for 2.2.1.
+
+void
+rl_macro_dumper(readable = 0)
+ int readable
+ PROTOTYPE: ;$
+
+ # rl_variable_bind() is documented by readline-4.2 but it has been implemented
+ # from 2.2.1.
+
+int
+rl_variable_bind(name, value)
+ CONST char * name
+ CONST char * value
+ PROTOTYPE: $$
+
+ # rl_variable_dumper is documented by Readline 4.2,
+ # but have been implemented for 2.2.1.
+
+void
+rl_variable_dumper(readable = 0)
+ int readable
+ PROTOTYPE: ;$
+
+#if (RL_READLINE_VERSION >= 0x0402)
+
+int
+rl_set_paren_blink_timeout(usec)
+ int usec
+ PROTOTYPE: $
+
+#endif /* (RL_READLINE_VERSION >= 0x0402) */
+
+ # rl_get_termcap() is documented by readline-4.2 but it has been implemented
+ # from 2.2.1.
+
+ # Do not free the string returned.
+char *
+rl_get_termcap(cap)
+ CONST char * cap
+ PROTOTYPE: $
+
+ #
+ # 2.4.12 Alternate Interface
+ #
+
+void
+rl_callback_handler_install(prompt, lhandler)
+ const char * prompt
+ SV * lhandler
+ PROTOTYPE: $$
+ CODE:
+ {
+ static char *cb_prompt = NULL;
+ int len = strlen(prompt) + 1;
+
+ /* The value of prompt may be used after return from this routine. */
+ if (cb_prompt) {
+ Safefree(cb_prompt);
+ }
+ New(0, cb_prompt, len, char);
+ Copy(prompt, cb_prompt, len, char);
+
+ /*
+ * Don't remove braces. The definition of SvSetSV() of
+ * Perl 5.003 has a problem.
+ */
+ if (callback_handler_callback) {
+ SvSetSV(callback_handler_callback, lhandler);
+ } else {
+ callback_handler_callback = newSVsv(lhandler);
+ }
+
+ rl_callback_handler_install(cb_prompt, callback_handler_wrapper);
+ }
+
+void
+rl_callback_read_char()
+ PROTOTYPE:
+
+void
+rl_callback_handler_remove()
+ PROTOTYPE:
+
+ #
+ # 2.5 Readline Signal Handling
+ #
+
+void
+rl_cleanup_after_signal()
+ PROTOTYPE:
+
+void
+rl_free_line_state()
+ PROTOTYPE:
+
+void
+rl_reset_after_signal()
+ PROTOTYPE:
+
+void
+rl_resize_terminal()
+ PROTOTYPE:
+
+#if (RL_READLINE_VERSION >= 0x0402)
+
+void
+rl_set_screen_size(rows, cols)
+ int rows
+ int cols
+ PROTOTYPE: $$
+
+void
+rl_get_screen_size()
+ PROTOTYPE:
+ PPCODE:
+ {
+ int rows, cols;
+ rl_get_screen_size(&rows, &cols);
+ EXTEND(sp, 2);
+ PUSHs(sv_2mortal(newSViv(rows)));
+ PUSHs(sv_2mortal(newSViv(cols)));
+ }
+
+#endif /* (RL_READLINE_VERSION >= 0x0402) */
+
+int
+rl_set_signals()
+ PROTOTYPE:
+
+int
+rl_clear_signals()
+ PROTOTYPE:
+
+ #
+ # 2.6 Custom Completers
+ #
+
+int
+rl_complete_internal(what_to_do = TAB)
+ int what_to_do
+ PROTOTYPE: ;$
+
+#if (RL_READLINE_VERSION >= 0x0403)
+int
+_rl_completion_mode(function)
+ rl_command_func_t * function
+ PROTOTYPE: $
+ CODE:
+ RETVAL = rl_completion_mode(function);
+ OUTPUT:
+ RETVAL
+
+#endif /* (RL_READLINE_VERSION >= 0x0403) */
+
+void
+rl_completion_matches(text, fn = NULL)
+ const char * text
+ SV * fn
+ PROTOTYPE: $;$
+ PPCODE:
+ {
+ char **matches;
+
+ if (SvTRUE(fn)) {
+ /* use completion_entry_function temporarily */
+ Function *rlfunc_save = *(fn_tbl[CMP_ENT].rlfuncp);
+ SV *callback_save = fn_tbl[CMP_ENT].callback;
+ fn_tbl[CMP_ENT].callback = newSVsv(fn);
+
+ matches = rl_completion_matches(text,
+ completion_entry_function_wrapper);
+
+ SvREFCNT_dec(fn_tbl[CMP_ENT].callback);
+ fn_tbl[CMP_ENT].callback = callback_save;
+ *(fn_tbl[CMP_ENT].rlfuncp) = rlfunc_save;
+ } else
+ matches = rl_completion_matches(text, NULL);
+
+ /*
+ * Without the next line the Perl internal stack is broken
+ * under some condition. Perl bug or undocumented feature
+ * !!!?
+ */
+ SPAGAIN; sp -= 2;
+
+ if (matches) {
+ int i, count;
+
+ /* count number of entries */
+ for (count = 0; matches[count]; count++)
+ ;
+
+ EXTEND(sp, count);
+ for (i = 0; i < count; i++) {
+ PUSHs(sv_2mortal(newSVpv(matches[i], 0)));
+ xfree(matches[i]);
+ }
+ xfree((char *)matches);
+ } else {
+ /* return null list */
+ }
+ }
+
+t_xstr
+rl_filename_completion_function(text, state)
+ const char * text
+ int state
+ PROTOTYPE: $$
+
+t_xstr
+rl_username_completion_function(text, state)
+ const char * text
+ int state
+ PROTOTYPE: $$
+
+
+ ########################################################################
+ #
+ # Gnu History Library
+ #
+ ########################################################################
+
+ #
+ # 2.3.1 Initializing History and State Management
+ #
+void
+using_history()
+ PROTOTYPE:
+
+ # history_get_history_state() and history_set_history_state() are useless
+ # and too dangerous to be used in Perl code
+ # void
+ # history_get_history_state()
+ # PROTOTYPE:
+ # PPCODE:
+ # {
+ # HISTORY_STATE *state;
+ #
+ # state = history_get_history_state();
+ # EXTEND(sp, 4);
+ # PUSHs(sv_2mortal(newSViv(state->offset)));
+ # PUSHs(sv_2mortal(newSViv(state->length)));
+ # PUSHs(sv_2mortal(newSViv(state->size)));
+ # PUSHs(sv_2mortal(newSViv(state->flags)));
+ # xfree((char *)state);
+ # }
+
+ #
+ # 2.3.2 History List Management
+ #
+
+void
+add_history(string)
+ CONST char * string
+ PROTOTYPE: $
+
+HIST_ENTRY *
+remove_history(which)
+ int which
+ PROTOTYPE: $
+ OUTPUT:
+ RETVAL
+ CLEANUP:
+ if (RETVAL) {
+ xfree(RETVAL->line);
+ xfree(RETVAL->data);
+ xfree((char *)RETVAL);
+ }
+
+HIST_ENTRY *
+replace_history_entry(which, line)
+ int which
+ CONST char * line
+ PROTOTYPE: $$
+ CODE:
+ RETVAL = replace_history_entry(which, line, (char *)NULL);
+ OUTPUT:
+ RETVAL
+ CLEANUP:
+ if (RETVAL) {
+ xfree(RETVAL->line);
+ xfree(RETVAL->data);
+ xfree((char *)RETVAL);
+ }
+
+void
+clear_history()
+ PROTOTYPE:
+
+int
+stifle_history(i)
+ SV * i
+ PROTOTYPE: $
+ CODE:
+ {
+ if (SvOK(i)) {
+ int max = SvIV(i);
+ stifle_history(max);
+ RETVAL = max;
+ } else {
+ RETVAL = unstifle_history();
+ }
+ }
+ OUTPUT:
+ RETVAL
+
+int
+unstifle_history()
+ PROTOTYPE:
+
+int
+history_is_stifled()
+ PROTOTYPE:
+
+ #
+ # 2.3.3 Information about the History List
+ #
+
+ # history_list() is implemented as a perl function in Gnu.pm.
+
+int
+where_history()
+ PROTOTYPE:
+
+HIST_ENTRY *
+current_history()
+ PROTOTYPE:
+
+HIST_ENTRY *
+history_get(offset)
+ int offset
+ PROTOTYPE: $
+
+int
+history_total_bytes()
+ PROTOTYPE:
+
+ #
+ # 2.3.4 Moving Around the History List
+ #
+int
+history_set_pos(pos)
+ int pos
+ PROTOTYPE: $
+
+HIST_ENTRY *
+previous_history()
+ PROTOTYPE:
+
+HIST_ENTRY *
+next_history()
+ PROTOTYPE:
+
+ #
+ # 2.3.5 Searching the History List
+ #
+int
+history_search(string, direction = -1)
+ CONST char * string
+ int direction
+ PROTOTYPE: $;$
+
+int
+history_search_prefix(string, direction = -1)
+ CONST char * string
+ int direction
+ PROTOTYPE: $;$
+
+int
+history_search_pos(string, direction = -1, pos = where_history())
+ CONST char * string
+ int direction
+ int pos
+ PROTOTYPE: $;$$
+
+ #
+ # 2.3.6 Managing the History File
+ #
+int
+read_history_range(filename = NULL, from = 0, to = -1)
+ CONST char * filename
+ int from
+ int to
+ PROTOTYPE: ;$$$
+
+int
+write_history(filename = NULL)
+ CONST char * filename
+ PROTOTYPE: ;$
+
+int
+append_history(nelements, filename = NULL)
+ int nelements
+ CONST char * filename
+ PROTOTYPE: $;$
+
+int
+history_truncate_file(filename = NULL, nlines = 0)
+ CONST char * filename
+ int nlines
+ PROTOTYPE: ;$$
+
+ #
+ # 2.3.7 History Expansion
+ #
+void
+history_expand(line)
+ # should be defined as 'const char *'
+ char * line
+ PROTOTYPE: $
+ PPCODE:
+ {
+ char *expansion;
+ int result;
+
+ result = history_expand(line, &expansion);
+ EXTEND(sp, 2);
+ PUSHs(sv_2mortal(newSViv(result)));
+ PUSHs(sv_2mortal(newSVpv(expansion, 0)));
+ xfree(expansion);
+ }
+
+void
+_get_history_event(string, cindex, qchar = 0)
+ CONST char * string
+ int cindex
+ int qchar
+ PROTOTYPE: $$;$
+ PPCODE:
+ {
+ char *text;
+
+ text = get_history_event(string, &cindex, qchar);
+ EXTEND(sp, 2);
+ if (text) { /* don't free `text' */
+ PUSHs(sv_2mortal(newSVpv(text, 0)));
+ } else {
+ PUSHs(&PL_sv_undef);
+ }
+ PUSHs(sv_2mortal(newSViv(cindex)));
+ }
+
+void
+history_tokenize(text)
+ CONST char * text
+ PROTOTYPE: $
+ PPCODE:
+ {
+ char **tokens;
+
+ tokens = history_tokenize(text);
+ if (tokens) {
+ int i, count;
+
+ /* count number of entries */
+ for (count = 0; tokens[count]; count++)
+ ;
+
+ EXTEND(sp, count);
+ for (i = 0; i < count; i++) {
+ PUSHs(sv_2mortal(newSVpv(tokens[i], 0)));
+ xfree(tokens[i]);
+ }
+ xfree((char *)tokens);
+ } else {
+ /* return null list */
+ }
+ }
+
+#define DALLAR '$' /* define for xsubpp bug */
+
+t_xstr
+_history_arg_extract(line, first = 0 , last = DALLAR)
+ CONST char * line
+ int first
+ int last
+ PROTOTYPE: $;$$
+ CODE:
+ RETVAL = history_arg_extract(first, last, line);
+ OUTPUT:
+ RETVAL
+
+
+ #
+ # GNU Readline/History Library Variable Access Routines
+ #
+
+MODULE = Term::ReadLine::Gnu PACKAGE = Term::ReadLine::Gnu::Var
+
+void
+_rl_store_str(pstr, id)
+ const char * pstr
+ int id
+ PROTOTYPE: $$
+ CODE:
+ {
+ size_t len;
+
+ ST(0) = sv_newmortal();
+ if (id < 0 || id >= sizeof(str_tbl)/sizeof(struct str_vars)) {
+ warn("Gnu.xs:_rl_store_str: Illegal `id' value: `%d'", id);
+ XSRETURN_UNDEF;
+ }
+
+ if (str_tbl[id].read_only) {
+ warn("Gnu.xs:_rl_store_str: store to read only variable");
+ XSRETURN_UNDEF;
+ }
+
+ /*
+ * Use xmalloc() and xfree() instead of New() and Safefree(),
+ * because this block may be reallocated by the GNU Readline Library.
+ */
+ if (str_tbl[id].accessed && *str_tbl[id].var) {
+ /*
+ * First time a variable is used by this routine,
+ * it may be a static area. So it cannot be freed.
+ */
+ xfree(*str_tbl[id].var);
+ *str_tbl[id].var = NULL;
+ }
+ str_tbl[id].accessed = 1;
+
+ len = strlen(pstr) + 1;
+ *str_tbl[id].var = xmalloc(len);
+ Copy(pstr, *str_tbl[id].var, len, char);
+
+ /* return variable value */
+ if (*str_tbl[id].var) {
+ sv_setpv(ST(0), *str_tbl[id].var);
+ }
+ }
+
+void
+_rl_store_rl_line_buffer(pstr)
+ const char * pstr
+ PROTOTYPE: $
+ CODE:
+ {
+ size_t len;
+
+ ST(0) = sv_newmortal();
+ if (pstr) {
+ len = strlen(pstr);
+
+ /*
+ * Old manual did not document this function, but can be
+ * used.
+ */
+ rl_extend_line_buffer(len + 1);
+
+ Copy(pstr, rl_line_buffer, len + 1, char);
+ /* rl_line_buffer is not NULL here */
+ sv_setpv(ST(0), rl_line_buffer);
+
+ /* fix rl_end and rl_point */
+ rl_end = len;
+ if (rl_point > len)
+ rl_point = len;
+ }
+ }
+
+void
+_rl_fetch_str(id)
+ int id
+ PROTOTYPE: $
+ CODE:
+ {
+ ST(0) = sv_newmortal();
+ if (id < 0 || id >= sizeof(str_tbl)/sizeof(struct str_vars)) {
+ warn("Gnu.xs:_rl_fetch_str: Illegal `id' value: `%d'", id);
+ } else {
+ if (*(str_tbl[id].var)) {
+ sv_setpv(ST(0), *(str_tbl[id].var));
+ }
+ }
+ }
+
+void
+_rl_store_int(pint, id)
+ int pint
+ int id
+ PROTOTYPE: $$
+ CODE:
+ {
+ ST(0) = sv_newmortal();
+ if (id < 0 || id >= sizeof(int_tbl)/sizeof(struct int_vars)) {
+ warn("Gnu.xs:_rl_store_int: Illegal `id' value: `%d'", id);
+ XSRETURN_UNDEF;
+ }
+
+ if (int_tbl[id].read_only) {
+ warn("Gnu.xs:_rl_store_int: store to read only variable");
+ XSRETURN_UNDEF;
+ }
+
+ /* set C variable */
+ if (int_tbl[id].charp)
+ *((char *)(int_tbl[id].var)) = (char)pint;
+ else
+ *(int_tbl[id].var) = pint;
+
+ /* return variable value */
+ sv_setiv(ST(0), pint);
+ }
+
+void
+_rl_fetch_int(id)
+ int id
+ PROTOTYPE: $
+ CODE:
+ {
+ ST(0) = sv_newmortal();
+ if (id < 0 || id >= sizeof(int_tbl)/sizeof(struct int_vars)) {
+ warn("Gnu.xs:_rl_fetch_int: Illegal `id' value: `%d'", id);
+ /* return undef */
+ } else {
+ sv_setiv(ST(0),
+ int_tbl[id].charp ? (int)*((char *)(int_tbl[id].var))
+ : *(int_tbl[id].var));
+ }
+ }
+
+FILE *
+_rl_store_iostream(stream, id)
+ FILE * stream
+ int id
+ PROTOTYPE: $$
+ CODE:
+ {
+ switch (id) {
+ case 0:
+ RETVAL = rl_instream = stream;
+ break;
+ case 1:
+ RETVAL = rl_outstream = stream;
+#ifdef __CYGWIN__
+ {
+ /* Cygwin b20.1 library converts NL to CR-NL
+ automatically. But it does not do it on a file
+ stream made by Perl. Set terminal attribute
+ explicitly */
+ struct termios tio;
+ tcgetattr(fileno(rl_outstream), &tio);
+ tio.c_iflag |= ICRNL;
+ tio.c_oflag |= ONLCR;
+ tcsetattr(fileno(rl_outstream), TCSADRAIN, &tio);
+ }
+#endif /* __CYGWIN__ */
+ break;
+ default:
+ warn("Gnu.xs:_rl_store_iostream: Illegal `id' value: `%d'", id);
+ XSRETURN_UNDEF;
+ break;
+ }
+ }
+ OUTPUT:
+ RETVAL
+
+FILE *
+_rl_fetch_iostream(id)
+ int id
+ PROTOTYPE: $
+ CODE:
+ {
+ switch (id) {
+ case 0:
+ RETVAL = rl_instream;
+ break;
+ case 1:
+ RETVAL = rl_outstream;
+ break;
+ default:
+ warn("Gnu.xs:_rl_fetch_iostream: Illegal `id' value: `%d'", id);
+ XSRETURN_UNDEF;
+ break;
+ }
+ }
+ OUTPUT:
+ RETVAL
+
+Keymap
+_rl_fetch_keymap(id)
+ int id
+ PROTOTYPE: $
+ CODE:
+ {
+ switch (id) {
+ case 0:
+ RETVAL = rl_executing_keymap;
+ break;
+ case 1:
+ RETVAL = rl_binding_keymap;
+ break;
+ default:
+ warn("Gnu.xs:_rl_fetch_keymap: Illegal `id' value: `%d'", id);
+ XSRETURN_UNDEF;
+ break;
+ }
+ }
+ OUTPUT:
+ RETVAL
+
+void
+_rl_store_function(fn, id)
+ SV * fn
+ int id
+ PROTOTYPE: $$
+ CODE:
+ {
+ /*
+ * If "fn" is undef, default value of the GNU Readline
+ * Library is set.
+ */
+ ST(0) = sv_newmortal();
+ if (id < 0 || id >= sizeof(fn_tbl)/sizeof(struct fn_vars)) {
+ warn("Gnu.xs:_rl_store_function: Illegal `id' value: `%d'", id);
+ XSRETURN_UNDEF;
+ }
+
+ if (SvTRUE(fn)) {
+ /*
+ * Don't remove braces. The definition of SvSetSV() of
+ * Perl 5.003 has a problem.
+ */
+ if (fn_tbl[id].callback) {
+ SvSetSV(fn_tbl[id].callback, fn);
+ } else {
+ fn_tbl[id].callback = newSVsv(fn);
+ }
+ *(fn_tbl[id].rlfuncp) = fn_tbl[id].wrapper;
+ } else {
+ if (fn_tbl[id].callback) {
+ SvSetSV(fn_tbl[id].callback, &PL_sv_undef);
+ }
+ *(fn_tbl[id].rlfuncp) = fn_tbl[id].defaultfn;
+ }
+
+ /* return variable value */
+ sv_setsv(ST(0), fn);
+ }
+
+void
+_rl_fetch_function(id)
+ int id
+ PROTOTYPE: $
+ CODE:
+ {
+ ST(0) = sv_newmortal();
+ if (id < 0 || id >= sizeof(fn_tbl)/sizeof(struct fn_vars)) {
+ warn("Gnu.xs:_rl_fetch_function: Illegal `id' value: `%d'", id);
+ /* return undef */
+ } else if (fn_tbl[id].callback && SvTRUE(fn_tbl[id].callback)) {
+ sv_setsv(ST(0), fn_tbl[id].callback);
+ }
+ }
+
+Function *
+_rl_fetch_last_func()
+ PROTOTYPE:
+ CODE:
+ RETVAL = rl_last_func;
+ OUTPUT:
+ RETVAL
+
+MODULE = Term::ReadLine::Gnu PACKAGE = Term::ReadLine::Gnu::XS
+
+void
+tgetstr(id)
+ const char * id
+ PROTOTYPE: $
+ CODE:
+ ST(0) = sv_newmortal();
+ if (id) {
+ /*
+ * The magic number `2032' is derived from bash
+ * terminal.c:_rl_init_terminal_io().
+ */
+ char buffer[2032];
+ char *bp = buffer;
+ char *t;
+ t = tgetstr(id, &bp); /* don't free returned string */
+ if (t) {
+ char buf[2032];
+ /* call tputs() to apply padding information */
+ tputs_ptr = buf;
+ tputs(t, 1, tputs_char);
+ *tputs_ptr = '\0';
+ sv_setpv(ST(0), buf);
+ }
+ }
+
+ #
+ # Local Variables:
+ # c-default-style: "gnu"
+ # End:
+ #
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/Gnu.xs
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/INSTALL
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/INSTALL 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/INSTALL 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,119 @@
+-*- Indented-text -*-
+# $Id: INSTALL,v 1.21 2002-07-27 23:20:05-05 hiroo Exp $
+
+1. How to Install Term::ReadLine::Gnu
+
+ You need the GNU Readline library installed. Except for this,
+ you can install this module by the standard method, i.e.
+
+ perl Makefile.PL; make install
+
+1.1 Install GNU Readline library 2.1 or later and their header files.
+
+ See the section `How to Install GNU Readline Library'.
+
+1.2 Make and install
+
+ % perl Makefile.PL [--prefix=...] [--includedir=...] [--libdir=...]
+ % make
+ % make test
+ % make install
+
+ If you have installed the GNU Readline Library
+ (libreadline.{a,so} and readline/readline.h, etc.) on
+ directories for which your perl is not configured to search
+ (refer the value of ccflags and libpath in the output of `perl
+ -V'), specify the paths as follows;
+
+ % perl Makefile.PL --includedir=/mydir/include --libdir=/mydir/lib
+
+ This example is equivalent to the following;
+
+ % perl Makefile.PL --prefix=/mydir
+
+ If you are not an administrator and cannot install Perl module
+ in your system directory, try
+ perldoc perlfaq8
+ and see the section 'How do I keep my own module/library
+ directory?' (This section is found in the Perl 5.6
+ documentation).
+
+1.3 Trouble Shooting
+
+ If you have any trouble when using or installing this module,
+ please let me (hiroo.hayashi at computer.org) know by E-Mail. It
+ may help other people who have the same problem. I'm sorry
+ that I cannot watch all articles on comp.lang.perl.modules.
+
+ When you report your trouble, be sure to send me the following
+ information;
+ o result of `perl -V'
+ o compiler you used to compile the GNU Readline Library
+ (libreadline.a).
+ o terminal emulator which you are using
+ o result of `echo $TERM`
+
+2. How to Install GNU Readline Library
+
+ Now this module supports only GNU Readline Library 2.1 and
+ later. Executing `perl Makefile.PL` detects which version of
+ the GNU Readline Library is already installed and warns you if
+ you have the unsupported version.
+
+ In the following example, the install prefix directory is
+ `/usr/local/gnu'.
+
+ You can specify any directory for the GNU Readline library and
+ its header files, by editing `LIBS' and/or `INC' section in
+ Makefile.PL.
+
+2.1. Install
+
+ readline-2.2.tar.gz has some bugs, so I strongly recommend you
+ to use readline-2.2.1.tar.gz and/or later instead.
+
+ 1. get and extract readline-XX.tar.gz
+
+ 2. configure
+ % ./configure --prefix=/usr/local/gnu
+ 3. make and install
+ % make install
+
+ If you have any reason in which use must use one of the follows;
+ readline-2.1
+ libreadline.a in bash-2.0.tar.gz
+ Cygwin b20.1
+ see INSTALL file which is included in Term-ReadLine-Gnu-1.11.
+
+2.2 Shared Library
+
+ If you want to build it as shared library, use readline-4.0
+ (or later). Type `make shared' instead of `make' to build
+ shared library.
+
+ You HAVE TO build the library as shared library on the
+ following OSs;
+ HPUX
+
+ You DON'T HAVE TO and may build the library as shared library
+ on the following OSs;
+ GNU/Linux 2.x
+ SunOS 4.x, 5.x
+ AIX 4.1.x
+ Cygwin 20.x
+
+ # Please let me know on your experience on others OSs.
+
+2.3 Multibyte Character (Japanese character) Handling
+
+ # readline-4.3 on some system has multibyte support. If your
+ # system supports it, ignore this section.
+
+ Since the GNU Readline Library is 8 bit clean, I use Japanese
+ characters without any patch. But I have to hit Backspace key
+ twice to erase a Japanese character.
+
+ If you are using EUC Japanese charactor try to use
+ Gnu/euc_jp.pm module.
+
+EOF
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/INSTALL
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/MANIFEST 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/MANIFEST 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,24 @@
+Gnu.pm The GNU Readline extension Perl module
+Gnu.xs The GNU Readline extension external subroutines
+Gnu/XS.pm
+Gnu/euc_jp.pm
+INSTALL Installtion instructions
+MANIFEST This list of files
+Makefile.PL The GNU Readline extension makefile writer
+README The Instructions
+eg/perlsh A powerful calculator
+eg/fileman A short completion example
+eg/pftp An ftp client with the GNU Readline support
+eg/ptksh+ Simple perl/Tk shell which demonstrates the callback functions
+ppport.h Perl/Pollution/Portability Version 1.0007
+t/comptest/0123 A file for t/readline.t
+t/comptest/012345 A file for t/readline.t
+t/comptest/023456 A file for t/readline.t
+t/comptest/README A file for t/readline.t
+t/comptest/a_b A file for t/readline.t
+t/button.pl a test script for t/callback.t
+t/callback.t a test script for the GNU Readline callback function
+t/history.t a test script for the GNU History Library function
+t/inputrc A file for t/readline.t
+t/readline.t a test script for the GNU Readline extension
+typemap The GNU Readline extension interface types
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/MANIFEST
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/Makefile.PL 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/Makefile.PL 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,190 @@
+#
+# Makefile.PL for Term::ReadLine::Gnu
+#
+# $Id: Makefile.PL,v 1.27 2003-03-16 20:26:25-05 hiroo Exp $
+#
+# Copyright (c) 2003 Hiroo Hayashi. All rights reserved.
+# <hiroo.hayashi at computer.org>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+# OS/2 support is contributed by Ilya Zakharevich.
+# <ilya at math.ohio-state.edu>
+#
+# Usage: perl Makefile.PL [--prefix=...] [--includedir=...] [--libdir=...]
+# [OPTIMIZE=...]
+#
+# Read INSTALL for more details.
+########################################################################
+use strict;
+use ExtUtils::MakeMaker;
+use Config;
+use Getopt::Long;
+
+my ($defs, $libs, $lddflags, $RLLIB, $RLINC);
+
+$defs = ($Config{strings} =~ m|/string.h$|) ? '-DHAVE_STRING_H' : '';
+
+# Parse command line to specify paths for the GNU Readline Library
+{
+ my ($prefix, $libdir, $incdir);
+ GetOptions("prefix=s" => \$prefix,
+ "libdir=s" => \$libdir,
+ "includedir=s" => \$incdir);
+ $RLLIB = defined $libdir
+ ? "-L$libdir" : (defined $prefix ? "-L$prefix/lib" : '');
+ $RLINC = defined $incdir
+ ? "-I$incdir" : (defined $prefix ? "-I$prefix/include" : '');
+}
+
+if ($Config{osname} eq 'os2') {
+ # Check ftp://ftp.math.ohio-state.edu/pub/users/ilya/os2/
+ $libs = '-lreadline_import';
+ $defs .= ' -DOS2_USEDLL';
+ $lddflags = '';
+} else {
+ # Search libtermcap, libncurses, or libcurses in this order.
+ # I emulate the behavior of the configure script for bash, and don't
+ # know why AIX prefers curses.
+ # libtermcap.a on HPUX cannot be used for dynamically linked binary.
+ my $PREFER_CURSES = $Config{osname} eq 'aix' || $Config{osname} eq 'hpux';
+ my $TERMCAP_LIB = (! $PREFER_CURSES && &search_lib('-ltermcap'))
+ || &search_lib('-lncurses')
+ || &search_lib('-lcurses');
+ die "Could not find neither libtermcap.a, libncurses.a, or libcurses.\n"
+ unless $TERMCAP_LIB;
+
+ $libs = "-lreadline $TERMCAP_LIB";
+ # Latest Perl in FreeBSD does not need this hack. (Dec.2002)
+ $libs .= ' -lcrypt' if ($Config{osname} =~ /freebsd/i);
+ $lddflags = ($Config{osname} =~ /cygwin/i) ? '-static' : '';
+}
+
+# Check version of GNU Readline Library (for version 4.2 and before)
+{
+ my ($rlmajorver, $rlminorver) =
+ check_readline_version($RLINC, $RLLIB, $defs, $lddflags, $libs);
+
+ if ($rlmajorver < 4 || $rlmajorver == 4 && $rlminorver <= 2) {
+ $defs .= " -DRL_READLINE_VERSION=" .
+ sprintf("0x%02x%02x", $rlmajorver, $rlminorver);
+ $defs .= " -DRL_VERSION_MAJOR=$rlmajorver";
+ $defs .= " -DRL_VERSION_MINOR=$rlminorver";
+ }
+}
+
+# generate a Makefile
+WriteMakefile
+ (
+ NAME => 'Term::ReadLine::Gnu',
+ VERSION_FROM => 'Gnu.pm',
+ LIBS => [ "$RLLIB $libs" ],
+ dynamic_lib => { OTHERLDFLAGS => $lddflags },
+ DEFINE => $defs,
+ ($Config{osname} eq 'os2' ?
+ (
+ IMPORTS => { xfree => 'emxlibcm.401' }, # Yuck!
+ ) : () ),
+ INC => $RLINC,
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' },
+ clean => { FILES => "rlver.c rlver$Config{_exe}" },
+);
+
+if ($Config{usesfio} eq 'true') {
+ warn <<'EOM';
+
+******************** !!!Warning!!! *********************
+** Your Perl is configured as `usesfio' equals true. **
+** Term::ReadLine::Gnu may not work with your Perl. **
+** If it works, let me know your result of `perl -V'. **
+********************************************************
+EOM
+}
+
+exit(0);
+
+########################################################################
+# Search a library '$lib' in $Config{libpth} directories, and return
+# $lib if exist or undef unless exist.
+
+# ExtUtils::Liblist::ext() do similar job as this subroutine, but it
+# warns unnecessary messages.
+sub search_lib {
+ my ($lib) = @_;
+ unless ($lib =~ /^-l/) {
+ warn "search_lib: illegal arguments, \`$lib\'.\n";
+ return undef;
+ }
+ my $libbase = 'lib' . substr($lib, 2) . $Config{lib_ext};
+ my $libbase_so = 'lib' . substr($lib, 2) . "." . $Config{so};
+ foreach (split(' ', $Config{libpth})) {
+ if (-f $_ . '/' . $libbase) {
+# print "$_/$libbase\n";
+ print "Found \`$_/$libbase\'.\n";
+ return $lib;
+ } elsif (-f $_ . '/' . $libbase_so) {
+# print "$_/$libbase_so\n";
+ print "Found \`$_/$libbase_so\'.\n";
+ return $lib;
+ }
+ }
+ return undef;
+}
+
+########################################################################
+# Check libreadline.a version
+#
+# Readline 4.2a introduced the macro
+# RL_READLINE_VERSION
+# RL_VERSION_MAJOR
+# RL_VERSION_MINOR
+# Someday we don't need this subroutine..
+sub check_readline_version {
+ my ($RLINC, $RLLIB, $defs, $lddflags, $libs) = @_;
+ my $frlver = 'rlver.c';
+
+ # make temp file
+ open(F, ">$frlver") || die "Cannot open $frlver:$!\n";
+ print F <<'EOF';
+/* used by Makefile.pl to check the version of the GNU Readline Library */
+#include <stdio.h>
+#include <readline/readline.h>
+main() { puts(rl_library_version); }
+EOF
+ close(F);
+
+ # compile it
+ my $comp_cmd = "$Config{cc} $RLINC $Config{ccflags} $defs $frlver -o rlver $RLLIB $lddflags $Config{ldflags} $libs";
+ print $comp_cmd, "\n";
+ system($comp_cmd);
+ if ($?) {
+ die <<EOM;
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+Could not compile $frlver.
+
+If you have installed the GNU Readline Library (libreadline.{a,so} and
+readline/readline.h, etc.) on directories for which your perl is not
+configured to search (refer the value of `ccflags' and `libpath' in
+the output of `perl -V'), specify the paths as follows;
+
+ perl Makefile.PL --includedir=/yourdir/include --libdir=/yourdir/lib
+or
+ perl Makefile.PL --prefix=/yourdir
+
+Note that the GNU Readline Library version 2.0 and earlier causes error
+here. Update it to version 2.1 and/or later.
+
+Read INSTALL for more details.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+EOM
+ }
+
+ # execute it and get version
+ my $rlver;
+ chomp($rlver = `./rlver`);
+ print "It seems that you have the GNU Readline Library version $rlver.\n";
+ # $rlver may be '8.21-beta3' or '4.2a'
+ return $rlver =~ /(\d+)\.(\d+)/;
+}
+# End of Makefile.PL
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/Makefile.PL
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/README
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/README 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/README 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,406 @@
+ -*- Indented-text -*-
+$Id: README,v 1.24 2003-03-16 22:52:50-05 hiroo Exp $
+
+Term::ReadLine::Gnu --- GNU Readline Library Wrapper Module
+
+ Copyright (c) 2003 Hiroo Hayashi. All rights reserved.
+
+ This program is free software; you can redistribute it and/or
+ modify it under the same terms as Perl itself.
+
+Description:
+
+ Term::ReadLine::Gnu (TRG) is an implementation of the
+ interface to the GNU Readline Library. This module gives you
+ input line editing facility, input history management
+ facility, word completion facility, etc. It uses the real GNU
+ Readline Library and has the interface with the almost all
+ variables and functions which are documented in the GNU
+ Readline/History Library. So you can program your custom
+ editing function, your custom completion function, and so on
+ with Perl. TRG may be useful for a C programmer to prototype
+ a program which uses the GNU Readline Library.
+
+ TRG is upper compatible with Term::ReadLine included in Perl
+ distribution. Term::ReadLine uses TRG automatically when TRG
+ is available. You can enjoy full line editing feature with
+ Perl debugger which use Term::ReadLine with no patch.
+
+ Ilya Zakharevich distributes his implementation,
+ Term::ReadLine::Perl, which bases on Jeffrey Friedl's
+ readline.pl. His module works very well, and is easy to
+ install because it is written by only Perl. I am trying to
+ make my module compatible with his. He gives useful advises
+ for me. Unfortunately readline.pl simulated old GNU Readline
+ library before TRG was born. For example, it was not 8 bit
+ clean and it warns to the variables in ~/.inputrc which it did
+ not know yet. We Japanese usually use 8 bit characters, so
+ this was bad feature for me. I could make a patch for these
+ problems but I had interest with C interface facility and
+ dynamic loading facility of Perl, so I thought it was a good
+ chance for me to study them. Then I made this module instead
+ of fixing his module.
+
+Prerequisites:
+ You must have GNU Readline Library Version 2.1 or later. See
+ INSTALL for more detail.
+
+ By a report GNU Readline Library may not work with perl with
+ sfio. Since I do not have sfio library, I am not sure.
+
+How to build/install:
+ See INSTALL.
+
+Bugs:
+ There may be many bugs in both programs and documents
+ (especially in English grammar). Comments and bug reports are
+ very welcome.
+
+Author:
+ Hiroo Hayashi <hiroo.hayashi at computer.org>
+
+
+Revision History:
+
+1.14 2003-03-16
+ - kludge not to cause segmentation fault on Perl 5.8.0
+ w/PerlIO and FileHandle (ex. CPAN.pm)
+ - clean up Makefile.PL (use strict, fix for HPUX and FreeBSD,
+ fix typo, etc.)
+
+1.13 2002-07-27
+ - readline-4.2 support
+ new variables
+ rl_completion_suppress_append
+ rl_completion_mark_symlink_dirs
+ new functions
+ rl_replace_line()
+ rl_completion_mode()
+ - tgetstr() calls tput() to apply padding information. No
+ more "$<2>" on prompt.
+ - shadow_redisplay() with ornament works on xterm.
+
+1.12 2002-03-30
+ - add '-static' flag to 'LDDFLAGS' on Cygwin 1.3.
+ - shadow redisplay does not pester you with warning on a poor
+ terminal, or a terminal with wrong TERM environment variable
+ setting.
+ - update documents
+ - improve coding style of Gnu.xs. (indentation stype, more
+ typemap, etc.)
+
+1.11 2001-10-27
+ - fix bug of filename-list. Now works with perldb.
+ - by setting rl_line_buffer, proper value are set in rl_end
+ and rl_point.
+ - add history-expand-line command
+ - readline-4.2a support
+ new variable
+ rl_readline_version
+ new function
+ rl_get_termcap
+
+1.10 2001-04-22
+ - readline-4.2 support
+ new variables
+ rl_attemped_completion_over
+ rl_completion_type
+ rl_deprep_term_function
+ rl_directory_rewrite_hook
+ rl_dispatching
+ rl_editing_mode
+ rl_executing_macro
+ rl_explicit_arg
+ rl_gnu_readline_p
+ rl_num_char_to_read
+ rl_numeric_arg
+ rl_prep_term_function
+ rl_readline_state
+ history_word_delimiters
+ new functions
+ rl_add_funmap_entry
+ rl_alphabetic
+ rl_clear_pending_input
+ rl_crlf
+ rl_deprep_terminal
+ rl_execute_next
+ rl_expand_prompt
+ rl_get_screen_size
+ rl_macro_bind
+ rl_macro_dumper
+ rl_prep_terminal
+ rl_push_macro_input
+ rl_set_keyboard_input_timeout
+ rl_set_paren_blink_timeout(usec)
+ rl_set_prompt
+ rl_set_screen_size
+ rl_setkey
+ rl_show_char
+ rl_tty_set_default_bindings
+ rl_tty_set_default_bindings
+ rl_variable_bind
+ rl_variable_dumper
+ rename functions
+ free_undo_list() -> rl_free_undo_list()
+ ding() -> rl_ding()
+ completion_matches() -> rl_completion_matches()
+ filename_completion_function -> rl_filename_completion_function()
+ username_completion_function -> rl_username_completion_function()
+ max_input_history -> history_max_entries
+
+ - fix bug when ornament string does not use any control characters.
+ - add Gnu/euc_jp.pm which is still experimental.
+ - typemap: redefine FILE * to support perl 5.7.
+
+1.09 2000-04-04
+ - Perl-5.6 now does not warn without `POLLUTE=1' during `perl
+ Makefile.PL'. (Thanks to PPPort.)
+ - change the default terminal escape sequence to stop
+ underline.
+ - support rl_already_prompted and rl_on_new_line_with_prompt()
+ which are introduced by readline-4.1-beta.
+ - support rl_funmap_names() and rl_last_func.
+ - update documentation.
+
+1.08 1999-12-30
+ - fix Makefile.PL to search libreadline.* correctly even if it
+ is not included in the paths specified with the configuration
+ variable `libpth'.
+ - add dummy assignment to %ENV before $self->initialize()
+
+1.07 1999-07-19
+ - search path for the GNU Readline Library is specified by
+ command line argument instead of editing Makefile.PL.
+ - fix bug of t/readline.t which warns for the GNU Readline
+ version 2.1.
+ - Makefile.PL now looks for shared libraries not only for
+ static ones
+ - add support for Cygwin b20.1 and HPUX (HPUX support may be
+ incomplete.)
+ - no change on Gnu.pm and Gnu.xs
+
+1.06 1999-05-05
+ - fix a bug which causes segmentation fault when
+ completion_matches() returns long list.
+ - fix a bug which causes segmentation fault when
+ perl subroutine returns a list of undef in
+ attempted_completion_function_wrapper().
+ - disable Autosplit for AutoLoad.pm bug distributed with Perl
+ 5.004 or earlier.
+ - add check if perl is configured with sfio to Makefile.PL.
+
+1.05 1999-04-04
+ - bug fix
+ Term::ReadLine::Perl compatibility variable
+ `completion_function' and function `rl_filename_list' are
+ now compatible with Term::ReadLine::Perl. Completion code
+ written for Term::ReadLine::Perl, e.g. perl5db.pl, works
+ with this module.
+
+ search text of list_completion is quoted
+
+ - add support of new variables and functions introduced by GNU
+ Readline Library Version 4.0
+ new variable
+ rl_erase_empty_line
+ rl_catch_signals
+ rl_catch_sigwinch
+ rl_pre_input_hook
+ completion_display_matches_hook
+ history_inhibit_expansion_function
+ new function
+ rl_display_match_list()
+ rl_cleanup_after_signal()
+ rl_free_line_state()
+ rl_reset_after_signal()
+ rl_resize_terminal()
+ rl_set_signals()
+ rl_clear_signals()
+
+ - add support of variables and function which were not supported
+ yet
+ filename_quoting_function
+ filename_dequoting_function
+ char_is_quoted_p
+ ignore_some_completions_function
+ directory_completion_hook
+
+ rl_get_all_function_names()
+
+ - add support of functions which are specific to Term::ReadLine::Gnu
+ display_readline_version()
+ change_ornaments()
+ shadow_redisplay()
+
+ - rename some functions for the orthogonality
+ rl_unbind_function_in_map to rl_unbind_function
+ rl_unbind_command_in_map to rl_unbind_command
+
+ - `make test' is executed non-interactively and comprehensively
+
+ - sample code improvement
+ eg/perlsh
+ Perl symbol completion was rewritten and much more
+ improved.
+ SIGINT clears the current line
+ add support \w (current working package) in the prompt
+ string
+ add support `afterinit' hook as Perl debugger.
+
+ eg/pftp
+ password input is now invisible.
+ displaying of completion candidates are improved by using
+ completion_display_matches_hook.
+
+ - internal changes
+ Perl code for Term::ReadLine::Gnu::XS package are moved
+ into separate file Gnu/XS.pm and `AutoSplit'ed.
+
+ replace operate_and_get_next() to one borrowed from bash.
+
+1.04 1999-02-23
+ - fix a bug by which $if-$endif feature in ~/.inputrc was
+ disabled.
+ - works with GNU Readline Library version 4.0 in which some
+ function names were changed. New functions, that are
+ introduced in the new library, were not supported in this
+ release.
+
+1.03 1998-09-27
+ - fix a bug when prompt string includes non-printing
+ characters and an input line is longer than terminal width.
+ Constants, RL_PROMPT_START_IGNORE and RL_PROMPT_END_IGNORE,
+ are incorporated from the GNU Readline Library to support
+ this feature.
+ - now works on a system which does not have /etc/termcap and
+ has termcap compatible library, libncurses or libcurses.
+
+1.02 1998-08-14
+ - fix a bug in Makefile.PL, which quoted a variable, $increadlinedir,
+ with a pair of single quotes
+ - this is an internal revision
+
+1.01 1998-05-13
+ - support readline-2.2
+ add rl_unbind_function_in_map() and rl_unbind_command_in_map()
+ Makefile.PL checks the version of the GNU Readline Library
+
+ - define rl_save_prompt() and rl_restore_prompt()
+
+ - document fix
+ 'Changes' file is removed. It is merged into README file.
+ fix a bug in a sample program of rl_completion_entry_function
+
+1.00 1998-04-15
+ - the 1st major release
+
+ - ornaments feature is now on by default as recent
+ Term::ReadLine and Term::ReadLine::Perl
+
+ - document fix
+ remove description related to mymalloc
+
+ - add ornaments-change function to t/readline.t which
+ demonstrates rl_message().
+
+0.10 1998-03-31
+ - new functions/variables
+ ornaments support
+ newTTY() (not tested)
+ max_input_history
+ read_history() (an aliase of read_history_range())
+ unstifle_history()
+ history_search_pos()
+ history_list()
+ history_tokenize() (Thank you, Tim Thomas)
+ history_arg_extract()
+ get_history_event()
+ - new sample/test programs
+ eg/fileman
+ t/history.t
+ - bug fix
+ dynamic loading works on Solaris2.x (define xfree() locally)
+ readline() calls add_history() only when MinLength > 0
+ Feature `addhistory' is renamed to `addHistory' since
+ Term/ReadLine.pm is fixed.
+ add NULL check for all sv_setpv()
+ remove arguments 'pos' from history_search()
+ - misc
+ change my E-mail address
+
+0.09 Mon Aug 25 00:33:29 1997
+ - add documentation about readline-2.1.tar.gz
+ - add documentation about Solaris 2.5 with dynamic loading
+ - bug fix
+ fix for Digital Unix C compiler
+ - add two sample programs
+ eg/pftp An ftp client with the GNU Readline support
+ eg/ptksh+ Simple perl/Tk shell which demonstrates
+ the callback functions
+
+0.08 Sun Apr 13 23:24:52 1997
+
+ - bug fix: AddHistory() accepts list again.
+ - move perlsh into eg/.
+ - add eg/ptksh+ which demonstrates the callback functions.
+ Thank you Achim.
+ - add eg/pftp: an ftp client which has much the GNU Readline support.
+ - Author's Email address is changed.
+ - internal functions, fetch_var() and store_var(), are removed.
+
+0.07 Wed Mar 19 02:26:06 1997
+
+ - interface to internal function and variables are changed.
+ New interface is compatible with new Term::ReadLine.pm which
+ is distributed with Perl 5.003_92 and later. But it is not
+ compatible with previous release.
+
+ - add method interface to all internal function
+ - add Attribs method to access internal variables
+ - EXPORT_OK contains only some constant definitions
+
+ - tkRunning support (new ReadLine.pm is required)
+ - add document
+ - bug fixes
+ - XS bugs correspond to callback interface
+ - fix _rl_store_function() and _rl_fetch_function()
+ - fix prototype of append_history
+ - use new _rl_store_rl_line_buffer() instead of
+ reallocate rl_line_buffer.
+ - etc.
+
+0.06 Wed Feb 5 01:26:27 1997
+ - the first revision on CPAN
+ - support for non ANSI C compiler
+ - rename addhistory to AddHistory
+ - checked by gcc -Wall
+ - fix void_arg_func_wrapper()
+ - add hook for rl_startup_hook in readline()
+ - update documents
+
+0.05 Sat Jan 25 00:06:56 1997
+ - Fix for Perl 5.002 and 5.003
+ escape from an strange Exporter's behavior
+ remove white spaces in prototype
+ add argument explicitly
+
+0.04 Thu Jan 23 00:25:45 1997
+ - This revision supports readline-2.1 or later. readline-2.0
+ is not supported.
+ - implement almost all GNU Readline/History Library variables
+ and functions
+ - use filehandle directly to access rl_instream and rl_outstream
+ - define operate_and_get_next and bind to "\C-o" by default
+
+0.03 Sun Nov 24 23:34:27 1996
+ - OS/2 support by Ilya Zakharevich <ilya at math.ohio-state.edu>
+ - implement $rl_completer_word_break_characters
+ - define HAVE_STRING_H by checking $Config{strings}
+ - remove verbose prototypes on methods
+
+0.02 Thu Nov 21 00:22:11 1996
+ - fix to install on
+ SunOS 4.1.3, Solaris 2.3, AIX 4.1.3
+
+0.01 Wed Nov 20 01:14:09 1996
+ - The 1st alpha release revision (tested on Linux 1.2.13)
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/README
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/eg/fileman
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/eg/fileman 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/eg/fileman 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,309 @@
+#!/usr/local/bin/perl
+#
+# $Id: fileman,v 1.1 1998-02-28 19:01:24+09 hayashi Exp $
+#
+# This is a sample program of Term::ReadLine::Gnu perl module. The
+# origin is a C program in the GNU Readline Libarary manual Edition
+# 2.1, "2.5.4 A Short Completion Example". This program is under GPL.
+#
+# Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+# Original C version
+# Copyright (C) 1998 Hiroo Hayashi
+# Perl version
+
+# fileman.c -- A tiny application which demonstrates how to use the
+# GNU Readline library. This application interactively allows users
+# to manipulate files and their modes.
+
+use strict;
+use Term::ReadLine;
+
+# A structure which contains information on the commands this program
+# can understand.
+
+my %commands =
+ ('cd' => { func => \&com_cd, doc => "Change to directory DIR" },
+ 'delete' => { func => \&com_delete, doc => "Delete FILE" },
+ 'help' => { func => \&com_help, doc => "Display this text" },
+ '?' => { func => \&com_help, doc => "Synonym for `help'" },
+ 'list' => { func => \&com_list, doc => "List files in DIR" },
+ 'ls' => { func => \&com_list, doc => "Synonym for `list'" },
+ 'pwd' => { func => \&com_pwd,
+ doc => "Print the current working directory" },
+ 'quit' => { func => \&com_quit, doc => "Quit using Fileman" },
+ 'rename' => { func => \&com_rename, doc => "Rename FILE to NEWNAME" },
+ 'stat' => { func => \&com_stat, doc => "Print out statistics on FILE" },
+ 'view' => { func => \&com_view, doc => "View the contents of FILE" },
+ );
+
+# The name of this program, as taken from argv[0].
+my $progname = $0;
+
+# When non-zero, this global means the user is done using this program.
+my $done = 0;
+
+my $term = initialize_readline(); # Bind our completer.
+$term->MinLine(0); ## disable implict call of add_history()
+
+# Loop reading and executing lines until the user quits.
+while ($done == 0) {
+ my $line = $term->readline ("FileMan: ");
+
+ last unless defined $line;
+
+ # Remove leading and trailing whitespace from the line. Then, if
+ # there is anything left, add it to the history list and execute
+ # it.
+ my $s = stripwhite($line);
+
+ if ($s) {
+ $term->AddHistory($s); ## normally this is done implictly
+ execute_line($s);
+ }
+}
+
+exit 0;
+
+# Execute a command line.
+sub execute_line {
+ my $line = shift;
+
+ my ($word, $arg) = split(' ', $line);
+
+ my $command = find_command ($word);
+
+ unless ($command) {
+ printf STDERR "$word: No such command for FileMan.\n";
+ return (-1);
+ }
+
+ # Call the function.
+ return (&{$command->{func}}($arg));
+}
+
+# Look up NAME as the name of a command, and return a pointer to that
+# command. Return a NULL pointer if NAME isn't a command name.
+sub find_command {
+ my $name = shift;
+
+ return $commands{$name};
+}
+
+# Strip whitespace from the start and end of STRING. Return a pointer
+# into STRING.
+sub stripwhite {
+ my $string = shift;
+ $string =~ s/^\s*//;
+ $string =~ s/\s*$//;
+ return $string;
+}
+
+#/* **************************************************************** */
+#/* */
+#/* Interface to Readline Completion */
+#/* */
+#/* **************************************************************** */
+
+# Tell the GNU Readline library how to complete. We want to try to
+# complete on command names if this is the first word in the line, or
+# on filenames if not.
+sub initialize_readline
+{
+ # Allow conditional parsing of the ~/.inputrc file.
+ my $term = new Term::ReadLine 'FileMan';
+
+ # Tell the completer that we want a crack first.
+ $term->Attribs->{attempted_completion_function} = \&fileman_completion;
+
+ return $term;
+}
+
+# Attempt to complete on the contents of TEXT. START and END bound
+# the region of rl_line_buffer that contains the word to complete.
+# TEXT is the word to complete. We can use the entire contents of
+# rl_line_buffer in case we want to do some simple parsing. Return
+# the array of matches, or NULL if there aren't any.
+sub fileman_completion {
+ my ($text, $line, $start, $end) = @_;
+
+ my @matches = ();
+
+ # If this word is at the start of the line, then it is a command
+ # to complete. Otherwise it is the name of a file in the current
+ # directory.
+ @matches = $term->completion_matches ($text, \&command_generator)
+ if ($start == 0);
+
+ return @matches;
+}
+
+# Generator function for command completion. STATE lets us know
+# whether to start from scratch; without any state (i.e. STATE == 0),
+# then we start at the top of the list.
+
+## Term::ReadLine::Gnu has list_completion_function similar with this
+## function. I defined new one to be compared with original C version.
+{
+ my $list_index;
+ my @name;
+
+ sub command_generator {
+ my ($text, $state) = @_;
+
+ # If this is a new word to complete, initialize now. This
+ # includes saving the length of TEXT for efficiency, and
+ # initializing the index variable to 0.
+ unless ($state) {
+ $list_index = 0;
+ @name = keys(%commands);
+ }
+
+ # Return the next name which partially matches from the
+ # command list.
+ while ($list_index <= $#name) {
+ $list_index++;
+ return $name[$list_index - 1]
+ if ($name[$list_index - 1] =~ /^$text/);
+ }
+ # If no names matched, then return NULL.
+ return undef;
+ }
+}
+
+#/* **************************************************************** */
+#/* */
+#/* FileMan Commands */
+#/* */
+#/* **************************************************************** */
+
+
+# List the file(s) named in arg.
+sub com_list {
+ my $arg = shift;
+
+ return (system ("ls -FClg $arg"));
+}
+
+sub com_view {
+ my $arg = shift;
+ return 1 unless (valid_argument ("view", $arg));
+
+ return (system "more $arg");
+}
+
+sub com_rename {
+ too_dangerous ("rename");
+ return (1);
+}
+
+sub com_stat {
+ my $arg = shift;
+
+ return (1) unless valid_argument ("stat", $arg);
+
+ my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+ $atime,$mtime,$ctime,$blksize,$blocks);
+
+ unless (($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+ $atime,$mtime,$ctime,$blksize,$blocks) = stat($arg)) {
+ print STDERR "$arg: $!\n";
+ return (1);
+ }
+
+ printf("Statistics for \`$arg\':\n");
+
+ printf("%s has %d link%s, and is %d byte%s in length.\n", $arg,
+ $nlink, ($nlink == 1) ? "" : "s",
+ $size, ($size == 1) ? "" : "s");
+ printf("Inode Last Change at: %s\n", scalar localtime ($ctime));
+ printf(" Last access at: %s\n", scalar localtime ($atime));
+ printf(" Last modified at: %s\n", scalar localtime ($mtime));
+ return (0);
+}
+
+sub com_delete {
+ too_dangerous("delete");
+ return (1);
+}
+
+# Print out help for ARG, or for all of the commands if ARG is not
+# present.
+sub com_help {
+ my $arg = shift;
+ my $printed = 0;
+
+ if ($commands{$arg}) {
+ printf ("%s\t\t%s.\n", $arg, $commands{$arg}->{doc});
+ $printed++;
+ }
+
+ unless ($printed) {
+ print "No commands match \`$arg\'. Possibilties are:\n";
+
+ foreach (sort keys(%commands)) {
+ # Print in six columns.
+ if ($printed == 6) {
+ $printed = 0;
+ print "\n";
+ }
+
+ print "$_\t";
+ $printed++;
+ }
+
+ print "\n" if ($printed);
+
+ }
+ return (0);
+}
+
+# Change to the directory ARG.
+sub com_cd {
+ my $arg = shift;
+ unless (chdir ($arg)) {
+ print STDERR "$arg: $!\n";
+ return 1;
+ }
+
+ com_pwd();
+ return (0);
+}
+
+# Print out the current working directory.
+sub com_pwd {
+ my $dir = $ENV{PWD} || `pwd`;
+
+ unless ($dir) {
+ print ("Error getting pwd: $dir\n");
+ return 1;
+ }
+
+ print ("Current directory is $dir\n");
+ return 0;
+}
+
+# The user wishes to quit using this program. Just set DONE non-zero.
+sub com_quit {
+ $done = 1;
+ 0;
+}
+
+# Function which tells you that you can't do this.
+sub too_dangerous {
+ my $caller = shift;
+ printf STDERR
+ ("%s: Too dangerous for me to distribute. Write it yourself.\n",
+ $caller);
+}
+
+# Return non-zero if ARG is a valid argument for CALLER, else print an
+# error message and return zero.
+sub valid_argument {
+ my ($caller, $arg) = @_;
+ if (! $arg) {
+ printf STDERR ("%s: Argument required.\n", $caller);
+ return (0);
+ }
+
+ return (1);
+}
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/eg/fileman
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/eg/perlsh
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/eg/perlsh 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/eg/perlsh 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,472 @@
+#! /usr/local/bin/perl
+#
+# $Id: perlsh,v 1.24 2001-10-27 22:59:15-05 hayashi Exp $
+#
+# Copyright (c) 2000 Hiroo Hayashi. All Rights Reserved.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+=head1 NAME
+
+perlsh - one-line perl evaluator with line editing function and
+ variable name completion function
+
+=head1 SYNOPSIS
+
+ perlsh
+
+=head1 DESCRIPTION
+
+This program reads input a line, and evaluates it by perl interpreter,
+and prints the result. If the result is a list value then each value
+of the list is printed line by line. This program can be used as a
+very strong calculator which has whole perl functions.
+
+This is a sample program Term::ReadLine::Gnu module. When you input a
+line, the line editing function of GNU Readline Library is available.
+Perl symbol name completion function is also available.
+
+=cut
+
+package PerlSh;
+
+use strict;
+use Term::ReadLine;
+
+use vars qw($PS1 $PS2 $HISTFILE $HISTSIZE $INPUTRC $STRICT
+ $HOSTNAME $LOGNAME $CWP);
+
+#$PS1 = '$ ';
+$PS1='\w[\!]$ ';
+$PS2 = '> ';
+$HISTFILE = ($ENV{HOME} || ((getpwuid($<))[7])) . "/.perlsh_history";
+$HISTSIZE = 256;
+$INPUTRC = ($ENV{HOME} || ((getpwuid($<))[7])) . "/.perlshrc";
+$STRICT = 0;
+
+$HOSTNAME = $ENV{HOSTNAME};
+$LOGNAME = $ENV{LOGNAME};
+$CWP = 'main'; # current working package
+
+package main;
+if (-f $PerlSh::INPUTRC) {
+ do $PerlSh::INPUTRC;
+}
+
+package PerlSh;
+
+use vars qw($term $attribs); # to access as `$PerlSh::term' from prompt
+$term = new Term::ReadLine 'PerlSh';
+$attribs = $term->Attribs;
+
+$term->bind_key(ord "^", 'history-expand-line', 'emacs-meta');
+$term->bind_key(ord "\cv", 'display-readline-version', 'emacs-ctlx');
+$term->bind_key(ord "\cc", 'abort'); # not works yet FIXME!!!
+
+if (defined &main::afterinit) {
+ package main;
+ &afterinit;
+ package PerlSh;
+}
+
+&toplevel; # never returns
+
+########################################################################
+sub toplevel {
+ # disable implicit add_history() call
+ $term->MinLine(undef);
+
+ $term->stifle_history($HISTSIZE);
+ if (-f $HISTFILE) {
+ $term->ReadHistory($HISTFILE)
+ or warn "perlsh: cannot read history file: $!\n";
+ }
+ $attribs->{attempted_completion_function} = \&attempt_perl_completion;
+ $attribs->{special_prefixes} = '$@%&';
+ $attribs->{completion_display_matches_hook}
+ = \&perl_symbol_display_match_list;
+
+ $SIG{INT} = sub {
+ $term->modifying;
+ $term->delete_text;
+ $attribs->{point} = $attribs->{end} = 0;
+ $term->redisplay;
+ };
+
+ my ($strict, $command, @result);
+ $strict = $STRICT ? '' : 'no strict;';
+ while (defined($command = &reader)) {
+ @result = eval ("$strict package $CWP; $command");
+ use strict;
+ if ($@) { print "Error: $@\n"; next; }
+ printer (@result);
+ $CWP = $1 if ($command =~ /^\s*package\s+([\w:]+)/);
+ }
+ &quit;
+}
+
+sub quit {
+ $term->WriteHistory($HISTFILE)
+ or warn "perlsh: cannot write history file: $!\n";
+ exit (0);
+}
+
+sub reader {
+ my ($line, $command);
+ $command = '';
+ while (1) {
+ $line = $term->readline($command ? $PS2 : prompt($PS1));
+ return undef unless (defined $line);
+
+ if ($line =~ /\\$/) {
+ chop $line;
+ $command = $command ? $command . " $line" : $line;
+ } else {
+ $command = $command ? $command . " $line" : $line;
+ $term->addhistory($command) if (length($command) > 0);
+ return $command;
+ }
+ }
+}
+
+sub printer {
+ my (@res) = @_;
+ my ($i);
+ foreach $i (@res) { print "$i\n"; }
+}
+
+sub prompt {
+ local($_) = @_;
+ # if reference to a subroutine return the return value of it
+ return &$_ if (ref($_) eq 'CODE');
+
+ # \h: hostname, \u: username, \w: package name, \!: history number
+ s/\\h/$HOSTNAME/g;
+ s/\\u/$LOGNAME/g;
+ s/\\w/$CWP/g;
+ s/\\!/$attribs->{history_base} + $attribs->{history_length}/eg;
+ $_;
+}
+
+#
+# custom completion for Perl
+#
+
+sub perl_symbol_display_match_list ($$$) {
+ my($matches, $num_matches, $max_length) = @_;
+ map { $_ =~ s/^((\$#|[\@\$%&])?).*::(.+)/$3/; }(@{$matches});
+ $term->display_match_list($matches);
+ $term->forced_update_display;
+}
+
+sub attempt_perl_completion ($$$$) {
+ my ($text, $line, $start, $end) = @_;
+
+ no strict qw(refs);
+ if (substr($line, 0, $start) =~ m/\$([\w:]+)\s*(->)?\s*{\s*['"]?$/) {
+ # $foo{key, $foo->{key
+ $attribs->{completion_append_character} = '}';
+ return $term->completion_matches($text,
+ \&perl_hash_key_completion_function);
+ } elsif (substr($line, 0, $start) =~ m/\$([\w:]+)\s*->\s*['"]?$/) {
+ # $foo->method
+ $attribs->{completion_append_character} = ' ';
+ return $term->completion_matches($text,
+ \&perl_method_completion_function);
+ } else { # Perl symbol completion
+ $attribs->{completion_append_character} = '';
+ return $term->completion_matches($text,
+ \&perl_symbol_completion_function);
+ }
+}
+
+# static global variables for completion functions
+use vars qw($i @matches);
+
+sub perl_hash_key_completion_function ($$) {
+ my($text, $state) = @_;
+
+ if ($state) {
+ $i++;
+ } else {
+ # the first call
+ $i = 0; # clear index
+ my ($var,$arrow) = (substr($attribs->{line_buffer},
+ 0, $attribs->{point} - length($text))
+ =~ m/\$([\w:]+)\s*(->)?\s*{\s*['"]?$/); # });
+ no strict qw(refs);
+ $var = "${CWP}::$var" unless ($var =~ m/::/);
+ if ($arrow) {
+ my $hashref = eval "\$$var";
+ @matches = keys %$hashref;
+ } else {
+ @matches = keys %$var;
+ }
+
+ }
+ for (; $i <= $#matches; $i++) {
+ return $matches[$i] if ($matches[$i] =~ /^\Q$text/);
+ }
+ return undef;
+}
+
+sub _search_ISA ($) {
+ my ($mypkg) = @_;
+ no strict 'refs';
+ my $isa = "${mypkg}::ISA";
+ return $mypkg, map _search_ISA($_), @$isa;
+}
+
+sub perl_method_completion_function ($$) {
+ my($text, $state) = @_;
+
+ if ($state) {
+ $i++;
+ } else {
+ # the first call
+ my ($var, $pkg, $sym, $pk);
+ $i = 0; # clear index
+ $var = (substr($attribs->{line_buffer},
+ 0, $attribs->{point} - length($text))
+ =~ m/\$([\w:]+)\s*->\s*$/)[0];
+ $pkg = ref eval (($var =~ m/::/) ? "\$$var" : "\$${CWP}::$var");
+ no strict qw(refs);
+ @matches = map { $pk = $_ . '::';
+ grep (/^\w+$/
+ && ($sym = "${pk}$_", defined *$sym{CODE}),
+ keys %$pk);
+ } _search_ISA($pkg);
+ }
+ for (; $i <= $#matches; $i++) {
+ return $matches[$i] if ($matches[$i] =~ /^\Q$text/);
+ }
+ return undef;
+}
+
+#
+# Perl symbol name completion
+#
+{
+ my ($prefix, %type, @keyword);
+
+ sub perl_symbol_completion_function ($$) {
+ my($text, $state) = @_;
+
+ if ($state) {
+ $i++;
+ } else {
+ # the first call
+ my ($pre, $pkg, $sym);
+ $i = 0; # clear index
+
+ no strict qw(refs);
+ ($prefix, $pre, $pkg) = ($text =~ m/^((\$#|[\@\$%&])?(.*::)?)/);
+ @matches = grep /::$/, $pkg ? keys %$pkg : keys %::;
+ $pkg = ($CWP eq 'main' ? '::' : $CWP . '::') unless $pkg;
+
+ if ($pre) { # $foo, @foo, $#foo, %foo, &foo
+ @matches = (@matches,
+ grep (/^\w+$/
+ && ($sym = $pkg . $_,
+ defined *$sym{$type{$pre}}),
+ keys %$pkg));
+ } else { # foo
+ @matches = (@matches,
+ !$prefix && @keyword,
+ grep (/^\w+$/
+ && ($sym = $pkg . $_,
+ defined *$sym{CODE}
+ || defined *$sym{FILEHANDLE}
+ ),
+ keys %$pkg));
+ }
+ }
+ my $entry;
+ for (; $i <= $#matches; $i++) {
+ $entry = $prefix . $matches[$i];
+ return $entry if ($entry =~ /^\Q$text/);
+ }
+ return undef;
+ }
+
+ BEGIN {
+ %type = ('$' => 'SCALAR', '*' => 'SCALAR',
+ '@' => 'ARRAY', '$#' => 'ARRAY',
+ '%' => 'HASH',
+ '&' => 'CODE'); # '
+
+ # from perl5.004_02 perlfunc
+ @keyword = qw(
+ chomp chop chr crypt hex index lc lcfirst
+ length oct ord pack q qq
+ reverse rindex sprintf substr tr uc ucfirst
+ y
+
+ m pos quotemeta s split study qr
+
+ abs atan2 cos exp hex int log oct rand sin
+ sqrt srand
+
+ pop push shift splice unshift
+
+ grep join map qw reverse sort unpack
+
+ delete each exists keys values
+
+ binmode close closedir dbmclose dbmopen die
+ eof fileno flock format getc print printf
+ read readdir rewinddir seek seekdir select
+ syscall sysread sysseek syswrite tell telldir
+ truncate warn write
+
+ pack read syscall sysread syswrite unpack vec
+
+ chdir chmod chown chroot fcntl glob ioctl
+ link lstat mkdir open opendir readlink rename
+ rmdir stat symlink umask unlink utime
+
+ caller continue die do dump eval exit goto
+ last next redo return sub wantarray
+
+ caller import local my package use
+
+ defined dump eval formline local my reset
+ scalar undef wantarray
+
+ alarm exec fork getpgrp getppid getpriority
+ kill pipe qx setpgrp setpriority sleep
+ system times wait waitpid
+
+ do import no package require use
+
+ bless dbmclose dbmopen package ref tie tied
+ untie use
+
+ accept bind connect getpeername getsockname
+ getsockopt listen recv send setsockopt shutdown
+ socket socketpair
+
+ msgctl msgget msgrcv msgsnd semctl semget
+ semop shmctl shmget shmread shmwrite
+
+ endgrent endhostent endnetent endpwent getgrent
+ getgrgid getgrnam getlogin getpwent getpwnam
+ getpwuid setgrent setpwent
+
+ endprotoent endservent gethostbyaddr
+ gethostbyname gethostent getnetbyaddr
+ getnetbyname getnetent getprotobyname
+ getprotobynumber getprotoent getservbyname
+ getservbyport getservent sethostent setnetent
+ setprotoent setservent
+
+ gmtime localtime time times
+
+ abs bless chomp chr exists formline glob
+ import lc lcfirst map my no prototype qx qw
+ readline readpipe ref sub sysopen tie tied
+ uc ucfirst untie use
+
+ dbmclose dbmopen
+ );
+ }
+}
+
+__END__
+
+=pod
+
+Before invoking, this program reads F<~/.perlshrc> and evaluates the
+content of the file.
+
+When this program is terminated, the content of the history buffer is
+saved in a file F<~/.perlsh_history>, and it is read at next
+invoking.
+
+=head1 VARIABLES
+
+You can customize the behavior of C<perlsh> by setting following
+variables in F<~/.perlshrc>;
+
+=over 4
+
+=item C<$PerlSh::PS1>
+
+The primary prompt string. The following backslash-escaped special
+characters can be used.
+
+ \h: host name
+ \u: user name
+ \w: package name
+ \!: history number
+
+The default value is `C<\w[\!]$ >'.
+
+=item C<$PerlSh::PS2>
+
+The secondary prompt string. The default value is `C<E<gt> >'.
+
+=item C<$PerlSh::HISTFILE>
+
+The name of the file to which the command history is saved. The
+default value is C<~/.perlsh_history>.
+
+=item C<$PerlSh::HISTSIZE>
+
+If not C<undef>, this is the maximum number of commands to remember in
+the history. The default value is 256.
+
+=item C<$PerlSh::STRICT>
+
+If true, restrict unsafe constructs. See C<use strict> in perl man
+page. The default value is 0;
+
+=over
+
+=head1 FILES
+
+=over 4
+
+=item F<~/.perlshrc>
+
+This file is eval-ed at initialization. If a subroutine C<afterinit>
+is defined in this file, it will be eval-ed after initialization.
+Here is a sample.
+
+ # -*- mode: perl -*-
+ # decimal to hexa
+ sub h { map { sprintf("0x%x", $_ ) } @_;}
+
+ sub tk {
+ $t->tkRunning(1);
+ use Tk;
+ $mw = MainWindow->new();
+ }
+
+ # for debugging Term::ReadLine::Gnu
+ sub afterinit {
+ *t = \$PerlSh::term;
+ *a = \$PerlSh::attribs;
+ }
+
+=item F<~/.perlsh_history>
+
+=item F<~/.inputrc>
+
+A initialization file for the GNU Readline Library. Refer its manual
+for details.
+
+=back
+
+=head1 SEE ALSO
+
+Term::ReadLine::Gnu
+
+GNU Readline Library Manual
+
+=head1 AUTHOR
+
+Hiroo Hayashi <hiroo.hayashi at computer.org>
+
+=cut
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/eg/perlsh
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/eg/pftp
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/eg/pftp 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/eg/pftp 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,470 @@
+#! /usr/local/bin/perl
+#
+# $Id: pftp,v 1.9 1999-03-20 02:46:02+09 hayashi Exp $
+#
+# Copyright (c) 1997,1998,1999 Hiroo Hayashi. All Rights Reserved.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+=head1 NAME
+
+pftp - an ftp client with the GNU Readline support
+
+=head1 SYNOPSIS
+
+B<pftp> [B<-u>] [B<-g>] [B<-M>] [B<-h>] [B<-d>] [I<host>]
+
+=head1 DESCRIPTION
+
+This is an ftp client which has the GNU Readline support. It can
+complete not only local file name but also remote file name and host
+name to which login.
+
+This is a sample program of Perl Term::ReadLine::Gnu module.
+
+=cut
+
+use Term::ReadLine;
+use strict;
+use Net::Domain qw(hostdomain); # libnet
+use Net::FTP; # libnet-1.05 or later is recommended
+use File::Listing; # libwww (for parse_dir)
+use Getopt::Std;
+use Cwd; # for getcwd
+
+use vars qw($AUTOLOAD
+ $opt_d $opt_u $opt_g $opt_M $opt_h);
+
+sub usage {
+ print STDERR <<"EOM";
+usage : $0 [-d] [-i] [-u] [-g] [-M] [-h] host
+ -d : debug mode
+ -i : interactive mode (not implemented)
+ -u : disable autologin
+ -g : turn off glob
+ -M : show manual page
+ -h : show this message
+EOM
+ exit 0;
+}
+
+getopts('dugMh') or &usage;
+&man if $opt_M;
+&usage if $opt_h;
+
+#
+# setup Term::ReadLine::GNU
+#
+my $HOSTFILE = ($ENV{HOME} || (getpwuid($<))[7]) . "/.pftp_hosts";
+
+my $term = Term::ReadLine->new('PFTP');
+my $attribs = $term->Attribs;
+$term->ornaments('md,me,,'); # bold face prompt
+
+#
+# read hostname to which login
+#
+my $host;
+my @hosts = read_hosts($HOSTFILE);
+if (@ARGV) {
+ $host = shift;
+} else {
+ $attribs->{completion_word} = \@hosts;
+ $attribs->{completion_append_character} = '';
+ $attribs->{completion_entry_function} =
+ $attribs->{'list_completion_function'};
+ $host = $term->readline('hostname> ');
+ $host =~ s/^\s+//;
+ $host =~ s/\s+$//;
+ $attribs->{completion_append_character} = ' ';
+ $attribs->{completion_entry_function} = undef;
+}
+
+#
+# make ftp connection
+#
+my $ftp = Net::FTP->new($host,
+ Debug => $opt_d);
+die "$0: cannot connect \`$host\'\n" unless $ftp;
+
+print STDERR $ftp->message;
+write_hosts($HOSTFILE, $host, @hosts);
+
+#
+# login
+#
+my $login = 'anonymous';
+my $password = (getpwuid($<))[0] . '@' . hostdomain;
+if ($opt_u) {
+ $login = $term->readline('login name> ', $login);
+
+ # mask typed characters for password
+ $attribs->{redisplay_function} = $attribs->{shadow_redisplay};
+ $password = $term->readline('password> ', $password);
+ undef $attribs->{redisplay_function};
+}
+
+$ftp->login($login, $password) or die "$0: cannot login: " . $ftp->message;
+print STDERR $ftp->message;
+
+$ftp->binary; # default binary
+print STDERR $ftp->message;
+
+my $pwd = $ftp->pwd;
+print STDERR $ftp->message;
+
+#
+# setup completion function
+#
+my @ftp_cmd_list = qw(cwd cd pwd ls dir get mget put mput lcd help);
+
+# completion_display_match_hook is supported by GNU Readline Library
+# 4.0 and later. Earlier versions ignore it.
+
+$attribs->{attempted_completion_function} = sub {
+ my ($text, $line, $start, $end) = @_;
+ if (substr($line, 0, $start) =~ /^\s*$/) {
+ $attribs->{completion_word} = \@ftp_cmd_list;
+ undef $attribs->{completion_display_matches_hook};
+ return $term->completion_matches($text,
+ $attribs->{'list_completion_function'});
+ } elsif ($line =~ /^\s*(ls|dir|get|mget)\s/) {
+ $attribs->{completion_display_matches_hook} = \&ftp_display_match_list;
+ return $term->completion_matches($text,
+ \&ftp_filename_completion_function);
+ } elsif ($line =~ /^\s*(cd|cwd)\s/) {
+ $attribs->{completion_display_matches_hook} = \&ftp_display_match_list;
+ return $term->completion_matches($text,
+ \&ftp_dirname_completion_function);
+ } else { # put mput lcd
+ undef $attribs->{completion_display_matches_hook};
+ return (); # local file name completion
+ }
+};
+
+#
+# Command loop
+#
+$SIG{INT} = 'IGNORE'; # ignore Control-C
+
+while (defined($_ = $term->readline("$login\@$host:$pwd> "))) {
+ no strict 'refs';
+ next if /^\s*$/;
+ my ($cmd, @args) = $term->history_tokenize($_);
+ if ($cmd eq 'quit' || $cmd eq 'bye') {
+ last;
+ }
+ my $func = "cmd_" . $cmd;
+ &$func(@args);
+ $attribs->{completion_append_character} = ' ';
+}
+$ftp->quit;
+print STDERR $ftp->message;
+
+exit (0);
+
+########################################################################
+#
+# complete remote filename
+#
+sub ftp_filename_completion_function ( $$ ) {
+ my($text, $state) = @_;
+ ftp_completion_function($text, $state, 0);
+}
+
+sub ftp_dirname_completion_function ( $$ ) {
+ my($text, $state) = @_;
+ ftp_completion_function($text, $state, 1);
+}
+
+{
+ my ($i, $file, $dir, $fdir, $cw);
+
+ sub ftp_completion_function ( $$$ ) {
+ my($text, $state, $dironly) = @_;
+ my $entry;
+
+ unless ($state) {
+ $i = 0; # clear counter at the first call
+ ($dir, $file) = ($text =~ m|(.*/)?(.*)$|);
+ $dir = '' unless defined $dir; # to piecify -w
+ $fdir = ($dir =~ m|^/|) ? $dir : "$pwd/$dir"; # full path name
+ $fdir =~ s|//|/|g;
+ $attribs->{completion_append_character} = ' ';
+ return undef unless defined ($cw = rdir($fdir));
+ } else {
+ $i++;
+ }
+ for (; $i <= $#{$cw}; $i++) {
+ if (($entry = $cw->[$i]) =~ /^$file/
+ && !($dironly && ($entry !~ m|/$|))) {
+ $attribs->{completion_append_character} = ''
+ if $entry =~ m|/$|;
+ return ($dir . $entry);
+ }
+ }
+ return undef;
+ }
+}
+
+sub ftp_display_match_list {
+ my($matches, $num_matches, $max_length) = @_;
+ map { $_ =~ s|.*/([^/])|\1|; }(@{$matches});
+ $term->display_match_list($matches);
+ $term->forced_update_display;
+}
+
+########################################################################
+
+sub AUTOLOAD {
+ # tell a lie to Domain.pm
+ goto &SYS_gethostname if $AUTOLOAD =~/SYS_gethostname$/;
+
+ $AUTOLOAD =~ s/.*::cmd_//;
+ warn "command \`$AUTOLOAD\' is not defined or not implemented.\n";
+}
+
+my %rdir;
+
+sub rdir { # get remote dir info and save it in %rdir
+ my $dir = shift;
+ return $rdir{$dir} if defined $rdir{$dir};
+
+ my $d = $ftp->ls('-F', $dir);
+ if ($d) {
+ foreach (@{$d}) {
+ s|.*/(.)|$1|; # remove directory name
+ s/[*@]$//;
+ }
+ return $rdir{$dir} = $d;
+ } else {
+ return undef;
+ }
+}
+
+sub cmd_cwd {
+ if ($ftp->cwd(@_)) {
+ $pwd = $ftp->pwd();
+ } else {
+ print STDERR "cwd: cannot chdir to \`$_\'\n"
+ }
+ print STDERR $ftp->message;
+}
+
+# Why this does not work?
+#*cmd_cd = \&cmd_cwd;
+
+sub cmd_cd {
+ &cmd_cwd;
+}
+
+sub cmd_pwd {
+ $pwd = $ftp->pwd();
+ if ($pwd) {
+ print STDERR "$pwd\n";
+ } else {
+ print STDERR "pwd failed.\n";
+ }
+ print STDERR $ftp->message;
+}
+
+sub cmd_ls {
+ # strip ls option
+ return &cmd_dir if $_[0] =~ /^-/ && shift =~ /l/;
+
+ my $dir = shift || $pwd;
+ my $d = rdir($dir);
+ if (defined $d) {
+ dump_list($d);
+ } else {
+ print STDERR "ls failed\n";
+ }
+ print STDERR $ftp->message;
+}
+
+# from bash-2.0/lib/readline/complete.c:display_matches()
+# bash-4.0 and later has rl_display_match_list. Ignore it for compativility.
+sub dump_list {
+ use integer;
+ my @list = sort @{$_[0]};
+ my ($len, $max, $limit, $count, $i, $j, $l, $tmp);
+ my $screenwidth = $ENV{COLUMNS} || 80;
+ $max = 0;
+ foreach (@list) {
+ $len = length;
+ $max = $len if $len > $max;
+ }
+ $max += 2;
+ $limit = $screenwidth / $max;
+ $limit-- if ($limit != 1 && ($limit * $max == $screenwidth));
+ $limit = 1 if $limit == 0;
+ $count = (@list + ($limit - 1))/ $limit;
+ for $i (0..$count - 1) {
+ $l = $i;
+ for $j (0..$limit - 1) {
+ $tmp = $list[$l];
+ last if $l > @list || ! $tmp;
+ print $tmp;
+ print ' ' x ($max - length $tmp) if $j + 1 < $limit;
+ $l += $count;
+ }
+ print "\n";
+ }
+}
+
+sub cmd_dir {
+ # strip ls option
+ shift if $_[0] =~ /^-/;
+
+ my $dir = $ftp->dir('-F', @_);
+ print STDERR $ftp->message;
+
+ my @dir;
+ if ($dir) {
+ foreach (@{$dir}) {
+ print STDERR "$_\n";
+
+ my $info = (parse_dir($_, '+0000'))[0]; # GMT
+ next unless $info; # ignore if parse_dir() can not phase.
+ next if $$info[0] =~ m|^\.\.?/$|; # ignore '.' and '..'
+ $$info[0] =~ s|.*/(.)|$1|; # remove directory name
+ $$info[0] =~ s/[*@]$//;
+ push(@dir, $$info[0]);
+ }
+ $rdir{$pwd} = \@dir;
+ } else {
+ print STDERR "dir failed\n";
+ }
+}
+
+sub cmd_get {
+ $ftp->get(@_);
+ print STDERR $ftp->message;
+}
+
+sub cmd_mget {
+ if ($opt_g) {
+ foreach (@_) {
+ $ftp->get($_);
+ print STDERR $ftp->message;
+ }
+ } else {
+ my $d = $ftp->ls(@_);
+ print STDERR $ftp->message;
+ foreach (sort @{$d}) {
+ $ftp->get($_);
+ print STDERR $ftp->message;
+ }
+ }
+}
+
+sub cmd_put {
+ $ftp->put(@_);
+ print STDERR $ftp->message;
+}
+
+sub cmd_mput {
+ my $f;
+ foreach $f (@_) {
+ foreach ($opt_g ? $f : glob $f) {
+ $ftp->put($_);
+ print STDERR $ftp->message;
+ }
+ }
+}
+
+sub cmd_lcd {
+ chdir $_[0] or warn "cannot chdir to $_[0]: $!\n";
+ printf STDERR "local current directory is \`%s\'\n", getcwd();
+}
+
+sub cmd_help {
+ print STDERR "@ftp_cmd_list\n";
+}
+
+################################################################
+sub read_hosts {
+ my $file = shift;
+ return () unless -f $file;
+ open(F, $file) or die "$0: cannot open file \`$file\'\n";
+ my @l = <F>;
+ close(F);
+ chomp @l;
+ return @l;
+}
+
+sub write_hosts {
+ my $file = shift;
+ my $lastline = '';
+ open(F, ">$file") or die "$0: cannot open file \`$file\'\n";
+ foreach (sort @_) {
+ print F ($_, "\n") if $_ ne $lastline;
+ $lastline = $_;
+ }
+ close(F);
+}
+
+################################################################
+# show man page
+sub man {
+ my $pager = $ENV{'PAGER'} || 'more';
+ exec "pod2man $0|nroff -man|$pager";
+ die "cannot exec pod2man, nroff, or $pager : $!\n";
+}
+
+__END__
+
+=pod
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-u>
+
+disable autologin.
+
+=item B<-g>
+
+turn off glob.
+
+=item B<-h>
+
+show usage.
+
+=item B<-M>
+
+show thie manual.
+
+=item B<-d>
+
+debug mode.
+
+=item I<host>
+
+remote host name.
+
+=back
+
+=head1 FILES
+
+=over 4
+
+=item I<~/.pftp_hosts>
+
+This file contains the list of host names. These name are used for
+completing of remote host name. If the host name which you login is
+not contained in this file, it will be added automatically.
+
+=back
+
+=head1 AUTHOR
+
+Hiroo Hayashi <hiroo.hayashi at computer.org>
+
+=head1 BUGS
+
+Commands which the author does not know are not supported.
+
+=cut
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/eg/pftp
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/eg/ptksh+
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/eg/ptksh+ 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/eg/ptksh+ 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,127 @@
+#!/usr/local/bin/perl -w
+#
+# $Id: ptksh+,v 1.5 1997/04/01 17:15:34 ach Exp ach $
+#
+# POD documentation after __END__
+
+# This program is contributed by Achim Bohnet. It demonstrates how to
+# use the callback functions in the GNU Readline Library. This script
+# is essetially equivalent with executing the following lines in
+# `eg/perlsh';
+# $PerlSh::term->tkRunning(1);
+# use Tk;
+# $mw = MainWindow->new();
+#
+# Hiroo Hayashi
+
+require 5.003_92;
+
+use Tk;
+
+# Bug: Require script does not work with all possibilities of
+# missing/existing new MainWindow and MainLoop. Therefore
+# I have disabled it.
+# Mainloop in script would be the end. No readline :-(
+#require shift @ARGV if (@ARGV);
+
+
+package Tk::RL;
+use Tk;
+use Term::ReadLine;
+
+$name = 'ptksh+';
+
+$mw = MainWindow->new() unless ($mw = Tk::Exists 'MainWindow');
+$mw->title($name);
+$mw->iconname($name);
+$mw->protocol('WM_DELETE_WINDOW' => \&quit);
+
+
+##### Gnu Readline Stuff #####
+my $term = new Term::ReadLine $name;
+my $attribs = $term->Attribs;
+
+$term->callback_handler_install("$name> ", \&doline);
+
+$mw->fileevent(STDIN,'readable',
+ $attribs->{callback_read_char});
+
+sub quit {
+ $mw->fileevent(STDIN,'readable','');
+ $term->callback_handler_remove();
+ $mw->destroy;
+}
+
+my $outstream = $attribs->{outstream};
+sub doline {
+ my $line = shift;
+
+ if (defined $line) {
+ if ($line =~ /^p\s(.*)$/) {
+ $line = "print $1, \"!\\n\";";
+ }
+
+ eval "{package main; $line }";
+ print $outstream "$@\n" if $@;
+ $term->add_history($line) if $line ne "";
+ $attribs->{line_buffer} = ''; # needed for eval errors
+ } else {
+ quit() unless defined $line;
+ }
+}
+
+# To test if Tk is not blocked: Tk::RL::tk_active<return>
+sub tk_active {
+ print STDERR "I'm working behing the scene\n";
+ $mw->after(1500,\&tk_active);
+}
+#$mw->after(1500,\&tk_active);
+
+
+package main;
+
+# be gentle if 'required' script defined $mw;
+$mw = $Tk::RL::mw if not defined $mw;
+
+MainLoop;
+print "\n";
+
+__END__
+
+=head1 NAME
+
+ptksh+ - Simple perl/Tk shell that uses the Gnu Readline features
+
+=head1 SYNOPSIS
+
+ % ptksh+
+ ptksh+> $b=$mw->Button(-text=>'hello',-command=>sub{print STDERR 'hello'})
+ ptksh+> $b->pack;
+ ptksh+> ...
+ ptksh+> ^D
+ %
+
+=head1 DESCRIPTION
+
+This (very) simple perl/Tk shell allows you to enter perl/Tk commands
+interactively.
+Additionally it supports command line editing and keeps a history
+of previously entered commands. It requires C<Term-Readline-Gnu>
+to be installed.
+
+You can exit ptksh+ with ^D or using your Window Manager 'Close'
+item.
+
+=head1 SEE ALSO
+
+Term::Readline, Term::Readline::Gnu, Tk, perldebug
+
+=head1 AUTHOR
+
+Achim Bohnet <F<ach at mpe.mpg.de>>, URL:L<http://www.xray.mpe.mpg.de/~ach/>
+
+Copyright (c) 1996-1997 Achim Bohnet. All rights reserved. This program
+is free software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+=cut
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/eg/ptksh+
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/ppport.h
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/ppport.h 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/ppport.h 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,286 @@
+
+#ifndef _P_P_PORTABILITY_H_
+#define _P_P_PORTABILITY_H_
+
+/* Perl/Pollution/Portability Version 1.0007 */
+
+/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and
+ distributed under the same license as any version of Perl. */
+
+/* For the latest version of this code, please retreive the Devel::PPPort
+ module from CPAN, contact the author at <kjahds at kjahds.com>, or check
+ with the Perl maintainers. */
+
+/* If you needed to customize this file for your project, please mention
+ your changes, and visible alter the version number. */
+
+
+/*
+ In order for a Perl extension module to be as portable as possible
+ across differing versions of Perl itself, certain steps need to be taken.
+ Including this header is the first major one, then using dTHR is all the
+ appropriate places and using a PL_ prefix to refer to global Perl
+ variables is the second.
+*/
+
+
+/* If you use one of a few functions that were not present in earlier
+ versions of Perl, please add a define before the inclusion of ppport.h
+ for a static include, or use the GLOBAL request in a single module to
+ produce a global definition that can be referenced from the other
+ modules.
+
+ Function: Static define: Extern define:
+ newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
+
+*/
+
+
+/* To verify whether ppport.h is needed for your module, and whether any
+ special defines should be used, ppport.h can be run through Perl to check
+ your source code. Simply say:
+
+ perl -x ppport.h *.c *.h *.xs foo/*.c [etc]
+
+ The result will be a list of patches suggesting changes that should at
+ least be acceptable, if not necessarily the most efficient solution, or a
+ fix for all possible problems. It won't catch where dTHR is needed, and
+ doesn't attempt to account for global macro or function definitions,
+ nested includes, typemaps, etc.
+
+ In order to test for the need of dTHR, please try your module under a
+ recent version of Perl that has threading compiled-in.
+
+*/
+
+
+/*
+#!/usr/bin/perl
+ at ARGV = ("*.xs") if !@ARGV;
+%badmacros = %funcs = %macros = (); $replace = 0;
+foreach (<DATA>) {
+ $funcs{$1} = 1 if /Provide:\s+(\S+)/;
+ $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
+ $replace = $1 if /Replace:\s+(\d+)/;
+ $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
+ $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
+}
+foreach $filename (map(glob($_), at ARGV)) {
+ unless (open(IN, "<$filename")) {
+ warn "Unable to read from $file: $!\n";
+ next;
+ }
+ print "Scanning $filename...\n";
+ $c = ""; while (<IN>) { $c .= $_; } close(IN);
+ $need_include = 0; %add_func = (); $changes = 0;
+ $has_include = ($c =~ /#.*include.*ppport/m);
+
+ foreach $func (keys %funcs) {
+ if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
+ if ($c !~ /\b$func\b/m) {
+ print "If $func isn't needed, you don't need to request it.\n" if
+ $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
+ } else {
+ print "Uses $func\n";
+ $need_include = 1;
+ }
+ } else {
+ if ($c =~ /\b$func\b/m) {
+ $add_func{$func} =1 ;
+ print "Uses $func\n";
+ $need_include = 1;
+ }
+ }
+ }
+
+ if (not $need_include) {
+ foreach $macro (keys %macros) {
+ if ($c =~ /\b$macro\b/m) {
+ print "Uses $macro\n";
+ $need_include = 1;
+ }
+ }
+ }
+
+ foreach $badmacro (keys %badmacros) {
+ if ($c =~ /\b$badmacro\b/m) {
+ $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
+ print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
+ $need_include = 1;
+ }
+ }
+
+ if (scalar(keys %add_func) or $need_include != $has_include) {
+ if (!$has_include) {
+ $inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
+ "#include \"ppport.h\"\n";
+ $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
+ } elsif (keys %add_func) {
+ $inc = join('',map("#define NEED_$_\n", sort keys %add_func));
+ $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
+ }
+ if (!$need_include) {
+ print "Doesn't seem to need ppport.h.\n";
+ $c =~ s/^.*#.*include.*ppport.*\n//m;
+ }
+ $changes++;
+ }
+
+ if ($changes) {
+ open(OUT,">/tmp/ppport.h.$$");
+ print OUT $c;
+ close(OUT);
+ open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
+ while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
+ close(DIFF);
+ unlink("/tmp/ppport.h.$$");
+ } else {
+ print "Looks OK\n";
+ }
+}
+__DATA__
+*/
+
+#ifndef PERL_REVISION
+# ifndef __PATCHLEVEL_H_INCLUDED__
+# include "patchlevel.h"
+# endif
+# ifndef PERL_REVISION
+# define PERL_REVISION (5)
+ /* Replace: 1 */
+# define PERL_VERSION PATCHLEVEL
+# define PERL_SUBVERSION SUBVERSION
+ /* Replace PERL_PATCHLEVEL with PERL_VERSION */
+ /* Replace: 0 */
+# endif
+#endif
+
+#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
+
+#ifndef ERRSV
+# define ERRSV perl_get_sv("@",FALSE)
+#endif
+
+#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
+/* Replace: 1 */
+# define PL_sv_undef sv_undef
+# define PL_sv_yes sv_yes
+# define PL_sv_no sv_no
+# define PL_na na
+# define PL_stdingv stdingv
+# define PL_hints hints
+# define PL_curcop curcop
+# define PL_curstash curstash
+# define PL_copline copline
+# define PL_Sv Sv
+/* Replace: 0 */
+#endif
+
+#ifndef dTHR
+# ifdef WIN32
+# define dTHR extern int Perl___notused
+# else
+# define dTHR extern int errno
+# endif
+#endif
+
+#ifndef boolSV
+# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
+#endif
+
+#ifndef gv_stashpvn
+# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
+#endif
+
+#ifndef newSVpvn
+# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
+#endif
+
+#ifndef newRV_inc
+/* Replace: 1 */
+# define newRV_inc(sv) newRV(sv)
+/* Replace: 0 */
+#endif
+
+#ifndef newRV_noinc
+# ifdef __GNUC__
+# define newRV_noinc(sv) \
+ ({ \
+ SV *nsv = (SV*)newRV(sv); \
+ SvREFCNT_dec(sv); \
+ nsv; \
+ })
+# else
+# if defined(CRIPPLED_CC) || defined(USE_THREADS)
+static SV * newRV_noinc (SV * sv)
+{
+ SV *nsv = (SV*)newRV(sv);
+ SvREFCNT_dec(sv);
+ return nsv;
+}
+# else
+# define newRV_noinc(sv) \
+ ((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
+# endif
+# endif
+#endif
+
+/* Provide: newCONSTSUB */
+
+/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
+#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
+
+#if defined(NEED_newCONSTSUB)
+static
+#else
+extern void newCONSTSUB _((HV * stash, char * name, SV *sv));
+#endif
+
+#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
+void
+newCONSTSUB(stash,name,sv)
+HV *stash;
+char *name;
+SV *sv;
+{
+ U32 oldhints = PL_hints;
+ HV *old_cop_stash = PL_curcop->cop_stash;
+ HV *old_curstash = PL_curstash;
+ line_t oldline = PL_curcop->cop_line;
+ PL_curcop->cop_line = PL_copline;
+
+ PL_hints &= ~HINT_BLOCK_SCOPE;
+ if (stash)
+ PL_curstash = PL_curcop->cop_stash = stash;
+
+ newSUB(
+
+#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
+ /* before 5.003_22 */
+ start_subparse(),
+#else
+# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
+ /* 5.003_22 */
+ start_subparse(0),
+# else
+ /* 5.003_23 onwards */
+ start_subparse(FALSE, 0),
+# endif
+#endif
+
+ newSVOP(OP_CONST, 0, newSVpv(name,0)),
+ newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
+ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
+ );
+
+ PL_hints = oldhints;
+ PL_curcop->cop_stash = old_cop_stash;
+ PL_curstash = old_curstash;
+ PL_curcop->cop_line = oldline;
+}
+#endif
+
+#endif /* newCONSTSUB */
+
+
+#endif /* _P_P_PORTABILITY_H_ */
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/ppport.h
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/t/button.pl
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/t/button.pl 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/t/button.pl 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,3 @@
+my $b;
+$b=$mw->Button(-text=>'hello',-command=>sub{print $OUT 'hello'});
+$b->pack;
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/t/button.pl
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/t/callback.t
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/t/callback.t 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/t/callback.t 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,102 @@
+# -*- perl -*-
+# callback.t - Test script for Term::ReadLine:GNU callback function
+#
+# $Id: callback.t,v 1.6 2003-03-16 00:22:39-05 hiroo Exp hiroo $
+#
+# Copyright (c) 2000 Hiroo Hayashi. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+BEGIN {
+ print "1..7\n"; $n = 1;
+ $ENV{PERL_RL} = 'Gnu'; # force to use Term::ReadLine::Gnu
+}
+END {print "not ok 1\tfail to loading\n" unless $loaded;}
+
+my $verbose = defined @ARGV && ($ARGV[0] eq 'verbose');
+
+$^W = 1; # perl -w
+use strict;
+use vars qw($loaded $n);
+eval "use ExtUtils::testlib;" or eval "use lib './blib';";
+use Term::ReadLine;
+
+$loaded = 1;
+print "ok 1\tloading\n"; $n++;
+
+########################################################################
+# test new method
+
+my $term = new Term::ReadLine 'ReadLineTest';
+print defined $term ? "ok $n\n" : "not ok $n\n"; $n++;
+
+my $attribs = $term->Attribs;
+print defined $attribs ? "ok $n\n" : "not ok $n\n"; $n++;
+
+my ($version) = $attribs->{library_version} =~ /(\d+\.\d+)/;
+
+########################################################################
+# check Tk is installed
+#disable the warning, "Too late to run INIT block at..."
+$^W = 0;
+if (eval "use Tk; 1") {
+ print "ok $n\tuse Tk\n"; $n++;
+} else {
+ print "ok $n\t# skipped since Tk is not installed.\n"; $n++;
+ print "ok $n\t# skipped since Tk is not installed.\n"; $n++;
+ print "ok $n\t# skipped since Tk is not installed.\n"; $n++;
+ print "ok $n\t# skipped since Tk is not installed.\n"; $n++;
+ exit 0;
+}
+$^W = 1;
+
+########################################################################
+my ($IN, $OUT);
+if ($verbose) {
+ # wait for Perl Tk script from tty
+ $IN = $attribs->{instream};
+ $OUT = $attribs->{outstream};
+} else {
+ # test automatically
+ # to surpress warning on GRL 4.2a (and above?).
+ $attribs->{prep_term_function} = sub {} if ($version > 4.1);
+
+# open(IN, 't/button.pl') or die "cannot open 't/button.pl': $!\n";
+# $IN = \*IN;
+# old Perl did not work with the next line...
+ $IN = \*DATA; # does not work. Why?
+ open(NULL, '>/dev/null') or die "cannot open \`/dev/null\': $!\n";
+ $attribs->{outstream} = $OUT = \*NULL;
+}
+
+########################################################################
+my $mw;
+$mw = MainWindow->new();
+$mw->protocol('WM_DELETE_WINDOW' => \&quit);
+
+$attribs->{instream} = $IN;
+$mw->fileevent($IN, 'readable', $attribs->{callback_read_char});
+print "ok $n\tcallback_read_char\n"; $n++;
+
+$term->callback_handler_install("> ", sub {
+ my $line = shift;
+ quit() unless defined $line;
+ eval $line;
+ print $OUT "$@\n" if $@;
+});
+print "ok $n\tcallback_handler_install\n"; $n++;
+
+&MainLoop;
+
+sub quit {
+ $mw->fileevent($IN, 'readable', '');
+ $term->callback_handler_remove();
+ $mw->destroy;
+ print "ok $n\n"; $n++;
+ exit 0;
+}
+
+__END__
+$b=$mw->Button(-text=>'hello',-command=>sub{print $OUT 'hello'})
+$b->pack;
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/t/callback.t
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/0123
===================================================================
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/0123
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/012345
===================================================================
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/012345
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/023456
===================================================================
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/023456
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/README
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/README 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/README 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,2 @@
+This directory is for filename completion test.
+The size of most of files in this directory is zero.
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/README
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/a_b
===================================================================
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/t/comptest/a_b
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/t/history.t
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/t/history.t 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/t/history.t 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,476 @@
+# -*- perl -*-
+# history.t --- Term::ReadLine:GNU History Library Test Script
+#
+# $Id: history.t,v 1.9 2003-03-16 00:22:39-05 hiroo Exp hiroo $
+#
+# Copyright (c) 2002 Hiroo Hayashi. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl t/history.t'
+
+BEGIN {
+ print "1..82\n"; $n = 1;
+ $ENV{PERL_RL} = 'Gnu'; # force to use Term::ReadLine::Gnu
+}
+END {print "not ok $n\n" unless $loaded;}
+
+$^W = 1; # perl -w
+use strict;
+use vars qw($loaded $n);
+eval "use ExtUtils::testlib;" or eval "use lib './blib';";
+use Term::ReadLine;
+sub show_indices;
+
+$loaded = 1;
+print "ok $n\n"; $n++;
+
+# Perl-5.005 and later has Test.pm, but I define this here to support
+# older version.
+my $res;
+my $ok = 1;
+sub ok {
+ my $what = shift || '';
+
+ if ($res) {
+ print "ok $n\t$what\n";
+ } else {
+ print "not ok $n\t$what";
+ print @_ ? "\t at _\n" : "\n";
+ $ok = 0;
+ }
+ $n++;
+}
+
+########################################################################
+# test new method
+
+my $t = new Term::ReadLine 'ReadLineTest';
+print defined $t ? "ok $n\n" : "not ok $n\n"; $n++;
+
+my $OUT = $t->OUT || \*STDOUT;
+
+########################################################################
+# test ReadLine method
+
+if ($t->ReadLine eq 'Term::ReadLine::Gnu') {
+ print "ok $n\n";
+} else {
+ print "not ok $n\n";
+ print $OUT ("Package name should be \`Term::ReadLine::Gnu\', but it is \`",
+ $t->ReadLine, "\'\n");
+}
+$n++;
+
+########################################################################
+# test Attribs method
+use vars qw($attribs);
+
+$attribs = $t->Attribs;
+print defined $attribs ? "ok $n\n" : "not ok $n\n"; $n++;
+
+my ($version) = $attribs->{library_version} =~ /(\d+\.\d+)/;
+
+########################################################################
+# 2.3.1 Initializing History and State Management
+
+# test using_history
+# This is verbose since 'new' has already initialized the GNU history library.
+$t->using_history;
+
+# history_get_history_state!!!, history_set_history_state!!!
+
+# check the values of initialized variables
+print $attribs->{history_base} == 1
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+print $attribs->{history_length} == 0
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+print $attribs->{max_input_history} == 0
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+print $attribs->{history_expansion_char} eq '!'
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+print $attribs->{history_subst_char} eq '^'
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+print $attribs->{history_comment_char} eq "\0"
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+if ($version > 4.2 - 0.01) {
+ $res = $attribs->{history_word_delimiters} eq " \t\n;&()|<>";
+ ok('history_word_delimiters');
+} else {
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+}
+print $attribs->{history_no_expand_chars} eq " \t\n\r="
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+print ! defined $attribs->{history_search_delimiter_chars}
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+print $attribs->{history_quotes_inhibit_expansion} == 0
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+print ! defined $attribs->{history_inhibit_expansion_function}
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+
+########################################################################
+# 2.3.2 History List Management
+
+my @list_set;
+# default value of `history_base' is 1
+ at list_set = qw(one two two three);
+show_indices;
+
+# test SetHistory(), GetHistory()
+$t->SetHistory(@list_set);
+print cmp_list(\@list_set, [$t->GetHistory]) ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+
+# test add_history()
+$t->add_history('four');
+push(@list_set, 'four');
+print cmp_list(\@list_set, [$t->GetHistory]) ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+
+# test remove_history()
+$t->remove_history(2);
+splice(@list_set, 2, 1);
+print cmp_list(\@list_set, [$t->GetHistory]) ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+
+# test replace_history_entry()
+$t->replace_history_entry(3, 'daarn');
+splice(@list_set, 3, 1, 'daarn');
+print cmp_list(\@list_set, [$t->GetHistory]) ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+
+# stifle_history
+print $t->history_is_stifled == 0 ? "ok $n\n" : "not ok $n\n"; $n++;
+$t->stifle_history(3);
+print($t->history_is_stifled == 1
+ && $attribs->{history_length} == 3 && $attribs->{max_input_history} == 3
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+#print "@{[$t->GetHistory]}\n";
+show_indices;
+
+# history_is_stifled()
+$t->add_history('five');
+print($t->history_is_stifled == 1 && $attribs->{history_length} == 3
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+show_indices;
+
+# unstifle_history()
+$t->unstifle_history;
+print($t->history_is_stifled == 0 && $attribs->{history_length} == 3
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+#print "@{[$t->GetHistory]}\n";
+show_indices;
+
+# history_is_stifled()
+$t->add_history('six');
+print($t->history_is_stifled == 0 && $attribs->{history_length} == 4
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+show_indices;
+
+# clear_history()
+$t->clear_history;
+print ($attribs->{history_length} == 0 ? "ok $n\n" : "not ok $n\n"); $n++;
+show_indices;
+
+########################################################################
+# 2.3.3 Information About the History List
+
+$attribs->{history_base} = 0;
+show_indices;
+ at list_set = qw(zero one two three four);
+$t->stifle_history(4);
+show_indices;
+$t->SetHistory(@list_set);
+show_indices;
+
+# history_list()
+# history_list() routine emulates history_list() function in
+# GNU Readline Library.
+splice(@list_set, 0, 1);
+print cmp_list(\@list_set, [$t->history_list])
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+
+# at first where_history() returns 0
+print $t->where_history == 0 ? "ok $n\n" : "not ok $n\n"; $n++;
+
+# current_history()
+# history_base + 0 = 1
+print $t->current_history eq 'one' ? "ok $n\n" : "not ok $n\n"; $n++;
+
+# history_total_bytes()
+print $t->history_total_bytes == 15 ? "ok $n\n" : "not ok $n\n"; $n++;
+
+########################################################################
+# 2.3.4 Moving Around the History List
+
+# history_set_pos()
+$t->history_set_pos(2);
+print $t->where_history == 2 ? "ok $n\n" : "not ok $n\n"; $n++;
+# history_base + 2 = 3
+print $t->current_history eq 'three' ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+
+$t->history_set_pos(10000); # should be ingored
+print $t->where_history == 2 ? "ok $n\n" : "not ok $n\n"; $n++;
+
+# previous_history()
+print $t->previous_history eq 'two' ? "ok $n\n" : "not ok $n\n"; $n++;
+print $t->where_history == 1 ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+print $t->previous_history eq 'one' ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+$^W = 0; # returns NULL
+print $t->previous_history eq '' ? "ok $n\n" : "not ok $n\n"; $n++;
+$^W = 1;
+show_indices;
+
+# next_history()
+print $t->next_history eq 'two' ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+print $t->next_history eq 'three' ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+print $t->next_history eq 'four' ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+$^W = 0; # returns NULL
+print $t->next_history eq '' ? "ok $n\n" : "not ok $n\n"; $n++;
+$^W = 1;
+print $t->where_history == 4 ? "ok $n\n" : "not ok $n\n"; $n++;
+show_indices;
+
+
+########################################################################
+# 2.3.5 Searching the History List
+
+ at list_set = ('red yellow', 'green red', 'yellow blue', 'green blue');
+$t->SetHistory(@list_set);
+
+$t->history_set_pos(1);
+#show_indices;
+
+# history_search()
+print($t->history_search('red', -1) == 6 && $t->where_history == 1
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search('blue', -1) == -1 && $t->where_history == 1
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search('yellow', -1) == 4 && $t->where_history == 0
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+
+print($t->history_search('red', 1) == 0 && $t->where_history == 0
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search('blue', 1) == 7 && $t->where_history == 2
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search('red', 1) == -1 && $t->where_history == 2
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+
+print($t->history_search('red') == 6 && $t->where_history == 1
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+
+# history_search_prefix()
+print($t->history_search_prefix('red', -1) == 0
+ && $t->where_history == 0 ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search_prefix('green', 1) == 0
+ && $t->where_history == 1 ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search_prefix('red', 1) == -1
+ && $t->where_history == 1 ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search_prefix('red') == 0
+ && $t->where_history == 0 ? "ok $n\n" : "not ok $n\n"); $n++;
+
+# history_search_pos()
+$t->history_set_pos(3);
+print($t->history_search_pos('red', -1, 1) == 1
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search_pos('red', -1, 3) == 1
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search_pos('black', -1, 3) == -1
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search_pos('yellow', -1) == 2
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search_pos('green') == 3
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search_pos('yellow', 1, 1) == 2
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search_pos('yellow', 1) == -1
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+print($t->history_search_pos('red', 1, 2) == -1
+ ? "ok $n\n" : "not ok $n\n"); $n++;
+
+########################################################################
+# 2.3.6 Managing the History File
+
+$t->stifle_history(undef);
+my $hfile = '.history_test';
+my @list_write = $t->GetHistory();
+$t->WriteHistory($hfile) || warn "error at write_history: $!\n";
+
+$t->SetHistory(); # clear history list
+print ! $t->GetHistory ? "ok $n\n" : "not ok $n\n"; $n++;
+
+$t->ReadHistory($hfile) || warn "error at read_history: $!\n";
+print cmp_list(\@list_write, [$t->GetHistory]) ? "ok $n\n" : "not ok $n\n";
+$n++;
+
+ at list_write = qw(0 1 2 3 4);
+$t->SetHistory(@list_write);
+# write_history()
+! $t->write_history($hfile) || warn "error at write_history: $!\n";
+$t->SetHistory(); # clear history list
+# read_history()
+! $t->read_history($hfile) || warn "error at read_history: $!\n";
+print cmp_list(\@list_write, [$t->GetHistory]) ? "ok $n\n" : "not ok $n\n";
+$n++;
+
+# read_history() with range
+! $t->read_history($hfile, 1, 3) || warn "error at read_history: $!\n";
+print cmp_list([0,1,2,3,4,1,2], [$t->GetHistory])
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+#print "@{[$t->GetHistory]}\n";
+! $t->read_history($hfile, 2, -1) || warn "error at read_history: $!\n";
+print cmp_list([0,1,2,3,4,1,2,2,3,4], [$t->GetHistory])
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+#print "@{[$t->GetHistory]}\n";
+
+# append_history()
+! $t->append_history(5, $hfile) || warn "error at append_history: $!\n";
+$t->SetHistory(); # clear history list
+! $t->read_history($hfile) || warn "error at read_history: $!\n";
+print cmp_list([0,1,2,3,4,1,2,2,3,4], [$t->GetHistory])
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+#print "@{[$t->GetHistory]}\n";
+
+# history_truncate_file()
+$t->history_truncate_file($hfile, 6); # always returns 0
+$t->SetHistory(); # clear history list
+! $t->read_history($hfile) || warn "error at read_history: $!\n";
+print cmp_list([4,1,2,2,3,4], [$t->GetHistory])
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+#print "@{[$t->GetHistory]}\n";
+
+########################################################################
+# 2.3.7 History Expansion
+
+my ($string, $ret, @ret, $exp, @exp);
+
+ at list_set = ('red yellow', 'blue red', 'yellow blue', 'green blue');
+$t->SetHistory(@list_set);
+$t->history_set_pos(2);
+
+# history_expand()
+#print "${\($t->history_expand('!!'))}";
+# !! : last entry of the history list
+print $t->history_expand('!!') eq 'green blue'
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+print $t->history_expand('!yel') eq 'yellow blue'
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+
+($ret, $string) = $t->history_expand('!red');
+print $ret == 1 && $string eq 'red yellow' ? "ok $n\n" : "not ok $n\n"; $n++;
+
+# get_history_event()
+my ($text, $cindex);
+# 1 2
+# 012345678901234567890123
+$string = '!-2 !?red? "!blu" white';
+
+# !-2: 2 line before
+($text, $cindex) = $t->get_history_event($string, 0);
+$res = $cindex == 3 && $text eq 'yellow blue'; ok('get_history_event');
+#print "$cindex,$text\n";
+
+# non-event designator
+($text, $cindex) = $t->get_history_event($string, 3);
+$res = $cindex == 3 && ! defined $text; ok;
+#print "$cindex,$text\n";
+
+# The following 2 test may fail with readline-4.3 with some locale
+# setting. It comes from bug of the Readline Library. I sent a patch
+# to the maintainer. `LANG=C make test' should work.
+# !?red?: line including `red'
+($text, $cindex) = $t->get_history_event($string, 4);
+$res = $cindex == 10 && $text eq 'blue red'; ok;
+#print "$cindex,$text\n";
+
+# "!?blu": line including `blu'
+($text, $cindex) = $t->get_history_event($string, 12, '"');
+$res = $cindex == 16 && $text eq 'blue red'; ok;
+#print "$cindex,$text\n";
+
+
+# history_tokenize(), history_arg_extract()
+
+$string = ' foo "double quoted"& \'single quoted\' (paren)';
+# for history_tokenize()
+ at exp = ('foo', '"double quoted"', '&', '\'single quoted\'', '(', 'paren', ')');
+# for history_arg_extract()
+$exp = "@exp";
+
+ at ret = $t->history_tokenize($string);
+print cmp_list(\@ret, \@exp) ? "ok $n\n" : "not ok $n\n"; $n++;
+
+$ret = $t->history_arg_extract($string, 0, '$'); #') comments for font-lock;
+print $ret eq $exp ? "ok $n\n" : "not ok $n\n"; $n++;
+$ret = $t->history_arg_extract($string, 0);
+print $ret eq $exp ? "ok $n\n" : "not ok $n\n"; $n++;
+$ret = $t->history_arg_extract($string);
+print $ret eq $exp ? "ok $n\n" : "not ok $n\n"; $n++;
+$_ = $string;
+$ret = $t->history_arg_extract;
+print $ret eq $exp ? "ok $n\n" : "not ok $n\n"; $n++;
+
+########################################################################
+# 2.4 History Variables
+
+# history_base, history_length, max_input_history are tested above
+
+# history_expansion_char!!!, history_subst_char!!!, history_comment_char!!!,
+# history_word_delimiters!!!, history_no_expand_chars!!!
+
+# history_inhibit_expansion_function
+ at list_set = ('red yellow', 'blue red', 'yellow blue', 'green blue');
+$t->SetHistory(@list_set);
+$t->history_set_pos(2);
+$attribs->{history_inhibit_expansion_function} = sub {
+ my ($string, $index) = @_;
+ substr($string, $index + 1, 1) eq '!'; # inhibit expanding '!!'
+};
+
+print $t->history_expand('!!') eq '!!'
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+print $t->history_expand(' !r') eq ' red yellow'
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+print $t->history_expand('!! !y') eq 'green blue yellow blue'
+ ? "ok $n\n" : "not ok $n\n"; $n++;
+
+end_of_test:
+
+exit 0;
+
+########################################################################
+# subroutines
+
+# compare lists
+sub cmp_list {
+ ($a, $b) = @_;
+ my @a = @$a;
+ my @b = @$b;
+ return undef if $#a ne $#b;
+ for (0..$#a) {
+ return undef if $a[$_] ne $b[$_];
+ }
+ return 1;
+}
+
+# debugging support
+sub show_indices {
+ return;
+ printf("where_history: %d ", $t->where_history);
+# printf("current_history(): %s ", $t->current_history);
+ printf("history_base: %d, ", $attribs->{history_base});
+ printf("history_length: %d, ", $attribs->{history_length});
+# printf("max_input_history: %d ", $attribs->{max_input_history});
+# printf("history_total_bytes: %d ", $t->history_total_bytes);
+ print "\n";
+}
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/t/history.t
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/t/inputrc
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/t/inputrc 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/t/inputrc 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,8 @@
+# readline init file for t/readline.t
+# `a' and `b' should be bind to about, and 'c' not.
+"a": abort
+$if ReadLineTest
+"b": abort
+$else
+"c": abort
+$endif
\ No newline at end of file
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/t/inputrc
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/t/readline.t
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/t/readline.t 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/t/readline.t 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,955 @@
+# -*- perl -*-
+# readline.t - Test script for Term::ReadLine:GNU
+#
+# $Id: readline.t,v 1.44 2003-03-16 00:22:39-05 hiroo Exp hiroo $
+#
+# Copyright (c) 2002 Hiroo Hayashi. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl t/readline.t'
+
+BEGIN {
+ print "1..104\n"; $n = 1;
+ $ENV{PERL_RL} = 'Gnu'; # force to use Term::ReadLine::Gnu
+}
+END {print "not ok 1\tfail to loading\n" unless $loaded;}
+
+my $verbose = defined @ARGV && ($ARGV[0] eq 'verbose');
+
+$^W = 1; # perl -w
+use strict;
+use vars qw($loaded $n);
+eval "use ExtUtils::testlib;" or eval "use lib './blib';";
+use Term::ReadLine;
+use Term::ReadLine::Gnu qw(ISKMAP ISMACR ISFUNC RL_STATE_INITIALIZED);
+
+$loaded = 1;
+print "ok 1\tloading\n"; $n++;
+
+
+# Perl-5.005 and later has Test.pm, but I define this here to support
+# older version.
+my $res;
+my $ok = 1;
+sub ok {
+ my $what = shift || '';
+
+ if ($res) {
+ print "ok $n\t$what\n";
+ } else {
+ print "not ok $n\t$what";
+ print @_ ? "\t at _\n" : "\n";
+ $ok = 0;
+ }
+ $n++;
+}
+
+########################################################################
+# test new method
+
+$ENV{'INPUTRC'} = '/dev/null'; # stop reading ~/.inputrc
+
+my $t = new Term::ReadLine 'ReadLineTest';
+$res = defined $t; ok('new');
+
+my $OUT;
+if ($verbose) {
+ $OUT = $t->OUT;
+} else {
+ open(NULL, '>/dev/null') or die "cannot open \`/dev/null\': $!\n";
+ $OUT = \*NULL;
+ $t->Attribs->{outstream} = \*NULL;
+}
+
+########################################################################
+# test ReadLine method
+
+$res = $t->ReadLine eq 'Term::ReadLine::Gnu';
+ok('ReadLine method',
+ "\tPackage name should be \`Term::ReadLine::Gnu\', but it is \`",
+ $t->ReadLine, "\'\n");
+
+########################################################################
+# test Features method
+
+my %features = %{ $t->Features };
+$res = %features;
+ok('Features method',"\tNo additional features present.\n");
+
+########################################################################
+# test Attribs method
+
+my $a = $t->Attribs;
+$res = defined $a; ok('Attrib method');
+
+########################################################################
+# 2.3 Readline Variables
+
+my ($maj, $min) = $a->{library_version} =~ /(\d+)\.(\d+)/;
+my $version = $a->{readline_version};
+$res = ($version == 0x100 * $maj + $min); ok('readline_version');
+
+# Version 2.0 is NOT supported.
+$res = $version > 0x0200; ok('rl_version');
+
+# check the values of initialized variables
+$res = $a->{line_buffer} eq ''; ok;
+$res = $a->{point} == 0; ok;
+$res = $a->{end} == 0; ok;
+$res = $a->{mark} == 0; ok;
+$res = $a->{done} == 0; ok;
+if ($version >= 0x0402) {
+ $res = $a->{num_chars_to_read} == 0; ok('num_chars_to_read');
+} else {
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+}
+$res = $a->{pending_input} == 0; ok('pending_input');
+if ($version >= 0x0402) {
+ $res = $a->{dispatching} == 0; ok('dispatching');
+} else {
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+}
+$res = $a->{erase_empty_line} == 0; ok;
+$res = ! defined($a->{prompt}); ok;
+if ($version >= 0x0402) {
+ $res = $a->{already_prompted} == 0; ok('already_prompted');
+ $res = $a->{gnu_readline_p} == 1; ok('gnu_readline_p');
+} else {
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+}
+if ($version < 0x0402) {
+ $res = ! defined($a->{terminal_name}); ok;
+} else {
+ $res = $a->{terminal_name} eq $ENV{TERM}; ok;
+}
+$res = $a->{readline_name} eq 'ReadLineTest'; ok('readline_name');
+
+# rl_instream, rl_outstream, rl_last_func!!!,
+# rl_startup_hook, rl_pre_input_hook, rl_event_hook,
+# rl_getc_function, rl_redisplay_function
+# rl_prep_term_function!!!, rl_deprep_term_function!!!
+
+# not defined here
+$res = ! defined($a->{executing_keymap}); ok('executing_keymap');
+# anonymous keymap
+$res = defined($a->{binding_keymap}); ok('binding_keymap');
+
+if ($version >= 0x0402) {
+ $res = ! defined($a->{executing_macro}); ok('executing_macro');
+ $res = ($a->{readline_state} == RL_STATE_INITIALIZED);
+ ok('readline_state');
+ $res = $a->{explicit_arg} == 0; ok('explicit_arg');
+ $res = $a->{numeric_arg} == 1; ok('numeric_arg');
+ $res = $a->{editing_mode} == 1; ok('editing_mode');
+} else {
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+}
+
+########################################################################
+# 2.4 Readline Convenience Functions
+
+########################################################################
+# define some custom functions
+
+sub reverse_line { # reverse a whole line
+ my($count, $key) = @_; # ignored in this sample function
+
+ $t->modifying(0, $a->{end}); # save undo information
+ $a->{line_buffer} = reverse $a->{line_buffer};
+}
+
+# From the GNU Readline Library Manual
+# Invert the case of the COUNT following characters.
+sub invert_case_line {
+ my($count, $key) = @_;
+
+ my $start = $a->{point};
+ return 0 if ($start >= $a->{end});
+
+ # Find the end of the range to modify.
+ my $end = $start + $count;
+
+ # Force it to be within range.
+ if ($end > $a->{end}) {
+ $end = $a->{end};
+ } elsif ($end < 0) {
+ $end = 0;
+ }
+
+ return 0 if $start == $end;
+
+ if ($start > $end) {
+ my $temp = $start;
+ $start = $end;
+ $end = $temp;
+ }
+
+ # Tell readline that we are modifying the line, so it will save
+ # undo information.
+ $t->modifying($start, $end);
+
+ # I'm happy with Perl :-)
+ substr($a->{line_buffer}, $start, $end-$start) =~ tr/a-zA-Z/A-Za-z/;
+
+ # Move point to on top of the last character changed.
+ $a->{point} = $count < 0 ? $start : $end - 1;
+ return 0;
+}
+
+########################################################################
+# 2.4.1 Naming a Function
+
+my ($func, $type);
+
+# test add_defun
+$res = (! defined($t->named_function('reverse-line'))
+ && ! defined($t->named_function('invert-case-line'))
+ && defined($t->named_function('operate-and-get-next'))
+ && defined($t->named_function('display-readline-version'))
+ && defined($t->named_function('change-ornaments')));
+ok('add_defun');
+
+($func, $type) = $t->function_of_keyseq("\ct");
+$res = $type == ISFUNC && $t->get_function_name($func) eq 'transpose-chars';
+ok;
+
+$t->add_defun('reverse-line', \&reverse_line, ord "\ct");
+$t->add_defun('invert-case-line', \&invert_case_line);
+
+$res = (defined($t->named_function('reverse-line'))
+ && defined($t->named_function('invert-case-line'))
+ && defined($t->named_function('operate-and-get-next'))
+ && defined($t->named_function('display-readline-version'))
+ && defined($t->named_function('change-ornaments')));
+ok;
+
+($func, $type) = $t->function_of_keyseq("\ct");
+$res = $type == ISFUNC && $t->get_function_name($func) eq 'reverse-line';
+ok;
+
+########################################################################
+# 2.4.2 Selecting a Keymap
+
+# test rl_make_bare_keymap, rl_copy_keymap, rl_make_keymap, rl_discard_keymap
+my $baremap = $t->make_bare_keymap;
+$t->bind_key(ord "a", 'abort', $baremap);
+my $copymap = $t->copy_keymap($baremap);
+$t->bind_key(ord "b", 'abort', $baremap);
+my $normmap = $t->make_keymap;
+
+$res = (($t->get_function_name(($t->function_of_keyseq('a', $baremap))[0])
+ eq 'abort')
+ && ($t->get_function_name(($t->function_of_keyseq('b', $baremap))[0])
+ eq 'abort')
+ && ($t->get_function_name(($t->function_of_keyseq('a', $copymap))[0])
+ eq 'abort')
+ && ! defined($t->function_of_keyseq('b', $copymap))
+ && ($t->get_function_name(($t->function_of_keyseq('a', $normmap))[0])
+ eq 'self-insert'));
+ok('bind_key');
+
+$t->discard_keymap($baremap);
+$t->discard_keymap($copymap);
+$t->discard_keymap($normmap);
+
+# test rl_get_keymap, rl_set_keymap,
+# rl_get_keymap_by_name, rl_get_keymap_name
+$res = $t->get_keymap_name($t->get_keymap) eq 'emacs';
+ok;
+
+$t->set_keymap('vi');
+$res = $t->get_keymap_name($t->get_keymap) eq 'vi';
+ok;
+
+# equivalent to $t->set_keymap('emacs');
+$t->set_keymap($t->get_keymap_by_name('emacs'));
+$res = $t->get_keymap_name($t->get_keymap) eq 'emacs';
+ok;
+
+########################################################################
+# 2.4.3 Binding Keys
+
+#print $t->get_keymap_name($a->{executing_keymap}), "\n";
+#print $t->get_keymap_name($a->{binding_keymap}), "\n";
+
+# test rl_bind_key (rl_bind_key_in_map), rl_generic_bind, rl_parse_and_bind
+# define subroutine to use again later
+my ($helpmap, $mymacro);
+sub bind_my_function {
+ $t->bind_key(ord "\ct", 'reverse-line');
+ $t->bind_key(ord "\cv", 'display-readline-version', 'emacs-ctlx');
+ $t->parse_and_bind('"\C-xv": display-readline-version');
+ $t->bind_key(ord "c", 'invert-case-line', 'emacs-meta');
+ if ($version >= 0x0402) {
+ # rl_set_key in introduced by GRL 4.2
+ $t->set_key("\eo", 'change-ornaments');
+ } else {
+ $t->bind_key(ord "o", 'change-ornaments', 'emacs-meta');
+ }
+ $t->bind_key(ord "^", 'history-expand-line', 'emacs-meta');
+
+ # make an original map
+ $helpmap = $t->make_bare_keymap();
+ $t->bind_key(ord "f", 'dump-functions', $helpmap);
+ $t->generic_bind(ISKMAP, "\e?", $helpmap);
+ $t->bind_key(ord "v", 'dump-variables', $helpmap);
+ # 'dump-macros' is documented but not defined by GNU Readline 2.1
+ $t->generic_bind(ISFUNC, "\e?m", 'dump-macros') if $version > 0x0201;
+
+ # bind a macro
+ $mymacro = "\ca[insert text from beginning of line]";
+ $t->generic_bind(ISMACR, "\e?i", $mymacro);
+}
+
+bind_my_function; # do bind
+
+{
+ my ($fn, $ty);
+ # check keymap binding
+ ($fn, $ty) = $t->function_of_keyseq("\cX");
+ $res = $t->get_keymap_name($fn) eq 'emacs-ctlx' && $ty == ISKMAP;
+ ok('keymap binding');
+
+ # check macro binding
+ ($fn, $ty) = $t->function_of_keyseq("\e?i");
+ $res = $fn eq $mymacro && $ty == ISMACR;
+ ok('macro binding');
+}
+
+# check function binding
+$res = (is_boundp("\cT", 'reverse-line')
+ && is_boundp("\cX\cV", 'display-readline-version')
+ && is_boundp("\cXv", 'display-readline-version')
+ && is_boundp("\ec", 'invert-case-line')
+ && is_boundp("\eo", 'change-ornaments')
+ && is_boundp("\e^", 'history-expand-line')
+ && is_boundp("\e?f", 'dump-functions')
+ && is_boundp("\e?v", 'dump-variables')
+ && ($version <= 0x0201 or is_boundp("\e?m", 'dump-macros')));
+ok('function binding');
+
+# test rl_read_init_file
+$res = $t->read_init_file('t/inputrc') == 0;
+ok('rl_read_init_file');
+
+$res = (is_boundp("a", 'abort')
+ && is_boundp("b", 'abort')
+ && is_boundp("c", 'self-insert'));
+ok;
+
+# resume
+$t->bind_key(ord "a", 'self-insert');
+$t->bind_key(ord "b", 'self-insert');
+$res = (is_boundp("a", 'self-insert')
+ && is_boundp("b", 'self-insert'));
+ok;
+
+# test rl_unbind_key (rl_unbind_key_in_map),
+# rl_unbind_command_in_map, rl_unbind_function_in_map
+$t->unbind_key(ord "\ct"); # reverse-line
+$t->unbind_key(ord "f", $helpmap); # dump-function
+$t->unbind_key(ord "v", 'emacs-ctlx'); # display-readline-version
+if ($version > 0x0201) {
+ $t->unbind_command_in_map('display-readline-version', 'emacs-ctlx');
+ $t->unbind_function_in_map($t->named_function('dump-variables'), $helpmap);
+} else {
+ $t->unbind_key(ord "\cV", 'emacs-ctlx');
+ $t->unbind_key(ord "v", $helpmap);
+}
+
+my @keyseqs = ($t->invoking_keyseqs('reverse-line'),
+ $t->invoking_keyseqs('dump-functions'),
+ $t->invoking_keyseqs('display-readline-version'),
+ $t->invoking_keyseqs('dump-variables'));
+$res = scalar @keyseqs == 0; ok('unbind_key',"@keyseqs");
+
+if ($version >= 0x0402) {
+ $t->add_funmap_entry('foo_bar', 'reverse-line');
+# This does not work. We need `equal' in Lisp.
+# $res = ($t->named_function('reverse-line')
+# == $t->named_function('foo_bar'));
+ $res = defined $t->named_function('foo_bar');
+ ok('add_funmap_entry');
+} else {
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+}
+########################################################################
+# 2.4.4 Associating Function Names and Bindings
+
+bind_my_function; # do bind
+
+# rl_named_function, rl_function_of_keyseq, and add_funmap_entry are
+# tested above
+
+# test rl_invoking_keyseqs
+ at keyseqs = $t->invoking_keyseqs('abort', 'emacs-ctlx');
+$res = "\\C-g" eq "@keyseqs";
+ok('invoking_keyseqs');
+
+# Test rl_function_dumper!!!, rl_list_funmap_names!!!, rl_funmap_names!!!
+########################################################################
+# 2.4.5 Allowing Undoing
+# rl_begin_undo_group!!!, rl_end_undo_group!!!, rl_add_undo!!!,
+# rl_free_undo_list!!!, rl_do_undo!!!, rl_modifying
+########################################################################
+# 2.4.6 Redisplay
+# rl_redisplay!!!, rl_forced_update_display, rl_on_new_line!!!,
+# rl_on_new_line_with_prompt!!!, rl_reset_line_state!!!, rl_crlf!!!,
+# rl_show_char!!!,
+# rl_message, rl_clear_message, rl_save_prompt, rl_restore_prompt:
+# see Gnu/XS.pm:change_ornaments()
+# rl_expand_prompt!!!, rl_set_prompt!!!
+########################################################################
+# 2.4.7 Modifying Text
+# rl_insert_text!!!, rl_delete_text!!!, rl_copy_text!!!, rl_kill_text!!!,
+# rl_push_macro_input!!!
+########################################################################
+# 2.4.8 Character Input
+# rl_read_key!!!, rl_getc, rl_stuff_char!!!, rl_execute_next!!!,
+# rl_clear_pending_input!!!
+########################################################################
+# 2.4.9 Terminal Management
+# rl_prep_terminal!!!, rl_deprep_terminal!!!,
+# rl_tty_set_default_bindings!!!, rl_reset_terminal!!!
+########################################################################
+# 2.4.10 Utility Functions
+# rl_extend_line_buffer!!!, rl_initialize, rl_ding!!!, rl_alphabetic!!!,
+# rl_display_match_list
+########################################################################
+# 2.4.11 Miscellaneous Functions
+# rl_macro_bind!!!, rl_macro_dumpter!!!,
+# rl_variable_bind!!!, rl_variable_dumper!!!
+# rl_set_paren_blink_timeout!!!
+# rl_get_termcap!!!
+########################################################################
+# 2.4.12 Alternate Interface
+# tested in callbac,.t
+# rl_callback_handler_install, rl_callback_read_char,
+# rl_callback_handler_remove,
+########################################################################
+# 2.5 Readline Signal Handling
+$res = $a->{catch_signals} == 1; ok('catch_signals');
+$res = $a->{catch_sigwinch} == 1; ok('catch_sigwinch');
+
+# rl_cleanup_after_signal!!!, rl_free_line_state!!!,
+# rl_reset_after_signal!!!, rl_resize_terminal!!!,
+# rl_set_screen_size, rl_get_screen_size
+if ($version >= 0x0402) {
+ my ($rowsav, $colsav) = $t->get_screen_size;
+ $t->set_screen_size(60, 132);
+ my ($row, $col) = $t->get_screen_size;
+ # col=131 on a terminal which does not support auto-wrap function
+ $res = ($row == 60 && ($col == 132 || $col == 131));
+ ok('set/get_screen_size');
+ $t->set_screen_size($rowsav, $colsav);
+} else {
+ print "ok $n # skipped because GNU Readline Library is older than 4.2.\n";
+ $n++;
+}
+# rl_set_signals!!!, rl_clear_signals!!!
+########################################################################
+# 2.6 Custom Completers
+# 2.6.1 How Completing Works
+# 2.6.2 Completion Functions
+# rl_complete_internal!!!, rl_possible_completions!!!,
+# rl_insert_completions!!!, rl_completion_matches,
+# rl_filename_completion_function, rl_username_completion_function
+# 2.6.3 Completion Variables
+$res = ! defined $a->{completion_entry_function}; ok;
+$res = ! defined $a->{attempted_completion_function}; ok;
+$res = ! defined $a->{filename_quoting_function}; ok;
+$res = ! defined $a->{filename_dequoting_function}; ok;
+$res = ! defined $a->{char_is_quoted_p}; ok;
+$res = $a->{completion_query_items} == 100; ok;
+$res = ($a->{basic_word_break_characters}
+ eq " \t\n\"\\'`\@\$><=;|&{("); ok;
+$res = $a->{basic_quote_characters} eq "\"'"; ok;
+$res = ($a->{completer_word_break_characters}
+ eq " \t\n\"\\'`\@\$><=;|&{("); ok;
+$res = ! defined $a->{completer_quote_characters}; ok;
+$res = ! defined $a->{filename_quote_characters}; ok;
+$res = ! defined $a->{special_prefixes}; ok;
+$res = $a->{completion_append_character} eq " "; ok;
+$res = $a->{ignore_completion_duplicates} == 1; ok;
+$res = $a->{filename_completion_desired} == 0; ok;
+$res = $a->{filename_quoting_desired} == 1; ok;
+$res = $a->{attempted_completion_over} == 0; ok;
+$res = $a->{completion_type} == 0; ok;
+$res = $a->{inhibit_completion} == 0; ok;
+$res = ! defined $a->{ignore_some_completions_function};ok;
+$res = ! defined $a->{directory_completions_hook}; ok;
+$res = ! defined $a->{completions_display_matches_hook};ok;
+
+
+########################################################################
+
+$t->parse_and_bind('set bell-style none'); # make readline quiet
+
+my ($INSTR, $line);
+# simulate key input by using a variable 'rl_getc_function'
+$a->{getc_function} = sub {
+ unless (length $INSTR) {
+ print $OUT "Error: getc_function: insufficient string, \`\$INSTR\'.";
+ undef $a->{getc_function};
+ return 0;
+ }
+ my $c = substr $INSTR, 0, 1; # the first char of $INSTR
+ $INSTR = substr $INSTR, 1; # rest of $INSTR
+ return ord $c;
+};
+
+# check some key binding used by following test
+sub is_boundp {
+ my ($seq, $fname) = @_;
+ my ($fn, $type) = $t->function_of_keyseq($seq);
+ if ($fn) {
+ return ($t->get_function_name($fn) eq $fname
+ && $type == ISFUNC);
+ } else {
+ warn ("No function is bound for sequence \`", toprint($seq),
+ "\'. \`$fname\' is expected,");
+ return 0;
+ }
+}
+
+$res = (is_boundp("\cM", 'accept-line')
+ && is_boundp("\cF", 'forward-char')
+ && is_boundp("\cB", 'backward-char')
+ && is_boundp("\ef", 'forward-word')
+ && is_boundp("\eb", 'backward-word')
+ && is_boundp("\cE", 'end-of-line')
+ && is_boundp("\cA", 'beginning-of-line')
+ && is_boundp("\cH", 'backward-delete-char')
+ && is_boundp("\cD", 'delete-char')
+ && is_boundp("\cI", 'complete'));
+ok('default key binding',
+ "Default key binding is changed? Some of following test will fail.");
+
+$INSTR = "abcdefgh\cM";
+$line = $t->readline("self insert> ");
+$res = $line eq 'abcdefgh'; ok('self insert', $line);
+
+$INSTR = "\cAe\cFf\cBg\cEh\cH ij kl\eb\ebm\cDn\cM";
+$line = $t->readline("cursor move> ", 'abcd'); # default string
+$res = $line eq 'eagfbcd mnj kl'; ok('cursor move', $line);
+
+# test reverse_line, display_readline_version, invert_case_line
+$INSTR = "\cXvabcdefgh XYZ\e6\cB\e4\ec\cT\cM";
+$line = $t->readline("custom commands> ");
+$res = $line eq 'ZYx HGfedcba'; ok('custom commands', $line);
+
+# test undo of reverse_line
+$INSTR = "abcdefgh\cTi\c_\c_\cM";
+$line = $t->readline("test undo> ");
+$res = $line eq 'abcdefgh'; ok('undo', $line);
+
+# test macro, change_ornaments
+$INSTR = "1234\e?i\eoB\cM\cM";
+$line = $t->readline("keyboard macro> ");
+$res = $line eq "[insert text from beginning of line]1234"; ok('macro', $line);
+$INSTR = "\cM";
+$line = $t->readline("bold face prompt> ");
+$res = $line eq ''; ok('ornaments', $line);
+
+# test operate_and_get_next
+$INSTR = "one\cMtwo\cMthree\cM\cP\cP\cP\cO\cO\cO\cM";
+$line = $t->readline("> "); # one
+$line = $t->readline("> "); # two
+$line = $t->readline("> "); # three
+$line = $t->readline("> ");
+$res = $line eq 'one'; ok('operate_and_get_next 1', $line);
+$line = $t->readline("> ");
+$res = $line eq 'two'; ok('operate_and_get_next 2', $line);
+$line = $t->readline("> ");
+$res = $line eq 'three'; ok('operate_and_get_next 3', $line);
+$line = $t->readline("> ");
+$res = $line eq 'one'; ok('operate_and_get_next 4', $line);
+
+########################################################################
+# test history expansion
+
+$t->ornaments(0); # ornaments off
+
+#print $OUT "\n# history expansion test\n# quit by EOF (\\C-d)\n";
+$a->{do_expand} = 1;
+$t->MinLine(4);
+
+sub prompt {
+ # equivalent with "$nline = $t->where_history + 1"
+ my $nline = $a->{history_base} + $a->{history_length};
+ "$nline> ";
+}
+
+$INSTR = "!1\cM";
+$line = $t->readline(prompt);
+$res = $line eq 'abcdefgh'; ok('history 1', $line);
+
+$INSTR = "123\cM"; # too short
+$line = $t->readline(prompt);
+$INSTR = "!!\cM";
+$line = $t->readline(prompt);
+$res = $line eq 'abcdefgh'; ok('history 2', $line);
+
+$INSTR = "1234\cM";
+$line = $t->readline(prompt);
+$INSTR = "!!\cM";
+$line = $t->readline(prompt);
+$res = $line eq '1234'; ok('history 3', $line);
+
+########################################################################
+# test custom completion function
+
+$t->parse_and_bind('set bell-style none'); # make readline quiet
+
+$INSTR = "t/comp\cI\e*\cM";
+$line = $t->readline("insert completion>");
+# "a_b" < "README" on some kind of locale since strcoll() is used in
+# the GNU Readline Library.
+# Not all perl support setlocale. My perl supports locale and I tried
+# use POSIX qw(locale_h); setlocale(LC_COLLATE, 'C');
+# But it seems that it does not affect strcoll() linked to GNU
+# Readline Library.
+$res = $line eq 't/comptest/0123 t/comptest/012345 t/comptest/023456 t/comptest/README t/comptest/a_b '
+ || $line eq 't/comptest/0123 t/comptest/012345 t/comptest/023456 t/comptest/a_b t/comptest/README ';
+ok('insert completion', $line);
+
+$INSTR = "t/comp\cIR\cI\cM";
+$line = $t->readline("filename completion (default)>");
+$res = $line eq 't/comptest/README '; ok('default completion', $line);
+
+$a->{completion_entry_function} = $a->{'username_completion_function'};
+my $user = getlogin || 'root';
+$INSTR = "${user}\cI\cM";
+$line = $t->readline("username completion>");
+if ($line eq "${user} ") {
+ print "ok $n\tusername completion\n"; $n++;
+} elsif ($line eq ${user}) {
+ print "ok $n\t# skipped. It seems that there is no user whose name is '${user}' or there is a user whose name starts with '${user}'\n"; $n++;
+} else {
+ print "not ok $n\tusername completion\n"; $n++;
+ $ok = 0;
+}
+
+$a->{completion_word} = [qw(a list of words for completion and another word)];
+$a->{completion_entry_function} = $a->{'list_completion_function'};
+print $OUT "given list is: a list of words for completion and another word\n";
+$INSTR = "a\cI\cIn\cI\cIo\cI\cM";
+$line = $t->readline("list completion>");
+$res = $line eq 'another '; ok('list completion', $line);
+
+
+$a->{completion_entry_function} = $a->{'filename_completion_function'};
+$INSTR = "t/comp\cI\cI\cI0\cI\cI1\cI\cI\cM";
+$line = $t->readline("filename completion>");
+$res = $line eq 't/comptest/0123'; ok('filename completion', $line);
+undef $a->{completion_entry_function};
+
+# attempted_completion_function
+
+$a->{attempted_completion_function} = sub { undef; };
+$a->{completion_entry_function} = sub {};
+$INSTR = "t/comp\cI\cM";
+$line = $t->readline("null completion 1>");
+$res = $line eq 't/comp'; ok('null completion 1', $line);
+
+$a->{attempted_completion_function} = sub { (undef, undef); };
+undef $a->{completion_entry_function};
+$INSTR = "t/comp\cI\cM";
+$line = $t->readline("null completion 2>");
+$res = $line eq 't/comptest/'; ok('null completion 2', $line);
+
+sub sample_completion {
+ my ($text, $line, $start, $end) = @_;
+ # If first word then username completion, else filename completion
+ if (substr($line, 0, $start) =~ /^\s*$/) {
+ return $t->completion_matches($text, $a->{'list_completion_function'});
+ } else {
+ return ();
+ }
+}
+
+$a->{attempted_completion_function} = \&sample_completion;
+print $OUT "given list is: a list of words for completion and another word\n";
+$INSTR = "li\cIt/comp\cI\cI\cI0\cI\cI2\cI\cM";
+$line = $t->readline("list & filename completion>");
+$res = $line eq 'list t/comptest/023456 '; ok('list & file completion', $line);
+undef $a->{attempted_completion_function};
+
+# ignore_some_completions_function
+$a->{ignore_some_completions_function} = sub {
+ return (grep m|/$| || ! m|^(.*/)?[0-9]*$|, @_);
+};
+$INSTR = "t/co\cIRE\cI\cM";
+$line = $t->readline("ignore_some_completion>");
+$res = $line eq 't/comptest/README '; ok('ingore_some_completion', $line);
+undef $a->{ignore_some_completions_function};
+
+# char_is_quoted, filename_quoting_function, filename_dequoting_function
+
+sub char_is_quoted ($$) { # borrowed from bash-2.03:subst.c
+ my ($string, $eindex) = @_;
+ my ($i, $pass_next);
+
+ for ($i = $pass_next = 0; $i <= $eindex; $i++) {
+ my $c = substr($string, $i, 1);
+ if ($pass_next) {
+ $pass_next = 0;
+ return 1 if ($i >= $eindex); # XXX was if (i >= eindex - 1)
+ } elsif ($c eq '\'') {
+ $i = index($string, '\'', ++$i);
+ return 1 if ($i == -1 || $i >= $eindex);
+# } elsif ($c eq '"') { # ignore double quote
+ } elsif ($c eq '\\') {
+ $pass_next = 1;
+ }
+ }
+ return 0;
+}
+$a->{char_is_quoted_p} = \&char_is_quoted;
+$a->{filename_quoting_function} = sub {
+ my ($text, $match_type, $quote_pointer) = @_;
+ my $qc = $a->{filename_quote_characters};
+ return $text if $quote_pointer;
+ $text =~ s/[\Q${qc}\E]/\\$&/;
+ return $text;
+};
+$a->{filename_dequoting_function} = sub {
+ my ($text, $quote_char) = @_;
+ $quote_char = chr $quote_char;
+ $text =~ s/\\//g;
+ return $text;
+};
+
+$a->{completer_quote_characters} = '\'';
+$a->{filename_quote_characters} = ' _\'\\';
+
+$INSTR = "t/comp\cIa\cI 't/comp\cIa\cI\cM";
+$line = $t->readline("filename_quoting_function>");
+$res = $line eq 't/comptest/a\\_b \'t/comptest/a_b\' ';
+ok('filename_quoting_function', $line);
+
+$INSTR = "\'t/comp\cIa\\_\cI\cM";
+$line = $t->readline("filename_dequoting_function>");
+$res = $line eq '\'t/comptest/a_b\' ';
+ok('filename_dequoting_function', $line);
+
+undef $a->{char_is_quoted_p};
+undef $a->{filename_quoting_function};
+undef $a->{filename_dequoting_function};
+
+# directory_completion_hook
+$a->{directory_completion_hook} = sub {
+ if ($_[0] eq 'comp/') { # simple alias function
+ $_[0] = 't/comptest/';
+ return 1;
+ } else {
+ return 0;
+ }
+};
+
+$INSTR = "comp/\cI\cM";
+$line = $t->readline("directory_completion_hook>");
+$res = $line eq 't/comptest/';
+ok('directory_completion_hook', $line);
+undef $a->{directory_completion_hook};
+
+# filename_list
+my @m = $t->filename_list('t/comptest/01');
+$res = $#m == 1;
+ok('filename_list', $#m);
+
+$t->parse_and_bind('set bell-style audible'); # resume to default style
+
+########################################################################
+# test rl_startup_hook, rl_pre_input_hook
+
+$a->{startup_hook} = sub { $a->{point} = 10; };
+$INSTR = "insert\cM";
+$line = $t->readline("rl_startup_hook test>", "cursor is, <- here");
+$res = $line eq 'cursor is,insert <- here'; ok('startup_hook', $line);
+$a->{startup_hook} = undef;
+
+$a->{pre_input_hook} = sub { $a->{point} = 10; };
+$INSTR = "insert\cM";
+$line = $t->readline("rl_pre_input_hook test>", "cursor is, <- here");
+if ($version >= 0x0400) {
+ $res = $line eq 'cursor is,insert <- here'; ok('pre_input_hook', $line);
+} else {
+ print "ok $n # skipped because GNU Readline Library is older than 4.0.\n";
+ $n++;
+}
+$a->{pre_input_hook} = undef;
+
+#########################################################################
+# test redisplay_function
+$a->{redisplay_function} = $a->{shadow_redisplay};
+$INSTR = "\cX\cVThis is a password.\cM";
+$line = $t->readline("password> ");
+$res = $line eq 'This is a password.'; ok('redisplay_function', $line);
+undef $a->{redisplay_function};
+
+print "ok $n\n"; $n++;
+
+#########################################################################
+# test rl_display_match_list
+
+if ($version >= 0x0400) {
+ my @match_list = @{$a->{completion_word}};
+ $t->display_match_list(\@match_list);
+ $t->parse_and_bind('set print-completions-horizontally on');
+ $t->display_match_list(\@match_list);
+ $t->parse_and_bind('set print-completions-horizontally off');
+ print "ok $n\n"; $n++;
+} else {
+ print "ok $n # skipped because GNU Readline Library is older than 4.0.\n";
+ $n++;
+}
+
+#########################################################################
+# test rl_completion_display_matches_hook
+
+if ($version >= 0x0400) {
+ # See 'eg/perlsh' for better example
+ $a->{completion_display_matches_hook} = sub {
+ my($matches, $num_matches, $max_length) = @_;
+ map { $_ = uc $_; }(@{$matches});
+ $t->display_match_list($matches);
+ $t->forced_update_display;
+ };
+ $t->parse_and_bind('set bell-style none'); # make readline quiet
+ $INSTR = "Gnu.\cI\cI\cM";
+ $t->readline("completion_display_matches_hook>");
+ undef $a->{completion_display_matches_hook};
+ print "ok $n\n"; $n++;
+ $t->parse_and_bind('set bell-style audible'); # resume to default style
+} else {
+ print "ok $n # skipped because GNU Readline Library is older than 4.0.\n";
+ $n++;
+}
+
+########################################################################
+# test ornaments
+
+$INSTR = "\cM\cM\cM\cM\cM\cM\cM";
+print $OUT "# ornaments test\n";
+print $OUT "# Note: Some function may not work on your terminal.\n";
+# Kterm seems to have a bug with 'ue' (End underlining) does not work\n";
+$t->ornaments(1); # equivalent to 'us,ue,md,me'
+print $OUT "\n" unless defined $t->readline("default ornaments (underline)>");
+# cf. man termcap(5)
+$t->ornaments('so,me,,');
+print $OUT "\n" unless defined $t->readline("standout>");
+$t->ornaments('us,me,,');
+print $OUT "\n" unless defined $t->readline("underlining>");
+$t->ornaments('mb,me,,');
+print $OUT "\n" unless defined $t->readline("blinking>");
+$t->ornaments('md,me,,');
+print $OUT "\n" unless defined $t->readline("bold>");
+$t->ornaments('mr,me,,');
+print $OUT "\n" unless defined $t->readline("reverse>");
+$t->ornaments('vb,,,');
+print $OUT "\n" unless defined $t->readline("visible bell>");
+$t->ornaments(0);
+print $OUT "# end of ornaments test\n";
+
+print "ok $n\n"; $n++;
+
+########################################################################
+# end of non-interactive test
+unless ($verbose) {
+ # $^X : `perl' for dynamically linked perl, `./perl' for
+ # statically linked perl.
+ print STDERR "ok\tTry \`$^X -Mblib t/readline.t verbose\', if you will.\n"
+ if $ok;
+ exit 0;
+}
+undef $a->{getc_function};
+
+########################################################################
+# interactive test
+
+########################################################################
+# test redisplay_function
+
+$a->{redisplay_function} = $a->{shadow_redisplay};
+$line = $t->readline("password> ");
+print "<$line>\n";
+undef $a->{redisplay_function};
+
+########################################################################
+# test rl_getc_function and rl_getc()
+
+sub uppercase {
+# my $FILE = $a->{instream};
+# return ord uc chr $t->getc($FILE);
+ return ord uc chr $t->getc($a->{instream});
+}
+
+$a->{getc_function} = \&uppercase;
+print $OUT "\n" unless defined $t->readline("convert to uppercase>");
+$a->{getc_function} = undef;
+
+########################################################################
+# test event_hook
+$a->{getc_function} = undef;
+
+my $timer = 20; # 20 x 0.1 = 2.0 sec timer
+$a->{event_hook} = sub {
+ if ($timer-- < 0) {
+ $a->{done} = 1;
+ undef $a->{event_hook};
+ }
+};
+$line = $t->readline("input in 2 seconds> ");
+undef $a->{event_hook};
+print "<$line>\n";
+
+########################################################################
+# convert control charactors to printable charactors (ex. "\cx" -> '\C-x')
+sub toprint {
+ join('',
+ map{$_ eq "\e" ? '\M-': ord($_)<32 ? '\C-'.lc(chr(ord($_)+64)) : $_}
+ (split('', $_[0])));
+}
+
+my %TYPE = (0 => 'Function', 1 => 'Keymap', 2 => 'Macro');
+
+print $OUT "\n# Try the following commands.\n";
+foreach ("\co", "\ct", "\cx",
+ "\cx\cv", "\cxv", "\ec", "\e^",
+ "\e?f", "\e?v", "\e?m", "\e?i", "\eo") {
+ my ($p, $type) = $t->function_of_keyseq($_);
+ printf $OUT "%-9s: ", toprint($_);
+ (print "\n", next) unless defined $type;
+ printf $OUT "%-8s : ", $TYPE{$type};
+ if ($type == ISFUNC) { print $OUT ($t->get_function_name($p)); }
+ elsif ($type == ISKMAP) { print $OUT ($t->get_keymap_name($p)); }
+ elsif ($type == ISMACR) { print $OUT (toprint($p)); }
+ else { print $OUT "Error: Illegal type value"; }
+ print $OUT "\n";
+}
+
+print $OUT "\n# history expansion test\n# quit by EOF (\\C-d)\n";
+$a->{do_expand} = 1;
+while (defined($line = $t->readline(prompt))) {
+ print $OUT "<<$line>>\n";
+}
+print $OUT "\n";
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/t/readline.t
___________________________________________________________________
Name: svn:executable
+
Added: packages/libterm-readline-gnu-perl/branches/upstream/current/typemap
===================================================================
--- packages/libterm-readline-gnu-perl/branches/upstream/current/typemap 2005-07-12 18:06:17 UTC (rev 1239)
+++ packages/libterm-readline-gnu-perl/branches/upstream/current/typemap 2005-07-12 18:06:55 UTC (rev 1240)
@@ -0,0 +1,41 @@
+# typemap for Term::ReadLine::Gnu
+#
+# $Id: typemap,v 1.7 2003-03-16 00:11:14-05 hiroo Exp $
+
+const char * T_PV
+CONST char * T_PV
+#FILE * T_INOUT
+Keymap T_PTROBJ
+Function * T_PTROBJ
+rl_command_func_t * T_PTROBJ
+FILE * T_STDIO
+HIST_ENTRY * T_HIST_ENTRY
+t_xstr T_XSTR
+
+########################################################################
+INPUT
+T_STDIO
+ $var = PerlIO_findFILE(IoIFP(sv_2io($arg)))
+
+########################################################################
+OUTPUT
+T_STDIO
+ {
+ /* module FileHandle expects PerlIO is blessed to IO::Handle */
+ /* This stop segmentation fault on Perl 5.8.0 w/PerlIO */
+ GV *gv = newGVgen("IO::Handle");
+ PerlIO *fp = PerlIO_importFILE($var,0);
+ if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) )
+ sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("IO::Handle",1)));
+ else
+ $arg = &PL_sv_undef;
+ }
+T_XSTR
+ if ($var) {
+ sv_setpv($arg, $var);
+ xfree($var);
+ }
+T_HIST_ENTRY
+ if ($var && $var->line) {
+ sv_setpv($arg, $var->line);
+ }
Property changes on: packages/libterm-readline-gnu-perl/branches/upstream/current/typemap
___________________________________________________________________
Name: svn:executable
+
More information about the Pkg-perl-cvs-commits
mailing list