/[iselect]/ISelect.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /ISelect.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 13 by dpavlin, Thu Oct 25 16:08:43 2007 UTC revision 14 by dpavlin, Thu Oct 25 17:24:33 2007 UTC
# Line 9  use Data::Dump qw/dump/; Line 9  use Data::Dump qw/dump/;
9    
10  use base qw/Class::Accessor/;  use base qw/Class::Accessor/;
11  __PACKAGE__->mk_accessors( qw/  __PACKAGE__->mk_accessors( qw/
12    screen
13  lines  lines
14    error_text
15    status_text
16    
17  debug  debug
18  / );  / );
# Line 35  Term::ISelect - perl only implementation Line 38  Term::ISelect - perl only implementation
38          debug => 1          debug => 1
39    });    });
40    
41  =cut  =head2 open_screen
42    
43      $iselect->open_screen;
44    
45  my $scr;  =cut
46    
47  # leave sane terminal if script dies  # leave sane terminal if script dies
48  $SIG{__DIE__} = sub {  $SIG{__DIE__} = sub {
49      eval { system('stty sane'); };      eval { system('stty sane'); };
50  };  };
51    
52  my @lines;  sub open_screen {
53            my $self = shift;
54            $self->screen( new Term::Screen );
55    }
56    
57  my $top_screen_line = 0;        # offset in original text  my $top_screen_line = 0;        # offset in original text
58  my $pos = 0;  my $pos = 0;
59    
60  # default: select first line  # default: select first line
61  my $sel_pos = 0;  my $sel_pos = 0;
 my $status_text = '';  
 my $error_text = '';  
62    
63  my $status_lines = 3;  my $status_lines = 3;
64    
65  my $selectable_line;  my $selectable_line;
66    
67    =head2 full_line
68    
69    Returns line padded up to screen width
70    
71      $iselect->full_line( "foo bar" );
72    
73    =cut
74    
75  sub full_line {  sub full_line {
76            my $self = shift;
77    
78            my $cols = $self->screen->cols;
79    
80          my $t = shift;          my $t = shift;
81          $t = '' unless defined $t;          $t = '' unless defined $t;
82          return $t . (" " x ($scr->cols - length($t)));          $t = substr($t,0,$cols) if length($t) > $cols;
83            return $t . (" " x ($cols - length($t)));
84  }  }
85    
86  sub chunk {  
87          my $t = shift;  =head2 redraw_line
88          cluck "expected line" unless defined $t;  
89          return substr($t,0,$scr->cols);    $iselect->redraw_line( $line_on_screen, $content_of_line );
90  }  
91    =cut
92    
93  sub redraw_line {  sub redraw_line {
94            my $self = shift;
95    
96          my ($l,$line) = @_;          my ($l,$line) = @_;
97    
98          if ( defined $selectable_line->{ $l + $top_screen_line } ) {          if ( defined $selectable_line->{ $l + $top_screen_line } ) {
99                  $scr->at($l,0)->bold()->puts( full_line( chunk($line) ) )->normal();                  $self->screen->at($l,0)->bold()->puts( $self->full_line( $line ) )->normal();
100          } else {          } else {
101                  $scr->at($l,0)->puts( full_line( chunk($line) ) );                  $self->screen->at($l,0)->puts( $self->full_line( $line ) )
102          }          }
103  }  }
104    
105  sub redraw {  =head2 redraw_screen
106          for my $l (0 .. $scr->rows - $status_lines) {  
107      $iselect->redraw_screen
108    
109    =cut
110    
111    sub redraw_screen {
112            my $self = shift;
113            my @lines = $self->lines;
114            for my $l (0 .. $self->screen->rows - $status_lines) {
115                  my $line = $lines[ $l + $top_screen_line ];                  my $line = $lines[ $l + $top_screen_line ];
116                  redraw_line( $l, $line );                  $self->redraw_line( $l, $line );
117                  last if ($l == $#lines);                  last if ($l == $#lines);
118          }          }
119          selected(0);          $self->selected;
120  }  }
121    
122  sub status {  =head2 redraw_statusline
123          my $pcnt = int(($pos || 0) * 100 / ($#lines || 1));  
124    Redraw status line
125    
126      $iselect->redraw_statusline;
127    
128    =cut
129    
130    sub redraw_statusline {
131            my $self = shift;
132    
133            my @lines = $self->lines;
134    
135            my $pcnt = int(($pos || 0) * 100 / ( $#lines || 1));
136          my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);          my $pos_txt = sprintf('%d, %d%% ',$pos,$pcnt);
137            
138            my $scr = $self->screen || confess "need screen";
139    
140          $scr->at($scr->rows - $status_lines + 1,0)->reverse()->puts(          $scr->at($scr->rows - $status_lines + 1,0)->reverse()->puts(
141                  sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$status_text)                  sprintf(' %-'.($scr->cols - length($pos_txt) - 2).'s ',$self->status_text)
142          .$pos_txt)->normal();          .$pos_txt)->normal() if $self->status_text;
143    
144          $scr->at($scr->rows - $status_lines + 2,0)->puts(          $scr->at($scr->rows - $status_lines + 2,0)->puts(
145                  sprintf('%-'.$scr->cols.'s', $error_text)                  sprintf('%-'.$scr->cols.'s', $self->error_text)
146          );          ) if $self->error_text;
147  }  }
148    
149    =head2 selected
150    
151    Move selection (or refresh it)
152    
153      $iselect->selected( +1 );
154      $iselect->selected( -1 );
155      $iselect->selected( 0 );
156    
157    =cut
158    
159  sub selected {  sub selected {
160            my $self = shift;
161    
162          my $d = shift || 0;          my $d = shift || 0;
163    
164          my $screen_line = $pos - $top_screen_line;          my $screen_line = $pos - $top_screen_line;
165    
166          redraw_line( $screen_line, $lines[$pos] );          $self->redraw_line( $screen_line, ($self->lines)[$pos] );
167    
168          my $last_screen_line = $scr->rows - $status_lines;          my $last_screen_line = $self->screen->rows - $status_lines;
169    
170          if ( $d < 0 && $screen_line == 0 ) {          if ( $d < 0 && $screen_line == 0 ) {
171                  if ( $pos > 0 ) {                  if ( $pos > 0 ) {
172                          $top_screen_line--;                          $top_screen_line--;
173                          $pos--;                          $pos--;
174                  } else {                  } else {
175                          $error_text = "Already at Begin.";                          $self->error_text( "Already at Begin." );
176                  }                  }
177                  redraw;                  $self->redraw_screen;
178          } elsif ( $d > 0 && $screen_line == $last_screen_line ) {          } elsif ( $d > 0 && $screen_line == $last_screen_line ) {
179                  if ( $pos < $#lines ) {                  if ( $pos < scalar($self->lines) ) {
180                          $top_screen_line++;                          $top_screen_line++;
181                          $pos++;                          $pos++;
182                  } else {                  } else {
183                          $error_text = "Already at End.";                          $self->error_text( "Already at End." );
184                  }                  }
185                  redraw;                  $self->redraw_screen;
186          } else {          } else {
187                  $pos += $d;                  $pos += $d;
188          }          }
189    
190          my $line = $lines[$pos];          my $line = ($self->lines)[$pos];
191          if ( defined $selectable_line->{ $pos } ) {          if ( defined $selectable_line->{ $pos } ) {
192                  $scr->at($pos - $top_screen_line,0)->reverse->bold()->puts( full_line( chunk($line) ) )->normal();                  $self->screen->at($pos - $top_screen_line,0)->reverse->bold()->puts( $self->full_line( $line ) )->normal();
193                  $sel_pos = $pos;                  $sel_pos = $pos;
194          } else {          } else {
195                  $scr->at($pos - $top_screen_line,0)->reverse->puts( full_line( chunk($line) ) );                  $self->screen->at($pos - $top_screen_line,0)->reverse->puts( $self->full_line( $line ) );
196                  $sel_pos = -1;                  $sel_pos = -1;
197          }          }
198          status;          $self->redraw_statusline;
199  }  }
200    
201    
202  =head2 screen  =head2 loop
203    
204    Term::ISelect->screen(    $iselect->loop(
205          sub {          sub {
206                  my $line = shift;                  my $line = shift;
207                  warn "got line: $line\n";                  warn "got line: $line\n";
208          },          }
         qw/various lines to be used/,  
209    );    );
210    
211  =cut  =cut
212    
213  sub screen {  sub loop {
214          my $class = shift;          my $self = shift;
215    
216          my $callback = shift;          my $callback = shift;
217          confess "expect callback as first arg" unless ref($callback) eq 'CODE';          confess "expect callback as first arg" unless ref($callback) eq 'CODE';
218    
219          @lines = @_;          my @lines = $self->lines;
220    
221          # find which lines are selectable in input file          # find which lines are selectable in input file
222          for my $l (0 .. $#lines) {          for my $l (0 .. $#lines) {
# Line 175  sub screen { Line 231  sub screen {
231                  warn "selected first selectable line $sel_pos";                  warn "selected first selectable line $sel_pos";
232          }          }
233    
234          $scr = new Term::Screen || die "can't init Term::Screen";          $self->open_screen unless $self->screen;
         $scr->clrscr()->noecho();  
         redraw;  
         selected;  
235    
236          while(my $key = $scr->getch()) {          $self->screen->clrscr()->noecho();
237            $self->redraw_screen;
238            $self->selected;
239    
240                  $error_text = "";          while(my $key = $self->screen->getch()) {
241    
242                  my $lines_on_screen = $scr->rows - $status_lines;                  my $lines_on_screen = $self->screen->rows - $status_lines;
243    
244                  if ($key eq 'ku') {                  if ($key eq 'ku') {
245                          selected( -1 );                          $self->selected( -1 );
246                  } elsif ($key eq 'kd') {                  } elsif ($key eq 'kd') {
247                          selected( +1 );                          $self->selected( +1 );
248                  } elsif ($key eq 'pgup' ) {                  } elsif ($key eq 'pgup' ) {
249                          # first line on screen?                          # first line on screen?
250                          if ( $pos == $top_screen_line ) {                          if ( $pos == $top_screen_line ) {
251                                  $top_screen_line -= $lines_on_screen;                                  $top_screen_line -= $lines_on_screen;
252                                  $top_screen_line = 0 if $top_screen_line < 0;                                  $top_screen_line = 0 if $top_screen_line < 0;
253                                  redraw;                                  $self->redraw_screen;
254                          }                          }
255                          selected( -( $pos - $top_screen_line ) );                          $self->selected( -( $pos - $top_screen_line ) );
256                  } elsif ($key eq 'pgdn' ) {                  } elsif ($key eq 'pgdn' ) {
257                          # last line on screen?                          # last line on screen?
258                          if ( $pos - $top_screen_line == $lines_on_screen ) {                          if ( $pos - $top_screen_line == $lines_on_screen ) {
259                                  $top_screen_line += $lines_on_screen;                                  $top_screen_line += $lines_on_screen;
260                                  $top_screen_line = $#lines - $lines_on_screen if $top_screen_line >= $#lines - $lines_on_screen;                                  $top_screen_line = $#lines - $lines_on_screen if $top_screen_line >= $#lines - $lines_on_screen;
261                                  redraw;                                  $self->redraw_screen;
262                          }                          }
263                          selected( $top_screen_line + $lines_on_screen - $pos );                          $self->selected( $top_screen_line + $lines_on_screen - $pos );
264                  }                  }
265    
266                  $status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );                  my $status_text = sprintf("pos: %-3d sel_pos: %-3d top_screen_line: %-3d", $pos, $sel_pos, $top_screen_line );
267                  if ( length($key) > 1 ) {                  if ( length($key) > 1 ) {
268                          $status_text .= " key: $key";                          $status_text .= " key: $key";
269                  } else {                  } else {
270                          $status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );                          $status_text .= sprintf("key: %s [%03d][%02x]", $key =~ m/\w/ ? $key : '?' , ord($key), ord($key) );
271                  }                  }
272                    $self->status_text( $status_text );
273    
274                  # CTRL+L                  # CTRL+L
275                  redraw if ord($key) eq 0x0c;                  $self->redraw_screen if ord($key) eq 0x0c;
276    
277                  # Enter                  # Enter
278                  if ( ord($key) eq 0x0d && $sel_pos > 0 ) {                  if ( ord($key) eq 0x0d && $sel_pos > 0 ) {
279                          $error_text = "execute: " . $lines[ $sel_pos ];                          $self->error_text( "execute: " . $lines[ $sel_pos ] );
280                  }                  }
281    
282                  exit if (lc($key) eq 'q');                  return if (lc($key) eq 'q');
283    
284                  status;                  $self->redraw_statusline;
285    
286          }          }
287    
288          $scr->clrscr();          $self->clrscr();
289  }  }
290    
291  =head1 SEE ALSO  =head1 SEE ALSO
Legend:
Removed from v.13  
changed lines
  Added in v.14
  ViewVC Help
Powered by ViewVC 1.1.26