home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / xlisp / dir.lsp < prev    next >
Encoding:
Text File  |  1992-06-26  |  3.4 KB  |  106 lines
  1. ; (dir) An OS2XLISP file-listing function.
  2. ; Andrew Schulman 4-April-1988
  3.  
  4. ; usage: (dir [match-str|ext-sym] [print-flag])
  5. ; defaults: match-str is "*.*", print-flag is t
  6. ; examples:
  7. ;     os2xlisp            os/2 equivalent
  8. ;  -----------------      -------------------
  9. ;  (dir)                  c:>dir *.*
  10. ;  (dir "*.lsp")           c:>dir *.lsp
  11. ;  (dir 'lsp)              c:>dir *.lsp
  12. ;  (dir "*.lsp" nil)       none (returns directory info in a list)
  13.  
  14. ; get handles for OS/2 system calls
  15.  
  16. (define doscalls (loadmodule "DOSCALLS"))
  17. (define DOSFINDFIRST (getprocaddr doscalls "DOSFINDFIRST"))
  18. (define DOSFINDNEXT (getprocaddr doscalls "DOSFINDNEXT"))
  19. (define DOSFINDCLOSE (getprocaddr doscalls "DOSFINDCLOSE"))
  20.  
  21. ; get handle for C runtime-library call
  22.  
  23. (define crtlib (loadmodule "CRTLIB"))
  24. (define printf (getprocaddr crtlib "_printf"))
  25.  
  26. ; package printf for convenient use
  27.  
  28. (defmacro printf (mask &rest args)
  29.     `(c-call printf ,mask ,@args))
  30.  
  31. ; OS/2 file-search structure
  32. ;
  33. ;struct FileFindBuf {
  34. ;        unsigned create_date;
  35. ;        unsigned create_time;
  36. ;        unsigned access_date;
  37. ;        unsigned access_time;
  38. ;        unsigned write_date;
  39. ;        unsigned write_time;
  40. ;        unsigned long file_size;
  41. ;        unsigned long falloc_size;
  42. ;        unsigned attributes;
  43. ;        unsigned char string_len;
  44. ;        char file_name[13];
  45. ;        };
  46.  
  47. ; equivalent OS2XLISP structure
  48.  
  49. (define FileFindBuf
  50.     '((word create_date)
  51.       (word create_time)
  52.       (word access_date)
  53.       (word access_time)
  54.       (word write_date)
  55.       (word write_time)
  56.       (long file_size)
  57.       (long falloc_size)
  58.       (word attributes)
  59.       (byte string_len)
  60.       ((char 13) file_name)))
  61.  
  62. ; routine to print selected elements of the returned list
  63.           
  64. (define (print-dir filelist) 
  65.    (dotimes (i (length filelist))
  66.            (printf "%-20s %8lu\n" 
  67.             (cadr (assoc 'file_name (nth i filelist)))
  68.             (cadr (assoc 'file_size (nth i filelist))))))
  69.  
  70. ; directory routine
  71.         
  72. (define (dir &optional filespec (print-flag t))
  73.  
  74.     (if (null filespec)                     ; establish the filespec
  75.         (setf filespec "*.*"))
  76.     (if (not (equal 'STRING (type-of filespec)))
  77.         (setf filespec (format nil "*.~A" (symbol-name filespec))))
  78.  
  79.     (let*
  80.          ((filelist nil)                 ; intialize list
  81.          (hdir (word -1))                 ; default directory handle 
  82.          (attr (word 6))                 ; find normal, hidden, system files
  83.          (buf (make-struct FileFindBuf)) ; make instance of structure
  84.          (buflen (word (length buf)))     ; OS/2 needs structure's length
  85.          (find-count (word 1)))             ; find one file at a time
  86.  
  87.     (if (zerop (call DOSFINDFIRST    ; get info for first matching file
  88.         ^filespec                          
  89.         ^hdir                            
  90.         attr                               
  91.         ^buf                               
  92.         buflen                            
  93.         ^find-count                     
  94.         0))
  95.     ; then put info into list, find/add info for remaining files
  96.         (progn
  97.             (setf filelist (list (unpack-struct FileFindBuf ^buf)))
  98.             (while (zerop (call DOSFINDNEXT hdir ^buf buflen ^find-count))
  99.                 (nconc filelist
  100.                     (list (unpack-struct FileFindBuf ^buf))))))
  101.  
  102.     (call DOSFINDCLOSE hdir)
  103.  
  104.     (if print-flag (print-dir filelist) filelist))) ; print or return the list
  105.  
  106.