blob: 770dd81b3d9b9a7374c4272a8e25d9fa036aea44 (
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
|
#!/usr/bin/guile \
-e main -s
!#
(use-modules (ice-9 popen)
(logging logger)
(logging port-log)
(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 (clean-file full-dest)
(when (file-exists? full-dest)
(log-msg 'WARN (string-append "Deleting previous file: " full-dest))
(delete-file full-dest))
full-dest)
(define (git-config)
(log-msg 'INFO "Configuring git")
(symlink (expand-file "git/global-gitconfig") (clean-file (expand-file "~/.gitconfig")))
(log-msg 'OK " Symlink global config")
(symlink (expand-file "git/tribe29") (clean-file (expand-file "~/git/.gitconfig")))
(log-msg 'OK " Symlink Tribe29 config"))
(define (main args)
(setup-logging)
(log-msg 'INFO "Symlink PIM")
(symlink (expand-file "calendars.conf") (clean-file (expand-file "~/.calendars.conf")))
(log-msg 'OK " Symlink agenda")
(git-config)
(shutdown-logging))
|
