#! perl -w
#
# tkfif - A Tk front-ended find-in-files for win32.
#
# This app has been designed and written as an exercise for the author.
#
# Features: -
# * grid layout with stretchy entry widgets
# * good looking Menu widget fonts on Win32
# * The most recently used values from the entry widgets are stored 
#    in the registry and can be recalled -- a more attractive combobox
#    has been costructed with a Menubutton.
#
use strict;
use warnings;
#use diagnostics;
# Some hot handles...
select((select(STDOUT), $| = 1)[0]);
select((select(STDERR), $| = 1)[0]);
use Getopt::Long;
use Cwd;
use Tk;
use Tk::Menubutton;
use Tk::Checkbutton;
## use Tk::Text::SuperText;
use Tk::TextUndo;
use Tk::Radiobutton;
use Win32::FileOp;
use MRUList;
use fif;
use Data::Dumper;

my $title = "Tk Find in Files - MSEmtd";
my $version = "v2.1 - 20/06/01";

my ($patsMRU, $dirsMRU, $fpatsMRU);
my (@pats, @dirs, @fpats);
CreateMRULists();
my ($pat, $dir, $fpat, $ins, $exit, $count, $tree);
my $msgwin; # <-- current output window
ReadArgs();
$pat = $pat || $pats[0] || "something";
$dir = $dir || $dirs[0] || cwd();
$fpat = $fpat || $fpats[0] || ".+";
$tree = $tree || 0;
$ins = $ins || 0;
# todo check valid dirs and patterns
################################################
## Build the GUI
my $mw = new MainWindow(-title => $title);
$mw->protocol('WM_DELETE_WINDOW' => \&ExitApp);
my %images;
MakeImages();
my $findxpm = $mw->Pixmap( -data =>  $images{'find'} );
$mw->Icon(-image => $findxpm);
my $btnbm = $mw->Pixmap( -data =>  $images{'arrow'} );
my $folderxpm = $mw->Pixmap( -data =>  $images{'folder'} );

my $frtop = $mw->Frame(
#-background => 'yellow', 
)->pack(-side => 'top', -expand => 1, -fill => 'x');

## The grid of controls...
my $g = $frtop->Frame(-relief => 'groove', -borderwidth => 2)->pack(-side => 'left', -expand => 1, -fill => 'both');
## Frame of action buttons...
my $frbtns = $frtop->Frame()->pack(-side => 'left', -padx => 5, -pady => 5);
$frbtns->Button( -text => "Search", -command => \&Search )->pack(-padx => 5, -pady => 5);
$frbtns->Button( -text => "Exit", -command => \&ExitApp)->pack(-padx => 5, -pady => 5);

## Populate grid...
my ($r, $c) = (0,0);
my ($mb, $menu);
$g->Label(-text => 'Search for:')
->grid(-row => $r, -column => $c++, -sticky => 'w');
$g->Entry(-textvariable => \$pat, -width => 32)
->grid(-row => $r, -column => $c++, -sticky => 'ew');
my $mb_pat = $g->Menubutton(-image => $btnbm, -direction => 'right', -tearoff => 0)
->grid(-row => $r, -column => $c++, -sticky => 'w');
RemakeMenu( $mb_pat, \@pats, \$pat );

$c++; # <-- empty cell
$g->Checkbutton(-text => 'Case-insensitive?', -variable => \$ins)
->grid(-row => $r, -column => $c++, -sticky => 'w');

$r++; $c=0;
$g->Label(-text => 'Directory:')
->grid(-row => $r, -column => $c++, -sticky => 'w');
$g->Entry(-textvariable => \$dir)
->grid(-row => $r, -column => $c++, -sticky => 'ew');

my $mb_dir = $g->Menubutton(-image => $btnbm, -direction => 'right', -tearoff => 0)
->grid(-row => $r, -column => $c++, -sticky => 'w');
RemakeMenu( $mb_dir, \@dirs, \$dir );

$g->Button(-relief => 'flat', -image => $folderxpm, -command => \&PickDir)
->grid(-row => $r, -column => $c++, -sticky => 'w');
$g->Checkbutton(-text => 'Search subdirs?', -variable => \$tree)
->grid(-row => $r, -column => $c++, -sticky => 'w');

$r++; $c=0;
$g->Label(-text => 'Filespec:')
->grid(-row => $r, -column => $c++, -sticky => 'w');
$g->Entry(-textvariable => \$fpat)
->grid(-row => $r, -column => $c++, -sticky => 'ew');
my $mb_fpat = $g->Menubutton(-image => $btnbm, -direction => 'right', -tearoff => 0)
->grid(-row => $r, -column => $c++, -sticky => 'w');
RemakeMenu( $mb_fpat, \@fpats, \$fpat );

## The entry column is resizeable...
$g->gridColumnconfigure(1, -weight=>1);

## OK, run...
MainLoop();

###########################################################
sub ExitApp {
   ## print "\n\nSomebody asked me to exit...\n";
   SaveMRULists();
   ## print "OK, byeeeeeee!\n\n"; #<-- camp exit!
   exit;
}
sub Search {
   ## Now add values to recent menus unless already there...
   @pats = $patsMRU->add($pat);
   @dirs = $dirsMRU->add($dir);
   @fpats = $fpatsMRU->add($fpat);
   RemakeMenu( $mb_pat, \@pats, \$pat );
   RemakeMenu( $mb_dir, \@dirs, \$dir );
   RemakeMenu( $mb_fpat, \@fpats, \$fpat );
   if( not $exit ) {
      ## Create a new output window...
      my $mw = new MainWindow(-title => "results");
      my $resultsxpm = $mw->Pixmap( -data =>  $images{'results'} );
      $mw->Icon(-image => $resultsxpm);
      $mw->focusmodel('active');
      # Choose a fixed-width font for the listbox...
      $mw->fontCreate('listboxfont', -family => 'courier', -size => '8');
      $msgwin = $mw->Scrolled('Listbox', -scrollbars => 'se',
         -font => 'listboxfont',
         -width => '80', -height => '30',
         -exportselection => 0,
       )->pack(-expand => 'yes', -fill => 'both');
      $msgwin->bind('<Double-1>', sub{ OpenFile($msgwin->get('active')); });
      $msgwin->focus();
      $mw->raise;
      $mw->focus;
   }

   ## do search...
   fif::FindInFiles( -pat => $pat, -dir => $dir, -fpat => $fpat, 
                        -ins => $ins, -tree => $tree, 
                        -opref => \&MsgOut );
   ## Exit after first search if command line is set...
   ExitApp() if $exit;
}
## CreateMRULists : Set up the MRU lists from the registry
sub CreateMRULists {
   my %mruargs = (
   -groupname => "MSEmtd", 
   -appname => "tkfif",
   -maxrecent => 8,
   );
   $patsMRU = new MRUList( -recentname => "recent_pats", %mruargs );
   $dirsMRU = new MRUList( -recentname => "recent_dirs", %mruargs );
   $fpatsMRU = new MRUList( -recentname => "recent_fpats", %mruargs );
   @pats = $patsMRU->load;
   @dirs = $dirsMRU->load;
   @fpats = $fpatsMRU->load;
}
## SaveMRULists : Save the MRU Lists to the registry.
sub SaveMRULists {
   @pats = $patsMRU->save;
   @dirs = $dirsMRU->save;
   @fpats = $fpatsMRU->save;
}
###################
## RemakeMenu : set up a MRU list menubutton.
## arg 1 is the menubutton
## arg 2 is the array of things (ref)
## arg 3 is the text variable (ref)
sub RemakeMenu {
   my ($mb, $aref, $textvarref) = @_;
   my $menu = $mb->menu();
   ## Fix up the font...
   $menu->configure( -font => $mb->cget('-font') );
   ## Clear the menu...
   $menu->delete( 0, 'end' );
   ## Make entries in the menu and closures to set the value of the 
   ## text variable...
   foreach my $thing (@$aref) {
      $mb->command( -label => $thing, 
                           -command => sub{ $$textvarref = $thing } );
   }
}
###################
## OpenFile
## Open a file that was double-clicked in an output window
## expects a single arg in the pattern of fif::FindInFiles output
sub OpenFile {
   local $_ = shift or return;
   return unless /^([^\(]+)\((\d+)\):'(.*)'$/;
   my( $file, $line, $text ) = ($1, $2, $3);
   #print STDOUT "\$file = '$file'\n";
   #print STDOUT "\$line = '$line'\n";
   #print STDOUT "\$text = '$text'\n";
   if( ! open(FILE, "< $file") ) {
      MsgOut("WARNING: can't open '$file': $!");
      return;
   }
   ## Create a new output window...
   my $mw = new MainWindow(-title => $file);
   my $textxpm = $mw->Pixmap( -data =>  $images{'text'} );
   $mw->Icon(-image => $textxpm);

   $mw->focusmodel('active');
   # Choose a fixed-width font...
   $mw->fontCreate('listboxfont', -family => 'courier', -size => '8');
   $text = $mw->Scrolled('TextUndo', -scrollbars => 'se',
      -font => 'listboxfont',
      -width => '80', -height => '40'
    )->pack(-expand => 'yes', -fill => 'both');
   ## actually get hold of the scrolled widget...
   ## $text = $text->Subwidget('scrolled');
   while (<FILE>) {
      $text->insert( 'end', $_ );
   }
   close FILE;
#   $text->Load($file);
   $text->see("1.0");
   $mw->update();
   $mw->raise;
   $mw->focus;
   $text->see("$line.0");
   $text->markSet('insert', "$line.0");
   $text->tagConfigure('hilite', 
      -background => 'yellow', 
      -foreground => 'blue');
   $text->tagAdd('hilite', "insert linestart", "insert lineend");
   ##$text->selectionSet($line);
   $text->focus;
=for later   
   my $srchcount = 0;
   my @srchargs = ('-forward', '-count', '$srchcount', '--', $pat, 'insert');
   unshift @srchargs, ('-nocase') if ( $ins );
   my $srchindex = $text->search(@srchargs);
   if( $srchindex ) {
      $text->see($srchindex);
      $text->markSet('insert', $srchindex);
      $text->tagAdd('sel', "$srchindex + $srchcount chars");
   }
=cut
   #print Dumper($text);
}
###################
## is_valid_pattern
## Check the given pattern for validity.
## (from the Perl Cookbook)
sub is_valid_pattern {
    my $pat = shift;
    return eval { "" =~ /$pat/; 1 } || 0;
}
###################
## PickDir : pick a directory upon which to operate.
## Win32 style
sub PickDir {
   my $res = BrowseForFolder("Choose a directory for the root of the search",
                                          CSIDL_DRIVES, BIF_RETURNONLYFSDIRS );
   return unless $res;
   $dir = $res;
}
sub MsgOut {
   my $msg = "@_";
   if(! $msgwin) {
      print STDOUT $msg."\n";
      return;
   } else {
      $msgwin->insert('end', $msg);
      $msgwin->see('end');
      $msgwin->update();
   }
}
###################
## Usage
## Print out the program usage and die.
sub Usage
{
   my $usage = "$title $version\n";
   $usage .= "by Michael Erskine (michael.erskine\@tecspy.com)\n";
   $usage .= <<'EOF';
usage:
tkfif [-i] [-r] [-p=<pattern>] [-d=<directory>] [-f=<filename_pattern>]

e.g.: -
findinfiles -d="c:\projects" -f="\.(cpp|c|h|rc|dct)$" -p="\bchar\b\s+\w+\s*\[\d+\]"
(searches for character array declarations in some C/C++ source files)

args...
-p=<pattern> -- a regular expression (regex) to search for
-f=<filename_pattern> -- a regex for the matching of a filename
   e.g. "\.(c|h|cpp|hpp|rc|dct)$" which will be applied 
   insensitively(!).
-d=<directory> -- directory (must be absolute).
-exit -- when passed, the application will do a single search, print 
   the results to STDOUT and exit.
-i -- case insensitive matching
-r -- recursive subdir searching
-h|-help|-? -- print this!

EOF

   die($usage);
}
###################
## ReadArgs
## Process, validate and setup command line args.
sub ReadArgs
{
   my( $cl_fpat, $cl_dir, $cl_pat, $cl_ins, $cl_help, $cl_tree, $cl_exit );
   my $retval = GetOptions(
      "help|?|h" => \$cl_help,
      "p:s" => \$cl_pat,
      "i" => \$cl_ins,
      "r" => \$cl_tree,
      "f:s" => \$cl_fpat,
      "d:s" => \$cl_dir,
      "exit" => \$cl_exit
   );
   if( ! $retval ) {
      print STDERR "ERROR: did you supply all the required options?\n";
      Usage();
   }
   if( $cl_ins ) {
      $ins = 1;
   }
   if( $cl_tree ) {
      $tree = 1;
   }
   if( $cl_exit ) {
      $exit = 1;
   }
   if( $cl_fpat ) {
       die "ERROR: filename pattern arg '$cl_fpat' is not a valid regex.\n"
         unless is_valid_pattern( $cl_fpat );
      $fpat = $cl_fpat;
   }
   if( $cl_dir ) {
       die "ERROR: directory arg '$cl_dir' is not a valid directory.\n"
         unless -d $cl_dir;
      $dir = $cl_dir;
   }
   if( $cl_pat ) {
      die "ERROR: search pattern arg '$cl_pat' is not a valid regex.\n"
         unless is_valid_pattern( $cl_pat );
      $pat = $cl_pat;
   }
   if( $cl_help ) {
      Usage();
   }
}
################################
sub MakeImages
{
   $images{ 'folder' } = <<'EOXPM';
/* XPM */
static char *folder[] = {
/* width height num_colors chars_per_pixel */
"    19    17        8            1",
/* colors */
"` c #000000",
". c #9d9d00",
"# c #cece61",
"a c none",
"b c #ffce9d",
"c c #ffff9d",
"d c #ffffce",
"e c #f6f6f6",
/* pixels */
"aaaaaaaaaaaaaaaaaaa",
"aaaaaaaaaaaaaaaaaaa",
"aaaa.....`aaaaaaaaa",
"aaa.eddcc.`aaaaaaaa",
"aa.#######......aaa",
"aa.dddddddddddc#`aa",
"aa.dccccccccccb#`aa",
"aa.dcccccccbcbc#`aa",
"aa.dccccccccbcb#`aa",
"aa.dcccccbcbcbc#`aa",
"aa.dccccccbcbcb#`aa",
"aa.dcccbcbcbcbb#`aa",
"aa.dbcbcbcbcbbb#`aa",
"aa.#############`aa",
"aaa``````````````aa",
"aaaaaaaaaaaaaaaaaaa",
"aaaaaaaaaaaaaaaaaaa"
};
EOXPM
   $images{ 'arrow' } = <<'EOXPM';
/* XPM */
static char *arrow[] = {
/* width height num_colors chars_per_pixel */
"     9    16       16            1",
/* colors */
"` c #000000",
". c #007bbd",
"# c #21adff",
"a c #4abdff",
"b c #636363",
"c c #6bc6ff",
"d c #84ffff",
"e c #8cd6ff",
"f c #b5b5b5",
"g c #ffffff",
"h c #ffffff",
"i c #ffffff",
"j c #ffffff",
"k c #ffffff",
"l c #ffffff",
"m c none",
/* pixels */
"mffmmmmmm",
"fbbfmmmmm",
"b``bfmmmm",
"b`e`bfmmm",
"b`ce`bfmm",
"b`ace`bfm",
"b`aace`bf",
"b`aaace`b",
"b`aaa#.`b",
"b`#a#.`bf",
"b`##.`bfm",
"b`#.`bfmm",
"b`.`bfmmm",
"b``bfmmmm",
"fbbfmmmmm",
"mffmmmmmm"
};
EOXPM
   $images{ 'text' } = <<'EOXPM';
/* XPM */
static char *text[] = {
/* width height num_colors chars_per_pixel */
"    32    32        2            1",
/* colors */
"# c #bfbf00",
". c #ffffff",
/* pixels */
"################################",
"################################",
"################################",
"################################",
"####........................####",
"####........................####",
"####........................####",
"####........................####",
"####....################....####",
"####....################....####",
"####....################....####",
"####....################....####",
"####..........####..........####",
"####..........####..........####",
"####..........####..........####",
"####..........####..........####",
"####..........####..........####",
"####..........####..........####",
"####..........####..........####",
"####..........####..........####",
"####..........####..........####",
"####..........####..........####",
"####..........####..........####",
"####..........####..........####",
"####........................####",
"####........................####",
"####........................####",
"####........................####",
"################################",
"################################",
"################################",
"################################"
};
EOXPM
   $images{ 'results' } = <<'EOXPM';
/* XPM */
static char *results[] = {
/* width height num_colors chars_per_pixel */
"    32    32        2            1",
/* colors */
"# c #bfbf00",
". c #ffffff",
/* pixels */
"################################",
"################################",
"################################",
"################################",
"####........................####",
"####........................####",
"####........................####",
"####........................####",
"####....##############......####",
"####....##############......####",
"####....################....####",
"####....################....####",
"####....####........####....####",
"####....####........####....####",
"####....####......######....####",
"####....####......######....####",
"####....##############......####",
"####....##############......####",
"####....############........####",
"####....############........####",
"####....####....######......####",
"####....####....######......####",
"####....####......######....####",
"####....####......######....####",
"####........................####",
"####........................####",
"####........................####",
"####........................####",
"################################",
"################################",
"################################",
"################################"
};
EOXPM
   $images{ 'find' } = <<'EOXPM';
/* XPM */
static char *find[] = {
/* width height num_colors chars_per_pixel */
"    32    32       2             1",
/* colors */
"# c #bfbf00",
". c #ffffff",
/* pixels */
"################################",
"################################",
"################################",
"################################",
"####........................####",
"####........................####",
"####........................####",
"####........................####",
"####....################....####",
"####....################....####",
"####....################....####",
"####....################....####",
"####....####................####",
"####....####................####",
"####....####................####",
"####....####................####",
"####....############........####",
"####....############........####",
"####....############........####",
"####....############........####",
"####....####................####",
"####....####................####",
"####....####................####",
"####....####................####",
"####........................####",
"####........................####",
"####........................####",
"####........................####",
"################################",
"################################",
"################################",
"################################"
};
EOXPM

}
__END__
=head1 AUTHOR

Michael Erskine michael.erskine@tecspy.com

=head1 COPYRIGHT AND DISCLAIMER

This program is Copyright 2001 by Michael Erskine.
This program is free software; you can redistribute it and/or
modify it under the terms of the Perl Artistic License or the
GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any
later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

If you do not have a copy of the GNU General Public License write to
the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
MA 02139, USA.

=cut