From 027d15a06a5581b448b3e3a694467805c634f120 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Fri, 14 Oct 2022 23:18:49 +0200
Subject: Move load-config to own file.

Guile 3 defaults all modules to be declarative, but Guile doesn't
support extra args in define-module.
---
 module/calp/load-config.scm | 50 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)
 create mode 100644 module/calp/load-config.scm

(limited to 'module/calp/load-config.scm')

diff --git a/module/calp/load-config.scm b/module/calp/load-config.scm
new file mode 100644
index 00000000..5844c1b6
--- /dev/null
+++ b/module/calp/load-config.scm
@@ -0,0 +1,50 @@
+(cond-expand
+  (guile-3
+   (define-module (calp load-config)
+     :declarative? #f))
+  (else
+   (define-module (calp load-config)
+     )))
+
+(use-modules (srfi srfi-1)
+             (calp translation)
+             (hnh util path)
+             ((xdg basedir) :prefix xdg-))
+
+(export load-config find-config-file)
+
+(define (load-config config-file)
+ ;; Load config
+ ;; Sandbox and "stuff" not for security from the user. The config script is
+ ;; assumed to be "safe". Instead it's so we can control the environment in
+ ;; which it is executed.
+ (catch #t
+   (lambda () (load config-file))
+   (lambda args
+     (format (current-error-port)
+             ;; Two arguments:
+             ;; Configuration file path,
+             ;; thrown error arguments
+             (G_ "Failed loading config file ~a~%~s~%")
+             config-file
+             args
+             ))))
+
+
+(define (find-config-file altconfig)
+  (cond [altconfig
+         (if (file-exists? altconfig)
+             altconfig
+             (scm-error 'misc-error
+                        "wrapped-main"
+                        (G_ "Configuration file ~a missing")
+                        (list altconfig)
+                        #f))]
+        ;; altconfig could be placed in the list below. But I want to raise an error
+        ;; if an explicitly given config is missing.
+        [(find file-exists?
+               (list
+                (path-append (xdg-config-home) "calp" "config.scm")
+                (path-append (xdg-sysconfdir) "calp" "config.scm")))
+         => identity])
+  )
-- 
cgit v1.2.3