home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFA.ZIP / FWORDS.SEQ < prev    next >
Encoding:
Text File  |  1988-01-11  |  6.7 KB  |  174 lines
  1. \ FLOOK.SEQ     File searching                          by Tom Zimmer
  2.  
  3. ?dark
  4. .comment:
  5.   Some powerful file manipulation words are now being loaded, these
  6. words allow printing, searching and listing the first line of
  7. sequential files.  Here is a synopsis:
  8.  
  9.         FLOOK  <string> <filespec#1> <filespec#2> ...  to end of line
  10.         INDEX  <filespec#1> <filespec#2> ...             "      "
  11.         FPRINT <filespec#1> <filespec#2> ...             "      "
  12.  
  13.   Each of the words may be followed by as many filespecs as will fit on
  14. a line.  The filespecs will be precessed left to right.  Filespecs can
  15. be "*.*", or "*.SEQ", or "ANYFILE", or any other filespec you want.  It
  16. is probably not a good idea to use these words on .EXE or .COM files
  17. though.
  18.  
  19.   Here is an example of how FLOOK might be used:
  20.  
  21.         FLOOK <string> DF COLOR STATUS <enter>
  22.  
  23. will search the files DF.SEQ, COLOR.SEQ, and STATUS.SEQ for <string>
  24.  
  25. comment;
  26.  
  27. >overlay
  28.  
  29. only forth also editor also hidden definitions also
  30.  
  31. defer donfile           \ A function to do on all specified files
  32.  
  33. ' noop is donfile
  34.  
  35. variable fstime
  36.  
  37. : .file-once    ( --- )
  38.                 fstime @ 0=
  39.                 if      cr .file fstime on
  40.                 then    ;
  41.  
  42. variable noise
  43.  
  44. : searchfile    ( --- )
  45.                 inlen off 0.0 seek
  46.                 fstime off      noise @ if ." ." then
  47.                 8000 1
  48.                 do      ?keypause
  49.                         lineread c@ 0= ?leave
  50.                         slook.buf count outbuf count search nip
  51.                         if      noise @
  52.                                 if      .file-once
  53.                                         cr i 3 .r space
  54.                                 else    cr
  55.                                 then    outbuf count 2- type
  56.                         then
  57.                 loop    fstime @ if cr then ;
  58.  
  59. : searchedit    ( --- )
  60.                 [ forth ]
  61.                 inlen off 0.0 seek ." ." ?cr
  62.                 8000 1
  63.                 do      ?keypause
  64.                         lineread c@ 0= ?leave
  65.                         slook.buf count outbuf count search nip
  66.                         if      i loadline !
  67.                                 savescr #out @ #line @ >r >r
  68.                                 byte|line off
  69.                                 ?readfile
  70.                                 shndl @ hclose drop
  71.                                 8 scrline !
  72.                                 reedit
  73.                                 shndl @ memfile $>handle
  74.                                 shndl @ hopen drop      \ Reopen file
  75.                                 restscr r> r> at
  76.                                 leave
  77.                         then
  78.                 loop    ;
  79.  
  80. : $>tib         ( a1 --- )
  81.                 count >r tib r@ cmove r@ span ! r> #tib ! >in off  ;
  82.  
  83. variable withname
  84.  
  85. : .firstline    ( --- )
  86.                 inlen off 0.0 seek
  87.                 cr lineread count 2- 0 max withname @
  88.                 if      .file 20 #out @ - 0 max spaces
  89.                         60
  90.                 else    79
  91.                 then    min type
  92.                 ?keypause ;
  93.  
  94. only forth also definitions editor also hidden also
  95.  
  96. : fallof        ( func | file_specs --- )       \ Do something to all files
  97.                                                   \ matching file_specs.
  98.                 is donfile              \ Set function to be performed.
  99.                 begin   >in @ span @ <
  100.                 while   bl word         \ else get the file spec
  101.                         dup 1+ c@ ascii \
  102.                         = abort" Please do not specify a path"
  103.                         dup
  104.                         exlist dup @ >r off  \ Save exclude list, no excludes
  105.                         $getdir              \ and read the directory files.
  106.                         r> exlist !          \ Restore exclude list
  107.                         #fls @ 0=
  108.                         if      cr count type ."  No matching files."
  109.                         else    drop    #fls @ 0
  110.                                 ?do     i >fadr 1+ c@ ascii . <>
  111.                                         if      i >fadr $hopen 0=
  112.                                                 if      donfile
  113.                                                 then    close   ?keypause
  114.                                         then
  115.                                 loop
  116.                         then
  117.                 repeat  cr ;
  118.  
  119. : <flook>       ( search_string  file_specs --- )
  120.                 SAVESTATE
  121.                 >in @ span @ 1- >       \ if nothing following command
  122.                 if      cr ." String to LOOK for  ->" query
  123.                 then    bl word slook.buf over c@ 1+ 32 min cmove
  124.                 >in @ span @ 1- >       \ if nothing following command
  125.                 if      cr ." File spec to search ->" query
  126.                 then    ['] searchfile fallof
  127.                 RESTORESTATE ;
  128.  
  129. : <editall>     ( search_string  file_specs --- )
  130.                 SAVESTATE
  131.                 >in @ span @ 1- >       \ if nothing following command
  132.                 if      cr ." String to LOOK for  ->" query
  133.                 then    bl word slook.buf over c@ 1+ 32 min cmove
  134.                 >in @ span @ 1- >       \ if nothing following command
  135.                 if      cr ." File spec to search ->" query
  136.                 then    ['] searchedit fallof
  137.                 RESTORESTATE ;
  138.  
  139. overlay>
  140.  
  141. : editall       ( search_string file_specs --- ) \ edit all files containing
  142.                 ovon <editall> ovoff ;
  143.  
  144. : flook         ( search_string file_specs --- ) \ Search files for string
  145.                 ovon noise on <flook> ovoff ;
  146.  
  147. \ : flooki        ( search_string file_specs --- ) \ search, with no noise.
  148. \                 noise off <flook> ;
  149.  
  150. \ : xflook        ( search_string file_specs --- ) \ Search case sensitive
  151. \                 caps dup @ >r off flook r> caps ! ;
  152.  
  153. : index         ( file_spec --- )       \ Print first line of files
  154.                 ovon
  155.                 SAVESTATE
  156.                 cr cr ." **** Use SPACE to pause, and ESC to stop. ****"
  157.                 cr 3 tenths withname on
  158.                 >in @ span @ 1- >       \ if nothing following command
  159.                 if      " *.seq" ">$ $>tib \ substitute "*.seq"
  160.                         withname off
  161.                 then    ['] .firstline fallof
  162.                 RESTORESTATE ovoff ;
  163.  
  164. : fprint        ( file_specs --- )      \ Print files specified.
  165.                 ovon
  166.                 SAVESTATE
  167.                 >in @ span @ 1- >       \ if nothing following command
  168.                 if      cr ." File spec to print ->" query
  169.                 then    ['] listing fallof
  170.                 RESTORESTATE ovoff ;
  171.  
  172. only forth also definitions
  173.  
  174.