Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / look.seq < prev next >

Wrap

Text File | 1991-01-29 | 13.5 KB | 316 lines

\\ LOOK.SEQ Target compilable string search across many files *************************************************************************** Advertisement *************************************************************************** LOOK was written in Forth, and compiled using the TCOM optimizing compiler on the F-PC Forth system. LOOK is public domain, as is F-PC, and TCOM. To obtain the latest version of F-PC, and TCOM send $60.00 to this address: Tom Zimmer 292 Falcato Drive Milpitas, Ca. 95035 Home (408) 263-8859 Work (408) 432-4643 F-PC and TCOM are shipped on two 1.2 meg "AT" 5 1/4 inch floppy disks. If you need another format, be sure to specify the format and include $5.00 for additional handling. *************************************************************************** LOOK Description & Usage *************************************************************************** Here is a handy utility to search for a string in one or more files on your disk. It is used as follows: LOOK <string> <file_specs> <enter> LOOK "<string with spaces>" <file_specs> <enter> The string is space or quote delimited, and the file specs are space delimited. Multiple file specs can be included on the same line. You can also type in LOOK alone, and you will be prompted for the search string and file specs. LOOK <enter> String to LOOK for -><string with spaces> <enter> File spec(s) to search -><file_specs> <enter> The search will proceed, processing progresses at about 40,000 bytes per second on a 6 mhz PC-AT clone. Each file processed will cause a partial rotation of the "spinner" (see the spinner definition) to be displayed on the screen. When the search string is found, the filename is displayed, followed by the line number of the found line, and the lines contents up to 74 characters on the line. The filename is only displayed the first time a string is found. The LOOKing process can be paused by pressing the space bar, and can be terminated with ESC. DOS I/O re-direction is allowed, so the following: LOOK ZIMMER *.SEQ >ZFOUND.LST <enter> or LOOK "TOM ZIMMER" *.SEQ >ZFOUND.LST <enter> This will build a file containing all occurances of "TOM ZIMMER" found in the *.SEQ files of the current directory into a file called ZFOUND.LST. Only the first 700 files in a directory will be searched, although you can change the constant MAXFILES and recompile LOOK to increase of decrease this limit. Users of Forth BLOCK file systems may find LOOK useful in scanning their source files for text strings. LOOK will detect a file that doesn't contain CRLF delimited lines, and automatically break the file search into 64 character lines. This make reading the output of a scan through .BLK or .SCR files much more readable. *************************************************************************** Compiling LOOK *************************************************************************** If you have a recent version (1.14 of higher) of TCOM, you can re-compile this source file into LOOK.COM with the following DOS commandline: TCOM LOOK /OPT /NOINIT enter *************************************************************************** Program Code Begins *************************************************************************** { fload allspecs.seq 700 constant maxfiles \ only hold upto 700 filenames in list \ from any given directory. 40 constant lookmax \ longest string we will search for 2variable bytes_srch \ accumulator for number of bytes searched 0 value files_srch \ accumulator for number of files searched 0 value occur_srch \ accumulator for occurances found 0 value ?global \ search ALL directories flag variable fstime \ first time found flag, used in each file variable do_prompt \ flag, is a prompt needed 128 array spec_buf \ a place to hold the file specs lookmax 1+ array slook.buf \ and a place to hold the search string : .file-once ( --- ) \ display filename first time text found fstime @ 0= if cr .lrhndl fstime on then ; : .outbuf ( -- ) \ display the readline buffer outbuf count bounds do i c@ $20 < if $20 i c! then \ filter out ctrl chars loop outbuf count 2- 73 min 0max type ; \ display line 0 value spinval : spinner ( -- ) \ video spinner, doesn't effect cursor \ positon or I/O redirection. It is however \ VERY HARDWARE SPECIFIC TO IBM'S & CLONES " |/-\" drop spinval 3 and + c@ video-seg @ at? 24 min 160 * swap 2* + c!L incr> spinval ; : searchfile ( --- ) \ search current file for specified string IBRESET \ reset lineread operatons fstime off \ mark file as nothing found yet spinner \ notify user we are searching 1 more begin lineread c@ dup 132 > if 64 outbuf c! dup 64 - dup negate instart +! inlength +! then while slook.buf count outbuf count search nip if space .file-once cr loadline @ 4 .r space .outbuf incr> occur_srch ?keypause then repeat fstime @ if cr then ; : do_1file ( n1 -- ) \ open search and close one file dup >fadr 1+ c@l '.' = if drop exit then >fadr dir>pad >r spec_buf lrhndl $>handle lrhndl >pathend dup lrhndl 1+ - r@ + lrhndl c! r> cmove lrhndl count + off lrhndl hopen 0= if searchfile lrhndl endfile bytes_srch D+! incr> files_srch then lrhndl hclose drop \ close the file lrhndl clr-hcb ; \ clear the handle : $do_1spec ( a1 | -- ) \ do all files in a filespec count spec_buf place \ put in spec buffer spec_buf $getdir \ read the directory files. #fls 0 ?do i do_1file ?keypause loop ; : pad+\spec ( -- ) pad count + 1- c@ '\' <> if " \" pad +place then bl word count over c@ '\' = if 1 /string then pad +place ; : $do_1set ( a1 -- ) >in @ >r begin >in @ #tib @ < while dup count pad place pad+\spec pad $do_1spec repeat drop r> >in ! ; : searchallof ( | file_specs --- ) \ Do search all matching file_specs. 0 0 bytes_srch 2! 0 =: files_srch dirseg 0= if #tib @ >in ! exit then ?global if getdirs begin nextdir dup c@ while $do_1set repeat drop else begin >in @ #tib @ < while bl word $do_1spec repeat then cr ; : ?in-empty ( --- f1 ) \ is anything left in input stream? >in @ bl word c@ 0= swap >in ! ; : ?esc_bye ( -- ) \ leave if user pressed ESC esc_flg @ if ABORT then ; : get-filespecs ( --- ) \ get one or more file specifications ?in-empty \ if nothing following command if do_prompt @ if ." File spec(s) to search [*.*] ->" query cr ?esc_bye then ?in-empty \ if nothing following if " *.*" ">$ $>tib \ default to "*.*", then \ ALL files then ." in " tib #tib @ >in @ /string type space ; : get-global ( -- ) >in @ bl word 1+ " -g" caps-comp if >in ! exit then drop on> ?global here count 2 /string dup if 2dup startdir place else " \" startdir place then 2drop ." In " startdir count type ." and lower directories, in " ?in-empty \ if nothing following if " *.*" ">$ $>tib \ default to "*.*", then \ ALL files >in @ begin bl word dup c@ while count type space repeat drop >in ! ; : get-1word ( -- a1 ) tib #tib @ >in @ /string tuck bl skip nip - >in +! \ skip leading blanks before first word tib >in @ + c@ \ get delimiter character dup '0' '9' between over upc \ numeric or 'A' 'Z' between or \ alphabetic, then if drop \ discard, >in decr \ backup and $20 word \ use blank for delimiter else \ if non alphabetic, then >in incr \ bump past the delimiter word \ get delimited string >in incr then ; : get-string ( | string -- ) \ get the search string do_prompt off ?in-empty \ if nothing following command if ." String to LOOK for (no quotes) ->" query cr ?esc_bye do_prompt on 0 word else get-1word then count lookmax min slook.buf place ." Looking for " '"' emit slook.buf count type '"' emit space slook.buf c@ 0= if ." No search string specified" ABORT then ; : .info ( -- ) ." Tom's LOOKup utility V1.05 06/30/90 ESC=cancel, SPACE=pause" cr 8 spaces ." LOOK " '"' emit ." string" '"' emit ." file_spec(s) <Enter>" cr ." or " ." LOOK " '"' emit ." string" '"' emit ." -g<starting_dir> file_spec(s) <Enter>" cr ." (use -g for a global search all directories below <starting_dir>)" cr ; : flook ( search_string file_specs --- ) \ Search files for string DECIMAL \ always select decimal CAPS ON \ ignore cAsE ?DS: SSEG ! \ init search segment DOSIO_INIT \ init EMIT, TYPE & SPACES $FFF0 SET_MEMORY \ default to 64k code space DOS_TO_TIB \ move command tail to TIB ?in-empty \ if nothing following command if .info then maxfiles =: maxdir \ up to "maxfiles" directory entries dirinit \ initialize directory words diralloc \ allocate directory name space 20000 =: iblen \ make read buffer larger lineread_init \ initialize fast file reader off> occur_srch \ reset the occurance counter ?vmode 7 = \ setup for MONOCHROME or COLOR if $B000 else $B800 then video-seg ! get-string \ get search text get-global \ search all directories? ?global 0= if get-filespecs \ get the file specifications then searchallof \ search everything \ then report summary of search cr files_srch . ." Files searched, " bytes_srch 2@ d. ." Total bytes searched, " occur_srch u. ." Occurances found." cr dirrelease ; \ release directory name space }