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
1 #!./curseperl
2
3 eval <<'EndOfMain';   $evaloffset = __LINE__;
4
5     $SIG{'INT'} = 'endit';
6     $| = 1;             # command buffering on stdout
7     &initterm;
8     &inithelp;
9     &slurpfile && &pagearray;
10
11 EndOfMain
12
13 &endit;
14
15 ################################################################################
16
17 sub 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
31 sub 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
48 sub drawscreen {
49     &move(0,0);
50     for ($line .. $line + $lines2) {
51         &addstr($lines[$_]);
52     }
53     &clrtobot;
54     &percent;
55     &refresh;
56 }
57
58 sub expand {
59     while (($off = index($_[0],"\t")) >= 0) {
60         substr($_[0], $off, 1) = ' ' x (8 - $off % 8);
61     }
62 }
63
64 sub pagearray {
65     $line = 0;
66
67     $| = 1;
68
69     for (&drawscreen;;&drawscreen) {
70
71         $ch = &getch;
72         $ch = 'j' if $ch eq "\n";
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         }
84         elsif ($ch eq 'j') {
85             next if $percent >= 100;
86             $line += 1;
87             if ($dl && $ho) {
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         }
104         elsif ($ch eq 'k') {
105             next if $line <= 0;
106             $line -= 1;
107             if ($al && $ho && $ce) {
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         }
123         elsif ($ch eq 'q') {
124             last;
125         }
126         elsif ($ch eq 'h') {
127             &clear;
128             &help;
129             &clear;
130         }
131         else {
132             &bell;
133         }
134     }
135 }
136
137 sub defbell {
138     eval q#
139         sub bell {
140             print "\007";
141         }
142     #;
143 }
144
145 sub help {
146     local(*lines) = *helplines;
147     local($line);
148     &pagearray;
149 }
150
151 sub inithelp {
152     @helplines = split(/\n/,<<'EOT');
153
154   h              Display this help.
155   q              Exit.
156
157   SPACE          Forward  screen.
158   b              Backward screen.
159   j, CR          Forward  1 line.
160   k              Backward 1 line.
161   FF             Repaint screen.
162 EOT
163     for (@helplines) {
164         s/$/\n/;
165     }
166 }
167
168 sub percent {
169     &standout;
170       $percent = int(($line + $lines1) * 100 / @lines);
171       &move($lines1,0);
172       &addstr("($percent%)");
173     &standend;
174     &clrtoeol;
175 }
176
177 sub 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 }