perl 3.0 patch #23 patch #19, continued
[perl.git] / usub / pager
1 #!./curseperl
2
3 eval <<'EndOfMain';   $evaloffset = 3;  # line number of this line
4
5     $| = 1;             # command buffering on stdout
6     &initterm;
7     &inithelp;
8     &slurpfile && &pagearray;
9
10 EndOfMain
11
12 &endwin;
13
14 if ($@) {
15     print "";           # force flush of stdout
16     $@ =~ s/\(eval\)/$0/ && $@ =~ s/line (\d+)/'line ' . ($1 + $evaloffset)/e;
17     die $@;
18 }
19
20 exit;
21
22 ################################################################################
23
24 sub initterm {
25
26     &initscr; &cbreak; &noecho; &scrollok($stdscr, 1);
27     &defbell unless defined &bell;
28
29     $lines = $LINES; $lines1 = $lines - 1; $lines2 = $lines - 2;
30     $cols = $COLS;   $cols1  = $cols  - 1; $cols2  = $cols  - 2;;
31
32     $dl = &getcap('dl');
33     $al = &getcap('al');
34     $ho = &getcap('ho');
35     $ce = &getcap('ce');
36 }
37
38 sub slurpfile {
39     while (<>) {
40         s/^(\t+)/'        ' x length($1)/e;
41         &expand($_) if /\t/;
42         if (length($_) < $cols) {
43             push(@lines, $_);
44         }
45         else {
46             while ($_ && $_ ne "\n") {
47                 push(@lines, substr($_,0,$cols));
48                 substr($_,0,$cols) = '';
49             }
50         }
51     }
52     1;
53 }
54
55 sub drawscreen {
56     &move(0,0);
57     for ($line .. $line + $lines2) {
58         &addstr($lines[$_]);
59     }
60     &clrtobot;
61     &percent;
62     &refresh;
63 }
64
65 sub expand {
66     while (($off = index($_[0],"\t")) >= 0) {
67         substr($_[0], $off, 1) = ' ' x (8 - $off % 8);
68     }
69 }
70
71 sub pagearray {
72     $line = 0;
73
74     $| = 1;
75
76     for (&drawscreen;;&drawscreen) {
77
78         $ch = &getch;
79         $ch = "j" if $ch eq "\n";
80
81         if ($ch eq ' ') {
82             last if $percent >= 100;
83             &move(0,0);
84             $line += $lines1;
85         }
86         elsif ($ch eq 'b') {
87             $line -= $lines1;
88             &move(0,0);
89             $line = 0 if $line < 0;
90         }
91         elsif ($ch eq "j") {
92             $line += 1;
93             if ($dl) {
94                 print $ho, $dl;
95                 &mvcur(0,0,$lines2,0);
96                 print $ce,$lines[$line+$lines2],$ce;
97                 &wmove($curscr,0,0);
98                 &wdeleteln($curscr);
99                 &wmove($curscr,$lines2,0);
100                 &waddstr($curscr,$lines[$line+$lines2]);
101             }
102             &wmove($stdscr,0,0);
103             &wdeleteln($stdscr);
104             &wmove($stdscr,$lines2,0);
105             &waddstr($stdscr,$lines[$line+$lines2]);
106             &percent;
107             &refresh;
108             redo;
109         }
110         elsif ($ch eq "k") {
111             next if $line <= 0;
112             $line -= 1;
113             if ($al) {
114                 print $ho, $al, $ce, $lines[$line];
115                 &wmove($curscr,0,0);
116                 &winsertln($curscr);
117                 &waddstr($curscr,$lines[$line]);
118             }
119             &wmove($stdscr,0,0);
120             &winsertln($stdscr);
121             &waddstr($stdscr,$lines[$line]);
122             &percent;
123             &refresh;
124             redo;
125         }
126         elsif ($ch eq "\f") {
127             &clear;
128         }
129         elsif ($ch eq "q") {
130             last;
131         }
132         elsif ($ch eq "h") {
133             &clear;
134             &help;
135             &clear;
136         }
137         else {
138             &bell;
139         }
140     }
141 }
142
143 sub defbell {
144     eval q#
145         sub bell {
146             print "\007";
147         }
148     #;
149 }
150
151 sub help {
152     local(*lines) = *helplines;
153     local($line);
154     &pagearray;
155 }
156
157 sub inithelp {
158     @helplines = split(/\n/,<<'EOT');
159
160       Commands marked with * may be preceeded by a number, N.
161
162   h              Display this help.
163   q              Exit.
164
165   f, SPACE    *  Forward  N lines, default one screen.
166   b           *  Backward N lines, default one screen.
167   e, j, CR    *  Forward  N lines, default 1 line.
168   y, k        *  Backward N lines, default 1 line.
169   d           *  Forward  N lines, default 10 or last N to d or u command.
170   u           *  Backward N lines, default 10 or last N to d or u command.
171   r              Repaint screen.
172   R              Repaint screen, discarding buffered input.
173
174   /pattern    *  Search forward for N-th line containing the pattern.
175   ?pattern    *  Search backward for N-th line containing the pattern.
176   n           *  Repeat previous search (for N-th occurence).
177
178   g           *  Go to line N, default 1.
179   G           *  Like g, but default is last line in file.
180   p, %        *  Position to N percent into the file.
181   m<letter>      Mark the current position with <letter>.
182   '<letter>      Return to a previously marked position.
183   ''             Return to previous position.
184
185   E [file]       Examine a new file.
186   N           *  Examine the next file (from the command line).
187   P           *  Examine the previous file (from the command line).
188   =              Print current file name.
189   V              Print version number of "less".
190
191   -<flag>        Toggle a command line flag.
192   +cmd           Execute the less cmd each time a new file is examined.
193
194   !command       Passes the command to a shell to be executed.
195   v              Edit the current file with $EDITOR.
196 EOT
197     for (@helplines) {
198         s/$/\n/;
199     }
200 }
201
202 sub percent {
203     &standout;
204       $percent = int(($line + $lines1) * 100 / @lines);
205       &move($lines1,0);
206       &addstr("($percent%)");
207     &standend;
208     &clrtoeol;
209 }