diff options
Diffstat (limited to 'gnu/home')
| -rw-r--r-- | gnu/home/services.scm | 58 | ||||
| -rw-r--r-- | gnu/home/services/desktop.scm | 58 | ||||
| -rw-r--r-- | gnu/home/services/mcron.scm | 91 | ||||
| -rw-r--r-- | gnu/home/services/pm.scm | 145 | ||||
| -rw-r--r-- | gnu/home/services/shells.scm | 100 | ||||
| -rw-r--r-- | gnu/home/services/shepherd.scm | 3 | ||||
| -rw-r--r-- | gnu/home/services/xdg.scm | 91 |
7 files changed, 395 insertions, 151 deletions
diff --git a/gnu/home/services.scm b/gnu/home/services.scm index 99035686f1f..b17a34d19da 100644 --- a/gnu/home/services.scm +++ b/gnu/home/services.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> +;;; Copyright © 2021-2023 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2022-2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,6 +34,7 @@ #:use-module (guix i18n) #:use-module (guix modules) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (ice-9 match) #:use-module (ice-9 vlist) @@ -47,6 +49,10 @@ home-run-on-change-service-type home-provenance-service-type + literal-string + literal-string? + literal-string-value + environment-variable-shell-definitions home-files-directory xdg-configuration-files-directory @@ -171,32 +177,52 @@ packages, configuration files, activation script, and so on."))) configuration files that the user has declared in their @code{home-environment} record."))) +;; Representation of a literal string. +(define-record-type <literal-string> + (literal-string str) + literal-string? + (str literal-string-value)) + (define (environment-variable-shell-definitions variables) "Return a gexp that evaluates to a list of POSIX shell statements defining VARIABLES, a list of environment variable name/value pairs. The returned code ensures variable values are properly quoted." - #~(let ((shell-quote - (lambda (value) - ;; Double-quote VALUE, leaving dollar sign as is. - (let ((quoted (list->string - (string-fold-right + #~(let* ((quote-string + (lambda (value quoted-chars) + (list->string (string-fold-right (lambda (chr lst) - (case chr - ((#\" #\\) - (append (list chr #\\) lst)) - (else (cons chr lst)))) + (if (memq chr quoted-chars) + (append (list #\\ chr) lst) + (cons chr lst))) '() value)))) - (string-append "\"" quoted "\""))))) + (shell-double-quote + (lambda (value) + ;; Double-quote VALUE, leaving dollar sign as is. + (string-append "\"" (quote-string value '(#\" #\\)) + "\""))) + (shell-single-quote + (lambda (value) + ;; Single-quote VALUE to enter a literal string. + (string-append "'" (quote-string value '(#\')) + "'")))) (string-append #$@(map (match-lambda ((key . #f) "") ((key . #t) #~(string-append "export " #$key "\n")) - ((key . value) + ((key . (or (? string? value) + (? file-like? value) + (? gexp? value))) + #~(string-append "export " #$key "=" + (shell-double-quote #$value) + "\n")) + ((key . (? literal-string? value)) #~(string-append "export " #$key "=" - (shell-quote #$value) "\n"))) + (shell-single-quote + #$(literal-string-value value)) + "\n"))) variables)))) (define (environment-variables->setup-environment-script vars) @@ -313,7 +339,7 @@ directory containing FILES." (extend append) (default-value '()) (description "Files that will be put in -@file{~~/.guix-home/files}, and further processed during activation."))) +@file{~/.guix-home/files}, and further processed during activation."))) (define xdg-configuration-files-directory ".config") @@ -334,7 +360,7 @@ directory containing FILES." (extend append) (default-value '()) (description "Files that will be put in -@file{~~/.guix-home/files/.config}, and further processed during activation."))) +@file{~/.guix-home/files/.config}, and further processed during activation."))) (define xdg-data-files-directory ".local/share") @@ -355,7 +381,7 @@ directory containing FILES." (extend append) (default-value '()) (description "Files that will be put in -@file{~~/.guix-home/files/.local/share}, and further processed during +@file{~/.guix-home/files/.local/share}, and further processed during activation."))) diff --git a/gnu/home/services/desktop.scm b/gnu/home/services/desktop.scm index b0f4d969b0c..cb25b03b649 100644 --- a/gnu/home/services/desktop.scm +++ b/gnu/home/services/desktop.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2022 ( <paren@disroot.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +21,7 @@ #:use-module (gnu home services) #:use-module (gnu home services shepherd) #:use-module (gnu services configuration) + #:autoload (gnu packages glib) (dbus) #:autoload (gnu packages xdisorg) (redshift) #:use-module (guix records) #:use-module (guix gexp) @@ -27,8 +29,10 @@ #:use-module (ice-9 match) #:export (home-redshift-configuration home-redshift-configuration? + home-redshift-service-type - home-redshift-service-type)) + home-dbus-configuration + home-dbus-service-type)) ;;; @@ -161,7 +165,8 @@ format.")) (start #~(make-forkexec-constructor (list #$(file-append redshift "/bin/redshift") "-c" #$config-file))) - (stop #~(make-kill-destructor))))) + (stop #~(make-kill-destructor)) + (actions (list (shepherd-configuration-action config-file)))))) (define home-redshift-service-type (service-type @@ -172,3 +177,52 @@ format.")) (description "Run Redshift, a program that adjusts the color temperature of display according to time of day."))) + + +;;; +;;; D-Bus. +;;; + +(define-record-type* <home-dbus-configuration> + home-dbus-configuration make-home-dbus-configuration + home-dbus-configuration? + (dbus home-dbus-dbus ;file-like + (default dbus))) + +(define (home-dbus-shepherd-services config) + (list (shepherd-service + (documentation "Run the D-Bus daemon in session-specific mode.") + (provision '(dbus)) + (start #~(make-forkexec-constructor + (list #$(file-append (home-dbus-dbus config) + "/bin/dbus-daemon") + "--nofork" "--session" + (format #f "--address=unix:path=~a/bus" + (or (getenv "XDG_RUNTIME_DIR") + (format #f "/run/user/~a" + (getuid))))) + #:environment-variables + (cons "DBUS_VERBOSE=1" + (default-environment-variables)) + #:log-file + (format #f "~a/dbus.log" + (or (getenv "XDG_LOG_HOME") + (format #f "~a/.local/var/log" + (getenv "HOME")))))) + (stop #~(make-kill-destructor))))) + +(define (home-dbus-environment-variables config) + '(("DBUS_SESSION_BUS_ADDRESS" + . "unix:path=${XDG_RUNTIME_DIR:-/run/user/$UID}/bus"))) + +(define home-dbus-service-type + (service-type + (name 'home-dbus) + (extensions + (list (service-extension home-shepherd-service-type + home-dbus-shepherd-services) + (service-extension home-environment-variables-service-type + home-dbus-environment-variables))) + (default-value (home-dbus-configuration)) + (description + "Run the session-specific D-Bus inter-process message bus."))) diff --git a/gnu/home/services/mcron.scm b/gnu/home/services/mcron.scm index 0b3dbb810bc..5f35bfe0545 100644 --- a/gnu/home/services/mcron.scm +++ b/gnu/home/services/mcron.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +21,7 @@ (define-module (gnu home services mcron) #:use-module (gnu packages guile-xyz) #:use-module (gnu home services) + #:use-module (gnu services configuration) #:use-module (gnu services shepherd) #:use-module (gnu home services shepherd) #:use-module (guix records) @@ -53,45 +55,59 @@ ;; ;;; Code: -(define-record-type* <home-mcron-configuration> home-mcron-configuration - make-home-mcron-configuration - home-mcron-configuration? - (package home-mcron-configuration-package ; package - (default mcron)) - (jobs home-mcron-configuration-jobs ; list of jobs - (default '()))) +(define list-of-gexps? + (list-of gexp?)) + +(define-configuration/no-serialization home-mcron-configuration + (mcron (file-like mcron) "The mcron package to use.") + (jobs + (list-of-gexps '()) + "This is a list of gexps (@pxref{G-Expressions}), where each gexp +corresponds to an mcron job specification (@pxref{Syntax, mcron job +specifications,, mcron, GNU@tie{}mcron}).") + (log? (boolean #t) "Log messages to standard output.") + (log-format + (string "~1@*~a ~a: ~a~%") + "@code{(ice-9 format)} format string for log messages. The default value +produces messages like \"@samp{@var{pid} @var{name}: +@var{message}\"} (@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}). +Each message is also prefixed by a timestamp by GNU Shepherd.")) (define job-files (@@ (gnu services mcron) job-files)) (define shepherd-schedule-action (@@ (gnu services mcron) shepherd-schedule-action)) -(define home-mcron-shepherd-services - (match-lambda - (($ <home-mcron-configuration> mcron '()) ; no jobs to run - '()) - (($ <home-mcron-configuration> mcron jobs) - (let ((files (job-files mcron jobs))) - (list (shepherd-service - (documentation "User cron jobs.") - (provision '(mcron)) - (modules `((srfi srfi-1) - (srfi srfi-26) - (ice-9 popen) ; for the 'schedule' action - (ice-9 rdelim) - (ice-9 match) - ,@%default-modules)) - (start #~(make-forkexec-constructor - (list #$(file-append mcron "/bin/mcron") #$@files) - #:log-file (string-append - (or (getenv "XDG_LOG_HOME") - (format #f "~a/.local/var/log" - (getenv "HOME"))) - "/mcron.log"))) - (stop #~(make-kill-destructor)) - (actions - (list (shepherd-schedule-action mcron files))))))))) +(define (home-mcron-shepherd-services config) + (match-record config <home-mcron-configuration> + (mcron jobs log? log-format) + (if (null? jobs) + '() ;no jobs to run + (let ((files (job-files mcron jobs))) + (list (shepherd-service + (documentation "User cron jobs.") + (provision '(mcron)) + (modules `((srfi srfi-1) + (srfi srfi-26) + (ice-9 popen) ;for the 'schedule' action + (ice-9 rdelim) + (ice-9 match) + ,@%default-modules)) + (start #~(make-forkexec-constructor + (list (string-append #$mcron "/bin/mcron") + #$@(if log? + #~("--log" "--log-format" #$log-format) + #~()) + #$@files) + #:log-file (string-append + (or (getenv "XDG_LOG_HOME") + (format #f "~a/.local/var/log" + (getenv "HOME"))) + "/mcron.log"))) + (stop #~(make-kill-destructor)) + (actions + (list (shepherd-schedule-action mcron files))))))))) -(define home-mcron-profile (compose list home-mcron-configuration-package)) +(define home-mcron-profile (compose list home-mcron-configuration-mcron)) (define (home-mcron-extend config jobs) (home-mcron-configuration @@ -113,3 +129,12 @@ (default-value (home-mcron-configuration)) (description "Install and configure the GNU mcron cron job manager."))) + + +;;; +;;; Generate documentation. +;;; +(define (generate-doc) + (configuration->documentation 'home-mcron-configuration)) + +;;; mcron.scm ends here diff --git a/gnu/home/services/pm.scm b/gnu/home/services/pm.scm new file mode 100644 index 00000000000..5f09941827c --- /dev/null +++ b/gnu/home/services/pm.scm @@ -0,0 +1,145 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 ( <paren@disroot.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu home services pm) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (gnu home services) + #:use-module (gnu home services shepherd) + #:use-module (gnu packages monitoring) + #:use-module (gnu services shepherd) + + #:export (home-batsignal-configuration + home-batsignal-service-type)) + +;;; +;;; batsignal +;;; +;;; Daemon for running commands and displaying notifications on +;;; battery events. +;;; + +(define-record-type* <home-batsignal-configuration> + home-batsignal-configuration make-home-batsignal-configuration + home-batsignal-configuration? + (warning-level batsignal-warning-level ;integer + (default 15)) + (warning-message batsignal-warning-message ;string | #f + (default #f)) + (critical-level batsignal-critical-level ;integer + (default 5)) + (critical-message batsignal-critical-message ;string | #f + (default #f)) + (danger-level batsignal-danger-level ;integer + (default 2)) + (danger-command batsignal-danger-command ;file-like | string | #f + (default #f)) + (full-level batsignal-full-level ;integer | #f + (default #f)) + (full-message batsignal-full-message ;string | #f + (default #f)) + (batteries batsignal-batteries ;list of string + (default '())) + (poll-delay batsignal-poll-delay ;integer + (default 60)) + (icon batsignal-icon ;file-like | #f + (default #f)) + (notifications? batsignal-notifications? ;boolean + (default #t)) + (notifications-expire? batsignal-notifications-expire? ;boolean + (default #f)) + (notification-command batsignal-notification-command ;string | #f + (default #f)) + (ignore-missing? batsignal-ignore-missing? ;boolean + (default #f))) + +(define (home-batsignal-shepherd-services config) + (let ((warning-level (batsignal-warning-level config)) + (warning-message (batsignal-warning-message config)) + (critical-level (batsignal-critical-level config)) + (critical-message (batsignal-critical-message config)) + (danger-level (batsignal-danger-level config)) + (danger-command (batsignal-danger-command config)) + (full-level (batsignal-full-level config)) + (full-message (batsignal-full-message config)) + (batteries (batsignal-batteries config)) + (poll-delay (batsignal-poll-delay config)) + (icon (batsignal-icon config)) + (notifications? (batsignal-notifications? config)) + (notifications-expire? (batsignal-notifications-expire? config)) + (notification-command (batsignal-notification-command config)) + (ignore-missing? (batsignal-ignore-missing? config))) + (list (shepherd-service + (provision '(batsignal)) + (documentation "Run the batsignal battery-watching daemon.") + (start #~(make-forkexec-constructor + (append (list #$(file-append batsignal "/bin/batsignal") + "-w" (number->string #$warning-level) + "-c" (number->string #$critical-level) + "-d" (number->string #$danger-level) + "-m" (number->string #$poll-delay)) + (if #$warning-message + (list "-W" #$warning-message) + (list)) + (if #$critical-message + (list "-C" #$critical-message) + (list)) + (if #$danger-command + (list "-D" #$danger-command) + (list)) + (if #$full-level + (list "-f" (number->string #$full-level)) + (list)) + (if #$full-message + (list "-F" #$full-message) + (list)) + (if (null? (list #$@batteries)) + (list) + (list "-n" (string-join (list #$@batteries) ","))) + (if #$icon + (list "-I" #$icon) + (list)) + (if #$notifications? + (list) + (list "-N")) + (if #$notifications-expire? + (list "-e") + (list)) + (if #$notification-command + (list "-M" #$notification-command) + (list)) + (if #$ignore-missing? + (list "-i") + (list))) + #:log-file (string-append + (or (getenv "XDG_LOG_HOME") + (format #f "~a/.local/var/log" + (getenv "HOME"))) + "/batsignal.log"))) + (stop #~(make-kill-destructor)))))) + +(define home-batsignal-service-type + (service-type + (name 'home-batsignal) + (extensions + (list (service-extension home-shepherd-service-type + home-batsignal-shepherd-services))) + (default-value (home-batsignal-configuration)) + (description + "Run batsignal, a battery watching and notification daemon."))) diff --git a/gnu/home/services/shells.scm b/gnu/home/services/shells.scm index 172e58a9ffb..3326eb37f49 100644 --- a/gnu/home/services/shells.scm +++ b/gnu/home/services/shells.scm @@ -19,12 +19,14 @@ (define-module (gnu home services shells) #:use-module (gnu services configuration) + #:autoload (gnu system shadow) (%default-bashrc) #:use-module (gnu home services utils) #:use-module (gnu home services) #:use-module (gnu packages shells) #:use-module (gnu packages bash) #:use-module (guix gexp) #:use-module (guix packages) + #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) @@ -369,43 +371,6 @@ Used for executing user's commands at the exit of login shell. It won't be read in some cases (if the shell terminates by exec'ing another process for example).")) -;; TODO: Use value from (gnu system shadow) -(define guix-bashrc - "\ -# Bash initialization for interactive non-login shells and -# for remote shells (info \"(bash) Bash Startup Files\"). - -# Export 'SHELL' to child processes. Programs such as 'screen' -# honor it and otherwise use /bin/sh. -export SHELL - -if [[ $- != *i* ]] -then - # We are being invoked from a non-interactive shell. If this - # is an SSH session (as in \"ssh host command\"), source - # /etc/profile so we get PATH and other essential variables. - [[ -n \"$SSH_CLIENT\" ]] && source /etc/profile - - # Don't do anything else. - return -fi - -# Source the system-wide file. -if [[ -e /etc/bashrc ]]; then - source /etc/bashrc -fi - -# Adjust the prompt depending on whether we're in 'guix environment'. -if [ -n \"$GUIX_ENVIRONMENT\" ] -then - PS1='\\u@\\h \\w [env]\\$ ' -else - PS1='\\u@\\h \\w\\$ ' -fi -alias ls='ls -p --color=auto' -alias ll='ls -l' -alias grep='grep --color=auto'\n") - (define (add-bash-configuration config) (define (filter-fields field) (filter-configuration-fields home-bash-configuration-fields @@ -442,13 +407,23 @@ if [ -f ~/.profile ]; then source ~/.profile; fi # Honor per-interactive-shell startup file if [ -f ~/.bashrc ]; then source ~/.bashrc; fi " + + ;; The host distro might provide a bad 'PS1' default--e.g., not taking + ;; $GUIX_ENVIRONMENT into account. Provide a good default here when + ;; asked to. The default can be overridden below via + ;; 'environment-variables'. + (if (home-bash-configuration-guix-defaults? config) + "PS1='\\u@\\h \\w${GUIX_ENVIRONMENT:+ [env]}\\$ '\n" + "") + (serialize-field 'bash-profile) (serialize-field 'environment-variables))) ,@(list (file-if-not-empty 'bashrc (if (home-bash-configuration-guix-defaults? config) - (list (serialize-field 'aliases) guix-bashrc) + (list (serialize-field 'aliases) + (plain-file-content %default-bashrc)) (list (serialize-field 'aliases)))) (file-if-not-empty 'bash-logout))))) @@ -479,31 +454,30 @@ with text blocks from other extensions and the base service.") with text blocks from other extensions and the base service.")) (define (home-bash-extensions original-config extension-configs) - (match original-config - (($ <home-bash-configuration> _ _ _ environment-variables aliases - bash-profile bashrc bash-logout) - (home-bash-configuration - (inherit original-config) - (environment-variables - (append environment-variables - (append-map - home-bash-extension-environment-variables extension-configs))) - (aliases - (append aliases - (append-map - home-bash-extension-aliases extension-configs))) - (bash-profile - (append bash-profile - (append-map - home-bash-extension-bash-profile extension-configs))) - (bashrc - (append bashrc - (append-map - home-bash-extension-bashrc extension-configs))) - (bash-logout - (append bash-logout - (append-map - home-bash-extension-bash-logout extension-configs))))))) + (match-record original-config <home-bash-configuration> + (environment-variables aliases bash-profile bashrc bash-logout) + (home-bash-configuration + (inherit original-config) + (environment-variables + (append environment-variables + (append-map + home-bash-extension-environment-variables extension-configs))) + (aliases + (append aliases + (append-map + home-bash-extension-aliases extension-configs))) + (bash-profile + (append bash-profile + (append-map + home-bash-extension-bash-profile extension-configs))) + (bashrc + (append bashrc + (append-map + home-bash-extension-bashrc extension-configs))) + (bash-logout + (append bash-logout + (append-map + home-bash-extension-bash-logout extension-configs)))))) (define home-bash-service-type (service-type (name 'home-bash) diff --git a/gnu/home/services/shepherd.scm b/gnu/home/services/shepherd.scm index d2a803279fa..1a70a220f0b 100644 --- a/gnu/home/services/shepherd.scm +++ b/gnu/home/services/shepherd.scm @@ -45,7 +45,8 @@ shepherd-service-auto-start? shepherd-service-modules - shepherd-action)) + shepherd-action + shepherd-configuration-action)) (define-record-type* <home-shepherd-configuration> home-shepherd-configuration make-home-shepherd-configuration diff --git a/gnu/home/services/xdg.scm b/gnu/home/services/xdg.scm index 63c6041cd49..3007493f856 100644 --- a/gnu/home/services/xdg.scm +++ b/gnu/home/services/xdg.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> +;;; Copyright © 2021, 2022 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; ;;; This file is part of GNU Guix. @@ -35,10 +35,24 @@ #:export (home-xdg-base-directories-service-type home-xdg-base-directories-configuration home-xdg-base-directories-configuration? + home-xdg-base-directories-configuration-cache-home + home-xdg-base-directories-configuration-config-home + home-xdg-base-directories-configuration-data-home + home-xdg-base-directories-configuration-state-home + home-xdg-base-directories-configuration-log-home + home-xdg-base-directories-configuration-runtime-dir home-xdg-user-directories-service-type home-xdg-user-directories-configuration home-xdg-user-directories-configuration? + home-xdg-user-directories-configuration-desktop + home-xdg-user-directories-configuration-documents + home-xdg-user-directories-configuration-download + home-xdg-user-directories-configuration-music + home-xdg-user-directories-configuration-pictures + home-xdg-user-directories-configuration-publicshare + home-xdg-user-directories-configuration-templates + home-xdg-user-directories-configuration-videos xdg-desktop-action xdg-desktop-entry @@ -106,22 +120,25 @@ services more consistent.")) home-xdg-base-directories-configuration-fields)) (define (ensure-xdg-base-dirs-on-activation config) - #~(map (lambda (xdg-base-dir-variable) - ((@ (guix build utils) mkdir-p) - (getenv - xdg-base-dir-variable))) - '#$(filter-map - (lambda (field) - (let ((variable - (string-append - "XDG_" - (object->snake-case-string - (configuration-field-name field) 'upper)))) - ;; XDG_RUNTIME_DIR shouldn't be created during activation - ;; and will be provided by elogind or other service. - (and (not (string=? "XDG_RUNTIME_DIR" variable)) - variable))) - home-xdg-base-directories-configuration-fields))) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (map (lambda (xdg-base-dir-variable) + (mkdir-p + (getenv + xdg-base-dir-variable))) + '#$(filter-map + (lambda (field) + (let ((variable + (string-append + "XDG_" + (object->snake-case-string + (configuration-field-name field) 'upper)))) + ;; XDG_RUNTIME_DIR shouldn't be created during activation + ;; and will be provided by elogind or other service. + (and (not (string=? "XDG_RUNTIME_DIR" variable)) + variable))) + home-xdg-base-directories-configuration-fields))))) (define (last-extension-or-cfg config extensions) "Picks configuration value from last provided extension. If there @@ -231,6 +248,8 @@ pre-populated content.") home-activation-service-type home-xdg-user-directories-activation-service))) (default-value (home-xdg-user-directories-configuration)) + (compose identity) + (extend last-extension-or-cfg) (description "Configure XDG user directories. To disable a directory, point it to the $HOME."))) @@ -383,25 +402,25 @@ configuration." (define (serialize-alist config) (generic-serialize-alist append format-config config)) - (define (serialize-xdg-desktop-action action) - (match action - (($ <xdg-desktop-action> action name config) - `(,(format #f "[Desktop Action ~a]\n" - (string-capitalize (maybe-object->string action))) - ,(format #f "Name=~a\n" name) - ,@(serialize-alist config))))) - - (match entry - (($ <xdg-desktop-entry> file name type config actions) - (list (if (string-suffix? file ".desktop") - file - (string-append file ".desktop")) - `("[Desktop Entry]\n" - ,(format #f "Name=~a\n" name) - ,(format #f "Type=~a\n" - (string-capitalize (symbol->string type))) - ,@(serialize-alist config) - ,@(append-map serialize-xdg-desktop-action actions)))))) + (define (serialize-xdg-desktop-action desktop-action) + (match-record desktop-action <xdg-desktop-action> + (action name config) + `(,(format #f "[Desktop Action ~a]\n" + (string-capitalize (maybe-object->string action))) + ,(format #f "Name=~a\n" name) + ,@(serialize-alist config)))) + + (match-record entry <xdg-desktop-entry> + (file name type config actions) + (list (if (string-suffix? file ".desktop") + file + (string-append file ".desktop")) + `("[Desktop Entry]\n" + ,(format #f "Name=~a\n" name) + ,(format #f "Type=~a\n" + (string-capitalize (symbol->string type))) + ,@(serialize-alist config) + ,@(append-map serialize-xdg-desktop-action actions))))) (define-configuration home-xdg-mime-applications-configuration (added |