home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / fwords.seq < prev    next >
Text File  |  1990-07-03  |  9KB  |  247 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 seqhandle movepointer
  72.                 0.0 filepointer 2!
  73.                 off> fstime
  74.                 @> noise if ." ." ?cr then
  75.                 20000 1
  76.                 do      lineread c@ 0= ?leave
  77.                         searchsetup search nip
  78.                         if      @> noise
  79.                                 if      .file-once
  80.                                         cr i 3 .r space
  81.                                 else    cr
  82.                                 then    outbuf count 2- type
  83.                                 incr> occur_srch
  84.                                 ?keypause
  85.                                 PRINTING @ 0= @> statv and
  86.                                 IF <.STAT> THEN
  87.                         then
  88.                 loop    @> fstime if cr then ;
  89.  
  90. defined reedit nip #if          \ ONLY if REEDIT is defined
  91.  
  92. : searchedit    ( --- )
  93.                 [ forth ]
  94.                 IBRESET
  95.                 0.0 seqhandle movepointer
  96.                 0.0 filepointer 2!
  97.                 ." ." ?cr
  98.                 off> newbrowse
  99.                 off> ?browse
  100.                 off> seding
  101.                 on> leavenow
  102.                 20000 1
  103.                 do      i 127 and 0= if ?keypause then
  104.                         lineread c@ 0= ?leave
  105.                         searchsetup search nip
  106.                         if      i =: loadline
  107.                                 savecursor
  108.                                 savescr
  109.                                 <ed>
  110.                                 restscr
  111.                                 restcursor
  112.                                 leave
  113.                         then
  114.                 loop
  115.                 off> leavenow ;
  116.  
  117. #endif
  118.  
  119. variable withname
  120.  
  121. : .firstline    ( --- )
  122.                 IBRESET
  123.                 0.0 seqhandle movepointer
  124.                 0.0 filepointer 2!
  125.                 cr lineread count 2- 0MAX withname @
  126.                 if      .seqhandle 20 #out @ - spaces
  127.                         60
  128.                 else    79
  129.                 then    min type
  130.                 ?keypause ;
  131.  
  132. headers
  133.  
  134. forth definitions
  135.  
  136. : fallof        ( func | file_specs --- )       \ Do something to all files
  137.                                                   \ matching file_specs.
  138.                 is donfile              \ Set function to be performed.
  139.                 0.0  bytes_srch 2!
  140.                 0 =: files_srch
  141.                 dirseg 0= if #tib @ >in ! exit then
  142.                 begin   >in @ #tib @ <
  143.                 while   bl word         \ else get the file spec
  144.                         dup count + 1- c@ '.' = =: +a.?
  145.                         dup
  146.                         $getdir              \ and read the directory files.
  147.                         #fls 0=
  148.                         if      cr count type ."  No matching files."
  149.                         else    drop    #fls 0
  150.                                 ?do     i >fadr 1+ c@l '.' <>
  151.                                         if      i >fadr dir>pad >r
  152.                                                 here seqhandle+ $>handle
  153.                                                 seqhandle+ >pathend
  154.                                                 dup seqhandle+ 1+ - r@ +
  155.                                                 seqhandle+ c!
  156.                                                 r> cmove
  157.                                                 +a.?    \ add a dot
  158.                                                 if      '.'
  159.                                                         seqhandle+ count + c!
  160.                                                         1 seqhandle+ c+!
  161.                                                 then
  162.                                                 seqhandle+  count + off
  163.                                                 seqhandle+  $hopen 0=
  164.                                                 if      seqhandle endfile
  165.                                                               bytes_srch D+!
  166.                                                         incr> files_srch
  167.                                                         PRINTING @ 0=
  168.                                                         @> statv and
  169.                                                         IF      <.STAT>
  170.                                                         THEN    donfile
  171.                                                 then    close   ?keypause
  172.                                         then
  173.                                 loop
  174.                         then
  175.                 repeat  cr ;
  176.  
  177. : ?in-empty     ( --- f1 )              \ is anything left in input stream?
  178.                 >in @ bl word c@ 0= swap >in ! ;
  179.  
  180. : get-filespecs ( --- )
  181.                 ?in-empty               \ if nothing following command
  182.                 if      cr ." File spec(s) to search [*.seq] ->"
  183.                         query
  184.                         ?in-empty       \ if nothing following then
  185.                         if      " *.seq" ">$ $>tib \ substitute "*.seq"
  186.                         then
  187.                 then    ;
  188.  
  189. : flook         ( search_string file_specs --- ) \ Search files for string
  190.                 SAVESTATE noise on
  191.                 off> occur_srch
  192.                 ?in-empty               \ if nothing following command
  193.                 if      cr ." String to LOOK for     ->" query 0 word
  194.                 else    bl word
  195.                 then    slook.buf over c@ 1+ 32 min cmove
  196.                 get-filespecs ['] searchfile fallof
  197.                 RESTORESTATE
  198.                 cr files_srch .     ." Files searched, "
  199.                    bytes_srch 2@ d. ." Total bytes searched, "
  200.                    occur_srch u.    ." Occurances found." ;
  201.  
  202. defined reedit nip #if          \ ONLY if REEDIT is defined
  203.  
  204. : editall       ( search_string file_specs --- ) \ edit all files containing
  205.                 SAVESTATE
  206.                 ?in-empty               \ if nothing following command
  207.                 if      cr ." String to LOOK for and EDIT ->" query 0 word
  208.                 else    bl word
  209.                 then    slook.buf over c@ 1+ 32 min cmove
  210.                 get-filespecs ['] searchedit fallof
  211.                 RESTORESTATE ;
  212.  
  213. #endif
  214.  
  215. : index         ( file_spec --- )       \ Print first line of files
  216.                 SAVESTATE
  217.                 ." \n\n**** Use SPACE to pause, and ESC to stop. ****\n\:03"
  218.                 withname on
  219.                 ?in-empty               \ if nothing following command
  220.                 if      " *.seq" ">$ $>tib \ substitute "*.seq"
  221.                         withname off
  222.                 then    ['] .firstline fallof
  223.                 RESTORESTATE ;
  224.  
  225. defined listing nip #if         \ load only if LISTING is loaded
  226.  
  227. : fprint        ( file_specs --- )      \ Print files specified.
  228.                 ?printer.ready 0= if  cr .offline quit then
  229.                 SAVESTATE
  230.                 more? 0=       \ if nothing following command
  231.                 if      cr ." File spec(s) to print ->" query
  232.                 then
  233.                 on> ?listing
  234.                 ?in-empty 0=
  235.                 if      ['] listing fallof
  236.                 else    ." No file(s) specified to print."
  237.                 then
  238.                 off> ?listing
  239.                 RESTORESTATE ;
  240.  
  241. #endif
  242.  
  243. behead
  244.  
  245. only forth also definitions
  246.  
  247.