Merge pull request #27 from hirooih/import-examples

import examples from the GNU Readline Library

Gnu.pm

@@ -107,6 +107,7 @@ BEGIN {
                   Exporter DynaLoader);
 
     our %EXPORT_TAGS = (
+        readerr =>      [qw(READERR)],
         prompt =>       [qw(RL_PROMPT_START_IGNORE RL_PROMPT_END_IGNORE)],
         match_type =>   [qw(NO_MATCH SINGLE_MATCH MULT_MATCH)],
         keymap_type =>  [qw(ISFUNC ISKMAP ISMACR)],
@@ -128,6 +129,7 @@ BEGIN {
                             RL_STATE_EOF
                             )],
         );
+    Exporter::export_ok_tags('readerr');
     Exporter::export_ok_tags('prompt');
     Exporter::export_ok_tags('match_type');
     Exporter::export_ok_tags('keymap_type');
@@ -174,6 +176,10 @@ our %Features = (
 # will cause compatiblity problem. I hope the definition of these
 # constant value will not be changed.
 
+# Input error; can be returned by (*rl_getc_function) if readline is reading
+# a top-level command (RL_ISSTATE (RL_STATE_READCMD)).
+sub READERR      { -2; }
+
 # for non-printing characters in prompt string
 sub RL_PROMPT_START_IGNORE      { "\001"; }
 sub RL_PROMPT_END_IGNORE        { "\002"; }
@@ -1331,6 +1337,18 @@ Manual|https://tiswww.cwru.edu/php/chet/readline/readline.html>.
 
 =over 4
 
+=item C<SETSTATE(READLINE_STATE)>
+
+        int  RL_SETSTATE(int)                                   # GRL 6.0
+
+=item C<UNSETSTATE(READLINE_STATE)>
+
+        int  RL_UNSETSTATE(int)                                 # GRL 6.0
+
+=item C<ISSTATE(READLINE_STATE)>
+
+        int  RL_ISSTATE(int)                                    # GRL 6.0
+
 =item C<save_state(READLINE_STATE)>
 
         READLINE_STATE  rl_save_state()                         # GRL 6.0
@@ -2143,6 +2161,10 @@ The following tags are defined and their symbols can be exported.
 
 =over 4
 
+=item readerr
+
+READERR
+
 =item prompt
 
 RL_PROMPT_START_IGNORE RL_PROMPT_END_IGNORE

Gnu/XS.pm

@@ -303,6 +303,24 @@ sub rl_completion_mode {
     return _rl_completion_mode(_str2fn($_[0]));
 }
 
+#
+#       the GNU Readline Macros
+#
+sub SETSTATE {
+    my ($x) = @_;
+    return ($Attribs{readline_state} |= $x);
+}
+
+sub UNSETSTATE {
+    my ($x) = @_;
+    return ($Attribs{readline_state} &= ~$x);
+}
+
+sub ISSTATE {
+    my ($x) = @_;
+    return ($Attribs{readline_state} & $x);
+}
+
 #
 #       for compatibility with Term::ReadLine::Perl
 #

MANIFEST

@@ -1,29 +1,54 @@
-Changes		A change history
-Gnu.pm		The GNU Readline extension Perl module
-Gnu.xs		The GNU Readline extension external subroutines
+# This file lists the files included in Term::ReadLine::Gnu module distribution
+
+Changes                 A change history
+INSTALL.md              Installtion instructions
+MANIFEST                This list of files
+Makefile.PL             The GNU Readline extension makefile writer
+README.md               The Instructions
+ppport.h                Perl/Pollution/Portability Version 3.68
+typemap                 The GNU Readline extension interface types
+
+# Main Module Files
+Gnu.pm                  The GNU Readline extension Perl module
+Gnu.xs                  The GNU Readline extension external subroutines
 Gnu/XS.pm
-INSTALL.md	Installtion instructions
-MANIFEST	This list of files
-Makefile.PL	The GNU Readline extension makefile writer
-README.md	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/00checkver.t	A version check script
-t/01test_use.t	A test for "use Term::ReadLine"
-t/02test_use.t	A test for "use Term::ReadLine"
-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 Library function
-t/utf8_binary.t	A test script for UTF-8 binary string
-t/utf8_text.t	A test script for UTF-8 text string
-t/utf8.txt	A file for t/utf8_*.t
-typemap		The GNU Readline extension interface types
+
+# Test Scripts
+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/00checkver.t          A version check script
+t/01test_use.t          A test for "use Term::ReadLine"
+t/02test_use.t          A test for "use Term::ReadLine"
+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 Library function
+t/utf8_binary.t         A test script for UTF-8 binary string
+t/utf8_text.t           A test script for UTF-8 text string
+t/utf8.txt              A file for t/utf8_*.t
+
+# Sample Scripts
+eg/perlsh               A powerful calculator
+eg/pftp                 An ftp client with the GNU Readline support
+eg/ptksh+               Simple perl/Tk shell which demonstrates the callback functions
+
+# The following are ported from the examples in the GNU Readline Library distribution.
+eg/rlversion            Print out readline's version number
+eg/rlbasic              A basic readline() loop example
+eg/manexamp             2.1 Basic Behavior: rl_gets(), 2.4.13 A Readline Example: invert_case_line()
+eg/rltest               readline() loop + add_history() + history_list()
+eg/rl                   readline() loop + ri_startup_hook, rl_insert_text(), rl_instream, rl_num_chars_to_read
+eg/rlevent              rl + rl_event_hook
+eg/rlkeymaps            Tests for keymap functions
+eg/histexamp            history library example program
+eg/rl-callbacktest      2.4.14 Alternate Interface Example
+eg/rl-callbacktest2     Provides readline()-like interface using the alternate interface
+eg/rl-callbacktest3     rl-callbacktest + sigint_handler() + rl_getc_function
+eg/excallback           Alternate interface + rl_set_prompt()
+eg/rlptytest            Another alternate interface example using pty
+eg/rl-timeout           Test various readline builtin timeouts
+eg/rlcat                cat(1) using readline
+eg/fileman              2.6.4 A Short Completion Example: file manager example for readline library

eg/excallback

@@ -0,0 +1,135 @@
+#!/usr/bin/env perl
+#
+# excallback: Another test harness for the readline callback interface.
+#
+#   Copyright (C) 2024 Hiroo Hayashi
+#
+# Derived from: examples/excallback.c in the GNU Readline Library
+#   Author: Jeff Solomon <[email protected]>
+
+# This little examples demonstrates the alternate interface to using readline.
+# In the alternate interface, the user maintains control over program flow and
+# only calls readline when STDIN is readable. Using the alternate interface,
+# you can do anything else while still using readline (like talking to a
+# network or another program) without blocking.
+#
+# Specifically, this program highlights two importants features of the
+# alternate interface. The first is the ability to interactively change the
+# prompt, which can't be done using the regular interface since rl_prompt is
+# read-only.
+#
+# The second feature really highlights a subtle point when using the alternate
+# interface. That is, readline will not alter the terminal when inside your
+# callback handler. So let's so, your callback executes a user command that
+# takes a non-trivial amount of time to complete (seconds). While your
+# executing the command, the user continues to type keystrokes and expects them
+# to be re-echoed on the new prompt when it returns. Unfortunately, the default
+# terminal configuration doesn't do this. After the prompt returns, the user
+# must hit one additional keystroke and then will see all of his previous
+# keystrokes. To illustrate this, compile and run this program. Type "sleep" at
+# the prompt and then type "bar" before the prompt returns (you have 3
+# seconds). Notice how "bar" is re-echoed on the prompt after the prompt
+# returns? This is what you expect to happen. Now comment out the 4 lines below
+# the line that says COMMENT LINE BELOW. Recompile and rerun the program and do
+# the same thing. When the prompt returns, you should not see "bar". Now type
+# "f", see how "barf" magically appears? This behavior is un-expected and not
+# desired.
+
+use strict;
+use warnings;
+use Term::ReadLine;
+use IO::Pty;
+use POSIX qw(termios_h _POSIX_VDISABLE);
+
+my $t = new Term::ReadLine 'rlptytest';
+my $a = $t->Attribs;
+
+my $prompt = 1;
+my $old_lflag;
+my $old_vtime;
+my $term;
+
+# main program
+
+sub main {
+    # Adjust the terminal slightly before the handler is installed. Disable
+    # canonical mode processing and set the input character time flag to be
+    # non-blocking.
+    $term = POSIX::Termios->new;
+    if (!defined($term->getattr(fileno(STDIN)))) {
+        die "tcgetattr: $!\n";
+    }
+    $old_lflag = $term->getlflag();
+    $old_vtime = $term->getcc(VTIME);
+    $term->setlflag($old_lflag & ~ICANON);
+    $term->setcc(1, VTIME);
+
+    # COMMENT LINE BELOW - see above
+    if (!defined($term->setattr(fileno(STDIN), TCSANOW))) {
+        die "tcsetattr: $!\n";
+    }
+
+    $t->add_defun("change-prompt", \&change_prompt, ord "\cT");
+    $t->callback_handler_install(get_prompt(), \&process_line);
+    while (1) {
+        my $fds = '';
+        vec($fds, fileno(STDIN), 1) = 1;
+        if (select($fds, undef, undef, undef) < 0) {
+            die "select: $!\n";
+        }
+        $t->callback_read_char() if (vec($fds, fileno(STDIN), 1));
+    }
+    exit 0;
+}
+
+sub process_line {
+    my ($line) = @_;
+    if (!$line) {
+        printf STDERR "\n";
+
+        # reset the old terminal setting before exiting
+        $term->setlflag($old_lflag);
+        $term->setcc($old_vtime, VTIME);
+        if (!defined($term->setattr(fileno(STDIN), TCSANOW))) {
+            die "tcsetattr: $!\n";
+        }
+        exit(0);
+    }
+    if ($line eq "sleep") {
+        sleep(3);
+    } else {
+        print STDERR "|$line|\n";
+    }
+}
+sub change_prompt {
+    # toggle the prompt variable
+    $prompt = !$prompt;
+    $t->set_prompt(get_prompt());
+}
+sub change_promptx {
+    # toggle the prompt variable
+    $prompt = !$prompt;
+
+    # save away the current contents of the line
+    my $line_buf = $a->{line_buffer};
+
+    # install a new handler which will change the prompt and erase the current line
+    $t->callback_handler_install(get_prompt(), \&process_line);
+
+    # insert the old text on the new line
+    $t->insert_text($line_buf);
+
+    # redraw the current line - this is an undocumented function. It invokes the
+    # redraw-current-line command.
+    # $t->refresh_line(0, 0);
+    # $t->forced_update_display();
+    # $t->reset_line_state();
+    $t->redisplay();
+}
+
+sub get_prompt {
+    # The prompts can even be different lengths!
+    return $prompt ? "Hit ctrl-t to toggle prompt> " : "Pretty cool huh?> ";
+}
+
+main();

eg/fileman

@@ -1,4 +1,4 @@
-#!/usr/local/bin/perl
+#!/usr/bin/env perl
 #
 # This is a sample program of Term::ReadLine::Gnu perl module.  The
 # origin is a C program in the GNU Readline Libarary manual Edition

eg/histexamp

@@ -0,0 +1,64 @@
+#!/usr/bin/env perl
+#
+# histexamp -- history library example program.
+# https://tiswww.case.edu/php/chet/readline/history.html#History-Programming-Example
+#
+#   Copyright (C) 2024 Hiroo Hayashi
+#
+# Derived from: examples/histexamp.c in the GNU Readline Library
+#   Copyright (C) 1987-2009 Free Software Foundation, Inc.
+
+use strict;
+use warnings;
+use Term::ReadLine;
+use POSIX qw(strftime);
+
+my $t = new Term::ReadLine 'histexamp';
+my $a = $t->Attribs;
+
+my $done = 0;
+$t->using_history();
+$| = 1;    # autoflush
+while (!$done) {
+    printf('history$ ');
+    my $line = <>;
+    $line = 'quit' unless $line;
+    chomp $line;
+
+    if ($line) {
+        my ($result, $expansion) = $t->history_expand($line);
+        print $expansion, "\n" if ($result);
+
+        continue if ($result < 0 || $result == 2);
+
+        $t->add_history($expansion);
+        $line = $expansion;
+    }
+
+    if ($line eq "quit") {
+        $done = 1;
+    } elsif ($line eq "save") {
+        $t->write_history("history_file");
+    } elsif ($line eq "read") {
+        $t->read_history("history_file");
+    } elsif ($line eq "list") {
+        my $i = 0;
+        for (my $i = 0; $i < $a->{history_length}; $i++) {
+            my $offset  = $i + $a->{history_base};
+            my $tt      = $t->history_get_time($offset);
+            my $timestr = strftime("%a %R", localtime($tt));
+            printf("%d: %s: %s\n", $offset, $timestr, $t->history_get($offset));
+        }
+    } elsif ($line =~ /^delete/) {
+        my $which;
+        if (($which) = $line =~ /^delete\s+(\d+)$/) {
+            my $entry = $t->remove_history($which - $a->{history_base});
+            if (!$entry) {
+                warn("No such entry $which\n");
+            }
+        } else {
+            warn("non-numeric arg given to `delete'\n");
+        }
+    }
+}
+exit 0;