1 files changed, 190 insertions, 0 deletions
diff --git a/ext/curses/pager b/ext/curses/pager
new file mode 100644
index 0000000000..407bc50670
--- /dev/null
+++ b/ext/curses/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;
+}