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 +++++++++++++++++++++++++++++++++++++++++++++
 module/calp/main.scm        | 39 ++++++-----------------------------
 2 files changed, 56 insertions(+), 33 deletions(-)
 create mode 100644 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])
+  )
diff --git a/module/calp/main.scm b/module/calp/main.scm
index 265b83aa..30465a49 100644
--- a/module/calp/main.scm
+++ b/module/calp/main.scm
@@ -28,11 +28,15 @@
   :use-module ((xdg basedir) :prefix xdg-)
 
   :use-module (calp translation)
+  :use-module ((calp load-config) :select (load-config find-config-file))
 
   :export (main)
   )
 
 
+
+
+
 (define options
   `((statprof (value display-style)
               (description ,(xml->sxml (G_ "<group>Run the program within Guile's built in statical
@@ -109,42 +113,11 @@ zoneinfo database, but is currently broken.</p>")
   (define repl (option-ref opts 'repl #f))
   (define altconfig (option-ref opts 'config #f))
 
-  (define config-file
-    (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]))
+  (define config-file (find-config-file altconfig))
 
   (when stprof (statprof-start))
 
-
-
-  ;; 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
-              )))
+  (load-config config-file)
 
   (awhen (option-ref opts 'edit-mode #f)
          ((@ (calp html config) edit-mode) #t))
-- 
cgit v1.2.3