win32forth-cvs

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv13686/src

Modified Files:
	ANSFILE.F 
Log Message:
Jos: Added the ForAllFileNames feature and changed DIR so that it uses ForAllFileNames. Also dexed the changes.

Index: ANSFILE.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/ANSFILE.F,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** ANSFILE.F	13 Sep 2006 09:34:57 -0000	1.6
--- ANSFILE.F	21 Sep 2006 12:50:17 -0000	1.7
***************
*** 162,165 ****
--- 162,171 ----
     _win32-find-data 11 cells+ ;
  
+ : dir-attribute?  ( - flag )
+ \ *G Returns true when a file is a directory. \n
+ \ ** Need to call find-first-file or find-next-file word before using this word. \n
+ \ ** Can be used in combination with ForAllFileNames
+         _win32-find-data @ FILE_ATTRIBUTE_DIRECTORY and ;
+ 
  2 cells newuser file-time-buf
  \ *G 2Variable to hold the FILETIME structure, which is a little endian (i.e. reversed order)
***************
*** 195,212 ****
  ' zcount alias asciiz->asc-len ( adrz -- sadr slen )
  
  IN-SYSTEM
  
  : .dir->file-name ( -- ;print file name in the dir )
          _win32-find-data 11 cells+              \ adrz
          zcount                                  \ adrz scan-len slen
          dup>r type                              \ adrz len  ;print file name
!         12 r> - 0max spaces ;
  
  
! : .dir->file-size ( -- ;print file size )
!                 _win32-find-data @ FILE_ATTRIBUTE_DIRECTORY and
                  if   ."          dir "
!                 else _win32-find-data 8 cells+ @ dup 12 u,.r space \ print nFileSizeLow
!                      total-file-bytes +!
                  then ;
  
--- 201,255 ----
  ' zcount alias asciiz->asc-len ( adrz -- sadr slen )
  
+ : dir->file-name ( -- adr count )
+ \ *G Returns the adres and count of a file in a directory. \n
+ \ ** Need to call find-first-file or find-next-file word before using this word. \n
+ \ ** Can be used in combination with ForAllFileNames
+         get-file-name zcount ;
+ 
+ : ForAllFileNames { cfa } ( adr slen cfa -- )
+ \ *G Executes the CFA for each found file in a directory. \n
+ \ ** A file specification adr slen may contain wildcards \n
+ \ ** NOTE: Directory names are also considered to be a file-name. \n
+ \ ** Directory names can be detected by dir-attribute?
+         0 #files !                              \ reset # of files in dir
+         find-first-file nip                     \ adrd ior - find first file
+         0 <>    if      exit    then            \ if file is not found, exit
+         dir->file-name   get-file-name 0>
+                 if      cfa execute 1 #files +!
+                 else    2drop
+                 then
+ 
+                 begin   find-next-file nip 0=   \ ior - find next file
+                 while   get-file-name 0>
+                         if      1 #files +!  dir->file-name cfa execute
+                         then
+                 repeat
+         find-close drop ;
+ 
+ : ForAllFiles     (  cfa -- )
+ \ *G Executes the CFA on ALL found files in a directory. \n
+ \ ** NOTE: Directory names are also considered to be a file-name. \n
+ \ ** Directory names can be detected by dir-attribute? \n
+         s" *.*" rot ForAllFileNames  ;
+ 
+ 
  IN-SYSTEM
  
+ 
  : .dir->file-name ( -- ;print file name in the dir )
          _win32-find-data 11 cells+              \ adrz
          zcount                                  \ adrz scan-len slen
          dup>r type                              \ adrz len  ;print file name
!         12 r> - 0max spaces ;  deprecated
  
  
! : .dir->file-size ( -- )
! \ *G Print the size or directory indication of a file \n
! \ ** Need to call find-first-file or find-next-file word before using this word. \n
! \ ** Can be used in combination with ForAllFileNames
!         dir-attribute?
                  if   ."          dir "
!                 else    get-file-size dup 12 u,.r space \ print nFileSizeLow
!                         total-file-bytes +!
                  then ;
  
***************
*** 222,240 ****
                  WHILE   1 #files +!                  \ update file number
                          25 ?cr
!                         .dir->file-size                \ print the size of file
!                         .dir->file-name                \ and the name of file
                          start/stop
!                 REPEAT ;
  
  : print-dir-files ( adr slen -- ) \ W32F      Files Extra
  \ *G Print all the files and sub-directories in a directory that match a specific
  \ ** pattern.
!                 cr ." Directory of: " 2dup type
!                 ['] _print-dir-files catch
!                 IF      2drop                   \ discard abort results
                  THEN
!                 find-close drop
!                 cr #files @ . ." Files displayed, using "
!                 total-file-bytes @ 1 u,.r ."  bytes of disk." ;
  
  : dir           ( "name" -- )   \ W32F      Files Extra
--- 265,294 ----
                  WHILE   1 #files +!                  \ update file number
                          25 ?cr
!                         .dir->file-size               \ print the size of file
!                         .dir->file-name               \ and the name of file
                          start/stop
!                 REPEAT ; deprecated
! 
! : .file-size-name  ( adr len - )
! \ *G Print the size or directory indication and the name of file.
! \ ** It also formats the line. \n
! \ ** Need to call find-first-file or find-next-file word before using this word. \n
! \ ** Can be used in combination with ForAllFileNames
!         25 ?cr      .dir->file-size
!         dup>r type  12 r> - 0max spaces
!         start/stop ;
! 
  
  : print-dir-files ( adr slen -- ) \ W32F      Files Extra
  \ *G Print all the files and sub-directories in a directory that match a specific
  \ ** pattern.
!         cr ." Directory of: " 2dup type cr
!         0 total-file-bytes !                         \ reset total-file-bytes
!         0 #files !                                   \ reset # of files in dir
!         ['] .file-size-name ['] ForAllFileNames catch
!                 IF      3drop                        \ discard abort results
                  THEN
!         cr #files @ . ." Files displayed, using "
!         total-file-bytes @ 1 u,.r ."  bytes of disk." ;
  
  : dir           ( "name" -- )   \ W32F      Files Extra
***************
*** 245,249 ****
  \ ** If "name" ends in : assume a drive use "name"\*.* for the search pattern. \n
  \ *P The pattern can contain the standard Windows wildcards.
!                 /parse-word dup c@ 0=                    \ if not spec given, use *.*
                  IF   s" *.*" pocket place
                  THEN dup count + 1- c@ ':' =         \ if just a drive, add \
--- 299,303 ----
  \ ** If "name" ends in : assume a drive use "name"\*.* for the search pattern. \n
  \ *P The pattern can contain the standard Windows wildcards.
!                 /parse-word dup c@ 0=                \ if not spec given, use *.*
                  IF   s" *.*" pocket place
                  THEN dup count + 1- c@ ':' =         \ if just a drive, add \