blob: 4e53dca49a5d3bf26927099dc91bfa66ad0c5ebc (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
#!/usr/bin/guile \
-s
!#
(use-modules (ice-9 popen)
(logging logger)
(logging port-log)
(ice-9 ftw)
(ice-9 match)
(oop goops)
(term ansi-color))
(define (expand-file f)
;; https://irreal.org/blog/?p=83
(cond ((absolute-file-name? f) f)
((string=? (substring f 0 2) "~/")
(let ((prefix (passwd:dir (getpwuid (geteuid)))))
(string-append prefix (substring f 1 (string-length f)))))
((char=? (string-ref f 0) #\~)
(let* ((user-end (string-index f #\/))
(user (substring f 1 user-end))
(prefix (passwd:dir (getpwnam user))))
(string-append prefix (substring f user-end (string-length f)))))
(else (string-append (getcwd) "/" f))))
(define (symlink? path)
(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 (config-links src target)
(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)))))
(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))))
))
(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))
(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))
(target-subdir (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)))
(cdr result))
;; Likewise for skipped directories.
(define skip leaf)
;; Ignore unreadable files/directories but warn the user.
(define (error name stat errno result)
(format (current-error-port) "warning: ~a: ~a~%"
name (strerror errno))
result)
(file-system-fold enter? leaf down up skip error
(list 0)
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)
|
