aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.gitignore1
-rw-r--r--calendars.conf (renamed from .calendars.conf)0
-rwxr-xr-xinstall.scm67
3 files changed, 67 insertions, 1 deletions
diff --git a/.gitignore b/.gitignore
index ee640c5..b3ebf9e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,3 @@
-.*
Documents/
Nextcloud/
dev/
diff --git a/.calendars.conf b/calendars.conf
index 7876df9..7876df9 100644
--- a/.calendars.conf
+++ b/calendars.conf
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))