1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
#!/usr/bin/env perl
#
# manexamp -- The examples which appear in the documentation are here.
#
# Copyright (C) 2024 Hiroo Hayashi
#
# Derived from: examples/manexamp.c in the GNU Readline Library
# Copyright (C) 1987-2023 Free Software Foundation, Inc.
use strict;
use warnings;
use Term::ReadLine;
my $t = new Term::ReadLine 'manexamp';
my $a = $t->Attribs;
# ****************************************************************
#
# How to Emulate gets ()
#
# ****************************************************************
# https://tiswww.case.edu/php/chet/readline/readline.html#Basic-Behavior
# Read a string, and return it. Returns undef on EOF.
sub rl_gets () {
return $t->readline('');
}
# ****************************************************************
#
# Writing a Function to be Called by Readline.
#
# ****************************************************************
# https://tiswww.case.edu/php/chet/readline/readline.html#A-Readline-Example
# 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;
# For positive arguments, put point after the last changed character. For
# negative arguments, put point before the last changed character.
$a->{point} = $end;
# Swap start and end if we are moving backwards.
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/;
return 0;
}
$t->initialize();
$t->add_defun('invert-case-line', \&invert_case_line);
$t->bind_key(ord 'c', 'invert-case-line', 'emacs-meta');
while (defined($_ = rl_gets())) {
invert_case_line(1, '');
print "$_\n";
}
exit 0;
|
