blob: dfb85af7e0323ab0d4fa440f704745cdb9716aaf (
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
|
#!/usr/bin/guile \
-e main -s
!#
(use-modules (ice-9 popen)
(logging logger)
(logging port-log)
(ice-9 ftw)
(oop goops)
(term ansi-color))
(define (ansi-color-log-formatter lvl time str)
(let ((color (cond ((eq? lvl 'CRITICAL) 'RED)
((eq? lvl 'WARN) 'YELLOW)
((eq? lvl 'OK) 'GREEN))))
(string-append
(strftime "%F %H:%M:%S" (localtime time))
(colorize-string
(string-append " (" (symbol->string lvl) "): ") color 'BOLD)
str "\n")))
(define (setup-logging)
(let ((lgr (make <logger>))
(std (make <port-log>
#:port (current-output-port)
#:formatter ansi-color-log-formatter)))
;; add the handler to our logger
(add-handler! lgr std)
;; make this the application's default logger
(set-default-logger! lgr)
(open-log! lgr)))
(define (shutdown-logging)
(flush-log) ;; since no args, it uses the default
(close-log!) ;; since no args, it uses the default
(set-default-logger! #f))
(define (expand-file f)
;; https://irreal.org/blog/?p=83
(cond ((char=? (string-ref f 0) #\/) 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))
(log-msg 'WARN (string-append "Deleting previous file: " full-dest))
(delete-file full-dest)))
(define (config-links title 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)
(log-msg 'OK (string-append title " on " target)))))
(define (git-config)
(log-msg 'INFO "Configuring git")
(config-links " Symlink global config" "git/global-gitconfig" "~/.gitconfig")
(config-links " Symlink Tribe29 config" "git/tribe29" "~/git/.gitconfig"))
(define (symlink-dir dir target-dir)
(let ((cur (getcwd)))
(chdir dir)
(map (lambda (cmd)
(config-links (string-append " Symlink " cmd) cmd (string-append target-dir cmd)))
(scandir "." (lambda (f) (eq? 'regular (stat:type (stat f))))))
(chdir cur)))
(define (main args)
(setup-logging)
(log-msg 'INFO "Symlink PIM")
(config-links " Symlink agenda" "calendars.conf" "~/.calendars.conf")
(git-config)
(config-links " Symlink guile defaults" "dot-guile" "~/.guile")
(config-links " Symlink rofi" "rofi" "~/.config/rofi")
(config-links " Symlink zshrc" "dot-zshrc" "~/.zshrc")
(config-links " Symlink gpg-agent" "gnupu/gpg-agent.conf" "~/.gnupg/gpg-agent")
(symlink-dir "bin" "~/.local/bin/")
(shutdown-logging))
|
