From 549cf99065e36ab7f2310d30119346ff123665dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 24 Aug 2020 00:13:58 +0200 Subject: Replace (directories) with general (xdg basedir). --- module/calp/entry-points/html.scm | 4 +-- module/calp/main.scm | 23 ++++++++------- module/datetime/instance.scm | 4 +-- module/directories.scm | 40 ------------------------- module/xdg/basedir.scm | 61 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 78 insertions(+), 54 deletions(-) delete mode 100644 module/directories.scm create mode 100644 module/xdg/basedir.scm diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm index b2f613ea..8c400e1d 100644 --- a/module/calp/entry-points/html.scm +++ b/module/calp/entry-points/html.scm @@ -19,7 +19,7 @@ :use-module ((sxml simple) :select (sxml->xml)) :use-module ((sxml transformations) :select (href-transformer)) - :use-module (directories) + :use-module ((xdg basedir) :prefix xdg-) :autoload (vcomponent instance) (global-event-object) ) @@ -74,7 +74,7 @@ ;; TODO nicer way to resolve static (let ((link (path-append output-directory "/static"))) (unless (file-exists? link) - (symlink (path-append data-directory "www/static") link))))) + (symlink (path-append (xdg-data-home) "/calp/www/static") link))))) (define (re-root-static tree) diff --git a/module/calp/main.scm b/module/calp/main.scm index 2a7944a9..e336846a 100644 --- a/module/calp/main.scm +++ b/module/calp/main.scm @@ -8,7 +8,6 @@ :use-module ((util config) :select (set-config! get-config get-configuration-documentation)) :use-module (util options) :use-module ((util hooks) :select (shutdown-hook)) - :use-module (directories) :use-module ((text markup) :select (sxml->ansi-text)) @@ -19,6 +18,8 @@ :use-module (statprof) :use-module (calp repl) + :use-module ((xdg basedir) :prefix xdg-) + ) @@ -106,8 +107,9 @@ (when stprof (statprof-start)) - (cond [(eqv? #t repl) (repl-start (format #f "~a/calp-~a" - runtime-directory (getpid)))] + (cond [(eqv? #t repl) (repl-start (format #f "~a/calp-~a" + (xdg-runtime-dir) + (getpid)))] [repl => repl-start]) (if altconfig @@ -119,8 +121,8 @@ (awhen (find file-exists? (list - (path-append user-config-directory "/config.scm") - (path-append system-config-directory "/config.scm"))) + (path-append (xdg-config-home) "/calp/config.scm") + (path-append (xdg-sysconfdir) "/calp/config.scm"))) (primitive-load it))) @@ -160,21 +162,22 @@ (throw 'return)) (when (option-ref opts 'update-zoneinfo #f) - (let ((pipe - (let-env ((PREFIX (get-config 'path-prefix))) - (open-input-pipe (path-append libexec "/tzget"))))) + (let* ((locations (list "/usr/libexec/calp/tzget" (path-append (xdg-data-home) "/tzget"))) + (filename (or (find file-exists? locations) + (error "tzget not installed, please put it in one of ~a" locations))) + (pipe (open-input-pipe filename))) ;; (define path (read-line pipe)) (define line ((@ (ice-9 rdelim) read-line) pipe)) (define names (string-split line #\space)) ((@ (util io) with-atomic-output-to-file) - (path-append data-directory "/zoneinfo.scm") + (path-append (xdg-data-home) "/calp/zoneinfo.scm") (lambda () (write `(set-config! 'tz-list ',names)) (newline) (write `(set-config! 'last-zoneinfo-upgrade ,((@ (datetime) current-date)))) (newline))))) ;; always load zoneinfo if available. - (let ((z (path-append data-directory "/zoneinfo.scm"))) + (let ((z (path-append (xdg-data-home) "/calp/zoneinfo.scm"))) (when (file-exists? z) (primitive-load z))) diff --git a/module/datetime/instance.scm b/module/datetime/instance.scm index db24d8a2..5b5a6604 100644 --- a/module/datetime/instance.scm +++ b/module/datetime/instance.scm @@ -3,7 +3,7 @@ :use-module (util config) :use-module (util exceptions) :use-module (datetime zic) - :use-module (directories) + :use-module ((xdg basedir) :prefix xdg-) :export (zoneinfo)) (define-config tz-list '() @@ -21,7 +21,7 @@ (self tz-list))) ((file-list) (provide 'zoneinfo) - (let* ((directory (path-append data-directory "/zoneinfo")) + (let* ((directory (path-append (xdg-data-home) "/calp/zoneinfo")) (key (cons directory file-list))) (aif (hash-ref cache key) it diff --git a/module/directories.scm b/module/directories.scm deleted file mode 100644 index 8e46d8b6..00000000 --- a/module/directories.scm +++ /dev/null @@ -1,40 +0,0 @@ -(define-module (directories) - :use-module (util) - :use-module (util config) - ) - -;; TODO possiblyy create a (system) parameter, which flips many -;; settings between being based in $HOME, and in / (or $prefix/). - -(define-config path-prefix "/usr") - -(define-public runtime-directory - (or (getenv "XDG_RUNTIME_DIR") - "/tmp")) - -(define-public system-config-directory "/etc/calp") - -(define-public user-config-directory - (path-append - (or (getenv "XDG_CONFIG_HOME") - (and=> (getenv "HOME") - (lambda (s) (path-append s "/.config")))) - "/calp")) - -(define (libexec%) - (or (getenv "LIBEXEC") - (path-append (get-config 'path-prefix) - "/lib/calp"))) - -(define-syntax libexec (identifier-syntax (libexec%))) -(export libexec) - -(define (data-directory%) - (path-append - (or (getenv "XDG_DATA_HOME") - (path-append (get-config 'path-prefix) "/share")) - "/calp")) - -(define-syntax data-directory (identifier-syntax (data-directory%))) -(export data-directory) - diff --git a/module/xdg/basedir.scm b/module/xdg/basedir.scm new file mode 100644 index 00000000..e734500e --- /dev/null +++ b/module/xdg/basedir.scm @@ -0,0 +1,61 @@ +;;; Commentary: +;;; https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html +;;; Code: + +(define-module (xdg basedir) + :export (sysconfdir runtime-dir + data-home config-home cache-home + data-dirs config-dirs)) + +;;; XDG_DATA_HOME +;;; $HOME/.local/share +(define (data-home) + (or (getenv "XDG_DATA_HOME") + (string-append (getenv "HOME") "/.local/share"))) + +;;; XDG_CONFIG_HOME +;;; $HOME/.config +(define (config-home) + (or (getenv "XDG_CONFIG_HOME") + (string-append (getenv "HOME") "/.config"))) + +;;; XDG_DATA_DIRS +;;; colon (:) sepparated, in addition to XDG_DATA_HOME +;;; /usr/local/share/:/usr/share/ +(define (data-dirs) + (let ((str (getenv "XDG_DATA_DIRS"))) + (if str + (string-split str #\:) + '("/usr/local/share" "/usr/share")))) + +;;; sysconfdir +;;; /etc +;;; Techincly not part of the standard, but it's mentioned +(define (sysconfdir) + (or (getenv "sysconfdir") + "/etc")) + + +;;; XDG_CONFIG_DIRS +;;; colon (:) separated, in adddition to XDG_CONFIG_HOME +;;; /etc/xdg +(define (config-dirs) + (let ((str (getenv "XDG_CONFIG_DIRS"))) + (if str + (string-split str #\:) + (list (string-append sysconfdir "/xdg"))))) + +;;; XDG_CACHE_HOME +;;; $HOME/.cache +(define (cache-home) + (or (getenv "XDG_CACHE_HOME") + (string-append (getenv "HOME") "/.cache"))) + +;;; XDG_RUNTIME_DIR +;;; Default to /tmp or /tmp/$(uid), and raise a warning +(define (runtime-dir) + (or (getenv "XDG_RUNTIME_DIR") + (begin + (display "WARNING: XDG_RUNTIME_DIR unset, defaulting to /tmp\n" + (current-error-port)) + "/tmp"))) -- cgit v1.2.3