diff options
Diffstat (limited to 'gnu/usr.bin/perl/perl/usub/pager')
-rw-r--r-- | gnu/usr.bin/perl/perl/usub/pager | 190 |
1 files changed, 190 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/perl/usub/pager b/gnu/usr.bin/perl/perl/usub/pager new file mode 100644 index 0000000..407bc50 --- /dev/null +++ b/gnu/usr.bin/perl/perl/usub/pager @@ -0,0 +1,190 @@ +#!./curseperl + +eval <<'EndOfMain'; $evaloffset = __LINE__; + + $SIG{'INT'} = 'endit'; + $| = 1; # command buffering on stdout + &initterm; + &inithelp; + &slurpfile && &pagearray; + +EndOfMain + +&endit; + +################################################################################ + +sub initterm { + + &initscr; &cbreak; &noecho; &scrollok($stdscr, 1); + &defbell unless defined &bell; + + $lines = $LINES; $lines1 = $lines - 1; $lines2 = $lines - 2; + $cols = $COLS; $cols1 = $cols - 1; $cols2 = $cols - 2;; + + $dl = &getcap('dl'); + $al = &getcap('al'); + $ho = &getcap('ho'); + $ce = &getcap('ce'); +} + +sub slurpfile { + while (<>) { + s/^(\t+)/' ' x length($1)/e; + &expand($_) if /\t/; + if (length($_) < $cols) { + push(@lines, $_); + } + else { + while ($_ && $_ ne "\n") { + push(@lines, substr($_,0,$cols)); + substr($_,0,$cols) = ''; + } + } + } + 1; +} + +sub drawscreen { + &move(0,0); + for ($line .. $line + $lines2) { + &addstr($lines[$_]); + } + &clrtobot; + &percent; + &refresh; +} + +sub expand { + while (($off = index($_[0],"\t")) >= 0) { + substr($_[0], $off, 1) = ' ' x (8 - $off % 8); + } +} + +sub pagearray { + $line = 0; + + $| = 1; + + for (&drawscreen;;&drawscreen) { + + $ch = &getch; + $ch = 'j' if $ch eq "\n"; + + if ($ch eq ' ') { + last if $percent >= 100; + &move(0,0); + $line += $lines1; + } + elsif ($ch eq 'b') { + $line -= $lines1; + &move(0,0); + $line = 0 if $line < 0; + } + elsif ($ch eq 'j') { + next if $percent >= 100; + $line += 1; + if ($dl && $ho) { + print $ho, $dl; + &mvcur(0,0,$lines2,0); + print $ce,$lines[$line+$lines2],$ce; + &wmove($curscr,0,0); + &wdeleteln($curscr); + &wmove($curscr,$lines2,0); + &waddstr($curscr,$lines[$line+$lines2]); + } + &wmove($stdscr,0,0); + &wdeleteln($stdscr); + &wmove($stdscr,$lines2,0); + &waddstr($stdscr,$lines[$line+$lines2]); + &percent; + &refresh; + redo; + } + elsif ($ch eq 'k') { + next if $line <= 0; + $line -= 1; + if ($al && $ho && $ce) { + print $ho, $al, $ce, $lines[$line]; + &wmove($curscr,0,0); + &winsertln($curscr); + &waddstr($curscr,$lines[$line]); + } + &wmove($stdscr,0,0); + &winsertln($stdscr); + &waddstr($stdscr,$lines[$line]); + &percent; + &refresh; + redo; + } + elsif ($ch eq "\f") { + &clear; + } + elsif ($ch eq 'q') { + last; + } + elsif ($ch eq 'h') { + &clear; + &help; + &clear; + } + else { + &bell; + } + } +} + +sub defbell { + eval q# + sub bell { + print "\007"; + } + #; +} + +sub help { + local(*lines) = *helplines; + local($line); + &pagearray; +} + +sub inithelp { + @helplines = split(/\n/,<<'EOT'); + + h Display this help. + q Exit. + + SPACE Forward screen. + b Backward screen. + j, CR Forward 1 line. + k Backward 1 line. + FF Repaint screen. +EOT + for (@helplines) { + s/$/\n/; + } +} + +sub percent { + &standout; + $percent = int(($line + $lines1) * 100 / @lines); + &move($lines1,0); + &addstr("($percent%)"); + &standend; + &clrtoeol; +} + +sub endit { + &move($lines1,0); + &clrtoeol; + &refresh; + &endwin; + + if ($@) { + print ""; # force flush of stdout + $@ =~ s/\(eval\)/$0/ && $@ =~ s/line (\d+)/'line ' . ($1 + $evaloffset)/e; + die $@; + } + + exit; +} |