home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / FileBrowse.pm < prev    next >
Text File  |  2005-04-27  |  6KB  |  250 lines
  1. package Term::ReadLine::Zoid::FileBrowse;
  2.  
  3. use strict;
  4. use base 'Term::ReadLine::Zoid';
  5.  
  6. our $VERSION = 0.01;
  7.  
  8. our %_keymap = ( # maybe inherit from insert ? these could be remapped
  9.     up     => 'select_previous',
  10.     down     => 'select_next',
  11.     right    => 'select_next_col',
  12.     left     => 'select_previous_col',
  13.     page_up  => 'page_up',
  14.     page_down => 'page_down',
  15.     return     => 'accept_line',
  16.     ctrl_C     => 'return_empty_string',
  17.     escape     => 'switch_mode',
  18.     '/'     => 'fb_mini_buffer',
  19.     ' '     => 'toggle_mark',
  20.     '.'     => 'toggle_hide_hidden',
  21.     _default => 'self_insert',
  22.     _on_switch => 'fb_switch',
  23. );
  24.  
  25. sub keymap {
  26.     my $self = shift;
  27.     for (
  28.         ['hide_hidden_files', 1],
  29.         ['fb_prompt', "\e[1;37m -- \%s -- \e[0m"],
  30.     ) {
  31.         $$self{config}{$$_[0]} = $$_[1]
  32.             unless defined $$self{config}{$$_[0]}
  33.     }
  34.     return \%_keymap;
  35. }
  36.  
  37. # fb_item   == item currently selected (pointed at)
  38. # fb_marks  == marked _numbers_ in current dir
  39. # fb_marked == marked _items_ in other dirs
  40. # fb_items  == items in current dir
  41. # fb_dir    == current dir
  42.  
  43. sub fb_switch {
  44.     my $self = shift;
  45.     @$self{qw/fb_item fb_marks fb_marked fb_items/} = (0, [], [], []);
  46.     $self->fb_switch_dir('.');
  47. }
  48.  
  49. sub fb_switch_dir { # FIXME FIXME "marked" admisnistrationis contains bugs
  50.     my ($self, $dir) = @_;
  51.     $dir ||= $$self{fb_dir};
  52.     my $pwd;
  53.     if ($dir eq '.') { $dir = $ENV{PWD}; $pwd++; }
  54.     else {
  55.         $dir =~ s#^\./#$ENV{PWD}#;
  56.         $dir =~ s#/\.(/|$)|//+#/#g;
  57.         $dir =~ s#(^|/)[^/]*/\.\.(/|$)##g;
  58.         $dir =~ s#/?$#/#;
  59.     }
  60.  
  61.     opendir DIR, $dir or return $self->bell;
  62.     my (@marks, @marked);
  63.     for ($self->marked()) {
  64.         if (m#(.*/)(.*)#) {
  65.             if ($1 eq $dir) { push @marks, $2 }
  66.             else { push @marked, $_ }
  67.         }
  68.         elsif ($pwd) { push @marks, $_ }
  69.         else { push @marked, $_ }
  70.     }
  71.     $$self{fb_items} = [ '../',
  72.         map {-d "$dir/$_" ? $_.'/' : $_}
  73.         $$self{config}{hide_hidden_files}
  74.         ? (sort grep {$_ !~ /^\./    } readdir DIR)
  75.         : (sort grep {$_ !~ /^\.\.?$/} readdir DIR)
  76.     ];
  77.     close DIR;
  78.     $$self{fb_marked} = \@marked;
  79.     $$self{fb_marks} = [];
  80.     if (@marks) {
  81.         my $i = 0;
  82.         for my $item (@{$$self{fb_items}}) {
  83.             push @{$$self{fb_marks}}, $i
  84.                 if grep {$_ eq $item} @marks;
  85.             $i++;
  86.         }
  87.     }
  88.     @$self{qw/fb_item fb_dir/} = (0, $dir);
  89. }
  90.  
  91. sub draw { # Render Fu
  92.     my $self = shift;
  93.     
  94.     my @pos = (1, 1);
  95.     my @lines = map "   $_", @{$$self{fb_items}};
  96.     for (@{$$self{fb_marks}}) { $lines[$_] =~ s/^ /*/ }
  97.     $lines[ $$self{fb_item} ] =~ s/^(.) /$1>/;
  98.  
  99.     @lines = $self->col_format( @lines );
  100.     $$self{fb_rows} = scalar @lines;
  101.     $pos[1] += ($$self{fb_item} % $$self{fb_rows}); # assuming +1 offset due to fb_prompt
  102.  
  103.     unshift @lines, sprintf $$self{config}{fb_prompt}, $$self{fb_dir};
  104.  
  105.     $self->print(\@lines, \@pos);
  106. }
  107.  
  108. sub toggle_hide_hidden {
  109.     $_[0]{config}{hide_hidden_files}  =
  110.         $_[0]{config}{hide_hidden_files} ? 0 : 1 ;
  111.     $_[0]->fb_switch_dir();
  112. }
  113.  
  114. sub self_insert {
  115.     my ($self, $key) = @_;
  116.     return $self->bell unless $key =~ /^\d+$/;
  117.     #$$self{fb_item} .= $key;
  118. }
  119.  
  120. sub accept_line {
  121.     my $self = shift;
  122.     my $dir = $$self{fb_dir}.'/'.$$self{fb_items}[ $$self{fb_item} ];
  123.     return $self->fb_switch_dir($dir) if -d $dir;
  124.  
  125.     push @{$$self{fb_marks}}, $$self{fb_item};
  126.     my @words = map {s/'/\\'/g; '\''.$_.'\''} $self->marked();
  127.     $self->substring(join(' ', @words), $$self{pos});
  128.     $self->switch_mode();
  129. }
  130.  
  131. sub fb_mini_buffer {
  132.     my $self = shift;
  133. }
  134.  
  135. sub select_next { $_[0]{fb_item}++ if $_[0]{fb_item} < $#{$_[0]{fb_items}} }
  136.  
  137. sub page_up { 
  138.     my $self = shift;
  139.     my (undef, $higth) = $self->TermSize();
  140.     my $vpos = $$self{fb_item} % $$self{fb_rows};
  141.     if ($vpos > $higth) { $$self{fb_item} -= $higth }
  142.     else { $$self{fb_item} -= $vpos }
  143. }
  144.  
  145. sub page_down {
  146.     my $self = shift;
  147.     my (undef, $higth) = $self->TermSize();
  148.     my $rvpos = $$self{fb_rows} - ($$self{fb_item} % $$self{fb_rows});
  149.     if ($rvpos > $higth) { $$self{fb_item} += $higth }
  150.     else { $$self{fb_item} += $rvpos }
  151.     $$self{fb_item} = $#{$$self{fb_items}} if $$self{fb_item} > $#{$$self{fb_items}};
  152. }
  153.  
  154. sub select_previous { $_[0]{fb_item}-- if $_[0]{fb_item} > 0 }
  155.  
  156. sub select_next_col {
  157.     $_[0]{fb_item} += $_[0]{fb_rows}
  158.         unless $_[0]{fb_rows} > $#{$_[0]{fb_items}} - $_[0]{fb_item};
  159. }
  160.  
  161. sub select_previous_col {
  162.     $_[0]{fb_item} -= $_[0]{fb_rows}
  163.         unless $_[0]{fb_rows} > $_[0]{fb_item};
  164. }
  165.  
  166. sub toggle_mark { # FIXME should be toggle
  167.     my $self = shift;
  168.     my $l = scalar @{$$self{fb_marks}};
  169.     @{$$self{fb_marks}} = grep {$_ != $$self{fb_item}} @{$$self{fb_marks}};
  170.     push @{$$self{fb_marks}}, $$self{fb_item} if $l == scalar @{$$self{fb_marks}};
  171.     $self->select_next();
  172. }
  173.  
  174. sub marked {
  175.     my $self = shift;
  176.     my $dir = $$self{fb_dir};
  177.     $dir =~ s#^\Q$ENV{PWD}\E/?##;
  178.     $dir =~ s#/?$#/# if length $dir;
  179.     return @{$$self{fb_marked}},
  180.         map $dir.$_, @{$$self{fb_items}}[ @{$$self{fb_marks}} ];
  181. }
  182.  
  183. 1;
  184.  
  185. __END__
  186.  
  187. =head1 NAME
  188.  
  189. Term::ReadLine::Zoid::FileBrowse - a readline file browser mode
  190.  
  191. =head1 SYNOPSIS
  192.  
  193. This class is used as a mode under L<Term::ReadLine::Zoid>,
  194. see there for usage details.
  195.  
  196. =head1 DESCRIPTION
  197.  
  198. This module provides a "file browse" mode that lets you interactively select files
  199. and navigate your file-system.
  200.  
  201. =head1 KEY MAPPING
  202.  
  203. =over 4
  204.  
  205. =item up  (I<select_previous>)
  206.  
  207. =item down  (I<select_next>)
  208.  
  209. =item right  (I<select_next_col>)
  210.  
  211. =item left  (I<select_previous_col>)
  212.  
  213. =item page_up  (I<page_up>)
  214.  
  215. =item page_down  (I<page_down>)
  216.  
  217. =item return  (I<accept_line>)
  218.  
  219. =item ^C  (I<return_empty_string>)
  220.  
  221. =item escape  (I<switch_mode>)
  222.  
  223. =item /  (I<fb_mini_buffer>)
  224.  
  225. =item space  (I<toggle_mark>)
  226.  
  227. =item .  (I<toggle_hide_hidden>)
  228.  
  229. =back
  230.  
  231. =head1 TODO
  232.  
  233. make fb_prompt config compatible with PS1 stuff
  234. and keep $ENV{CLICOLOR} in mind
  235.  
  236. =head1 AUTHOR
  237.  
  238. Jaap Karssenberg (Pardus) E<lt>pardus@cpan.orgE<gt>
  239.  
  240. Copyright (c) 2004 Jaap G Karssenberg. All rights reserved.
  241. This program is free software; you can redistribute it and/or
  242. modify it under the same terms as Perl itself.
  243.  
  244. =head1 SEE ALSO
  245.  
  246. L<Term::ReadLine::Zoid>
  247.  
  248. =cut
  249.  
  250.