Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/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__

In reply to 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":



  • 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?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (7)
As of 2024-03-29 09:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found