home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / zelk / scm / traversedir.e < prev   
Encoding:
Text File  |  1992-10-17  |  3.7 KB  |  163 lines
  1. ;; traversedir.e - directory walking function
  2. ;; usage:
  3. ;;   (load "traverse.e")
  4. ;;      (traverse-p <path> <function>) 
  5. ;;   or (traverse <path> <function>)
  6. ;;   both call function with every file in path; 
  7. ;;   <function> takes one argument, the filename.
  8. ;; see examples below.
  9. ;; 
  10. ;; modified
  11. ;; 22sept
  12.  
  13.  
  14. (if (not (bound? 'chdir)) (load "chdir.o"))
  15. (if (not (bound? 'file-status)) (load "unix.o"))
  16. (if (not (bound? 'sh)) (load "shell.e"))
  17. (set! garbage-collect-notify? #f)
  18.  
  19.  
  20. (define (traverse path dofile)
  21.  
  22.     ;; helper
  23.     (define (traverse-dir path dofile)
  24.       (let ((dir (read-directory path))
  25.         (back (os-getwd)))
  26.     ;    (format #t "DIR: ~a~%" dir)
  27.         (format #t "traversing ~a~%" path)
  28.         (chdir path)
  29.         (dolist (entry dir)
  30.             (if (not (member entry '("." "..")))
  31.             (traverse entry dofile)))
  32.         (chdir back)
  33.       );let
  34.     );traverse-dir
  35.  
  36.   (if (equal? 'regular (file-status path))
  37.  
  38.       (dofile path)
  39.  
  40.       ; else
  41.       (if (file-exists? path)        ;dont try to read nonexistent links
  42.       (traverse-dir path dofile))
  43.   )
  44. );traverse
  45.  
  46.  
  47. ;; in this version the full path is kept in path, rather than chdiring
  48. ;; into each directory.
  49. (define (traverse-p path dofile)
  50.  
  51.     (define (traverse-p-dir path dofile)
  52.       (let ((dir (read-directory path)))
  53.         (format #t "traversing ~a~%" path)
  54.         (dolist (entry dir)
  55.             (if (not (member entry '("." "..")))
  56.             (traverse-p (string-append path "/" entry) dofile))
  57.         )
  58.       );let
  59.     );traverse-p-dir
  60.  
  61.   (if (equal? 'regular (file-status path))
  62.  
  63.       (dofile path)
  64.  
  65.       ; else
  66.       (if (file-exists? path)        ;dont try to read nonexistent links
  67.       (traverse-p-dir path dofile))
  68.   )
  69. );traverse-p
  70.  
  71.  
  72.  
  73. (define (traverse-print path)
  74. ;  (system (string-append "ls -l " path))
  75.   (print path))
  76.  
  77. (define (traversetest) (traverse "." traverse-print))
  78.  
  79.  
  80. ;; print recently created files
  81. (define (shownew)
  82.     (define seconds-per-day (* 60 60 24))
  83.     (define (isnew? path)
  84.       (> (os-filemodtime path) (- (os-curtime) (* seconds-per-day))))
  85.   (traverse "." (lambda (path) (if (isnew? path) (print path))))
  86. );shownew
  87.  
  88.  
  89. ;; print time-sorted names of files created between after, before
  90. (define (createdwhen after before)
  91.   (if (not (bound? 'sort))
  92.       (load "sort.scm" (global-environment)))
  93.   (let ((matches '())
  94.     (tmin (os-parsetime after))
  95.     (tmax (os-parsetime before)))
  96.     (if (or (= 0 tmin) (= 0 tmax))
  97.     (error 'createdwhen "bad time"))
  98.     (traverse "."
  99.       (lambda (i)
  100.     (let ((t (os-filemodtime i)))
  101.       (when (and (>= t tmin) (<= t tmax))
  102.         (set! matches
  103.               (cons (list t (string-append (os-getwd) "/" i)) matches))
  104.         (format #t "adding ~a ~a~%" i (os-timestring t))
  105.       );when
  106.     );
  107.       );lambda
  108.     );traverse
  109.     (set! matches (sort matches (lambda (a b) (> (car a) (car b)))))
  110.     (dolist (i matches)
  111.         (format #t "~a    ~a~%" (cadr i) (os-timestring (car i))))
  112.   matches);let
  113. );createdwhen
  114.           
  115.         
  116. ;; rm core files
  117. (define (rmcores)
  118.   (dolist (i (list (os-getenv "HOME") "/mm/zilla"))
  119.     (traverse i
  120.       (lambda (f)
  121.         (when (equal? f "core")
  122.           (format #t ">>> ~a~%" f)
  123.     )
  124.       ))))
  125.  
  126.  
  127. ;; grep thru all c files in this tree
  128. (define (grepthruC string)
  129.   (traverse "."
  130.     (lambda (f)
  131.       (let ((l (string-length f)))
  132.     (when (equal? ".c" (substring f (- l 2) l))
  133.           (print f)
  134.           (if (= (fsh "grep ~a ~a~%" string f) 0)
  135.           ;(print f)
  136.           #t
  137.           ;(got f)
  138.           )
  139.     );when
  140.       );let
  141.     );lambda
  142.   )
  143. );grepthruC
  144.  
  145.  
  146. ;; grep thru all libraries in this tree
  147. (define (grepthrulibs string)
  148.   (traverse "."
  149.     (lambda (f)
  150.       (let ((len (string-length f)))
  151.     (when (equal? ".a" (substring f (- len 2) len))
  152.           (print f)
  153.           (if (= (fsh "nm -o ~a | grep ~a~%" f string) 0)
  154.           ;(print f)
  155.           #t
  156.           ;(got f)
  157.           )
  158.     );when
  159.       );let
  160.     );lambda
  161.   )
  162. );grepthrulibs
  163.