<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">eval '(exit $?0)' &amp;&amp; eval 'exec perl -S $0 ${1+"$@"}' &amp;&amp; eval 'exec perl -S $0 $argv:q'
        if 0;

#D \module
#D   [       file=texfind.pl,
#D        version=1998.05.10,
#D          title=\TEXFIND, 
#D       subtitle=searching files, 
#D         author=Hans Hagen,
#D           date=\currentdate,
#D      copyright={PRAGMA / Hans Hagen \&amp; Ton Otten}]
#C
#C This module is part of the \CONTEXT\ macro||package and is
#C therefore copyrighted by \PRAGMA. See licen-en.pdf for 
#C details. 

# test with "doif(un|)defined"

use strict ; 
use Getopt::Long ;
use File::Find ;
use Cwd ;
use Tk ; 
use Tk::widgets  ; 
use Tk::ROText ;

use FindBin ;
use lib $FindBin::Bin ;
use path_tre ; 

my $FileSuffix    = 'tex' ; 
my $SearchString  = '' ; 
my $Recurse       = 0 ; 
my $NumberOfHits  = 0 ;
my $QuitSearch    = 0 ; 
my $Location      = '' ;
my $currentpath   = '.' ;

my @FileList ; 

my ($dw, $mw, $log, $sea, $fil, $num, $but, $dir, $loc) ; 

$mw = MainWindow -&gt; new () ; 
$dw = MainWindow -&gt; new () ; 

$mw -&gt; protocol( 'WM_DELETE_WINDOW' =&gt; sub { exit } ) ;
$dw -&gt; protocol( 'WM_DELETE_WINDOW' =&gt; sub { exit } ) ;

$log = $mw -&gt; Scrolled  ( 'ROText' ,
                          -scrollbars =&gt; 'se'           ,
                                -font =&gt; 'courier'      ,
                                -wrap =&gt; 'none'         , 
                               -width =&gt; 65             ,
                              -height =&gt; 22             )
           -&gt; pack      (       -side =&gt; 'bottom'       ,
                                -padx =&gt; 2              , 
                                -pady =&gt; 2              ,
                              -expand =&gt; 1              ,
                                -fill =&gt; 'both'         ) ;

$sea = $mw -&gt; Entry  (  -textvariable =&gt; \$SearchString , 
                                -font =&gt; 'courier'      ,
                               -width =&gt; 20             )
           -&gt; pack   (          -side =&gt; 'left'         , 
                                -padx =&gt; 2              , 
                                -pady =&gt; 2              ) ;

$fil = $mw -&gt; Entry  (  -textvariable =&gt; \$FileSuffix   ,
                                -font =&gt; 'courier'      ,
                               -width =&gt; 5              ) 
           -&gt; pack   (          -side =&gt; 'left'         , 
                                -padx =&gt; 2              , 
                                -pady =&gt; 2              ) ;

$but = $mw -&gt; Checkbutton ( -variable =&gt; \$Recurse      ,
                                -text =&gt; 'recurse'      )  
           -&gt; pack   (          -side =&gt; 'left'         ) ; 

$num = $mw -&gt; Entry  (  -textvariable =&gt; \$NumberOfHits , 
                                -font =&gt; 'courier'      ,
                             -justify =&gt; 'right'        ,
                               -width =&gt; 5              )
           -&gt; pack   (          -side =&gt; 'right'        , 
                                -padx =&gt; 2              , 
                                -pady =&gt; 2              ) ;

$loc = $mw -&gt; Entry  (  -textvariable =&gt; \$Location     , 
                                -font =&gt; 'courier'      ,
                               -width =&gt; 8              )
           -&gt; pack   (          -side =&gt; 'right'        , 
                                -padx =&gt; 2              , 
                                -pady =&gt; 2              ) ;

sub BuildDir 
  {  if (Exists($dir)) { $dir -&gt; destroy } ;
     $dir = $dw -&gt; Scrolled ( 'PathTree' ,
                               -scrollbars =&gt; 'se'         ) 
                -&gt; pack     (      -expand =&gt; 1            , 
                                     -fill =&gt; 'both'       ,
                                     -padx =&gt; 2            , 
                                     -pady =&gt; 2            ) ;
     $dir -&gt; configure      (        -font =&gt; 'courier'    ,
                                   -height =&gt; 24           , 
                                    -width =&gt; 65           , 
                         -selectbackground =&gt; 'blue3'      ,
                                -browsecmd =&gt; \&amp;ChangePath ) ;
     $dir -&gt; bind ('&lt;Return&gt;'   , \&amp;ShowFile  ) ; 
     $dir -&gt; bind ('&lt;Double-1&gt;' , \&amp;ShowFile  ) }

BuildDir ;

sub ShowFile { $mw -&gt; raise ; $sea -&gt; focusForce } 
sub ShowPath { $dw -&gt; raise ; $dir -&gt; focusForce } 

$log -&gt; tagConfigure ( 'found', -foreground =&gt; 'green3' ) ;
$log -&gt; tagConfigure ( 'title', -foreground =&gt; 'blue3' ) ;

$sea -&gt; bind ('&lt;Return&gt;'   , \&amp;LocateStrings  ) ;
$fil -&gt; bind ('&lt;Return&gt;'   , \&amp;LocateStrings  ) ;
$loc -&gt; bind ('&lt;Return&gt;'   , \&amp;ChangeLocation ) ; 
$log -&gt; bind ('&lt;Return&gt;'   , \&amp;ShowPath       ) ; 

$sea -&gt; bind ('&lt;KeyPress&gt;' , \&amp;QuitSearch     ) ;
$fil -&gt; bind ('&lt;KeyPress&gt;' , \&amp;QuitSearch     ) ;
$loc -&gt; bind ('&lt;KeyPress&gt;' , \&amp;QuitSearch     ) ; 

$sea -&gt; bind ('&lt;Escape&gt;'   , \&amp;QuitSearch     ) ;
$fil -&gt; bind ('&lt;Escape&gt;'   , \&amp;QuitSearch     ) ;
$loc -&gt; bind ('&lt;Escape&gt;'   , \&amp;QuitSearch     ) ;
$log -&gt; bind ('&lt;Escape&gt;'   , \&amp;QuitSearch     ) ;

$sea -&gt; bind ('&lt;Double-1&gt;' , \&amp;LocateStrings  ) ; 
$fil -&gt; bind ('&lt;Double-1&gt;' , \&amp;LocateStrings  ) ; 
$loc -&gt; bind ('&lt;Double-1&gt;' , \&amp;ChangeLocation ) ; 
$log -&gt; bind ('&lt;Double-1&gt;' , \&amp;ShowPath       ) ; 

sub ChangePath 
  { my $currentpath = shift ; 
chdir($currentpath) ; 
    $QuitSearch = 1 ; 
    $log -&gt; delete ('1.0', 'end') ;
    $log -&gt; insert ('end', "$currentpath\n\n", 'title') }

sub ChangeLocation
  { $QuitSearch = 1 ;
    $log -&gt; delete ('1.0', 'end') ;
    $Location =~ s/^\s*//o ;
    $Location =~ s/\s*$//o ;    
    $Location =~ s/(\\|\/\/)/\//go ;    
    unless (-d $Location) 
      { unless ($Location =~ /\//) { $Location .= '/' } }
    if (-d $Location) 
      { $log -&gt; insert ('end', "changed to location '$Location'\n\n", 'title') ;
        $currentpath = $Location ;
        chdir ($currentpath) ;
        $dir -&gt; destroy ; 
        BuildDir ;  
        $dw -&gt; raise ; 
        $dw -&gt; focusForce } 
    else
      { $log -&gt; insert ('end', "unknown location '$Location'\n\n", 'title') ;
        $Location = '' } }

sub QuitSearch 
  { $QuitSearch = 1 } 

sub SearchFile 
  { my ($FileName, $SearchString) = @_ ; 
    my $Ok = 0 ; my $len ; 
    open (TEX, $FileName) ; 
    my $LineNumber = 0 ; 
    while (&lt;TEX&gt;) 
      { ++$LineNumber ; 
        if ($QuitSearch) 
          { if ($Ok) { $log -&gt; see ('end') }
            last } 
        if (/$SearchString/i)
          { ++$NumberOfHits ; $num -&gt; update ; 
            unless ($Ok) 
              { $Ok = 1 ; 
                $log -&gt; insert ('end', "$FileName\n\n",'title') }
            $log -&gt; insert ('end', sprintf("%5i : ",$LineNumber), 'title') ;
            s/^\s*//o ;
#
            $len = 0 ; 
            while (/(.*?)($SearchString)/gi)
              { $len += length($1) + length($2) ;  
                $log -&gt; insert ('end', "$1") ; 
                $log -&gt; insert ('end', "$2", 'found' ) }
            $_ = substr($_,$len) ;  
            $log -&gt; insert ('end', "$_") ;
#
            $log -&gt; update ;
            $log -&gt; see ('end') } } 
    if ($Ok) { $log -&gt; insert ('end', "\n") }
    close (TEX) } 

sub DoLocateFiles 
  { @FileList = () ; 
    $NumberOfHits = 0 ; 
    if ($FileSuffix ne "") 
      { $log -&gt; delete ('1.0', 'end') ;
        if ($Recurse)
          { $log -&gt; insert ('end', "recursively identifying files\n", 'title') ;
            $log -&gt; see ('end') ;
            find (\&amp;wanted, $currentpath) ;
            sub wanted 
              { if ($QuitSearch) { last ; return } 
                if (/.*\.$FileSuffix/i) 
                  { ++$NumberOfHits ; $num -&gt; update ; 
                    push @FileList, $File::Find::name } } } 
        else  
          { $log -&gt; insert ('end', "identifying files\n", 'title') ;
            $log -&gt; see ('end') ;
            opendir(DIR, $currentpath) ; my @TEMPLIST = readdir(DIR) ; closedir(DIR) ;
            foreach my $FileName (@TEMPLIST) 
              { if ($FileName =~ /.*\.$FileSuffix/i) 
                  { ++$NumberOfHits ; $num -&gt; update ; 
                    if ($QuitSearch) 
                      { last } 
                    push @FileList, $FileName } } } 
        @FileList = sort @FileList } }

sub DoLocateStrings
  { $log -&gt; delete ('1.0', 'end') ; 
    $log -&gt; update ; 
    $log -&gt; see ('end') ; 
    $NumberOfHits = 0 ; 
    if ($SearchString ne "") 
      { foreach my $FileName (@FileList) 
          { if ($QuitSearch) 
              { $log -&gt; insert ('end', "search aborted\n", 'title') ;
                $log -&gt; see ('end') ; 
                last } 
            SearchFile($FileName,$SearchString) } } 
    unless ($QuitSearch) 
      { $log -&gt; insert ('end', "done\n", 'title') ;
        $log -&gt; see ('end') } }

sub LocateStrings
  { $QuitSearch = 0 ; 
    DoLocateFiles() ; 
    DoLocateStrings() } 

$log -&gt; insert ('end', 

  "data fields\n\n" , '' ,  


  "string   :", 'title', " regular expression to search for\n"   , '' ,
  "suffix   :", 'title', " type of file to search in\n"          , '' ,
  "recurse  :", 'title', " enable searching subpaths\n"          , '' ,
  "location :", 'title', " drive of root path\n"                 , '' ,
  "counter  :", 'title', " file/hit counter\n\n"                 , '' ,

  "key bindings\n\n" , '' ,  

  "double 1 :", 'title', " directory window &lt;-&gt; search window\n" , '' ,
  "enter    :", 'title', " start searching\n"                    , '' ,
  "escape   :", 'title', " quit searching\n\n"                   , '' ,
  
  "current path\n\n" , '' , 
 
  cwd(), 'title', "\n\n" , 'title' ) ; 

$log -&gt; update ; 

ShowPath ; 

MainLoop() ;
</pre></body></html>