#!/usr/local/bin/scsh \
-e main -s
USAGE
movedirfiles FROM-DIR TO-DIR
SYNOPSIS: Moves visible (not dotted) files from FROM-DIR into TO-DIR,
preserving relative paths --provided they don't clash with a namesake.
This isn't carefully wrought comfort code. It's digidirt good enough
for my purpose. In particular, it relies on the nonstandard "mv -n"
option of the OS X / BSD variant of "mv". (Edited after use.)
!#
;; 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))))
(define (file-name-sans-directory path)
(last (split-file-name path)))
(define (file-name-dotted? fname)
(and (not (file-name-directory? fname))
(string-any #\. (file-name-sans-directory fname))
(string-null? (file-name-extension fname))))
;; Return quasirelative paths of subdirectories, each dir before its subdirs
(define (find-directories dirname)
(with-cwd dirname
(run/strings (find "." -type d))))
(define (find-visible-files dirname)
(remove! (lambda (fname) (file-name-dotted? fname))
(run/strings (find ,dirname -type f))))
(define (copy-directory-skeleton orig-dir clone-dir)
(for-each (lambda (path0)
(let ((path1 (path-list->file-name (list path0) clone-dir)))
(if (file-not-exists? path1)
(create-directory (simplerify-file-name path1)))))
(find-directories orig-dir)))
;; ... but don't overwrite an existing file ("mv -n", a nonstandard switch)
;; (RENAME-FILE wouldn't move files onto another device.)
(define (move-file from-fname to-filordirname)
(format #t "(-> \"~a\" \"~a\")~%" from-fname to-filordirname)
(run (mv -n ,from-fname ,to-filordirname)))
(define (move-directory-files from-dir to-dir)
(copy-directory-skeleton from-dir to-dir)
(for-each (lambda (fname)
(move-file (path-list->file-name (list fname) from-dir)
(path-list->file-name (list fname) to-dir)))
(with-cwd from-dir
(find-visible-files "."))))
(define (main args)
(let ((from-dir (second args))
(to-dir (third args)))
(move-directory-files from-dir to-dir)))
