aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorÓscar Nájera <hi@oscarnajera.com>2022-04-20 13:33:01 +0200
committerÓscar Nájera <hi@oscarnajera.com>2022-04-20 13:40:31 +0200
commitb48072aca0edf714cb0386ce4a82eb13c274e960 (patch)
tree7f66a9d8994f85ed83f851c97e5b863ac2ad645d
parent10996bf8c3248ca77b14c02678e3bcb098bc330b (diff)
downloaddotfiles-b48072aca0edf714cb0386ce4a82eb13c274e960.tar.gz
dotfiles-b48072aca0edf714cb0386ce4a82eb13c274e960.tar.bz2
dotfiles-b48072aca0edf714cb0386ce4a82eb13c274e960.zip
Quick fix dotfiles copy-symlink-deltree
The folder deletion should take place only when subfolders are also ready for deletion and link. Otherwise when going up don't register the folder. This is only tested for my own setup on one nested level.
-rwxr-xr-xinstall.scm46
1 files changed, 27 insertions, 19 deletions
diff --git a/install.scm b/install.scm
index 605a8f6..05dd0bc 100755
--- a/install.scm
+++ b/install.scm
@@ -13,6 +13,12 @@
(oop goops)
(term ansi-color))
+(define-syntax ->>
+ (syntax-rules ()
+ ((_ value) value)
+ ((_ value (f ...) rest ...) (->> (f ... value) rest ...))
+ ((_ value f rest ...) (->> (f value) rest ...))))
+
(define (ansi-color-log-formatter lvl time str)
(let ((color (cond ((eq? lvl 'CRITICAL) 'RED)
((eq? lvl 'WARN) 'YELLOW)
@@ -102,7 +108,8 @@
(define (config-links src target dry-run)
(let ((src-path (expand-file src))
(target-path (dot-replace (expand-file target))))
- (unless (and (symlink? target-path) (equal? (readlink target-path) src-path))
+ (unless (and (symlink? target-path)
+ (equal? (readlink target-path) src-path))
(rm-tree target-path dry-run)
(make-dir-parents (dirname target-path))
(symlink src-path target-path)
@@ -114,35 +121,36 @@
then symlink the files not the dir"
(define src-len (string-length file-name))
+ (define (target-subfile path)
+ (->> (substring path src-len)
+ (string-append target-path)
+ dot-replace
+ expand-file))
(define (enter? name stat result)
- (let* ((subdir (substring name src-len))
- (target-subdir (expand-file (dot-replace (string-append target-path subdir)))))
- (false-if-exception (eq? 'directory (stat:type (lstat target-subdir))))))
+ (->> (target-subfile name)
+ lstat
+ stat:type
+ (eq? 'directory)
+ false-if-exception))
(define (leaf name stat result)
- (let* ((subfile (substring name src-len))
- (target-subfile (string-append target-path subfile)))
- (config-links name target-subfile #f))
-
+ (config-links name (target-subfile name) #f)
(set-car! result (1+ (car result)))
result)
(define (down name stat result)
(log-msg 'INFO (format #f "Inspecting ~a" name ))
(cons 0 result))
+
(define (up name stat result)
- (let* ((subdir (substring name src-len))
- (target-subdir (expand-file (dot-replace (string-append target-path subdir))))
- (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)
- (when (= (car result) target-subdir-file-count)
- ;(format #t "~% Clear ~a because is identical to source" name)
- (leaf name stat result)))
-
- (list-set! result 1 (1+ (cadr result)))
+ (let ((should-clear (->> (scandir (target-subfile name)
+ (lambda (x)
+ (not (member x (list "." "..")))))
+ (length)
+ (= (car result)))))
+ (when should-clear (leaf name stat result))
+ (list-set! result 1 (+ (cadr result) (if should-clear 1 0))))
(cdr result))
;; Likewise for skipped directories.
(define skip leaf)