Merge branch 'master' into core-updates

5 files changed, 114 insertions, 52 deletions

diff --git a/gnu/home/services.scm b/gnu/home/services.scm
index 254663c6bb..5ee3357792 100644
--- a/gnu/home/services.scm
+++ b/gnu/home/services.scm
@@ -33,12 +33,14 @@
   #:use-module (guix modules)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
 
   #:export (home-service-type
             home-profile-service-type
             home-environment-variables-service-type
             home-files-service-type
             home-xdg-configuration-files-service-type
+            home-xdg-data-files-service-type
             home-run-on-first-login-service-type
             home-activation-service-type
             home-run-on-change-service-type
@@ -46,8 +48,10 @@
 
             home-files-directory
             xdg-configuration-files-directory
+            xdg-data-files-directory
 
             fold-home-service-types
+            lookup-home-service-types
             home-provenance
 
             %initialize-gettext)
@@ -285,10 +289,10 @@ directory containing FILES."
                 (description "Files that will be put in
 @file{~~/.guix-home/files}, and further processed during activation.")))
 
-(define xdg-configuration-files-directory "config")
+(define xdg-configuration-files-directory ".config")
 
 (define (xdg-configuration-files files)
-  "Add config/ prefix to each file-path in FILES."
+  "Add .config/ prefix to each file-path in FILES."
   (map (match-lambda
          ((file-path . rest)
           (cons (string-append xdg-configuration-files-directory "/" file-path)
@@ -296,7 +300,7 @@ directory containing FILES."
          files))
 
 (define home-xdg-configuration-files-service-type
-  (service-type (name 'home-files)
+  (service-type (name 'home-xdg-configuration)
                 (extensions
                  (list (service-extension home-files-service-type
                                           xdg-configuration-files)))
@@ -304,7 +308,30 @@ 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")
+
+(define (xdg-data-files files)
+  "Add .local/share prefix to each file-path in FILES."
+  (map (match-lambda
+         ((file-path . rest)
+          (cons (string-append xdg-data-files-directory "/" file-path)
+                rest)))
+         files))
+
+(define home-xdg-data-files-service-type
+  (service-type (name 'home-xdg-data)
+                (extensions
+                 (list (service-extension home-files-service-type
+                                          xdg-data-files)))
+                (compose concatenate)
+                (extend append)
+                (default-value '())
+                (description "Files that will be put in
+@file{~~/.guix-home/files/.local/share}, and further processed during
+activation.")))
+
 
 (define %initialize-gettext
   #~(begin
@@ -580,3 +607,13 @@ environment, and its configuration file, when available.")))
 
 (define* (fold-home-service-types proc seed)
   (fold-service-types proc seed (all-home-service-modules)))
+
+(define lookup-home-service-types
+  (let ((table
+         (delay (fold-home-service-types (lambda (type result)
+                                           (vhash-consq (service-type-name type)
+                                                        type result))
+                                         vlist-null))))
+    (lambda (name)
+      "Return the list of services with the given NAME (a symbol)."
+      (vhash-foldq* cons '() name (force table)))))
diff --git a/gnu/home/services/shells.scm b/gnu/home/services/shells.scm
index 7b9769bcf3..fd5a66090d 100644
--- a/gnu/home/services/shells.scm
+++ b/gnu/home/services/shells.scm
@@ -77,7 +77,7 @@ user's customizations.  Extend home-shell-profile service only if you
 really know what you do."))
 
 (define (add-shell-profile-file config)
-  `(("profile"
+  `((".profile"
      ,(mixed-text-file
        "shell-profile"
        "\
@@ -211,18 +211,18 @@ source ~/.profile
         (zsh-serialize-field config field)))))
 
 (define (zsh-get-configuration-files config)
-  `(("zprofile" ,(zsh-file-by-field config 'zprofile)) ;; Always non-empty
-    ,@(if (and (zsh-field-not-empty? config 'zshenv)
-               (zsh-field-not-empty? config 'environment-variables))
-          `(("zshenv" ,(zsh-file-by-field config 'zshenv))) '())
+  `((".zprofile" ,(zsh-file-by-field config 'zprofile)) ;; Always non-empty
+    ,@(if (or (zsh-field-not-empty? config 'zshenv)
+              (zsh-field-not-empty? config 'environment-variables))
+          `((".zshenv" ,(zsh-file-by-field config 'zshenv))) '())
     ,@(if (zsh-field-not-empty? config 'zshrc)
-          `(("zshrc" ,(zsh-file-by-field config 'zshrc))) '())
+          `((".zshrc" ,(zsh-file-by-field config 'zshrc))) '())
     ,@(if (zsh-field-not-empty? config 'zlogin)
-          `(("zlogin" ,(zsh-file-by-field config 'zlogin))) '())
+          `((".zlogin" ,(zsh-file-by-field config 'zlogin))) '())
     ,@(if (zsh-field-not-empty? config 'zlogout)
-          `(("zlogout" ,(zsh-file-by-field config 'zlogout))) '())))
+          `((".zlogout" ,(zsh-file-by-field config 'zlogout))) '())))
 
-(define (zsh-home-files config)
+(define (add-zsh-dot-configuration config)
   (define zshenv-auxiliary-file
     (mixed-text-file
      "zshenv-auxiliary"
@@ -230,14 +230,14 @@ source ~/.profile
      "[[ -f $ZDOTDIR/.zshenv ]] && source $ZDOTDIR/.zshenv\n"))
 
   (if (home-zsh-configuration-xdg-flavor? config)
-      `(("zshenv" ,zshenv-auxiliary-file))
+      `((".zshenv" ,zshenv-auxiliary-file))
       (zsh-get-configuration-files config)))
 
-(define (zsh-xdg-configuration-files config)
+(define (add-zsh-xdg-configuration config)
   (if (home-zsh-configuration-xdg-flavor? config)
       (map
        (lambda (lst)
-         (cons (string-append "zsh/." (car lst))
+         (cons (string-append "zsh/" (car lst))
                (cdr lst)))
        (zsh-get-configuration-files config))
       '()))
@@ -298,10 +298,10 @@ source ~/.profile
                 (extensions
                  (list (service-extension
                         home-files-service-type
-                        zsh-home-files)
+                        add-zsh-dot-configuration)
                        (service-extension
                         home-xdg-configuration-files-service-type
-                        zsh-xdg-configuration-files)
+                        add-zsh-xdg-configuration)
                        (service-extension
                         home-profile-service-type
                         add-zsh-packages)))
@@ -430,7 +430,7 @@ alias grep='grep --color=auto'\n")
           (field-obj (car (filter-fields field))))
       (if (or extra-content
               (not (null? ((configuration-field-getter field-obj) config))))
-          `(,(object->snake-case-string file-name)
+          `(,(string-append "." (object->snake-case-string file-name))
             ,(apply mixed-text-file
                     (object->snake-case-string file-name)
                     (append (or extra-content '())
@@ -439,7 +439,7 @@ alias grep='grep --color=auto'\n")
 
   (filter
    (compose not null?)
-   `(("bash_profile"
+   `((".bash_profile"
       ,(mixed-text-file
         "bash_profile"
         "\
@@ -586,7 +586,7 @@ when typed in the shell, will automatically expand to the full text."
    serialize-fish-abbreviations))
 
 (define (fish-files-service config)
-  `(("config/fish/config.fish"
+  `(("fish/config.fish"
      ,(mixed-text-file
        "fish-config.fish"
        #~(string-append "\
@@ -650,7 +650,7 @@ end\n\n")
   (service-type (name 'home-fish)
                 (extensions
                  (list (service-extension
-                        home-files-service-type
+                        home-xdg-configuration-files-service-type
                         fish-files-service)
                        (service-extension
                         home-profile-service-type
diff --git a/gnu/home/services/shepherd.scm b/gnu/home/services/shepherd.scm
index feff130259..62ab0aadc6 100644
--- a/gnu/home/services/shepherd.scm
+++ b/gnu/home/services/shepherd.scm
@@ -51,7 +51,7 @@
   home-shepherd-configuration make-home-shepherd-configuration
   home-shepherd-configuration?
   (shepherd home-shepherd-configuration-shepherd
-            (default shepherd)) ; package
+            (default shepherd-0.9)) ; package
   (auto-start? home-shepherd-configuration-auto-start?
                (default #t))
   (services home-shepherd-configuration-services
@@ -78,12 +78,16 @@ as shepherd package."
             '#$files))
           (action 'root 'daemonize)
           (format #t "Starting services...~%")
-          (for-each
-           (lambda (service) (start service))
-           '#$(append-map shepherd-service-provision
-                          (filter shepherd-service-auto-start?
-                                  services)))
-          (newline)))
+          (let ((services-to-start
+                 '#$(append-map shepherd-service-provision
+                                (filter shepherd-service-auto-start?
+                                        services))))
+            (if (defined? 'start-in-the-background)
+                (start-in-the-background services-to-start)
+                (for-each start services-to-start))
+
+            (redirect-port (open-input-file "/dev/null")
+                           (current-input-port)))))
 
     (scheme-file "shepherd.conf" config)))
 
@@ -92,17 +96,21 @@ as shepherd package."
          (services (home-shepherd-configuration-services config)))
     (if (home-shepherd-configuration-auto-start? config)
         (with-imported-modules '((guix build utils))
-          #~(let ((log-dir (or (getenv "XDG_LOG_HOME")
-                               (format #f "~a/.local/var/log" (getenv "HOME")))))
-              ((@ (guix build utils) mkdir-p) log-dir)
-              (system*
-               #$(file-append shepherd "/bin/shepherd")
-               "--logfile"
-               (string-append
-                log-dir
-                "/shepherd.log")
-               "--config"
-               #$(home-shepherd-configuration-file services shepherd))))
+          #~(unless (file-exists?
+                     (string-append
+                      (or (getenv "XDG_RUNTIME_DIR")
+                          (format #f "/run/user/~a" (getuid)))
+                      "/shepherd/socket"))
+              (let ((log-dir (or (getenv "XDG_LOG_HOME")
+                                 (format #f "~a/.local/var/log"
+                                         (getenv "HOME")))))
+                ((@ (guix build utils) mkdir-p) log-dir)
+                (system*
+                 #$(file-append shepherd "/bin/shepherd")
+                 "--logfile"
+                 (string-append log-dir "/shepherd.log")
+                 "--config"
+                 #$(home-shepherd-configuration-file services shepherd)))))
         #~"")))
 
 (define (reload-configuration-gexp config)
diff --git a/gnu/home/services/symlink-manager.scm b/gnu/home/services/symlink-manager.scm
index 3b851229f3..e4c931fbee 100644
--- a/gnu/home/services/symlink-manager.scm
+++ b/gnu/home/services/symlink-manager.scm
@@ -54,6 +54,10 @@
            (or (getenv "XDG_CONFIG_HOME")
                (string-append (getenv "HOME") "/.config")))
 
+         (define xdg-data-home
+           (or (getenv "XDG_DATA_HOME")
+               (string-append (getenv "HOME") "/.local/share")))
+
          (define backup-directory
            (string-append home-directory "/" (number->string (current-time))
                           "-guix-home-legacy-configs-backup"))
@@ -61,19 +65,30 @@
          (define (preprocess-file file)
            "If file is in XDG-CONFIGURATION-FILES-DIRECTORY use
 subdirectory from XDG_CONFIG_HOME to generate a target path."
-           (if (string-prefix? #$xdg-configuration-files-directory file)
-               (string-append
-                (substring xdg-config-home
-                           (1+ (string-length home-directory)))
-                (substring file
-                           (string-length #$xdg-configuration-files-directory)))
-               (string-append "." file)))
+           (cond
+            ((string-prefix? #$xdg-configuration-files-directory file)
+             (string-append
+              (substring xdg-config-home
+                         (1+ (string-length home-directory)))
+              (substring file
+                         (string-length #$xdg-configuration-files-directory))))
+            ((string-prefix? #$xdg-data-files-directory file)
+             (string-append
+              (substring xdg-data-home
+                         (1+ (string-length home-directory)))
+              (substring file
+                         (string-length #$xdg-data-files-directory))))
+            (else file)))
 
          (define (target-file file)
            ;; Return the target of FILE, a config file name sans leading dot
            ;; such as "config/fontconfig/fonts.conf" or "bashrc".
            (string-append home-directory "/" (preprocess-file file)))
 
+         (define (no-follow-file-exists? file)
+           "Return #t if file exists, even if it's a dangling symlink."
+           (->bool (false-if-exception (lstat file))))
+
          (define (symlink-to-store? file)
            (catch 'system-error
              (lambda ()
@@ -112,7 +127,7 @@ subdirectory from XDG_CONFIG_HOME to generate a target path."
             (const #t)
             (lambda (file stat _)                 ;leaf
               (let ((file (target-file (strip file))))
-                (when (file-exists? file)
+                (when (no-follow-file-exists? file)
                   ;; DO NOT remove the file if it is no longer a symlink to
                   ;; the store, it will be backed up later during
                   ;; create-symlinks phase.
@@ -142,6 +157,7 @@ subdirectory from XDG_CONFIG_HOME to generate a target path."
                            #t
                            (G_ "Skipping ~a (not an empty directory)... done\n")
                            directory))
+                         ((= ENOENT errno) #t)
                          ((= ENOTDIR errno) #t)
                          (else
                           (apply throw args)))))))))
@@ -171,7 +187,7 @@ subdirectory from XDG_CONFIG_HOME to generate a target path."
             (lambda (file stat result)            ;leaf
               (let ((source (source-file (strip file)))
                     (target (target-file (strip file))))
-                (when (file-exists? target)
+                (when (no-follow-file-exists? target)
                   (backup-file (strip file)))
                 (format #t (G_ "Symlinking ~a -> ~a...")
                         target source)
@@ -180,7 +196,7 @@ subdirectory from XDG_CONFIG_HOME to generate a target path."
             (lambda (directory stat result)       ;down
               (unless (string=? directory config-file-directory)
                 (let ((target (target-file (strip directory))))
-                  (when (and (file-exists? target)
+                  (when (and (no-follow-file-exists? target)
                              (not (file-is-directory? target)))
                     (backup-file (strip directory)))
 
diff --git a/gnu/home/services/xdg.scm b/gnu/home/services/xdg.scm
index 361a2a6148..71c028c788 100644
--- a/gnu/home/services/xdg.scm
+++ b/gnu/home/services/xdg.scm
@@ -421,7 +421,8 @@ that the application cannot open the specified MIME type.")
   (define (add-xdg-desktop-entry-file entry)
     (let ((file (first entry))
           (config (second entry)))
-      (list (format #f "local/share/applications/~a" file)
+      ;; TODO: Use xdg-data-files instead of home-files here
+      (list (format #f "applications/~a" file)
           (apply mixed-text-file
                  (format #f "xdg-desktop-~a-entry" file)
                  config))))
@@ -468,7 +469,7 @@ that the application cannot open the specified MIME type.")
   (service-type (name 'home-xdg-mime-applications)
                 (extensions
                  (list (service-extension
-                        home-files-service-type
+                        home-xdg-data-files-service-type
                         home-xdg-mime-applications-files)
                        (service-extension
                         home-xdg-configuration-files-service-type