diff options
author | Óscar Nájera <hi@oscarnajera.com> | 2020-10-25 16:11:55 +0100 |
---|---|---|
committer | Óscar Nájera <hi@oscarnajera.com> | 2020-10-25 16:11:55 +0100 |
commit | b1bbcaaf3cae88c56a104e3e340b3eb59efd239f (patch) | |
tree | 20cb5ae5e715afa2fdaea20beaccd88d57d02390 | |
parent | f927663a0fbaeb2ef1db0a19956f4cd3ba0b06bd (diff) | |
download | dotfiles-b1bbcaaf3cae88c56a104e3e340b3eb59efd239f.tar.gz dotfiles-b1bbcaaf3cae88c56a104e3e340b3eb59efd239f.tar.bz2 dotfiles-b1bbcaaf3cae88c56a104e3e340b3eb59efd239f.zip |
symlink a tree
-rw-r--r-- | config/afew/config (renamed from .config/afew/config) | 0 | ||||
-rw-r--r-- | config/matplotlib/matplotlibrc (renamed from .config/matplotlib/matplotlibrc) | 0 | ||||
-rw-r--r-- | config/mpd/mpd.conf (renamed from .config/mpd/mpd.conf) | 0 | ||||
l--------- | config/paist | 1 | ||||
-rw-r--r-- | config/termite/config (renamed from .config/termite/config) | 0 | ||||
-rw-r--r-- | config/xkb/symbols/oscar (renamed from .config/xkb/symbols/oscar) | 0 | ||||
-rw-r--r-- | config/you/me | 0 | ||||
-rwxr-xr-x | walk.scm | 67 |
8 files changed, 41 insertions, 27 deletions
diff --git a/.config/afew/config b/config/afew/config index b964f5a..b964f5a 100644 --- a/.config/afew/config +++ b/config/afew/config diff --git a/.config/matplotlib/matplotlibrc b/config/matplotlib/matplotlibrc index 567f2fd..567f2fd 100644 --- a/.config/matplotlib/matplotlibrc +++ b/config/matplotlib/matplotlibrc diff --git a/.config/mpd/mpd.conf b/config/mpd/mpd.conf index 618ffb5..618ffb5 100644 --- a/.config/mpd/mpd.conf +++ b/config/mpd/mpd.conf diff --git a/config/paist b/config/paist new file mode 120000 index 0000000..115f2df --- /dev/null +++ b/config/paist @@ -0,0 +1 @@ +pio
\ No newline at end of file diff --git a/.config/termite/config b/config/termite/config index 434be72..434be72 100644 --- a/.config/termite/config +++ b/config/termite/config diff --git a/.config/xkb/symbols/oscar b/config/xkb/symbols/oscar index b0c0f87..b0c0f87 100644 --- a/.config/xkb/symbols/oscar +++ b/config/xkb/symbols/oscar diff --git a/config/you/me b/config/you/me new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/config/you/me @@ -6,6 +6,7 @@ (logging port-log) (ice-9 ftw) (ice-9 match) + (ice-9 and-let-star) (oop goops) (term ansi-color)) @@ -26,45 +27,62 @@ (false-if-exception (eq? 'symlink (stat:type (lstat path))))) -(define (clean-file full-dest) - (when (false-if-exception (lstat full-dest)) - (display (string-append "\nDeleting previous file: " full-dest)) - ;(delete-file full-dest) - )) +(define (clean-file full-dest dry-run) + (and-let* ((info (false-if-exception (lstat full-dest))) + (type (stat:type info)) + (deleter (if (eq? type 'directory) rmdir delete-file)) + (task (if dry-run "Would delete" "Deleting"))) + (format #t "~a ~a: ~a~%" task type full-dest) + (unless dry-run (deleter full-dest)))) + +(define (rm-tree path dry-run) + (define (enter? a b c) #t) + (define (down name stat result) result) + (define (leaf name stat result) + (clean-file name dry-run) + result) + (define up leaf) + (define skip leaf) + ;; Ignore unreadable files/directories but warn the user. + (define (error name stat errno result) + (format (current-error-port) "warning~a: ~a: ~a~%" + errno name (strerror errno)) + result) -(define (config-links src target) + (file-system-fold enter? leaf down up skip error + (list 0) + path)) + +(define (config-links src target dry-run) (let ((src-path (expand-file src)) (target-path (expand-file target))) (unless (and (symlink? target-path) (equal? (readlink target-path) src-path)) - (clean-file target-path) - ;(symlink src-path target-path) - (display (string-append "\n Symlink: " src " -> " target))))) + (rm-tree target-path dry-run) + (symlink src-path target-path) + (format #t " Symlink: ~a -> ~a~%" src target)))) + +(define (symlink-tree file-name target-path) + "Tree recursively symlinks target-path->file-name. The goal is to + have few symlinks, yet if in the target space there are some files + then symlink the files not the dir" -(define (total-file-size file-name target-path) - "Return the size in bytes of the files under FILE-NAME (similar - to `du --apparent-size' with GNU Coreutils.)" (define src-len (string-length file-name)) (define (enter? name stat result) - ;; Skip version control directories. (let* ((subdir (substring name src-len)) (target-subdir (string-append target-path subdir))) - (format #t "~%~a: ~a | ~a ~a" name subdir target-subdir (stat:type stat)) - (false-if-exception (eq? 'directory (stat:type (lstat target-subdir)))) - )) + (format #t "~a: ~a | ~a ~a~%" name subdir target-subdir (stat:type stat)) + (false-if-exception (eq? 'directory (stat:type (lstat target-subdir)))))) (define (leaf name stat result) - ;; Return RESULT plus the size of the file at NAME. (let* ((subfile (substring name src-len)) (target-subfile (string-append target-path subfile))) - (config-links name target-subfile)) + (config-links name target-subfile #f)) (set-car! result (1+ (car result))) result) - ;; Count zero bytes for directories. (define (down name stat result) - (format #t "~% down on ~a" name) (cons 0 result)) (define (up name stat result) (let* ((subdir (substring name src-len)) @@ -72,7 +90,7 @@ (target-subdir-file-count (length (scandir target-subdir (lambda (x) (not (member x (list "." "..")))))))) - (format #t "~% up on ~a ~a ~a ~a " result name target-subdir target-subdir-file-count) + (format #t " up on ~a ~a ~a ~a ~%" result name target-subdir target-subdir-file-count) (when (= (car result) target-subdir-file-count) ;(format #t "~% Clear ~a because is identical to source" name) (leaf name stat result))) @@ -93,9 +111,4 @@ file-name)) -(total-file-size "config" "/home/titan/.config") - -(let ((di "/home/titan/.config/you")) - (false-if-exception (eq? 'directory (stat:type (lstat di))))) - -(error "hci" #f) +(symlink-tree "config" "/home/titan/.config") |