This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.0 alpha 5
[perl5.git] / ext / curses / pager
CommitLineData
450a55e4
LW
1#!./curseperl
2
fe14fcc3 3eval <<'EndOfMain'; $evaloffset = __LINE__;
450a55e4 4
fe14fcc3 5 $SIG{'INT'} = 'endit';
450a55e4
LW
6 $| = 1; # command buffering on stdout
7 &initterm;
8 &inithelp;
9 &slurpfile && &pagearray;
10
11EndOfMain
12
fe14fcc3 13&endit;
450a55e4
LW
14
15################################################################################
16
17sub initterm {
18
19 &initscr; &cbreak; &noecho; &scrollok($stdscr, 1);
20 &defbell unless defined &bell;
21
22 $lines = $LINES; $lines1 = $lines - 1; $lines2 = $lines - 2;
23 $cols = $COLS; $cols1 = $cols - 1; $cols2 = $cols - 2;;
24
25 $dl = &getcap('dl');
26 $al = &getcap('al');
27 $ho = &getcap('ho');
28 $ce = &getcap('ce');
29}
30
31sub slurpfile {
32 while (<>) {
33 s/^(\t+)/' ' x length($1)/e;
34 &expand($_) if /\t/;
35 if (length($_) < $cols) {
36 push(@lines, $_);
37 }
38 else {
39 while ($_ && $_ ne "\n") {
40 push(@lines, substr($_,0,$cols));
41 substr($_,0,$cols) = '';
42 }
43 }
44 }
45 1;
46}
47
48sub drawscreen {
49 &move(0,0);
50 for ($line .. $line + $lines2) {
51 &addstr($lines[$_]);
52 }
53 &clrtobot;
54 &percent;
55 &refresh;
56}
57
58sub expand {
59 while (($off = index($_[0],"\t")) >= 0) {
60 substr($_[0], $off, 1) = ' ' x (8 - $off % 8);
61 }
62}
63
64sub pagearray {
65 $line = 0;
66
67 $| = 1;
68
69 for (&drawscreen;;&drawscreen) {
70
71 $ch = &getch;
fe14fcc3 72 $ch = 'j' if $ch eq "\n";
450a55e4
LW
73
74 if ($ch eq ' ') {
75 last if $percent >= 100;
76 &move(0,0);
77 $line += $lines1;
78 }
79 elsif ($ch eq 'b') {
80 $line -= $lines1;
81 &move(0,0);
82 $line = 0 if $line < 0;
83 }
fe14fcc3
LW
84 elsif ($ch eq 'j') {
85 next if $percent >= 100;
450a55e4 86 $line += 1;
fe14fcc3 87 if ($dl && $ho) {
450a55e4
LW
88 print $ho, $dl;
89 &mvcur(0,0,$lines2,0);
90 print $ce,$lines[$line+$lines2],$ce;
91 &wmove($curscr,0,0);
92 &wdeleteln($curscr);
93 &wmove($curscr,$lines2,0);
94 &waddstr($curscr,$lines[$line+$lines2]);
95 }
96 &wmove($stdscr,0,0);
97 &wdeleteln($stdscr);
98 &wmove($stdscr,$lines2,0);
99 &waddstr($stdscr,$lines[$line+$lines2]);
100 &percent;
101 &refresh;
102 redo;
103 }
fe14fcc3 104 elsif ($ch eq 'k') {
450a55e4
LW
105 next if $line <= 0;
106 $line -= 1;
fe14fcc3 107 if ($al && $ho && $ce) {
450a55e4
LW
108 print $ho, $al, $ce, $lines[$line];
109 &wmove($curscr,0,0);
110 &winsertln($curscr);
111 &waddstr($curscr,$lines[$line]);
112 }
113 &wmove($stdscr,0,0);
114 &winsertln($stdscr);
115 &waddstr($stdscr,$lines[$line]);
116 &percent;
117 &refresh;
118 redo;
119 }
120 elsif ($ch eq "\f") {
121 &clear;
122 }
fe14fcc3 123 elsif ($ch eq 'q') {
450a55e4
LW
124 last;
125 }
fe14fcc3 126 elsif ($ch eq 'h') {
450a55e4
LW
127 &clear;
128 &help;
129 &clear;
130 }
131 else {
132 &bell;
133 }
134 }
135}
136
137sub defbell {
138 eval q#
139 sub bell {
140 print "\007";
141 }
142 #;
143}
144
145sub help {
146 local(*lines) = *helplines;
147 local($line);
148 &pagearray;
149}
150
151sub inithelp {
152 @helplines = split(/\n/,<<'EOT');
153
450a55e4
LW
154 h Display this help.
155 q Exit.
156
fe14fcc3
LW
157 SPACE Forward screen.
158 b Backward screen.
159 j, CR Forward 1 line.
160 k Backward 1 line.
161 FF Repaint screen.
450a55e4
LW
162EOT
163 for (@helplines) {
164 s/$/\n/;
165 }
166}
167
168sub percent {
169 &standout;
170 $percent = int(($line + $lines1) * 100 / @lines);
171 &move($lines1,0);
172 &addstr("($percent%)");
173 &standend;
174 &clrtoeol;
175}
fe14fcc3
LW
176
177sub endit {
178 &move($lines1,0);
179 &clrtoeol;
180 &refresh;
181 &endwin;
182
183 if ($@) {
184 print ""; # force flush of stdout
185 $@ =~ s/\(eval\)/$0/ && $@ =~ s/line (\d+)/'line ' . ($1 + $evaloffset)/e;
186 die $@;
187 }
188
189 exit;
190}