Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help?? 
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::HList;
use Tk::Pane;
use File::Find;
use File::Spec;

my $maxfilesize = 5000000;  #limit file opens to 5 meg 
my $h;        #my HList; 
my $search = '';   #string to search for 
my $regex;
my $case = 1; #defaults to case sensitive  
my $cur_info; #currently selected file info  
my $display;  #labels to display info 
my $display1;
my $display2;
my $text;      #the textbox 
my $firstflag; #flag for displaying first result 
my $indicator; #searching indicator 
my $indicate = -1;
my $stop;      #used to stop excessively long searches 

my $mw = MainWindow->new(-bg=>'black');
$mw->geometry('800x700+100+15');

$mw->bind('<Control-c>', [sub{Tk::exit;}] );

my $topframe = $mw->Frame(-height =>30, -background=>'darkgrey')
                            ->pack(-fill=>'both', -expand=>1);

my $leftframe = $mw->Frame( -width =>25,
                            -background=>'black',
                            )->pack(-side => "left", -anchor => "n",
                                     -fill=>'both', -expand=>1);

my $mainframe = $mw->Frame(-background=>'black')
                            ->pack(-side => "right", -anchor => "n",
                              -fill=>'both', -expand=>1);

#create leftframe  
HList2();

#fill mainframe with default screen  
setup_pane();

$topframe->Button(-text => "Next",
                   -bg=>'cyan3',
                   -activebackground =>'cyan',
                   -padx=>40,
                   -relief=>'raised',
                   -command => sub {
                       if(defined  $h->info('selection')){
                       my $next = $h->info('next',$h->info('selection'
+));

                       if($next){
                              $h->selectionClear($h->info('selection')
+);
                              $h->selectionSet($next);
                              $h->see($next);
                              browseThis($next);
                            }else{print chr(07)}
                       }
                    })->pack(-side =>'left');

$topframe->Button(-text => "Previous",
                   -bg=>'thistle3',
                   -activebackground =>'thistle1',
                   -padx=>40,
                   -relief=>'raised',
                   -command => sub {
                          if(defined  $h->info('selection')){
                          my $prev = $h->info('prev',$h->info('selecti
+on'));

                           if($prev){
                              $h->selectionClear($h->info('selection')
+);
                              $h->selectionSet($prev);
                              $h->see($prev);
                              browseThis($prev);
                            }else{print chr(07)}
                         }
                  })->pack(-side =>'left');

$topframe->Button(-text => "Exit",
                   -bg => 'lightgrey',
                   -activebackground =>'snow',
                   -padx=>40,
                   -relief=>'raised',
                   -command => sub { exit; })->pack(-side =>'right');


$topframe->Button(-text => "Stop Search",
                   -bg => 'red',
                   -activebackground =>'yellow',
                   -relief=>'raised',
                   -command => sub {$stop = 1})->pack(-side =>'right',
+-padx => 20);
                          
                   
$topframe->Button(-text => "Delete Entry",
                   -bg=>'pink',
                   -activebackground =>'hotpink',
                   -padx=>40,
                   -relief=>'raised',
                   -command => sub {

                       if(defined  $h->info('selection')){
                       my $next = $h->info('next',$h->info('selection'
+));
                       my $prev = $h->info('prev',$h->info('selection'
+));
                       
                       $h->delete( 'entry', $h->info('selection') );

                       if($next){
                              $h->selectionClear($h->info('selection')
+);
                              $h->selectionSet($next);
                              $h->see($next);
                              browseThis($next);
                       }elsif($prev){
                              $h->selectionClear($h->info('selection')
+);
                              $h->selectionSet($prev);
                              $h->see($prev);
                              browseThis($prev);
                       }else{print chr(07)}
                     }
                   })->pack();

MainLoop;

sub HList2 {

 $h = $leftframe->Scrolled( 'HList',
                               -header => 1,
                               -columns => 1,
                               -width => 20,
                               -height => 60,
                               -takefocus => 1,
                               -background => 'steelblue',
                               -foreground =>'snow',
                               -selectmode => 'single',
                               -selectforeground => 'pink',
                               -selectbackground => 'black',
                               -browsecmd => \&browseThis,
                   )->pack(-side => "left", -anchor => "n");

$h->header('create', 0, -text => '    FILENAME ',
                        -borderwidth => 3,
                        -headerbackground => 'steelblue',
                        -relief => 'raised');

}

############################################################# 
sub setup_pane{

my $pane = $mainframe->Pane(
               -width => 1000,
               -height =>1000,
               -background => 'black',
               -sticky => 'n',
              )->pack(-side => "left", -anchor => "n",
                      -fill=>'both',-expand=>1);


# search entry box 
my $f1 = $pane->Frame(-background => 'black')
                 ->pack(-side => 'top', -fill => 'x', -expand => 1, -p
+ady =>5);

$f1->Label(-text=>"Search: ",-background => 'black',-foreground => 'gr
+een')
                                -> pack(-side =>'left', -anchor => 'n'
+);

my $entry = $f1->Entry(-textvariable => \$search,
                    -width =>50,
                    -bg => 'white',
                    ) ->pack(-side=>'left', -anchor => 'n');

$entry->focus();
$entry->bind('<Return>', [sub{&search_it}] );

$f1->Checkbutton(-text => 'Case Sensitive',
                 -bg => 'grey',
                 -fg => 'black',
                 -padx => 10,
                 -onvalue => 1,
                 -offvalue => 0,
                 -variable => \$case)->pack(-side =>'left');

########################################################## 
#currently selected file info 
my $f1a = $pane->Frame(-background => 'black')
                 ->pack(-side => 'top', -fill => 'x', -expand => 1);

$f1a->Label(-text=>"Filename: ",-background => 'black',-foreground => 
+'green')
                                -> pack(-side =>'left', -anchor => 'n'
+);

$display = $f1a->Label(-text=>'' ,-background => 'black',-foreground =
+> 'lightblue')
                               -> pack(-side =>'left', -anchor => 'n')
+;

my $f1b = $pane->Frame(-background => 'black')
                 ->pack(-side => 'top', -fill => 'x', -expand => 1);

$f1b->Label(-text=>"Size: ",-background => 'black',-foreground => 'gre
+en')
                                -> pack(-side =>'left', -anchor => 'n'
+);

$display1 = $f1b->Label(-text=>'' ,-background => 'black',-foreground 
+=> 'pink')
                               -> pack(-side =>'left', -anchor => 'n')
+;

my $f1c = $pane->Frame(-background => 'black')
                 ->pack(-side => 'top', -fill => 'x', -expand => 1);

$f1c->Label(-text=>"FullPath: ",-background => 'black',-foreground => 
+'green')
                                -> pack(-side =>'left', -anchor => 'n'
+);

$display2 = $f1c->Label(-text=>'' ,-background => 'black',-foreground 
+=> 'yellow')
                               -> pack(-side =>'left', -anchor => 'w')
+;

################################################################## 
#text box to display files 
my $f2 = $pane->Frame(-background => 'black')
                 ->pack(-side => 'bottom', -fill => 'both', -expand =>
+ 1,);


$text = $f2->Scrolled('Text',-scrollbars=>'se', -bg => 'lightyellow',
                          -height=>45
                          )->pack(-fill=>'both', -expand=>1);

}
##############################################################  
sub browseThis {
   my $ent = shift;
   my $data = $h->info('data',$ent);

$indicator->cancel;

my (undef,undef,$filename) = File::Spec->splitpath( $data );
my $size = -s $data;

$display->configure(-text=>  $filename);
$display1->configure(-text=> $size);
$display2->configure(-text=> $data);

&display_text($data);
}
############################################################ 
sub add_file{

my ($file,$abs_path)  = @_;

my $e = $h->addchild("",-data => $abs_path);

    $h->itemCreate ($e, 0,
       -itemtype => 'text',
       -text => $file,
           );
}
################################################################# 
sub search_it{

  if(length $search == 0){print chr(07);return}

 $h->delete('all');
 $firstflag = 0;
 $stop = 0;

#start the blinking "Searching message indicator " 
 $indicator = $mw->repeat(500,\&indicate);

my $path =  File::Spec->rel2abs('.');

if ($case){$regex =  qr/\Q$search\E/}
          else{$regex =  qr/\Q$search\E/i}

find(\&wanted,$path);

if($firstflag == 0){
   print chr(07);
   $indicator->cancel;
   $text->delete("1.0","end");
   $text->see("1.0");
   $text->insert('end',"NO RESULTS !!!!!");
 }

#goto hack to exit File::Find early 
FINISHED:

}

################################################################# 
sub wanted{
    return unless (-f and -T);  #only consider text files     
    if(-s $File::Find::name > $maxfilesize){return}

    open(FILE, $File::Find::name) || die "Cant open $File::Find::name:
+ $!\n";
      while (<FILE>) {           #process files line by line, no slurp
+ 
           next unless /$regex/;

      my $localname = File::Spec->abs2rel($File::Find::name);
      &add_file($localname, $File::Find::name);

     if($firstflag == 0){ #on subsequent searches the first entry 
                          #will not be 0, due to HList's internal coun
+ter 
                         my $first = $h->info('children');
                         &browseThis($first);
                         $h->selectionSet($first);
                         $firstflag = 1;
                        }
                        
      last;  #quit searching file after first match 
             #the textbox will show all matches 
          }

   close(FILE);
   $h->update;
   if($stop == 1){ goto FINISHED}
 }
##################################################################### 

sub display_text {
my $file = shift;

$text->delete("1.0","end");
$text->see("1.0");

$text->tagConfigure( 'search', -foreground => 'black',-background => '
+lightgreen' );

my $buf;

if($file =~ /([Hh]tml?|HTML?)$/ ){
    $buf = `lynx -dump -force_html $file`;
       }elsif($file =~ /(pdf|PDF)$/){
         $buf = `pdftotext $file -`;
           }elsif($file =~ /(ps|PS|eps|EPS)$/){
              $buf = `ps2ascii $file`;
                }elsif($file =~ /(pod)$/){
                   $buf = `pod2text $file`;
                     }else{
                         open (FH,"< $file") or warn "$! \n";
                         read( FH, $buf, -s FH );
                         close FH;
      }

$text->insert('end',$buf);

&search_text($text,\$search,'search','exact');

}
#################################################################### 

sub search_text {

    # The utility procedure below searches for all instances of a give
+n 
    # string in a text widget and applies a given tag to each instance
+ found. 
    # Arguments: 
    # 
    # w -       The window in which to search.  Must be a text widget.
+ 
    # string -  Reference to the string to search for.  The search is 
+done 
    #           using exact matching only;  no special characters. 
    # tag -     Tag to apply to each instance of a matching string. 

    my ( $w, $string, $tag, $kind ) = @_;
    #print "@_\n"; 

    return unless ref($string) && length($$string);

    $w->tagRemove( $tag, qw/0.0 end/ );
    my ( $current, $length ) = ( '1.0', 0 );

    my ($current_last, $length_last);

    while (1) {
       if($case){
           $current =
              $w->search(-count => \$length, "-$kind", $$string, $curr
+ent, 'end' );
          }else{
           $current =
             $w->search(-count => \$length, "-$kind",'-nocase', $$stri
+ng, $current, 'end' );
         }

        last if not $current;
#       warn "Posn=$current count=$length\n", 

        $w->see($current);

          $w->tagAdd( $tag, $current, "$current + $length char" );
        $current = $w->index("$current + $length char");
    }

}    # end search_text 
######################################################################
+ 
sub indicate {
   $indicate = -$indicate;  #negative toggle 
   $text->delete("1.0","end");
   $text->see("1.0");
   $text->insert('end','Searching ');
 if($indicate == -1){$text->insert('end',' .....No Results Yet')}
 $text->update;

}
####################################################################

[download]

In reply to ztksearch by zentara

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others wandering the Monastery: (4)
As of 2024-04-25 05:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found