Power-Programmierung/CD1.mdf/forth/compiler/fpc/source/look.seq

Text File | 1991-01-29 | 14KB | 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 [phone]
                               Work [phone]

  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

}