home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / FWORDS.SEQ < prev    next >
Encoding:
Text File  |  1989-09-21  |  9.1 KB  |  244 lines
  1. \ FWORDS.SEQ    File searching                          by Tom Zimmer
  2.  
  3. comment:
  4.  
  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> F-PC COLOR STATUS <enter>
  22.  
  23. will search the files F-PC.SEQ, COLOR.SEQ, and STATUS.SEQ for <string>
  24.  
  25. comment;
  26.  
  27.                 only
  28.                 forth  also
  29. \u editor       editor also
  30.                 hidden also definitions
  31.  
  32. defined slook.buf nip 0= #if    \ if SLOOK.BUF doesn't exist, define it
  33.  
  34. create slook.buf 36 allot
  35.  
  36. #endif
  37.  
  38. defer donfile           \ A function to do on all specified files
  39.  
  40. ' noop is donfile
  41.  
  42. variable noise
  43. 2variable bytes_srch
  44.   0 value files_srch
  45.   0 value occur_srch
  46.   0 value +a.?                  \ plus a dot?
  47.  
  48. headerless
  49.  
  50. variable fstime
  51.  
  52. : .file-once    ( --- )
  53.                 fstime @ 0=
  54.                 if      cr .seqhandle fstime on
  55.                 then    ;
  56.  
  57. code searchsetup ( --- a1 n1 a2 n2 )
  58.                 mov bx, # slook.buf 1+          \ slook.buf count
  59.                 push bx
  60.                 mov al, slook.buf byte
  61.                 sub ah, ah
  62.                 push ax
  63.                 mov bx, # outbuf 1+             \ outbuf count
  64.                 push bx
  65.                 mov al, outbuf byte
  66.                 1push
  67.                 end-code
  68.  
  69. : searchfile    ( --- )
  70.                 IBRESET
  71.                 0.0 seek
  72.                 off> fstime
  73.                 @> noise if ." ." ?cr then
  74.                 10000 1
  75.                 do      lineread c@ 0= ?leave
  76.                         searchsetup search nip
  77.                         if      @> noise
  78.                                 if      .file-once
  79.                                         cr i 3 .r space
  80.                                 else    cr
  81.                                 then    outbuf count 2- type
  82.                                 incr> occur_srch
  83.                                 ?keypause
  84.                                 PRINTING @ 0= @> statv and
  85.                                 IF <.STAT> THEN
  86.                         then
  87.                 loop    @> fstime if cr then ;
  88.  
  89. defined reedit nip #if          \ ONLY if REEDIT is defined
  90.  
  91. : searchedit    ( --- )
  92.                 [ forth ]
  93.                 IBRESET
  94.                 0.0 seek
  95.                 ." ." ?cr
  96.                 off> newbrowse
  97.                 off> ?browse
  98.                 off> seding
  99.                 on> leavenow
  100.                 10000 1
  101.                 do      i 127 and 0= if ?keypause then
  102.                         lineread c@ 0= ?leave
  103.                         searchsetup search nip
  104.                         if      i =: loadline
  105.                                 savecursor
  106.                                 savescr
  107.                                 <ed>
  108.                                 restscr
  109.                                 restcursor
  110.                                 leave
  111.                         then
  112.                 loop
  113.                 off> leavenow ;
  114.  
  115. #endif
  116.  
  117. variable withname
  118.  
  119. : .firstline    ( --- )
  120.                 IBRESET
  121.                 0.0 seek
  122.                 cr lineread count 2- 0MAX withname @
  123.                 if      .seqhandle 20 #out @ - spaces
  124.                         60
  125.                 else    79
  126.                 then    min type
  127.                 ?keypause ;
  128.  
  129. headers
  130.  
  131. forth definitions
  132.  
  133. : fallof        ( func | file_specs --- )       \ Do something to all files
  134.                                                   \ matching file_specs.
  135.                 is donfile              \ Set function to be performed.
  136.                 0.0  bytes_srch 2!
  137.                 0 =: files_srch
  138.                 dirseg 0= if #tib @ >in ! exit then
  139.                 begin   >in @ #tib @ <
  140.                 while   bl word         \ else get the file spec
  141.                         dup count + 1- c@ '.' = =: +a.?
  142.                         dup
  143.                         $getdir              \ and read the directory files.
  144.                         #fls 0=
  145.                         if      cr count type ."  No matching files."
  146.                         else    drop    #fls 0
  147.                                 ?do     i >fadr 1+ c@l '.' <>
  148.                                         if      i >fadr dir>pad >r
  149.                                                 here seqhandle+ $>handle
  150.                                                 seqhandle+ >pathend
  151.                                                 dup seqhandle+ 1+ - r@ +
  152.                                                 seqhandle+ c!
  153.                                                 r> cmove
  154.                                                 +a.?    \ add a dot
  155.                                                 if      '.'
  156.                                                         seqhandle+ count + c!
  157.                                                         1 seqhandle+ c+!
  158.                                                 then
  159.                                                 seqhandle+  count + off
  160.                                                 seqhandle+  $hopen 0=
  161.                                                 if      seqhandle endfile
  162.                                                               bytes_srch D+!
  163.                                                         incr> files_srch
  164.                                                         PRINTING @ 0=
  165.                                                         @> statv and
  166.                                                         IF      <.STAT>
  167.                                                         THEN    donfile
  168.                                                 then    close   ?keypause
  169.                                         then
  170.                                 loop
  171.                         then
  172.                 repeat  cr ;
  173.  
  174. : ?in-empty     ( --- f1 )              \ is anything left in input stream?
  175.                 >in @ bl word c@ 0= swap >in ! ;
  176.  
  177. : get-filespecs ( --- )
  178.                 ?in-empty               \ if nothing following command
  179.                 if      cr ." File spec(s) to search [*.seq] ->"
  180.                         query
  181.                         ?in-empty       \ if nothing following then
  182.                         if      " *.seq" ">$ $>tib \ substitute "*.seq"
  183.                         then
  184.                 then    ;
  185.  
  186. : flook         ( search_string file_specs --- ) \ Search files for string
  187.                 SAVESTATE noise on
  188.                 off> occur_srch
  189.                 ?in-empty               \ if nothing following command
  190.                 if      cr ." String to LOOK for     ->" query 0 word
  191.                 else    bl word
  192.                 then    slook.buf over c@ 1+ 32 min cmove
  193.                 get-filespecs ['] searchfile fallof
  194.                 RESTORESTATE
  195.                 cr files_srch .     ." Files searched, "
  196.                    bytes_srch 2@ d. ." Total bytes searched, "
  197.                    occur_srch u.    ." Occurances found." ;
  198.  
  199. defined reedit nip #if          \ ONLY if REEDIT is defined
  200.  
  201. : editall       ( search_string file_specs --- ) \ edit all files containing
  202.                 SAVESTATE
  203.                 ?in-empty               \ if nothing following command
  204.                 if      cr ." String to LOOK for and EDIT ->" query 0 word
  205.                 else    bl word
  206.                 then    slook.buf over c@ 1+ 32 min cmove
  207.                 get-filespecs ['] searchedit fallof
  208.                 RESTORESTATE ;
  209.  
  210. #endif
  211.  
  212. : index         ( file_spec --- )       \ Print first line of files
  213.                 SAVESTATE
  214.                 ." \n\n**** Use SPACE to pause, and ESC to stop. ****\n\:03"
  215.                 withname on
  216.                 ?in-empty               \ if nothing following command
  217.                 if      " *.seq" ">$ $>tib \ substitute "*.seq"
  218.                         withname off
  219.                 then    ['] .firstline fallof
  220.                 RESTORESTATE ;
  221.  
  222. defined listing nip #if         \ load only if LISTING is loaded
  223.  
  224. : fprint        ( file_specs --- )      \ Print files specified.
  225.                 ?printer.ready 0= if  cr .offline quit then
  226.                 SAVESTATE
  227.                 more? 0=       \ if nothing following command
  228.                 if      cr ." File spec(s) to print ->" query
  229.                 then
  230.                 on> ?listing
  231.                 ?in-empty 0=
  232.                 if      ['] listing fallof
  233.                 else    ." No file(s) specified to print."
  234.                 then
  235.                 off> ?listing
  236.                 RESTORESTATE ;
  237.  
  238. #endif
  239.  
  240. behead
  241.  
  242. only forth also definitions
  243.  
  244.