1eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
2 if 0;
3
4#D \module
5#D [ file=texfind.pl,
6#D version=1998.05.10,
7#D title=\TEXFIND,
8#D subtitle=searching files,
9#D author=Hans Hagen,
10#D date=\currentdate,
11#D copyright={PRAGMA / Hans Hagen \& Ton Otten}]
12#C
13#C This module is part of the \CONTEXT\ macro||package and is
14#C therefore copyrighted by \PRAGMA. See licen-en.pdf for
15#C details.
16
17# test with "doif(un|)defined"
18
19use strict ;
20use Getopt::Long ;
21use File::Find ;
22use Cwd ;
23use Tk ;
24use Tk::widgets ;
25use Tk::ROText ;
26
27use FindBin ;
28use lib $FindBin::Bin ;
29use path_tre ;
30
31my $FileSuffix = 'tex' ;
32my $SearchString = '' ;
33my $Recurse = 0 ;
34my $NumberOfHits = 0 ;
35my $QuitSearch = 0 ;
36my $Location = '' ;
37my $currentpath = '.' ;
38
39my @FileList ;
40
41my ($dw, $mw, $log, $sea, $fil, $num, $but, $dir, $loc) ;
42
43$mw = MainWindow -> new () ;
44$dw = MainWindow -> new () ;
45
46$mw -> protocol( 'WM_DELETE_WINDOW' => sub { exit } ) ;
47$dw -> protocol( 'WM_DELETE_WINDOW' => sub { exit } ) ;
48
49$log = $mw -> Scrolled ( 'ROText' ,
50 -scrollbars => 'se' ,
51 -font => 'courier' ,
52 -wrap => 'none' ,
53 -width => 65 ,
54 -height => 22 )
55 -> pack ( -side => 'bottom' ,
56 -padx => 2 ,
57 -pady => 2 ,
58 -expand => 1 ,
59 -fill => 'both' ) ;
60
61$sea = $mw -> Entry ( -textvariable => \$SearchString ,
62 -font => 'courier' ,
63 -width => 20 )
64 -> pack ( -side => 'left' ,
65 -padx => 2 ,
66 -pady => 2 ) ;
67
68$fil = $mw -> Entry ( -textvariable => \$FileSuffix ,
69 -font => 'courier' ,
70 -width => 5 )
71 -> pack ( -side => 'left' ,
72 -padx => 2 ,
73 -pady => 2 ) ;
74
75$but = $mw -> Checkbutton ( -variable => \$Recurse ,
76 -text => 'recurse' )
77 -> pack ( -side => 'left' ) ;
78
79$num = $mw -> Entry ( -textvariable => \$NumberOfHits ,
80 -font => 'courier' ,
81 -justify => 'right' ,
82 -width => 5 )
83 -> pack ( -side => 'right' ,
84 -padx => 2 ,
85 -pady => 2 ) ;
86
87$loc = $mw -> Entry ( -textvariable => \$Location ,
88 -font => 'courier' ,
89 -width => 8 )
90 -> pack ( -side => 'right' ,
91 -padx => 2 ,
92 -pady => 2 ) ;
93
94sub BuildDir
95 { if (Exists($dir)) { $dir -> destroy } ;
96 $dir = $dw -> Scrolled ( 'PathTree' ,
97 -scrollbars => 'se' )
98 -> pack ( -expand => 1 ,
99 -fill => 'both' ,
100 -padx => 2 ,
101 -pady => 2 ) ;
102 $dir -> configure ( -font => 'courier' ,
103 -height => 24 ,
104 -width => 65 ,
105 -selectbackground => 'blue3' ,
106 -browsecmd => \&ChangePath ) ;
107 $dir -> bind ('' , \&ShowFile ) ;
108 $dir -> bind ('' , \&ShowFile ) }
109
110BuildDir ;
111
112sub ShowFile { $mw -> raise ; $sea -> focusForce }
113sub ShowPath { $dw -> raise ; $dir -> focusForce }
114
115$log -> tagConfigure ( 'found', -foreground => 'green3' ) ;
116$log -> tagConfigure ( 'title', -foreground => 'blue3' ) ;
117
118$sea -> bind ('' , \&LocateStrings ) ;
119$fil -> bind ('' , \&LocateStrings ) ;
120$loc -> bind ('' , \&ChangeLocation ) ;
121$log -> bind ('' , \&ShowPath ) ;
122
123$sea -> bind ('' , \&QuitSearch ) ;
124$fil -> bind ('' , \&QuitSearch ) ;
125$loc -> bind ('' , \&QuitSearch ) ;
126
127$sea -> bind ('' , \&QuitSearch ) ;
128$fil -> bind ('' , \&QuitSearch ) ;
129$loc -> bind ('' , \&QuitSearch ) ;
130$log -> bind ('' , \&QuitSearch ) ;
131
132$sea -> bind ('' , \&LocateStrings ) ;
133$fil -> bind ('' , \&LocateStrings ) ;
134$loc -> bind ('' , \&ChangeLocation ) ;
135$log -> bind ('' , \&ShowPath ) ;
136
137sub ChangePath
138 { my $currentpath = shift ;
139chdir($currentpath) ;
140 $QuitSearch = 1 ;
141 $log -> delete ('1.0', 'end') ;
142 $log -> insert ('end', "$currentpath\n\n", 'title') }
143
144sub ChangeLocation
145 { $QuitSearch = 1 ;
146 $log -> delete ('1.0', 'end') ;
147 $Location =~ s/^\s*//o ;
148 $Location =~ s/\s*$//o ;
149 $Location =~ s/(\\|\/\/)/\//go ;
150 unless (-d $Location)
151 { unless ($Location =~ /\//) { $Location .= '/' } }
152 if (-d $Location)
153 { $log -> insert ('end', "changed to location '$Location'\n\n", 'title') ;
154 $currentpath = $Location ;
155 chdir ($currentpath) ;
156 $dir -> destroy ;
157 BuildDir ;
158 $dw -> raise ;
159 $dw -> focusForce }
160 else
161 { $log -> insert ('end', "unknown location '$Location'\n\n", 'title') ;
162 $Location = '' } }
163
164sub QuitSearch
165 { $QuitSearch = 1 }
166
167sub SearchFile
168 { my ($FileName, $SearchString) = @_ ;
169 my $Ok = 0 ; my $len ;
170 open (TEX, $FileName) ;
171 my $LineNumber = 0 ;
172 while ()
173 { ++$LineNumber ;
174 if ($QuitSearch)
175 { if ($Ok) { $log -> see ('end') }
176 last }
177 if (/$SearchString/i)
178 { ++$NumberOfHits ; $num -> update ;
179 unless ($Ok)
180 { $Ok = 1 ;
181 $log -> insert ('end', "$FileName\n\n",'title') }
182 $log -> insert ('end', sprintf("%5i : ",$LineNumber), 'title') ;
183 s/^\s*//o ;
184#
185 $len = 0 ;
186 while (/(.*?)($SearchString)/gi)
187 { $len += length($1) + length($2) ;
188 $log -> insert ('end', "$1") ;
189 $log -> insert ('end', "$2", 'found' ) }
190 $_ = substr($_,$len) ;
191 $log -> insert ('end', "$_") ;
192#
193 $log -> update ;
194 $log -> see ('end') } }
195 if ($Ok) { $log -> insert ('end', "\n") }
196 close (TEX) }
197
198sub DoLocateFiles
199 { @FileList = () ;
200 $NumberOfHits = 0 ;
201 if ($FileSuffix ne "")
202 { $log -> delete ('1.0', 'end') ;
203 if ($Recurse)
204 { $log -> insert ('end', "recursively identifying files\n", 'title') ;
205 $log -> see ('end') ;
206 find (\&wanted, $currentpath) ;
207 sub wanted
208 { if ($QuitSearch) { last ; return }
209 if (/.*\.$FileSuffix/i)
210 { ++$NumberOfHits ; $num -> update ;
211 push @FileList, $File::Find::name } } }
212 else
213 { $log -> insert ('end', "identifying files\n", 'title') ;
214 $log -> see ('end') ;
215 opendir(DIR, $currentpath) ; my @TEMPLIST = readdir(DIR) ; closedir(DIR) ;
216 foreach my $FileName (@TEMPLIST)
217 { if ($FileName =~ /.*\.$FileSuffix/i)
218 { ++$NumberOfHits ; $num -> update ;
219 if ($QuitSearch)
220 { last }
221 push @FileList, $FileName } } }
222 @FileList = sort @FileList } }
223
224sub DoLocateStrings
225 { $log -> delete ('1.0', 'end') ;
226 $log -> update ;
227 $log -> see ('end') ;
228 $NumberOfHits = 0 ;
229 if ($SearchString ne "")
230 { foreach my $FileName (@FileList)
231 { if ($QuitSearch)
232 { $log -> insert ('end', "search aborted\n", 'title') ;
233 $log -> see ('end') ;
234 last }
235 SearchFile($FileName,$SearchString) } }
236 unless ($QuitSearch)
237 { $log -> insert ('end', "done\n", 'title') ;
238 $log -> see ('end') } }
239
240sub LocateStrings
241 { $QuitSearch = 0 ;
242 DoLocateFiles() ;
243 DoLocateStrings() }
244
245$log -> insert ('end',
246
247 "data fields\n\n" , '' ,
248
249
250 "string :", 'title', " regular expression to search for\n" , '' ,
251 "suffix :", 'title', " type of file to search in\n" , '' ,
252 "recurse :", 'title', " enable searching subpaths\n" , '' ,
253 "location :", 'title', " drive of root path\n" , '' ,
254 "counter :", 'title', " file/hit counter\n\n" , '' ,
255
256 "key bindings\n\n" , '' ,
257
258 "double 1 :", 'title', " directory window <-> search window\n" , '' ,
259 "enter :", 'title', " start searching\n" , '' ,
260 "escape :", 'title', " quit searching\n\n" , '' ,
261
262 "current path\n\n" , '' ,
263
264 cwd(), 'title', "\n\n" , 'title' ) ;
265
266$log -> update ;
267
268ShowPath ;
269
270MainLoop() ;
271