This Text file is old! In a 🏛️Museum, an unsorted archive of (user-)pages. (Saved from Geocities in Oct-2009. The archival story: oocities.org)
--------------------------------------- (To 🚫report any bad content: archivehelp @ gmail.com)

; dirlist.scm - 
; pre-order traversal of directory tree
; uses indentation to show tree structure
; shows upwards accumulation (from the leaves) of cumulative disk space usage in each directory
; rounds to the nearest megabyte

; (Note: This program is only approximately what Windows Explorer will give
; you, but it still helps to locate problem areas in your directory tree of high
; disk space usage. There are inconsistencies in the way Windows measures disk space usage itself.
; For example, under Windows 98 the disk space derived from 'right-click -> properties'
; on a folder/directory in Windows Explorer does not always match the amount
; you get if you select every item in the folder/directory and do
; 'right-click -> properties'. Try 'Temporary Internet Files' for instance.) 
;--------------------------------------------------------------------------------

; if their are no sub-directories in a directory, the directory is a leaf: 
;  (leaf 234 "c:\\dir-name..."
; if there are sub-directories then the directory is a node: 
;  (node 234 2345 "c:\dir-name" (node ...(node...(leaf

; the two numbers associated with each directory are: 
;   the space consumed by files in that directory
;   and the cumulative total of all files in that directory and sub-directories

(define (string-pad s len)
   (let* ((str-len (string-length s))
         (excess (- len str-len)))
            (cond
               ((> excess 0) (string-append (make-string excess #\space) s))
	       ((< excess 0) (substring s (- excess) (string-length s)))
	       (else s))))

(define (reduce op base x)
   (if (null? x)
      base
      (op (car x)(reduce op base (cdr x)))))

(define (zip l1 l2)
   (cond 
      ((null? l1) '())
      (else 
       (cons 
        (list (car l1) (car l2)) 
        (zip (cdr l1) (cdr l2))))))

(define string-append-2
  (lambda (s1)
    (lambda (s2)
        (string-append s1 s2))))     

(define (directory-list-paths dir)
   (directory-list-paths-2 (map (string-append-2 dir) (directory-list dir)) '() '()))

(define (directory-list-paths-2 in files dirs)
   (cond 
      ((null? in) (list files dirs))
      ((directory-exists? (car in))
         (directory-list-paths-2 (cdr in) files (cons (string-append (car in) "\\") dirs)))
      (else 
        (directory-list-paths-2 (cdr in) (cons (car in) files) dirs))))

(define (file-paths directory-contents)
   (car directory-contents))

(define (dir-paths directory-contents)
   (cadr directory-contents))


;----------------------------------------------------------------------------------

(define (files-total-size files)
   (reduce + 0 (map file-size files))) 

(define (dir-space dir)
   (files-total-size (file-paths (directory-list-paths dir))))

(dir-space "c:\\Balzac\\")
;-----------------------------------------------------------------------------------
; directory tree walker (listing of file sizes)
; recursive in-order traversal of tree starting at root directory

; visit node: print out files in dir with sizes 
; traverse: for a directory get sub-directories, 
; recurse on each sub-directory in turn, 
; get a list of children/sub-directories,
; then recurse down this list visiting each one in turn

; need to create indentation matching tree structure
; need to create aligned fields with sizes in same column

(define (reduce op base x)
   (if (null? x)
      base
      (op (car x)(reduce op base (cdr x)))))

(define (sum-second l)
   (reduce (lambda (item acum) (+ (cadr item) acum)) 0 l))

(define (visit-node dir dir-size)
   (display (format "~%~A  ~A" dir dir-size)))

(define (walk-dir l)
  (walk-dir-1 l 1))

(define (walk-dir-2 l level)
  ;(display (format "~%walk-dir-2:~A" l))
  (cond
    ((null? l) 0)
    (else 
       (+ (walk-dir-1 (car l) level) (walk-dir-2 (cdr l) level)) )))
       
(define (indent per-level level)
   (make-string (* per-level level) #\space))

; print megabytes of disk space
; round to nearest megabyte (note: (expt 2 20) = 1048576)

(define (summarize space)
   (round (/ space 1048576)))

;(define (summarize space)
;   (round (/ space 1000000)))

(define (pad-number number padding)
   (string-pad (number->string number) padding))

(define (walk-dir-1 dir level)  
   (let* ((level (+ level 1))
          (dir-content (directory-list-paths dir))
          (sub-dirs (dir-paths dir-content))
	  (space (dir-space dir))
	  (line (format "~A: ~A ~A~A" 
	     (pad-number (summarize space) 3) 
             level 
	     (indent 2 level) 
             dir))
	  (rollup (+ (walk-dir-2 sub-dirs level) space) ))
              (newline)(display (string-append (pad-number (summarize rollup) 4) " " line)) 
              rollup
    )) 

(define (print-reverse lst)
   (cond
      ((null? lst) (void))
      (else 
         (begin 
            (print-reverse (cdr lst))
            (display (format "~%~A" (car lst))) ))))
;-----------------------------------------------------------------------------
; run program:
;(display "directory tree:")(newline)

; print out directory listing of files sizes
(define dir-listing (open-output-file "dirlisting2.txt" 'replace))
(current-output-port dir-listing) 
(walk-dir "c:\\")
(close-output-port dir-listing)