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