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

Tk-swish

by zentara (Archbishop)
on May 02, 2004 at 20:11 UTC ( [id://349858]=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info zentara
Description: This is a little Tk app for quickly browsing the results of a swish search. I use it as a fast Perl snippet searcher. To be honest, I think swish misses some of the results as compared to grep, but it's fast.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::HList;
use Tk::Pane;

# swish is available at http://homepage.mac.com/pauljlucas/software/sw
+ish/ 
# 
# Setting up swish can be a little tricky, this is what I do. 
# Say you install in /home/user/swish, we will make the swish++.index 
# in /home/user/swish. So...... 
# cd /home/user/swish 
# bin/index -c etc/swish++.conf -  
# 
# Then enter each directory, one at a time, followed by an enter. 
#  Here comes the tricky part.....swish will index the first directory
+ 
#  and will just pause, waiting for the next directory to be entered, 
#  when done, hit control-d. 
# 
# (You can tell that swish is waiting for the next directory to be inp
+utted, 
#  by hitting "enter", and swish will respond "invalid directory". If 
+that  
#  occurs, enter the next directory, or a control-d to finish. 
# 
# 
# Your swish++.conf should include 
# 
# ExcludeFile *.gif *.jpg *.png *.avi *.ppm *.xbm *.pbm *.wav *.mp3 *.
+tar.gz *.bz2 *.zip *.gz *.o *.so *.a 
# IndexFile   /home/zentara/swish/swish++.index 
# ResultsMax   10000 
# ResultSeparator "       " 
#                  ^^^^^^^ 
#                   a tab    needed so we can use spaces in filenames 
# 
# WordPercentMax  101 
# 
# 
######################################################################
+#### 
# user adjustable settings 
my $swish = '/home/zentara/swish/bin/search -c /home/zentara/swish/etc
+/swish++.conf';
my $maxfilesize = 1000000;  #limit file opens to 1 meg 

my $h;        #my HList; 
my $search;   #word to search for 
my $cur_info; #currently selected file info  
my $display;  #labels to display info 
my $display1;
my $display2;
my $text;     #the textbox 

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);


#fill leftframe with thumbnails 
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 => "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();


#in case you want to play with the Up Down arrow keys in HList 
#$mw->focusFollowsMouse; 
#$h->bind('<Return>', [sub {&browseThis($h->info('selection') )}] ); 

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=>"SearchSwish: ",-background => 'black',-foreground =
+> 'green')
                                -> 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{&swish_it}] );
########################################################## 
#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);

my @line=split(/\t/,$data);

chomp $line[3];
$display->configure(-text=>  $line[3]);
$display1->configure(-text=> $line[2]);
$display2->configure(-text=> $line[1]);

&display_text($line[1]);
}
############################################################ 
sub add_file{

my $data  = shift;

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

my @line=split(/\t/,$data); #needed to get filenames with spaces 

    $h->itemCreate ($e, 0,
       -itemtype => 'text',
       -text => $line[3],
           );
#return $e; 
}
################################################################# 

sub swish_it{
$h->delete('all');

my @list = ();
@list = `$swish $search`;

#remove results number, first line of the swish returns 
my $r = shift @list;

if($r =~ /^# results:/ ){ 
     my (undef,undef,$count) = split(/\s+/,$r);
        if($count == 0){print chr(07); return}
 }else{print chr(07); return}

foreach (@list){&add_file($_)}
my @children = $h->info('children');

my $first = shift @children;
$h->selectionSet($first);
browseThis($first);

}

################################################################# 

sub display_text {
my $file = shift;

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

if(-s $file > $maxfilesize){
print chr(07);
$text->insert('end',"File exceeds \$maxfilesize $maxfilesize");
return;
}

$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) {
        $current =
          $w->search( -count => \$length, "-$kind",'-nocase', $$string
+, $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 
######################################################################

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://349858]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (5)
As of 2024-03-28 15:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found