| Category: | GUI Programming |
| Author/Contact Info | zentara@zentara.net |
| Description: | This is a visual grep written using Perl/Gtk2. It uses File::Find to
search for keywords, then displays results for easy "copy&pasting". I use it as a snippet browser, when I'm looking for code snippets in my library, but only remember a keyword to search for. Here is a screenshot
The theme I'm using is at Z-theme UpDATED: Jan20,2006 A small bugfix and code cleanup Updated Jun 27,2012 Added unicode character support with the utf8::all module. Comment out these changes if you run into difficulties with too many utf8 errors. I also added a decode routine for input strings on the commandline. I havn't tested this extensively yet, but you should be able to pass in a unicode string as ARGV[0] and search for it. Also added -CS perlrun options. For instance you should now be able to run vgrep 'the œ character' and it should decode œ properly. Also I added a hack to the File::Find sub to find filenames with extended characters in them. So vgrep n zzœzz will find a file with that extended character string in its filename. Updated again: Jun30, 2012. I cleaned up decoding of @ARGV, so that all inputs are decoded to unicode. I also fixed a little bug where filenames were being double-decoded as unicode and throwing a warning. Updated again: Jul 01, 2012. This is becoming a little tutorial in unicode hacking. :-) Anyways, this update fixes an obscure bug with the interaction of Gtk2 and utf8::all. It all centers around why I needed to still manually decode @ARGV, even though the utf8::all module does this. As it turns out, from just experimentation, is that the use utf8::all line must come AFTER the GTk2 module declarations. WHY? Don't know. The result of this change allows me to remove the manual decoding of @ARGV, as well as the removal of the -CS perlrun option. This bug was finally fixed in the Glib source code. Updated 27 Feb 2013: Fixed a small bug where binaries, like pdf's, were not found while doing a name search. |
#!/usr/bin/perl
use warnings;
use strict;
# use utf8::all; # this must come AFTER the Gtk2 module declarations
use File::Find;
use Gtk2 -init;
use Glib qw(FALSE TRUE);
use Gtk2::Pango;
use Encode qw(decode);
use utf8::all; # must come after Gtk2 modules
$|++;
my $help;
while(<DATA>){$help .= $_}
my $seeking = 0; #global flag to indicate searching is in progress
my $cancel = 0; #global flag to cancel a long running search
my %files; #global to store results
my $current; #global to hold currently opened file
my ($recurse, $name, $case,$linenums,$quick_start) =(0,0,0,0,0);
#print "@ @ARGV\n"; # check raw input
# this is no longer needed after Jul 01 bugfix, see above.
# make sure the input string or filename is unicode decoded
# no matter which order the options are given
#foreach( @ARGV ){
# print "$_\t";
# $_ = decode('utf8', $_);
# print "$_\n";
#}
# remove options from @ARGV
if( grep{/\bn\b/} @ARGV ){@ARGV = grep { $_ ne 'n' } @ARGV; $name = 1
+};
if( grep{/\br\b/} @ARGV ){@ARGV = grep { $_ ne 'r' } @ARGV; $recurse =
+ 1 };
if( grep{/\bc\b/} @ARGV ){@ARGV = grep { $_ ne 'c' } @ARGV; $case = 1
+};
$linenums = 1; #opened file line numbering is on by default if 1
my $search_str = $ARGV[0] or $quick_start = 1;
#only accept 1 search string, so quote phrases on commandline
$search_str ||= undef;
#print "$name $recurse $case @ARGV \n";
my $font = Gtk2::Pango::FontDescription->from_string("Sans Bold 18");
my $hand_cursor = Gtk2::Gdk::Cursor->new ('hand2');
my $regular_cursor = Gtk2::Gdk::Cursor->new ('xterm');
my $hovering_over_link = FALSE;
my $blue = Gtk2::Gdk::Color->new (0,0,0xFFFF);
my $red = Gtk2::Gdk::Color->new (0xFFFF,0xFFFF,0);
my $white = Gtk2::Gdk::Color->new (0xFFFF,0xFFFF,0xFFFF);
my $window = Gtk2::Window->new;
$window->signal_connect( destroy => sub { Gtk2->main_quit; } );
$window->set_default_size( 700, 600 );
$window->signal_connect (key_press_event => \&key_handler);
#main box for display
my $vbox = Gtk2::VBox->new();
$vbox->set( "border_width" => 10 );
$window->add($vbox);
#top main box for search entry and options
my $vboxt = Gtk2::VBox->new();
$vboxt->set( "border_width" => 1 );
$vbox->pack_start( $vboxt, 0, 0, 1 ); # expand?, fill?, padding
#top layer
my $hboxt = Gtk2::HBox->new();
$hboxt->set( "border_width" => 1 );
$vboxt->pack_start( $hboxt, 0, 0, 1 ); # expand?, fill?, padding
#bottom layer
my $hboxb = Gtk2::HBox->new();
$hboxb->set( "border_width" => 1 );
$vboxt->pack_start( $hboxb, 0, 0, 1 ); # expand?, fill?, padding
################################################################
my $vboxC1 = Gtk2::VBox->new();
my $vboxC2 = Gtk2::VBox->new();
my $checkbutton1 = Gtk2::CheckButton->new('Recurse SubDirs');
$checkbutton1->signal_connect( clicked =>
sub{check_button_callback($checkbutton1, \$recurse, 're
+curse') } );
$vboxC1->pack_start( $checkbutton1, 0, 0, 0 );
if($recurse){$checkbutton1->set_active(1);}
my $checkbutton2 = Gtk2::CheckButton->new('Name Search Only');
$checkbutton2->signal_connect( clicked =>
sub{check_button_callback($checkbutton2, \$name , 'name'
+)});
$vboxC1->pack_start( $checkbutton2, 0, 0, 0 );
if($name){$checkbutton2->set_active(1);}
my $checkbutton3 = Gtk2::CheckButton->new('Case Sensitive');
$checkbutton3->signal_connect( clicked =>
sub{check_button_callback($checkbutton3, \$case , 'case')
+});
$vboxC2->pack_start( $checkbutton3, 0, 0, 0 );
if($case){$checkbutton3->set_active(1);}
my $checkbutton4 = Gtk2::CheckButton->new('File Line Numbered');
$checkbutton4->signal_connect( clicked =>
sub{check_button_callback($checkbutton4, \$linenums , 'li
+nenums')});
$vboxC2->pack_start( $checkbutton4, 0, 0, 0 );
if($linenums){$checkbutton4->set_active(1);}
$hboxt->pack_start( $vboxC1, 0, 0, 0 );
$hboxt->pack_start( $vboxC2, 0, 0, 0 );
#################################################################
# the search button
my $sbutton = Gtk2::Button->new_from_stock('gtk-find');
$sbutton->signal_connect( clicked => sub{ if(! $seeking){ do_dir_searc
+h()} });
$hboxt->pack_start( $sbutton, 0, 0, 5 );
##############################################################
# exit button
my $ebutton = Gtk2::Button->new_from_stock('gtk-quit');
$ebutton->signal_connect( clicked => sub { Gtk2->main_quit; } );
$hboxt->pack_end( $ebutton, 0, 0, 5 );
#################################################################
# the help button
my $hbutton = Gtk2::Button->new_from_stock('gtk-help');
$hbutton->signal_connect( clicked => \&print_usage );
$hboxt->pack_end( $hbutton, 0, 0, 5 );
##################################################################
#bottom fields
my $label = Gtk2::Label->new('Search Text:');
$label->modify_font($font);
$hboxb->pack_start( $label, 0, 0, 5 ); # expand?, fill?, padding
my $entry = Gtk2::Entry->new();
$entry->modify_font($font);
if(defined $search_str){ $entry->set_text($search_str) }
$hboxb->pack_start( $entry, 1, 1, 1 ); # expand?, fill?, padding
#setup default focaus chain
$vboxt->set_focus_child ($hboxb);
$hboxb->set_focus_child ($entry);
#$entry->has_focus(TRUE);
$entry->signal_connect (key_press_event => \&key_handler);
#################################################################
#box for list
my $hbox1 = Gtk2::HBox->new();
$hbox1->set( "border_width" => 1 );
#box for textview
my $hbox2 = Gtk2::HBox->new();
$hbox2->set( "border_width" => 1 );
#$hbox2->set_size_request(200,500);
my $f1_label = Gtk2::Label->new('Search Results');
$f1_label->modify_fg('normal',$red);
$f1_label->modify_font($font);
my $frame1 = Gtk2::Frame->new();
$frame1->set_label_widget($f1_label);
$vbox->pack_start( $frame1, 1, 1, 1 ); # expand?, fill?, padding
$frame1->set_border_width(1);
$frame1->add($hbox1);
$frame1->modify_bg('normal', $red);
my $f2_label = Gtk2::Label->new('File');
$f2_label->modify_fg('normal',$blue);
$f2_label->modify_font($font);
my $frame2 = Gtk2::Frame->new();
$frame2->set_label_widget($f2_label);
$vbox->pack_start( $frame2, 1, 1, 1 ); # expand?, fill?, padding
$frame2->set_border_width(1);
$frame2->add($hbox2);
$frame2->modify_bg('normal', $blue);
# Create a textbuffer to contain the resultant files
my $textbuffer0 = Gtk2::TextBuffer->new();
create_tags($textbuffer0);
$textbuffer0->set_text('');
$textbuffer0->apply_tag_by_name ('bold',$textbuffer0->get_start_iter,$
+textbuffer0->get_end_iter);
# Create a textview using that textbuffer
my $textview0 = Gtk2::TextView->new_with_buffer($textbuffer0);
$textview0->set_left_margin (5);
$textview0->signal_connect (event_after => \&event_after);
$textview0->signal_connect (motion_notify_event => \&motion_notify_eve
+nt);
my $swl = Gtk2::ScrolledWindow -> new();
$swl -> add_with_viewport($textview0);
$hbox1->add($swl);
######################################################
# Create a textbuffer to contain the opened files
my $textbuffer = Gtk2::TextBuffer->new();
create_tags($textbuffer);
$textbuffer->set_text('');
$textbuffer->apply_tag_by_name ('bold',$textbuffer->get_start_iter,$te
+xtbuffer->get_end_iter);
# Create a textview using that textbuffer
my $textview = Gtk2::TextView->new_with_buffer($textbuffer);
$textview->set_left_margin (5);
# Add the textview to a scrolledwindow
my $scrolledwindow = Gtk2::ScrolledWindow->new( undef, undef );
$scrolledwindow->add($textview);
# add that scrolledwindow to the vbox
$hbox2->add($scrolledwindow);
$window->show_all;
#setup a control-c exit----------
my @accels = (
{ key => 'C', mod => 'control-mask', func => sub{ Gtk2->main_quit
+} },
);
my $accel_group = Gtk2::AccelGroup->new;
use Gtk2::Gdk::Keysyms;
foreach my $a (@accels) {
$accel_group->connect ($Gtk2::Gdk::Keysyms{$a->{key}}, $a->{mod},
'visible', $a->{func});
}
$window->add_accel_group ($accel_group);
##############-------------------
if( $quick_start == 0){
Glib::Timeout->add (10, sub { do_dir_search(); 0 });
}
Gtk2->main;
######################################################################
+#######
sub do_file_search{
my $file = shift;
if( ! defined $file ){return}
my @lines = ();
foreach my $aref( @{$files{$file}} ){
push @lines, $$aref[0];
}
$textbuffer->set_text('');
open (FH,"< $file");
while(<FH>){
my $line = $.;
if($linenums){
my $lineI = sprintf "%03d", $line;
$textbuffer->insert_with_tags_by_name ($textbuffer->get_end_ite
+r, $lineI, 'rmap');
$textbuffer->insert ($textbuffer->get_end_iter, ' ');
}
if( grep {/^$line$/} @lines ){
$textbuffer->insert_with_tags_by_name ($textbuffer->get_end
+_iter, $_, 'rmapZ');
}else{
$textbuffer->insert_with_tags_by_name ($textbuffer->get_end_
+iter, $_, 'bold');
}
}
close FH;
#set up where to scroll to when opening file
my $first;
$lines[0] ||= 0;
if ( $lines[0] > 0 ){ $first = $lines[0] }else{$first = 1}
my $start_iter = $textbuffer->get_iter_at_line($first);
my $start_mark = $textbuffer->create_mark('start', $start_iter, 1);
$textview->scroll_to_mark($start_mark ,0.0, 0, 0, 0.0);
#set frame label to file name
$f2_label->set_text($file);
$current = $file;
}
################################################################
sub do_dir_search{
#prevent accidental double enter's or double find button presses
$seeking = 1;
$cancel = 0;
#clear old screens
$textbuffer->delete($textbuffer->get_start_iter,$textbuffer->get_end_i
+ter,);
$textbuffer0->delete($textbuffer0->get_start_iter,$textbuffer0->get_en
+d_iter,);
#clear old results
%files = ();
$f1_label->set_text('Search Results');
$f2_label->set_text('File');
# defaults are case-insensitive, no recurse, open and search files (no
+t filename)
my $path = '.';
$search_str = $entry->get_text();
if( ! length $search_str){$seeking = 0; $cancel = 0; return}
my $regex; #defaults to case insensitive
if ($case){$regex = qr/\Q$search_str\E/}
else{$regex = qr/\Q$search_str\E/i}
# use s modifier for multiline match
my $count = 0;
my $count1 = 0;
find (sub {
if( $cancel ){ return $File::Find::prune = 1}
$count1++;
if( ! $recurse ){
my $n = ($File::Find::name) =~ tr!/!!; #count slashes in file
return $File::Find::prune = 1 if ($n > 1);
}
return if -d;
# bugfix: the following return should be further below
# if here, it won't find names of binaries, like pdf's
# return unless (-f and -T );
# make it unicode aware for filenames
my $file = decode('utf8',$_);
$File::Find::name = $file;
if($name){
# $file will match, $_ will not
if ($file =~ /$regex/){
push @{$files{$File::Find::name}}, [-1,'']; #push into H
+oA
# print "$file $regex match\n";
}
}else{
# don't open and search binaries
return unless (-f and -T );
open (FH,"< $_");
while(<FH>){
if ($_ =~ /$regex/){
chomp $_;
push @{$files{$File::Find::name}}, [$., $_]; #push
+into HoA
}
}
close FH;
}
#------
my $key = $File::Find::name;
# print "key $key\n";
if( defined $files{$key} ){
$count++;
my $aref = $files{$key};
my @larray = @$aref;
insert_link ($textbuffer0, $key );
foreach my $aref(@larray){
if( $$aref[0] > 0 ){ #don't do for name searches, which are -
+1
#add line number with color
my $lineI = sprintf"%03d", $$aref[0];
$textbuffer0->insert_with_tags_by_name(
$textbuffer0->get_end_iter,"\n$lineI",'rmap');
#add matching line
$textbuffer0->insert_with_tags_by_name(
$textbuffer0->get_end_iter,"$$aref[1]",'bold');
}
}
$textbuffer0->insert($textbuffer0->get_end_iter,"\n");
}
$f1_label->set_text("$count1 checked -- $count matches .. Space
+Bar cancels");
Gtk2->main_iteration while Gtk2->events_pending;
#-----
}, $path);
$f1_label->set_text("$count matches DONE");
$seeking = 0;
$cancel = 0;
Gtk2->main_iteration while Gtk2->events_pending;
}
######################################################################
+########
sub insert_link {
my ($buffer, $file ) = @_;
#create tag here independently, so we can piggyback unique data
my $tag = $buffer->create_tag (undef,
foreground => "blue",
underline => 'single',
size => 20 * PANGO_SCALE
);
# piggyback data onto each tag
$tag->{file} = $file;
$buffer->insert_with_tags ($textbuffer0->get_end_iter, $file, $tag);
#print "$file file\n";
}
######################################################################
+#####
# Looks at all tags covering the position of iter in the text view,
# and if one of them is a link, follow it by showing the page identifi
+ed
# by the data attached to it.
#
sub follow_if_link {
my ($text_view, $iter) = @_;
my $tag = $iter->get_tags;
my $file = $tag->{file};
if($file){
do_file_search($file);
}
}
######################################################################
+#3
# Links can also be activated by clicking.
#
sub event_after {
my ($text_view, $event) = @_;
return FALSE unless $event->type eq 'button-release';
return FALSE unless $event->button == 1;
my $buffer = $text_view->get_buffer;
# we shouldn't follow a link if the user has selected something
my ($start, $end) = $buffer->get_selection_bounds;
return FALSE if defined $end
and $start->get_offset != $end->get_offset;
my ($x, $y) = $text_view->window_to_buffer_coords ('widget', #GTK_TE
+XT_WINDOW_WIDGET,
$event->x, $event
+->y);
my $iter = $text_view->get_iter_at_location ($x, $y);
follow_if_link ($text_view, $iter);
return FALSE;
}
#####################################################################
# Looks at all tags covering the position (x, y) in the text view,
# and if one of them is a link, change the cursor to the "hands" curso
+r
# typically used by web browsers.
#
sub set_cursor_if_appropriate {
my ($text_view, $x, $y) = @_;
my $hovering = FALSE;
my $buffer = $text_view->get_buffer;
my $iter = $text_view->get_iter_at_location ($x, $y);
foreach my $tag ($iter->get_tags) {
if ($tag->{file}) {
$hovering = TRUE;
last;
}
}
if ($hovering != $hovering_over_link)
{
$hovering_over_link = $hovering;
$text_view->get_window ('text')->set_cursor
($hovering_over_link ? $hand_cursor : $regular_cursor);
}
}
######################################################################
+#
# Update the cursor image if the pointer moved.
#
sub motion_notify_event {
my ($text_view, $event) = @_;
my ($x, $y) = $text_view->window_to_buffer_coords (
'widget', #GTK_TEXT_WINDOW_WI
+DGET,
$event->x, $event->y);
set_cursor_if_appropriate ($text_view, $x, $y);
$text_view->window->get_pointer;
return FALSE;
}
######################################################################
+###
sub check_button_callback {
my ($button,$ident,$name) = @_;
if ($button->get_active) {
# if control reaches here, the check button is down
$$ident = 1;
} else {
# if control reaches here, the check button is up
$$ident = 0;
}
#reload current file with(or without) linenums
#useful when copying for pasting to other apps
if( $name eq 'linenums' ){ do_file_search($current) }
}
######################################################################
+############
sub create_tags{
my $buffer = shift;
$buffer->create_tag( "italic", style => 'italic' );
$buffer->create_tag( "bold", weight => PANGO_WEIGHT_BOLD );
$buffer->create_tag( "big", size => 20 * PANGO_SCALE );
# points times the PANGO_SCALE factor
$buffer->create_tag( "x-large", scale => PANGO_SCALE_X_LARGE );
my $gray25_bits = pack 'CC', 0x02, 0x01, 0x01;
my $stipple = Gtk2::Gdk::Bitmap->create_from_data( undef, $gray25_b
+its, 3, 3);
$buffer->create_tag( "background_stipple", background_stipple => $s
+tipple );
$buffer->create_tag('rmap',
background => 'red',
background_stipple => $stipple ,
weight => PANGO_WEIGHT_BOLD,
);
$buffer->create_tag('rmapX',
background => 'red',
background_stipple => $stipple ,
scale => PANGO_SCALE_X_LARGE,
);
$buffer->create_tag('rmapZ',
foreground => 'red',
weight => PANGO_WEIGHT_BOLD,
size => 15 * PANGO_SCALE
);
$buffer->create_tag('blue',
background => 'blue',
);
}
######################################################################
sub key_handler {
my ($widget, $event) = @_;
# match the keyval --- in general you don't want to use magic
# numbers here, use values from %Gtk2::Gdk::Keysyms instead.
if (($seeking) && ($event->keyval == 32)) { #detect spacebar hit
+to cancel search
$cancel = 1;
$seeking = 0;
return TRUE; # tell the system we handled this
}
if ($event->keyval == 65293) { #detect Enter press
do_dir_search() unless $seeking;
return TRUE; # tell the system we handled this
}
return FALSE; # tell the system we did not handle this
}
######################################################################
sub print_usage{
$textbuffer->delete($textbuffer->get_start_iter,$textbuffer->get_end
+_iter,);
$textbuffer->set_text($help);
}
######################################################################
__DATA__
# USAGE:
# -- takes a single string ( or 1 quoted multiword string) on the comm
+and line to search for
# -- you can give options n r c, separately on the commandline, in any
+ order
# -- n ->search filenames only for the string, not the file contents
# -- r ->recurse into sub directories
# -- c ->case sensitive
# Will open with no options or search string, in empty mode.
# Found files, will be displayed as blue underlined hyperlinks.
# Under each link, will be the line numbers and matched lines.
# Clicking blue links will open the file, and all matched lines will
# be displayed in red text.
# Control-c from anywhere will kill the program.
# SpaceBar cancels a long search
# Multi-word search strings on the command line should be
# single quoted.
# Search strings entered in the entry box, do not need quotes
# and will be submitted by an enter keypress, or the find button.
# The line numbering can be turned off for copying and pasting from
# the opened files. A right click in the lower textbox, will open
# the textbox menu for Copying to the Clipboard for pasting with
# the paste options from other apps (Control-v). Otherwise, the selec
+ted
# text is only in the mouse clipboard buffer.
__END__
|
|
Back to
Code Catacombs