Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
Indeed, a nice tool!

As I am planning to use it intensively...

Here is a more friendlier-polished version!

This version accepts a final argument of a directory to search. It displays it as the title of the windows. The windows, takes the focus at the begining.

Besides some insignificant details, it has an improved help message. And better colors.

This good code, has also helped me a lot to practice with Gtk2.

use warnings; use strict; use File::Find; use Gtk2 -init; use Glib qw(FALSE TRUE); use Gtk2::Pango; $|++; my $VERSION='1.01'; 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); my ($recurse, $name, $case,$linenums,$quick_start, $use_regex) =(0,0,0 +,0,0); ##< patch ## ACTIVATE FLAGS AND ERASE THEM 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{/\bR\b/} @ARGV ){@ARGV = grep { $_ ne 'R' } @ARGV; $use_regex + = 1 }; ##<patch if( grep{/\bc\b/} @ARGV ){@ARGV = grep { $_ ne 'c' } @ARGV; $case = 1 +}; $linenums = 1; #opened file line numbering is on by default my $search_str = $ARGV[0] or $quick_start = 1; $search_str ||= undef; my $startdir= $ARGV[1]; ## OPTIONAL DIR FOR SEARCH... chdir($startdir) if (defined($startdir) and -d $startdir); #only accept 1 search string, so quote phrases on commandline #print "$name $recurse $case @ARGV\n"; my $font = Gtk2::Pango::FontDescription->from_string("Sans Bold 18 +"); my $fontMono = Gtk2::Pango::FontDescription->from_string("Andale Mono +Bold 10");##< my fault 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 $navy = Gtk2::Gdk::Color->new (0,0,0x8888); ##< my fau +lt my $red = Gtk2::Gdk::Color->new (0x8888,0,0); ##< my fau +lt my $yell = Gtk2::Gdk::Color->new (0xFFFF,0xFFFF,0x8888); ##< my fau +lt 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->set_title("[$0] $startdir") if ($startdir); $window->signal_connect (key_press_event => \&key_handler); $window->activate_focus; #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 $vboxC3 = Gtk2::VBox->new(); ##<patch 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);} + ## patch my $checkbutton5 = Gtk2::CheckButton->new('Use RegEx');##<------------ +--+ $checkbutton5->signal_connect( clicked => + # sub{check_button_callback($checkbutton5 +, # \$use_regex , + # patch 'use_regex')} +); # $vboxC2->pack_start( $checkbutton5, 0, 0, 0 ); + # + # if($case){$checkbutton5->set_active(1);} ##<------------ +--+ my $checkbutton3 = Gtk2::CheckButton->new('Case Sensitive'); $checkbutton3->signal_connect( clicked => sub{check_button_callback($checkbutton3, \$case , 'case') +}); $vboxC3->pack_start( $checkbutton3, 0, 0, 0 ); + ##< patch 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')}); $hboxt->pack_start( $vboxC3, 0, 0, 0 ); + ##< patch $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); $textview->modify_font ($fontMono); ##< my fault $textview->modify_base('normal',$yell); ##< my fault $textview->modify_text('normal',$navy); ##< my fault # 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; 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} ##< before if ($case) ##<-------+ { # if ($use_regex) # { # $regex = qr/$search_str/; # } # else # { # $regex = qr/\Q$search_str\E/ # } # patch } # (regex) else # { # if ($use_regex) # { # $regex = qr/$search_str/i; # } # 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; return unless (-f and -T ); if($name){ if ($_ =~ /$regex/){ push @{$files{$File::Find::name}}, [-1,'']; #push into HoA } } else { open (FH,"< $_"); while(<FH>) { if ($_ =~ /$regex/) { chomp $_; push @{$files{$File::Find::name}}, [$., $_]; #push +into HoA } } close FH; } #------ my $key = $File::Find::name; 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); + } ###################################################################### +##### # 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__ ___________ | U S A G E | perl $0 (options) 'search string' dir/ |___________|================================================== / Takes a quoted string on the command line to search for \ | You can give options: n r R c , separately on the commandline...| | | | -- n ->search fileNames only | | -- r ->recurse into sub directories | | -- R ->search using Regular expressions | | -- c ->case sensitive | | | | Will open with no options or search string, in empty mode. | | Dir is optional and the place to search. | | 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 selected | | text is only in the mouse clipboard buffer. | \_________________________________________________________________/ [http://perlmonks.org/?node_id=131741 | ZENTARA]< zentara@zentara.net +>
Zentara rules drools ;)!


In reply to Re: Gtk2 Visual Grep by chanio
in thread Gtk2 Visual Grep by zentara

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



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others examining the Monastery: (10)
    As of 2014-07-28 10:30 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite superfluous repetitious redundant duplicative phrase is:









      Results (195 votes), past polls