Code with similar effect but different implementation is used to MoveDirFiles (dir-streams here vs. "find . type -d" there).  And it isn't too useful either way. In other words: enjoy.


 #!/usr/local/bin/scsh \
 -lel dir-streams/load.scm -o dir-streams -e main -s

 Works with scsh 0.6.7 and sunterlib dir-streams 1.0.

 USAGE: clonedirskelt FROM-DIR TO-DIR
 Clone the directory skeleton (the bare subdir tree without leaves)
 of source directory FROM-DIR as target directory TO-DIR.  I.e.
 afterwards the names of the source and clone root may differ,
 but the names of the (strict) subdirs relative to FROM-DIR resp.
 TO-DIR will coincide. Forget symlinks (due to lack of ambition).

 The TO-DIR must not contain (hard-linked) cycles.

 The TO-DIR may preexist and live on --directories will not be
 creatively destroyed.  Ich verstehe mich.

 Examples
 clonedirskelt /foo/bar /ph/oo/bar
 clonedirskelt /foo/bar /foo/baz
 clonedirskelt /foo/bar ../baz

 Don't expect checks, error messages, quality.

 It would be nice to translate inward-pointing and to copy outward-
 pointing symlinks, but I do not need and did not do this.
 !#

 ;; simplify and remove trailing "/." (forgetting about symlinks)
 (define (simplerify-file-name fn)
   (let ((sn (simplify-file-name fn)))
     (cond ((string-suffix? "/." sn)
            (string-drop-right sn 2))
           ((string= sn ".") "")
           (else sn))))


 ;; SRC-ROOT, %CLONE-ROOT : String --directory paths
 (define (clone-dir-skeleton src-root %clone-root)
   (define clone-root (file-name-as-directory (resolve-file-name %clone-root
                                                                 (cwd))))
   (with-cwd src-root
     (dir-stream-for-each
      (dir-stream-from-dir-name "." #f)
      (lambda (fso-file) #f)
      (lambda (fso-dir)
        (let ((path-clone-dir (simplerify-file-name
                               (string-append clone-root
                                              (fs-object-file-name fso-dir)))))
          (format #t "~a~%" path-clone-dir)
          (if (file-not-exists? path-clone-dir)
              (create-directory path-clone-dir)))))))


 ;; no usage check tonite
 (define (main args)
   (clone-dir-skeleton (second args) (third args)))
