Hello community,
here is the log from the commit of package perl-IO-Pager for openSUSE:Factory
checked in at 2020-11-03 15:17:04
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-IO-Pager (Old)
and /work/SRC/openSUSE:Factory/.perl-IO-Pager.new.3463 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-IO-Pager"
Tue Nov 3 15:17:04 2020 rev:28 rq:845709 version:2.00
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-IO-Pager/perl-IO-Pager.changes
2020-06-17 14:50:17.580972076 +0200
+++ /work/SRC/openSUSE:Factory/.perl-IO-Pager.new.3463/perl-IO-Pager.changes
2020-11-03 15:17:38.396102070 +0100
@@ -1,0 +2,23 @@
+Tue Nov 3 11:53:28 UTC 2020 - Tina Müller <tina.muel...@suse.com>
+
+- Don't do parallel build
+
+-------------------------------------------------------------------
+Tue Nov 3 03:12:40 UTC 2020 - Tina Müller <timueller+p...@suse.de>
+
+- updated to 2.00
+ see /usr/share/doc/packages/perl-IO-Pager/CHANGES
+
+ 2.00 Nov 01 2020
+ Fix interactive tests 7 and 16 in bogus environments w/o PAGER. RT#13330
+ Add tp to local script installation. RT#133651
+ Add suport for visible scrollbar. RT#133652
+ ::Perl Rename prompt() to status(), I18N{prompt} to I18N{minihelp},
+ and I18N{status} to I18N{prompt}
+ ::Perl Fix long lines in absence of Text::Wrap
+ ::Perl Consolidate dialog()
+ ::Perl Add ability to open file interactively
+ ::Perl Prevent jumping to invalid bookmark
+ ::Perl Fix tp -j
+
+-------------------------------------------------------------------
Old:
----
IO-Pager-1.03.tgz
New:
----
IO-Pager-2.00.tgz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-IO-Pager.spec ++++++
--- /var/tmp/diff_new_pack.nSV7pr/_old 2020-11-03 15:17:39.252102894 +0100
+++ /var/tmp/diff_new_pack.nSV7pr/_new 2020-11-03 15:17:39.256102898 +0100
@@ -17,7 +17,7 @@
Name: perl-IO-Pager
-Version: 1.03
+Version: 2.00
Release: 0
%define cpan_name IO-Pager
Summary: Select a pager (possibly perl-based) & pipe it text if a TTY
@@ -53,8 +53,11 @@
find . -type f ! -path "*/t/*" ! -name "*.pl" ! -path "*/bin/*" ! -path
"*/script/*" ! -name "configure" -print0 | xargs -0 chmod 644
%build
+# no parallel build, otherwise we get:
+# make -j8
+# make: *** No rule to make target 'blib/lib/IO/Pager/tp', needed by
'manifypods'. Stop.
perl Makefile.PL INSTALLDIRS=vendor
-make %{?_smp_mflags}
+make
%check
make test
++++++ IO-Pager-1.03.tgz -> IO-Pager-2.00.tgz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/CHANGES new/IO-Pager-2.00/CHANGES
--- old/IO-Pager-1.03/CHANGES 2020-06-13 17:36:13.000000000 +0200
+++ new/IO-Pager-2.00/CHANGES 2020-11-02 02:20:04.000000000 +0100
@@ -1,5 +1,25 @@
Revision history for Perl extension IO::Pager.
+2.00 Nov 01 2020
+ Fix interactive tests 7 and 16 in bogus environments w/o PAGER. RT#13330
+
+ Add tp to local script installation. RT#133651
+
+ Add suport for visible scrollbar. RT#133652
+
+ ::Perl Rename prompt() to status(), I18N{prompt} to I18N{minihelp},
+ and I18N{status} to I18N{prompt}
+
+ ::Perl Fix long lines in absence of Text::Wrap
+
+ ::Perl Consolidate dialog()
+
+ ::Perl Add ability to open file interactively
+
+ ::Perl Prevent jumping to invalid bookmark
+
+ ::Perl Fix tp -j
+
1.03 Jun 13 2020
Fix destruction warnings in Buffered
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/META.json new/IO-Pager-2.00/META.json
--- old/IO-Pager-1.03/META.json 2020-06-13 17:38:17.000000000 +0200
+++ new/IO-Pager-2.00/META.json 2020-11-02 02:55:52.000000000 +0100
@@ -53,7 +53,7 @@
}
},
"release_status" : "stable",
- "version" : "1.03",
+ "version" : "2.00",
"x_runtime" : {
"recommends" : {}
},
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/META.yml new/IO-Pager-2.00/META.yml
--- old/IO-Pager-1.03/META.yml 2020-06-13 17:38:17.000000000 +0200
+++ new/IO-Pager-2.00/META.yml 2020-11-02 02:55:52.000000000 +0100
@@ -35,7 +35,7 @@
Tie::Handle: '0'
base: '0'
perl: '5.008000'
-version: '1.03'
+version: '2.00'
x_runtime:
recommends: {}
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/Makefile.PL
new/IO-Pager-2.00/Makefile.PL
--- old/IO-Pager-1.03/Makefile.PL 2019-10-13 15:25:46.000000000 +0200
+++ new/IO-Pager-2.00/Makefile.PL 2020-11-01 22:01:27.000000000 +0100
@@ -26,6 +26,7 @@
'Text::Wrap' => 0,
'Tie::Handle' => 0,
},
+ EXE_FILES => [ 'blib/lib/IO/Pager/tp' ],
META_MERGE => {
"meta-spec" => { version => 2 },
runtime => {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/README new/IO-Pager-2.00/README
--- old/IO-Pager-1.03/README 2019-10-20 22:41:13.000000000 +0200
+++ new/IO-Pager-2.00/README 2020-06-15 03:41:33.000000000 +0200
@@ -50,7 +50,7 @@
IO::Pager::Perl - Jerrad Pierce & Jeff Weisberg, Perl Artistic License
-All Else - Copyright (C) 2003-2019 Jerrad Pierce:
+All Else - Copyright (C) 2003-2020 Jerrad Pierce:
* Thou shalt not claim ownership of unmodified materials.
* Thou shalt not claim whole ownership of modified materials.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/TODO new/IO-Pager-2.00/TODO
--- old/IO-Pager-1.03/TODO 2020-06-13 14:51:22.000000000 +0200
+++ new/IO-Pager-2.00/TODO 2020-11-02 02:42:43.000000000 +0100
@@ -1,16 +1,26 @@
Important things here and in code flagged with XXX
-1.03
+Ctrl-Home/End for top/bottom. -Pgup/PgDn (konsole) for file next/prev?
+
+2.0
+ scrollbar:
+ pipe calcuations?
+ thumb size: txtN/rows = pages; rows/pages = thumb
+
+ grep scrolling is borked
+ dialog, refresh if _grep instead of specific row refresh
+ modify calls to line() to pass row? keep a buffer of
+ {_row}->[$row]=$line?
+ use screen as buffer: scroll-up decrement cursor until match/top & emit
+
+ squishing throws off line numbering. okay for jumping, awkward for
+ cross-referencing file in an editor
-IPP Consolidate special inputs? (multichar,abort &search, &write_buffer);
- (delete &search, \d)
+1.03
Lesskey #command
-!! & filter #super-nifty! built-in grep
!! - toggle-option #switch toggle_* to this?!
! _ display-option
- :e examine #open new file
- E examine
\eu undo-hilite #toggle higlight of current search term
F forw-forever #tail
@@ -20,8 +30,6 @@
IPP
kcub1[left],kcuf1[right],kcuu1[up],kcud1[down],kLFT[S-left],kRIT[S-right]
IPP kprv,knxt,khome,kend,kbs[backspace],kf1(help?),kich1(insert as mark?)
-IPP fix infinite scroll if invalid jump (bogus user entry or unmapped key)
-
1.02
IPP rename tp to ppp ("pure" perl pager)? (except stty/tput, and ReadKey)
@@ -29,32 +37,13 @@
IPP $me->{_text}->[prev] eq ''
IPP Document line numbering impacts?! (perf, RAM...)
-IPP Alt _fncRE join '' map {"^\Q$_\n"};//m
-
-IPP Term:Screen
-IPP https://metacpan.org/release/Term-Screen/source/lib/Term/Screen.pm#L474
-IPP getch: reimplement (versus #use#, misalignments with forking)
-IPP sysread vs. Term::ReadKey, as $^O alt for getc() in ReadMode()?
-IPP
-IPP get_fn_keys aliases
-
-IPP WINCH reflow
-IPP keep cursor at same content?
-IPP _cursor = int(_cursor * oldCols / newCols)-1
-
-IPP -rows makes smaller screen, but scrolling down fails.
-IPP Scrollng back up seems fine(ish) though.
+IPP WINCH reflow: keep cursor at same content?
IPP Display filename in status line?
-IPP Clear buffer for multiple files? OTOH, while different,
-IPP all-in-one is kind of a unique and nifty feature.
-IPP But can we offer discontinuous numbering?
-
IPP Rearchitect around String::Tagged::Terminal?
1.01
-IPP Check ref() eq 'CODE' before running
IPP ioctl() for cbreak to replace stty? May not be so cross-platform
@@ -78,13 +67,9 @@
IPP Pause bugs
-IPP extra scroll forwards required after backed up over pauses
-
IPP Left/right when paused causes vertical scrolling
IPP (horiz. scroll trigeering a form forward, how to prevent?!)
-IPP We get an extra chunk of output after menu closing
-
IPP Add more IO::Pager::Perl involved tests, scripted interaction?
IPP read from pipe, file
IPP navigation
@@ -106,11 +91,6 @@
Test functionality w/|w/o Term::ReadKey
- Fix IO::Pager and IO::Pager::less PODs (remove cuts)
-
-0.40
- Push previous versions to github
-
0.35
Odd failure of test 11 under tcsh and win-bash because
*reference* has extra trailing newline.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/lib/IO/Pager/Buffered.pm
new/IO-Pager-2.00/lib/IO/Pager/Buffered.pm
--- old/IO-Pager-1.03/lib/IO/Pager/Buffered.pm 2020-06-13 14:18:45.000000000
+0200
+++ new/IO-Pager-2.00/lib/IO/Pager/Buffered.pm 2020-06-15 16:56:01.000000000
+0200
@@ -1,5 +1,5 @@
package IO::Pager::Buffered;
-our $VERSION = 1.03; #Untouched since 1.03
+our $VERSION = 1.04; #Untouched since 1.03
use strict;
use base qw( IO::Pager );
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/lib/IO/Pager/Page.pm
new/IO-Pager-2.00/lib/IO/Pager/Page.pm
--- old/IO-Pager-1.03/lib/IO/Pager/Page.pm 2019-10-13 15:11:54.000000000
+0200
+++ new/IO-Pager-2.00/lib/IO/Pager/Page.pm 2020-06-15 16:58:11.000000000
+0200
@@ -2,7 +2,7 @@
use strict;
use warnings;
-our $VERSION = 1.02;
+our $VERSION = 1.04; #Untouched since 1.02
# The meat
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/lib/IO/Pager/Perl.pm
new/IO-Pager-2.00/lib/IO/Pager/Perl.pm
--- old/IO-Pager-1.03/lib/IO/Pager/Perl.pm 2020-06-13 17:23:44.000000000
+0200
+++ new/IO-Pager-2.00/lib/IO/Pager/Perl.pm 2020-11-02 02:55:19.000000000
+0100
@@ -1,5 +1,5 @@
package IO::Pager::Perl;
-our $VERSION = '1.03'; #Untouched since 1.03
+our $VERSION = '2.00'; #Untouched since 2.00
use strict;
use warnings;
@@ -13,6 +13,7 @@
sub ReadMode;
sub ReadKey;
+
sub new {
my $class = shift;
my %param = @_;
@@ -72,7 +73,8 @@
_search => '', _statCols => 0, _lineNo=>[0],
lineNo => 0, pause => '', #pause=>"\cL" #more
raw => 0, statusCol => 0, squeeze=>0,
- visualBell=>0, fold=>0,
+ visualBell => 0, fold => 0, _fileN => 1,
+ _mark => {1=>0}, scrollBar => 0,
%dims,
# if the termcap entries don't exist, nothing bad will happen
@@ -89,11 +91,11 @@
$me->add_text($text) if defined $text;
$me->{_I18N}={
- status=> '',
+ prompt=> '',
404=> 'Not Found',
top=> 'Top',
bottom=> 'Bottom',
- prompt=> "<h>=help \000<space>=down <b>=back <q>=quit",
+ minihelp=> "<h>=help \000<space>=down <b>=back <q>=quit",
continue=> 'press any key to continue',
searchwrap=> 'No more matches, next search will wrap',
nowrap=> 'Text::Wrap unavailable, disabling folding',
@@ -157,10 +159,11 @@
'?' => \&hcraes,
"'" => \&goto_mark,
'#' => \&toggle_num, #XXX Change toggle* to '-' initiated
- 'C' => \&toggle_raw, #multi-key input mode like \d+ to
- 'S' => \&toggle_fold, #mimic less?
+ 'C' => \&toggle_raw, #input mode like : to mimic less?
+ 'S' => \&toggle_fold,
'R' => \&flush_buffer,
':w'=> \&write_buffer,
+ ':e'=> \&open_file,
);
#Mise-en-place; prepare to cook some characters
@@ -169,15 +172,15 @@
$me->{_end} = $me->{rows} - 1;
- if( $me->{fold} ){
- eval "use Text::Wrap";
- $me->dialog($me->{_I18N}{nowrap} . "\n\n$@") if $@;
- }
- if( $@ or not $me->{fold} ){
- sub wrap {@_}
- }
-
$SIG{WINCH} = sub{ $me->resize() };
+ $me->{cols}-- if $me->{scrollBar};
+
+ #Can we fold?
+ eval "use Text::Wrap";
+ if( $@ ){
+ sub wrap{ join '', @_ }
+ $me->{fold} = 0;
+ }
$me;
}
@@ -186,14 +189,24 @@
my $me = shift;
my %dims = get_size();
$dims{rows}--;
+ $dims{cols}-- if $me->{scrollBar};
$me->{$_} = $dims{$_} foreach keys %dims;
$me->{_end} = $me->{rows} - 1;
- $me->{fold} ? $me->reflow() : $me->refresh();
- $me->prompt();
+ if( $me->{fold} ){
+ $me->reflow();
+ #XXX Crude attempt to mintain position,
+ #XXX only works if all rows folded same amount
+ #$me->jump( int($me->{_cursor} * $me->{cols) / $dims{cols})-1 );
+ #XXX need to somehow use _lineNo instead?
+ }
+ else{
+ $me->refresh();
+ }
+ $me->status();
- $me->{WINCH}->() if ref($me->{WINCH}) eq 'CODE';
+ $me->{WINCH}->() if ref($me->{WINCH}) eq 'CODE';
}
sub get_size {
@@ -342,7 +355,7 @@
#INPUT LOOP, revised with inspiration from Term::Screen::getch()
#my $input=''; #TIGHT
while( 1 ){
- $me->prompt(); # status line
+ $me->status(); # status line
my $exit = undef;
my $char = ReadKey($param{RT});
@@ -350,10 +363,10 @@
#functionality and for cleaner startup (no preload on piped input)
#next unless defined($char); #TIGHT
return 1 unless defined($char);
- $me->{_I18N}{status} = $input .= $char;
- $me->prompt();
+ $me->{_I18N}{prompt} = $input .= $char;
+ $me->status();
- unless( ($input=~ /^\e/ and index($me->{_fncRE}, $input)>0 )
+ unless( ($input=~ /^\e/ and index($me->{_fncRE}, $input)>0 )
|| $input =~ /^\d+/
|| $input =~ /:+/
|| defined($me->{_fnc}->{$input}) ){
@@ -367,33 +380,31 @@
my $n = $me->{_fnc}->{$input};
$n = svref_2object($n)->GV->NAME;
$exit = $me->{_fnc}->{$input}->($me);
- $me->{_I18N}{status} = $input = '';
+ $me->{_I18N}{prompt} = $input = '';
}
#vi-style input
elsif( $input =~ /^:/ ){
if( ($char eq "\cG") or ($input eq '::') ){
- $me->{_I18N}{status} = $input = '';
- $me->prompt();
+ $me->{_I18N}{prompt} = $input = '';
+ $me->status();
return 1; }
}
- #Line-number input
+ #Line-number input; would love to use getln, but does not mix w/ status
elsif( $me->{_fnc}->{'/(\d+)/'} and $input =~ /^\d+/ ){
if( $char eq "\cH" or ord($char)==127 ){
- chop($input); chop($input); }
+ $input = substr($input, 0, -2, ''); }
elsif( $char eq "\cG" ){
- $me->{_I18N}{status} = $input = '';
- $me->prompt();
- return 1; }
- if( $input =~ /^\d+\n$/ ){
- chomp($input);
+ $input = '';
+ $exit = 1; }
+ elsif( $char eq "\n" ){
+ #Remove extraneous characters that could cause infinite error loop
+ #XXX this prevents goofy RPN-like repeated commands
+ $input =~ y/0-9//cd;# chomp($input);
$exit = $input < $me->{_txtN} ? $me->jump($input) : $me->to_bott();
- $me->{_I18N}{status} = $input = '';
- $me->prompt();
- next; }
- #XXX need to do something here to handle no-decimal/bogus entry
- else{
- $me->{_I18N}{status} = $input;
- $me->prompt(); }
+ $input = ''; }
+
+ $me->{_I18N}{prompt} = $input;
+ $me->status();
}
return 1 if $param{RT} && defined($exit);
@@ -440,7 +451,7 @@
}
#XXX RegExp::Trie, List::RegExp? #quotemeta?
$me->{_fncRE} = join '|', sort keys %{ $me->{_fnc} };
- #$me->{_fncRE} = qr/^($me->{_fncRE})/;
+ #$me->{_fncRE} = qr/^($me->{_fncRE})$/;
}
sub beep{
@@ -451,11 +462,36 @@
$_[1] =~ s/\e/^[/;
$_[1] =~ s/([^[:print:]])/sprintf("\\%03o", ord($1))/ge; #Cook
$_[0]->dialog("Unrecognized command: $_[1]", 1);
+
+ $_[0]->{_I18N}{prompt} = '';
+ $_[0]->status();
}
}
-# display a prompt, etc
-sub prompt{
+sub getln{
+ my $input;
+ while(1){
+ my $l = ReadKey();
+ last if $l eq "\n" || $l eq "\r";
+
+ if( !defined($l)| $l eq "\e" || $l eq "\cG" ){
+ $input = '';
+ last; }
+ elsif( $l eq "\b" || $l eq "\177" ){
+ print "\b \b" if $input ne '';
+ substr($input, -1, 1, '');
+ next;
+ }
+
+ print $l;
+ $input .= $l;
+ }
+ return $input;
+}
+
+
+# display a minihelp, etc
+sub status{
my $me = shift;
$me->{_txtN} ||= 0;
@@ -466,17 +502,17 @@
($pct==1 ? $me->{_I18N}{bottom} : 'L'.$me->{_cursor}) :
$me->{_I18N}{top};
$pos .= 'C'.$me->{_left} if $me->{_left};
- my $p = sprintf "[tp] %d%% %s %s", 100*$pct, $pos, $me->{_I18N}{status};
+ my $p = sprintf "[tp] %d%% %s %s", 100*$pct, $pos, $me->{_I18N}{prompt};
print $me->{_term}->Tgoto('cm', 0, $me->{rows}); # bottom left
print $me->{_term}->Tputs('ce'); # clear line
- my $prompt = $me->{_I18N}{prompt};
+ my $minihelp = $me->{_I18N}{minihelp};
(my $pSansCodes = $p) =~ s/\e\[[\d;]*[a-zA-Z]//g;
- my $pN = $me->{cols} - 2 - length($pSansCodes) -
length($me->{_I18N}{prompt});
+ my $pN = $me->{cols} - 2 - length($pSansCodes) -
length($me->{_I18N}{minihelp});
$p .= ' ' x ($pN > 1 ? $pN : 1);
- $prompt = $pN>2 ? $prompt : do {$prompt =~ s/\000.+//; $prompt };
+ $minihelp = $pN>2 ? $minihelp : do {$minihelp =~ s/\000.+//; $minihelp };
print $me->{REV}; # reverse video
- print $p," ", $prompt; # status line
+ print $p," ", $minihelp; # status line
print $me->{NOR}; # normal video
}
@@ -484,7 +520,7 @@
ReadMode 0;
print "\n";
$| = $SP || 0;
- #Did we exit via signal or prompt?
+ #Did we exit via signal or user?
$RT ? die : return \"foo";
}
@@ -515,15 +551,6 @@
$me->dialog( $help . "\n" . (' 'x$padding) . $cont );
}
-sub dialog{
- my($me, $msg, $timeout) = @_;
- $msg = defined($msg) ? $msg : '';
- $timeout = defined($timeout) ? $timeout : 0;
- $me->disp_menu( $me->box_text($msg) );
- $timeout ? sleep($timeout) : getc();
- $me->remove_menu();
-}
-
sub max_width{
my $me = shift;
my $width = 0;
@@ -531,50 +558,34 @@
return $width;
}
-# put a box around some text
-sub box_text{
- my $me = shift;
- my @txt = split(/\n/, $_[0]);
- my $width = $me->max_width(@txt);
-
- my $b = '+' . '=' x ($width + 2) . '+';
- my $o = join('', map { "| $_" . (' 'x($width-length($_))) ." |\n" } @txt);
- "$b\n$o$b\n";
-}
-
-# display a popup menu (or other text)
-sub disp_menu{
- my $me = shift;
- my $menu = shift;
-
- $me->{_menuRows} = @{[split /\n/, $menu]};
- print $me->{_term}->Tgoto('cm',0, 2); # move
- print $me->{MENU}; # set color
- my $x = $me->{_term}->Tgoto('RI',0,4); # 4 transparent spaces
- $menu =~ s/^\s*/$x/gm;
- print $menu;
- print $me->{NOR}; # normal color
-}
+sub dialog{
+ my($me, $msg, $timeout) = @_;
+ my @txt = defined($msg) ? split(/\n/, $msg) : ();
+ my $w = $me->max_width(@txt);
-# remove popup and repaint
-sub remove_menu{
- my $me = shift;
+ #Prepare dialog
+ my $h = '+' . '='x($w+2) . '+';
+ my $d = join('', map { sprintf("%s| %- @{[$w+4]}s |\n",
+ $me->{_term}->Tgoto('RI',0,4),
+ $_) } $h, @txt, $h);
+
+ print $me->{_term}->Tgoto('cm',0, 2), # move
+ $me->{MENU}, # set color
+ $d, # dialog
+ $me->{NOR}; # normal color
- my $s = $me->{_menuRows} +2;
+ defined($timeout) ? sleep($timeout) : getc();
#Allow wipe of incomplete/paused output.
- my $pause = $me->{pause};
- $me->{pause} = undef;
+ local($me->{pause});
+ #XXX Use full refresh if _grep for simple accurate solution?
# Fractional restoration instead of full refresh
- foreach my $n (2 .. $s){
+ foreach my $n (2 .. scalar(@txt)+3){
print $me->{_term}->Tgoto('cm', 0, $n); # move
print $me->{_term}->Tputs('ce'); # clear line
$me->line($n);
}
-
- #Reset pause
- $me->{pause} = $pause;
}
sub flush_buffer{
@@ -606,8 +617,22 @@
$me->line($n+$me->{_cursor}) if # XXX w/o cursor messy
$me->{_cursor}+$me->{rows}+$n <= $me->{_txtN} # after menu & refresh
}
+ $me->scrollBar() if $me->{scrollBar};
}
+sub scrollBar{
+ my $me = shift;
+ my $mark = sprintf("%i", $me->{_cursor} / $me->{_txtN} * $me->{rows});
+ my $pages = sprintf("%i", $me->{_txtN}/$me->{rows});
+ my $thumb = int($me->{rows}/$pages);
+
+ for my $n (0 .. $me->{rows} -1){
+ print $me->{_term}->Tgoto('cm', $me->{cols}+1, $n);
+ print $n>=$mark && $n<$mark+$thumb ? ' ' : "$me->{REV} $me->{NOR}";
+ }
+}
+
+
sub line{
my $me = shift;
my $n = shift;
@@ -647,18 +672,14 @@
$me->{_search} ne '';
#Line numbering & search status
- my $info = $me->{statusCol} && !$me->{lineNo} ?
- ($matched ? '*' : ' ') :'';
+ my $info = $me->{statusCol} && !$me->{lineNo} ? ($matched ? '*' : ' ') : '';
$info = sprintf("% 8s",
$me->{fold} ? ($me->{_lineNo}->[$n]||-1) :
(defined($me->{_text}[$n]) ? $n+1 : '')
) if $me->{lineNo};
- $_ = ($me->{statusCol} && $matched ? $me->{REV} : '').
- $info.
- ($me->{statusCol} && $matched ? $me->{NOR} : '').
- ($me->{lineNo} ? ' ' : '').
- $_;
-
+ $_ = ($me->{Statuscol} && $matched ? $me->{REV} : ''). $info.
+ ($me->{statusCol} && $matched ? $me->{NOR} : '').
+ ($me->{lineNo} ? ' ' : ''). $_;
print;
if( $pausey ){
@@ -672,7 +693,6 @@
my $n = shift;
my $t = $me->{_term};
-# for(my $i=1; $i<=$n; $i++){
LINE: for(1..$n){
if( $me->{_end} >= $me->{_txtN}-1 ){
exit if $me->{eof} && ref($me->{text}) ne 'CODE';
@@ -691,14 +711,16 @@
print $t->Tputs('sf'); # scroll
print $t->Tgoto('cm', 0, $me->{rows} - 1); # move
}
-
print $t->Tputs('ce'); # clear line
#Skip cursor ahead to matching line if in grep mode
if( $me->{_grep} && $me->{_end} < $me->{_txtN} ){
until( $me->{_text}->[$me->{_end}] =~
m%$me->{_search}|\cF\c]\cL\cE \[\d+/% ){
- $me->{_end}++;
+ $me->dialog(#"$me->{_end} >= $me->{_txtN} #$me->{_cursor}\n".
+ 'Pagination in grep mode does not work at this time.', 1);
+ last LINE;
+# $me->{_end}++;
$me->{_cursor}++;
if( $me->{_end} >= $me->{_txtN} ){
$me->{cursor} = $me->{_end} = $me->{_txtN};
@@ -710,6 +732,7 @@
$me->{_cursor}++;
}
}
+ $me->scrollBar() if $me->{scrollBar};
}
sub downhalf { $_[0]->down_lines( $_[0]->{rows} / 2 ); }
sub downpage { $_[0]->down_lines( $_[0]->{rows} );
@@ -728,16 +751,23 @@
for (1 .. $n){
if( $me->{_cursor} <= 0 ){
- &beep; last;
- }else{
+ &beep; last; }
+ else{
print $me->{_term}->Tgoto('cm',0,0); # move
print $me->{_term}->Tputs('sr'); # scroll back
#XXX Skip cursor back to matching line if in grep mode
- #XXX this is tough because we want {rows} matching lines
- #XXX Requires cache of currently grepped lines, then unshift
- #XXX as we scroll back until we get {rows} new lines or hit top.
- #XXX finally, displaying the to {rows} of the cache
+ #Skip cursor back to matching line if in grep mode
+# if( $me->{_grep} && $me->{_cursor} > 0 ){
+# until( $me->{_text}->[$me->{_end}] =~
+# m%$me->{_search}|\cF\c]\cL\cE \[\d+/% ){
+# $me->{_cursor}--;
+# if( $me->{_cursor} <= 0 ){
+# $me->{cursor} = 0;
+# last;
+# }
+# }
+# }
$me->line( --$me->{_cursor} );
$me->{_end}--;
@@ -745,6 +775,7 @@
}
print $me->{_term}->Tgoto('cm',0,$me->{rows}); # goto bottom
+ $me->scrollBar() if $me->{scrollBar};
}
sub uppage { $_[0]->up_lines( $_[0]->{rows} ); }
sub upline { $_[0]->up_lines( 1 ); }
@@ -761,8 +792,9 @@
my $me = shift;
$me->I18N('status', $me->{BLD}.'*Mark name?*'.$me->{NOR}.$me->{REV});
- $me->prompt();
+ $me->status();
$me->{_term}->Tgoto('cm',
+ #XXX I18N
length('[tp] 100% Bottom Mark name?')+1,
$me->{rows});
my $mark = ReadKey();
@@ -770,14 +802,14 @@
next if $mark eq "'";
$me->{_mark}->{$mark} = $me->{_cursor};
$me->I18N('status', '');
- $me->prompt();
+ $me->status();
}
sub goto_mark{
my $me = shift;
my $mark = ReadKey();
- return if $mark eq "\cG";
+ return if $mark eq "\cG" or not exists($me->{_mark}->{$mark});
my $jump = $me->{_mark}->{$mark};
if( $mark eq '^' ){
@@ -811,7 +843,6 @@
sub jump{
my $me = shift;
-
$me->{_cursor} = shift;
$me->{_end} = $me->{_cursor} + $me->{rows}; # - 1;
$me->refresh();
@@ -819,31 +850,25 @@
sub tab_right{
my $me = shift;
-
$me->{_left} += 8;
$me->refresh();
}
sub tab_left{
my $me = shift;
-
- $me->{_left} -= 8;
- $me->{_left} = 0 if $me->{_left} < 0;
+ $me->{_left} = 0 if ($me->{_left} -= 8) < 0;
$me->refresh();
}
sub shift_right{
my $me = shift;
-
$me->{_left} += int($me->{cols}/2);
$me->refresh();
}
sub shift_left{
my $me = shift;
-
- $me->{_left} -= int($me->{cols}/2);
- $me->{_left} = 0 if $me->{_left} < 0;
+ $me->{_left} = 0 if ( $me->{_left} -= int($me->{cols}/2) ) < 0;
$me->refresh();
}
@@ -865,21 +890,7 @@
print $me->{HILT}; # set color
print $mode ? ( $mode > 0 ? '?' : '&' ) : '/';
- while(1){
- my $l = ReadKey();
- last if $l eq "\n" || $l eq "\r";
- if( $l eq "\e" || !defined($l) ){
- $me->{_search} = '';
- last;
- }
- if( $l eq "\b" || $l eq "\177" ){ #Why not octothorpe? || $l eq '#' ){
- print "\b \b" if $me->{_search} ne '';
- substr($me->{_search}, -1, 1, '');
- next;
- }
- print $l;
- $me->{_search} .= $l;
- }
+ $me->{_search} = $me->getln() || '';
print $me->{NOR}; # normal color
print $me->{_term}->Tgoto('cm', 0, $me->{rows}); # move bottom
print $me->{_term}->Tputs('ce'); # clear line
@@ -893,6 +904,7 @@
$me->{_search} = $prev if $me->{_search} eq '/' && $prev;
+ #Jump to first match
for my $n ( $me->{_cursor} .. $me->{_txtN} -1){ #XXX why offset needed?
next unless $me->{_text}[$n] =~ /$me->{_search}/i;
@@ -975,28 +987,12 @@
sub write_buffer{
my $me = shift;
- my $out;
print $me->{_term}->Tgoto('cm', 0, $me->{rows}); # move bottom
print $me->{_term}->Tputs('ce'); # clear line
print "Save to: ";
- while(1){
- my $l = ReadKey();
- return if $l eq "\cG";
- last if $l eq "\n" || $l eq "\r";
-
- if( !defined($l)| $l eq "\e" || $l eq "\cG" ){
- return;
- }
- if( $l eq "\b" || $l eq "\177" ){
- print "\b \b" if $out ne '';
- substr($out, -1, 1, '');
- next;
- }
- print $l;
- $out .= $l;
- }
+ my $out = $me->{_search} = $me->getln();
if( ! -e $out && open(OUT, '>', $out) ){
print OUT join($/, @{$me->{_text}});
CORE::close(OUT);
@@ -1006,6 +1002,31 @@
}
}
+sub open_file{
+ my $me = shift;
+
+ print $me->{_term}->Tgoto('cm', 0, $me->{rows}); # move bottom
+ print $me->{_term}->Tputs('ce'); # clear line
+ print "Examine: ";
+
+ my $file = $me->getln();
+ unless( -e $file ){
+ $me->dialog( sprintf("%s: $file", $me->{_I18N}{404}) );
+ return;
+ }
+ unless( open(IN, '<', $file) ){
+ $me->dialog($!);
+ return;
+ }
+ my $N = $me->get_fileN();
+ $me->set_fileN($N+1);
+ $me->add_text(sprintf("======== \cF\c]\cL\cE [%i/..] %s ========\n",
+ $N, $file), <IN>);
+}
+
+sub get_fileN{ $_[0]->{_fileN} }
+sub set_fileN{ $_[0]->{_fileN} = $_[1] }
+
sub dumb_mode{
my $me = shift;
@@ -1224,6 +1245,8 @@
=item &write_buffer - C<:w>
+=item &open_file - C<:e>
+
=back
=head3 Navigation
@@ -1326,25 +1349,23 @@
my $help = $t->I18N('help');
#Minimal status line
- $t->I18N('prompt', "<h> help");
+ $t->I18N('minihelp', "<h> help");
Current text elements available for customization are:
404 - search text not found dialog
- bottom - prompt line end of file indicator
continue - text to display at the bottom of the help dialog
help - help dialog text, a list of keys and their functions
- prompt - displayed at the bottom of the screen
+ minihelp - basic instructions displayed at the bottom of the screen
status - brief message to include in the status line
- top - prompt line start of file indicator
- bottom - prompt line end of file indicator
+ top - start of file prompt
+ bottom - end of file prompt
searchwrap - message that pager is about to loop for more matches
- nowrap - notice that missing Text::Wrap prevents folding toggle
-I<status> is intended for sharing short messages not worthy of a dialog
-e.g; when debugging. You will need to call the C<prompt> method after
-setting it to refresh the status line of the display, then void I<status>
-and call C<prompt> again to clear the message.
+I<prompt> is intended for sharing short messages not worthy of a dialog
+e.g; when debugging. You will need to call the C<status> method after
+setting it to refresh the status line of the display, then void I<prompt>
+and call C<status> again to clear the message.
=head3 Scalability
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/lib/IO/Pager/Unbuffered.pm
new/IO-Pager-2.00/lib/IO/Pager/Unbuffered.pm
--- old/IO-Pager-1.03/lib/IO/Pager/Unbuffered.pm 2020-06-13
14:18:59.000000000 +0200
+++ new/IO-Pager-2.00/lib/IO/Pager/Unbuffered.pm 2020-06-15
16:58:59.000000000 +0200
@@ -1,5 +1,5 @@
package IO::Pager::Unbuffered;
-our $VERSION = 1.02; #Untouched since 1.02
+our $VERSION = 1.04; #Untouched since 1.02
use strict;
use warnings;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/lib/IO/Pager/less.pm
new/IO-Pager-2.00/lib/IO/Pager/less.pm
--- old/IO-Pager-1.03/lib/IO/Pager/less.pm 2020-06-13 14:19:43.000000000
+0200
+++ new/IO-Pager-2.00/lib/IO/Pager/less.pm 2020-11-01 21:48:42.000000000
+0100
@@ -1,5 +1,5 @@
package IO::Pager::less;
-our $VERSION = 1.02; #Untouched since 1.02
+our $VERSION = 2.00; #Untouched since 2.00
use strict;
use warnings;
@@ -8,11 +8,15 @@
BEGIN{
die "Windows is currently unsupported" if $^O =~ /MSWin32/;
my $PAGER;
+
+ #Required for test 16
our $BLIB;
+
#local $ENV{PATHEXT} .= ";.PL"
foreach my $lib ( @INC ){
$PAGER = File::Spec->catfile($lib, 'IO', 'Pager', 'tp');
if( -e $PAGER ){
+ #Required for test 16
$ENV{PAGER} = $^X.($BLIB?' -Mblib ':' ').$PAGER;
last;
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/lib/IO/Pager/tp
new/IO-Pager-2.00/lib/IO/Pager/tp
--- old/IO-Pager-1.03/lib/IO/Pager/tp 2020-06-13 17:24:17.000000000 +0200
+++ new/IO-Pager-2.00/lib/IO/Pager/tp 2020-11-02 02:40:12.000000000 +0100
@@ -6,7 +6,7 @@
use Getopt::Long;
use vars '$VERSION';
-$VERSION = '1.03'; #Untouched since 1.03
+$VERSION = '1.04'; #Untouched since 1.04
my %Opts = (fold=>1);
(my $LESS = $ENV{LESS} || '') =~ s/P.+(?:\$|$)//;
@@ -23,7 +23,6 @@
#Custom argument processing
{
no warnings 'uninitialized';
- $Long{shift} = -(grep { /^-\d+$/ } @ARGV)[-1];
($Long{jump} = (grep { /^\+\d+$/ } @ARGV)[-1]) =~ s/^\+//;
($Long{search} = (grep { /^\+\// } @ARGV)[-1]) =~ s%\+/=%%;
}
@@ -33,7 +32,7 @@
(map { "$_!" } split//, 'JSenrs'), # bare
(map { "$_=s" } qw'j p cols'), # args ##rows
'f:s',
- 'tail'
+ qw/tail scrollbar/
);
$Long{f} = "\cL" if defined($Long{f}) && $Long{f} eq '';
$Long{tail} = $Long{tail} && scalar(@ARGV) == 1 ? 1 : 0;
@@ -44,7 +43,6 @@
$Opts{lineNo} = $Long{n} if defined($Long{n});
$Opts{raw} = $Long{r} if defined($Long{r});
$Opts{squeeze} = $Long{s} if defined($Long{s});
-$Opts{shift} = $Long{shift} if defined($Long{shift});
#$Opts{rows} = $Long{rows} if defined($Long{rows});
$Opts{cols} = $Long{cols} if defined($Long{cols});
$Opts{fold} = not $Long{S} if defined($Long{S});
@@ -53,6 +51,9 @@
$Opts{search} = $Long{p}||$Long{search}
if defined($Long{p})||defined($Long{search});
+$Opts{scrollBar} = $Long{scrollbar} if defined($Long{scrollbar});
+
+
#use Data::Dumper; print Dumper \%Opts; exit 0;
my $t = IO::Pager::Perl->new(%Opts);
@@ -81,6 +82,7 @@
$i++, $#ARGV+1, $file, $err), <FILE>;
$F[-1] .= $/ unless $F[-1] =~ /\n$/;
close(FILE);
+ $t->set_fileN($i);
}
}
$t->add_text(@F);
@@ -93,6 +95,7 @@
}
eval{
+ $t->jump($Opts{jump}) if $Opts{jump};
while( $t->more(RT=>.05) ){
my $X;
@@ -166,6 +169,12 @@
Do not fold long lines.
+=item B<--scrollbar>
+
+Display a scrollbar in the rightmost column.
+
+In the future this might also disable the top/bottom/% display in the status
bar.
+
=item B<--tail>
Keep checking the displayed file for new content.
@@ -182,7 +191,7 @@
=pod
-=item B<-cols>
+=item B<--cols>
Set the number of columns for the pager.
@@ -209,6 +218,8 @@
=item save buffer - C<:w>
+=item open file - C<:e>
+
=back
=head2 Navigation
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/lib/IO/Pager.pm
new/IO-Pager-2.00/lib/IO/Pager.pm
--- old/IO-Pager-1.03/lib/IO/Pager.pm 2020-06-13 17:38:05.000000000 +0200
+++ new/IO-Pager-2.00/lib/IO/Pager.pm 2020-11-02 02:55:29.000000000 +0100
@@ -1,5 +1,5 @@
package IO::Pager;
-our $VERSION = "1.03"; #Untouched since 1.03
+our $VERSION = "2.00"; #Untouched since 1.03
use 5.008; #At least, for decent perlio, and other modernisms
use strict;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/t/07-oo_interactive.t
new/IO-Pager-2.00/t/07-oo_interactive.t
--- old/IO-Pager-1.03/t/07-oo_interactive.t 2018-10-11 04:32:08.000000000
+0200
+++ new/IO-Pager-2.00/t/07-oo_interactive.t 2020-11-01 21:49:19.000000000
+0100
@@ -9,6 +9,7 @@
SKIP: {
skip_interactive();
+ use blib;
require IO::Pager;
require IO::Pager::Buffered;
{
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/t/16-PurePerl_interactive.t
new/IO-Pager-2.00/t/16-PurePerl_interactive.t
--- old/IO-Pager-1.03/t/16-PurePerl_interactive.t 2020-06-07
20:01:58.000000000 +0200
+++ new/IO-Pager-2.00/t/16-PurePerl_interactive.t 2020-11-01
22:15:28.000000000 +0100
@@ -4,14 +4,14 @@
require './t/TestUtils.pm';
t::TestUtils->import();
-BEGIN{ $IO::Pager::less::BLIB = $IO::Pager::less::BLIB = 1; }
-
# Test OO interface
SKIP: {
skip_interactive();
skip("Windows is currently unsupported") if $^O =~ /MSWin32/;
+ use blib;
+ $ENV{PERL5OPT} = '-Mblib';
require IO::Pager;
require IO::Pager::less;
{
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/IO-Pager-1.03/test.pl new/IO-Pager-2.00/test.pl
--- old/IO-Pager-1.03/test.pl 2017-05-13 18:41:19.000000000 +0200
+++ new/IO-Pager-2.00/test.pl 2020-11-01 22:12:26.000000000 +0100
@@ -4,6 +4,8 @@
exit 0 unless scalar(@ARGV) && ($ARGV[0] eq 'interactive');
undef($ENV{LESS});
+undef($ENV{PAGER});
+$ENV{PERL5OPT} = '-Mblib';
my @fail;
for (sort glob "t/*interactive.t") {
++++++ cpanspec.yml ++++++
--- /var/tmp/diff_new_pack.nSV7pr/_old 2020-11-03 15:17:39.380103017 +0100
+++ /var/tmp/diff_new_pack.nSV7pr/_new 2020-11-03 15:17:39.380103017 +0100
@@ -21,8 +21,12 @@
# sed on %{name}.files
#license: SUSE-NonFree
#skip_noarch: 1
-#custom_build: |-
-#./Build build flags=%{?_smp_mflags} --myflag
+custom_build: |
+ # no parallel build, otherwise we get:
+ # make -j8
+ # make: *** No rule to make target 'blib/lib/IO/Pager/tp', needed by
'manifypods'. Stop.
+ perl Makefile.PL INSTALLDIRS=vendor
+ make
#custom_test: |-
#startserver && make test
#ignore_requires: Bizarre::Module
