From af9eaa8186b5c482639b617ab6dc04444dfbdf30 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C3=93scar=20N=C3=A1jera?= <hi@oscarnajera.com>
Date: Mon, 28 Sep 2020 22:11:03 +0200
Subject: Setup calendar by symlink

---
 install.scm | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 67 insertions(+)
 create mode 100755 install.scm

(limited to 'install.scm')

diff --git a/install.scm b/install.scm
new file mode 100755
index 0000000..1151500
--- /dev/null
+++ b/install.scm
@@ -0,0 +1,67 @@
+#!/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 (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")
+
+  (shutdown-logging))
-- 
cgit v1.2.3