Subject: [bug#75688] [PATCH v3 4/4] build: glib-or-gtk-build-system: Replace wrapper scripts with 'search-paths.d'.

From: [email-masked]
Date: Mon, 27 Jan 2025 21:21:23 +0800

From: 宋文武 <[email-masked]>

* guix/build/glib-or-gtk-build-system.scm (write-search-path-file): New procedure.
(gtk-module-directories): Add version to arguments.
(gsettings-schema-directories): New procedure.
(data-directories): Don't check for "/glib-2.0/schemas".
(conf-directories): New procedure.
(wrap-all-programs): Rewrite in terms of 'write-search-path-file'.

Change-Id: I1c9e8d491b96e298d1568a5e29b04c762c26e4d1
---
 guix/build/glib-or-gtk-build-system.scm | 166 ++++++++++++++----------
 1 file changed, 95 insertions(+), 71 deletions(-)

diff --git a/guix/build/glib-or-gtk-build-system.scm b/guix/build/glib-or-gtk-build-system.scm
index 67a52ddad3..335a856575 100644
--- a/guix/build/glib-or-gtk-build-system.scm
+++ b/guix/build/glib-or-gtk-build-system.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2018 Mark H Weaver <[email-masked]>
 ;;; Copyright © 2021 Maxime Devos <[email-masked]>
 ;;; Copyright © 2021 Maxim Cournoyer <[email-masked]>
+;;; Copyright © 2025 宋文武 <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,6 +40,13 @@ (define-module (guix build glib-or-gtk-build-system)
 ;;
 ;; Code:
 
+(define* (write-search-path-file output variable value)
+  "Write VALUE to @file{etc/search-paths.d/VARIABLE} under OUTPUT."
+  (let ((search-paths.d (string-append output "/etc/search-paths.d")))
+    (mkdir-p search-paths.d)
+    (with-output-to-file (string-append search-paths.d "/" variable)
+      (lambda () (display value)))))
+
 (define (subdirectory-exists? parent sub-directory)
   (directory-exists? (string-append parent sub-directory)))
 
@@ -47,32 +55,12 @@ (define (directory-included? directory directories-list)
   (fold (lambda (s p) (or (string-ci=? s directory) p))
         #f directories-list))
 
-;; We do not include $HOME/.guix-profile/gtk-v.0 (v=2 or 3) because we do not
-;; want to mix gtk+-2 and gtk+-3 modules.  See
-;; https://developer.gnome.org/gtk3/stable/gtk-running.html
-(define (gtk-module-directories inputs)
-  "Check for the existence of \"libdir/gtk-v.0\" in INPUTS.  Return a list
+;; We load GTK modules via the GUIX_GTK2_PATH, GUIX_GTK3_PATH and GUIX_GTK4_PATH
+;; search paths.
+(define (gtk-module-directories inputs version)
+  "Check for the existence of \"libdir/gtk-VERSION\" in INPUTS.  Return a list
 with all found directories."
-  (let* ((version
-          (cond
-           ((string-match "gtk-4"
-                          (or (assoc-ref inputs "gtk")
-                              (assoc-ref inputs "source")
-                              ""))
-            "4.0")
-           ((string-match "gtk\\+-3"
-                          (or (assoc-ref inputs "gtk+")
-                              (assoc-ref inputs "source")
-                              ""))
-            "3.0")
-           ((string-match "gtk\\+-2"
-                          (or (assoc-ref inputs "gtk+")
-                              (assoc-ref inputs "source")
-                              ""))
-            "2.0")
-           (else
-            "4.0"))) ; We default to version 4.0.
-         (gtk-module
+  (let ((gtk-module
           (lambda (input prev)
             (let* ((in (match input
                          ((_ . dir) dir)
@@ -85,27 +73,22 @@ (define (gtk-module-directories inputs)
                   prev)))))
     (fold gtk-module '() inputs)))
 
-;; See
+;; XDG data files include themes, sounds, icons, etc. See:
 ;; http://www.freedesktop.org/wiki/DesktopThemeSpec
 ;; http://freedesktop.org/wiki/Specifications/sound-theme-spec
 ;; http://freedesktop.org/wiki/Specifications/icon-theme-spec
 ;;
-;; Currently desktop themes are not well supported and do not honor
-;; XDG_DATA_DIRS.  One example is evince which only looks for desktop themes
-;; in $HOME/.themes (for backward compatibility) and in XDG_DATA_HOME (which
-;; defaults to $HOME/.local/share).  One way to handle these applications
-;; appears to be by making $HOME/.themes a symlink to
-;; $HOME/.guix-profile/share/themes.
+;; We load them via XDG_DATA_DIRS (from profile, has higher priority) and
+;; GUIX_XDG_DATA_DIRS (application specified) search paths.
 (define (data-directories inputs)
-  "Check for the existence of \"$datadir/glib-2.0/schemas\" or XDG themes data
-in INPUTS.  Return a list with all found directories."
+  "Check for the existence of XDG data files in INPUTS.  Return a list with all found
+directories."
   (define (data-directory input previous)
     (let* ((in (match input
                  ((_ . dir) dir)
                  (_ "")))
            (datadir (string-append in "/share")))
-      (if (and (or (subdirectory-exists? datadir "/glib-2.0/schemas")
-                   (subdirectory-exists? datadir "/sounds")
+      (if (and (or (subdirectory-exists? datadir "/sounds")
                    (subdirectory-exists? datadir "/themes")
                    (subdirectory-exists? datadir "/cursors")
                    (subdirectory-exists? datadir "/wallpapers")
@@ -117,15 +100,45 @@ (define (data-directories inputs)
 
   (fold data-directory '() inputs))
 
+;;; XDG configuration files are expected to be installed in etc/xdg directory.
+;;; We load them via XDG_CONFIG_DIRS (from profile, has higher priority) and
+;;; GUIX_XDG_CONFIG_DIRS (application specified) search paths.
+(define (conf-directories inputs)
+  "Check for the existence of XDG configuration files in INPUTS.  Return a list with
+all found directories."
+  (define (conf-directory input previous)
+    (let* ((in (match input
+                 ((_ . dir) dir)
+                 (_ "")))
+           (conf-dir (string-append in "/etc/xdg")))
+      (if (and (directory-exists? conf-dir)
+               (not (directory-included? conf-dir previous)))
+          (cons conf-dir previous)
+          previous)))
+
+  (fold conf-directory '() inputs))
+
+;;; GIO GSettings schemas are expected to be installed in $datadir/glib-2.0/schemas
+;;; directory.  We load them via the GUIX_GSETTINGS_SCHEMA_DIR search path.
+(define (gsettings-schema-directories inputs)
+  "Check for the existence of \"$datadir/glib-2.0/schemas\" in INPUTS.
+Return a list with all found directories."
+  (define (gsettings-schema-directory input previous)
+    (let* ((in (match input
+                 ((_ . dir) dir)
+                 (_ "")))
+           (schema-dir (string-append in "/share/glib-2.0/schemas")))
+      (if (and (directory-exists? schema-dir)
+               (not (directory-included? schema-dir previous)))
+          (cons schema-dir previous)
+          previous)))
+
+  (fold gsettings-schema-directory '() inputs))
+
 ;; All GIO modules are expected to be installed in GLib's $libdir/gio/modules
 ;; directory.  That directory has to include a file called giomodule.cache
-;; listing all available modules.  GIO can be made aware of modules in other
-;; directories with the help of the environment variable GIO_EXTRA_MODULES.
-;; The official GIO documentation states that this environment variable should
-;; only be used for testing and not in a production environment.  However, it
-;; appears that there is no other way of specifying multiple modules
-;; directories (NIXOS also does use this variable). See
-;; https://developer.gnome.org/gio/stable/running-gio-apps.html
+;; listing all available modules.  We load them via the GUIX_GIO_EXTRA_MODULES
+;; search path.
 (define (gio-module-directories inputs)
   "Check for the existence of \"$libdir/gio/modules\" in the INPUTS and
 returns a list with all found directories."
@@ -141,50 +154,61 @@ (define (gio-module-directories inputs)
 
   (fold gio-module-directory '() inputs))
 
+
+;;; XXX: Only works for ELF executables and python3 scripts.
 (define* (wrap-all-programs #:key inputs outputs
                             (glib-or-gtk-wrap-excluded-outputs '())
                             #:allow-other-keys)
   "Implement phase \"glib-or-gtk-wrap\": look for GSettings schemas and
-gtk+-v.0 libraries and create wrappers with suitably set environment variables
+GTK libraries and create @file{etc/search-paths.d} with suitably set of files
 if found.
 
 Wrapping is not applied to outputs whose name is listed in
 GLIB-OR-GTK-WRAP-EXCLUDED-OUTPUTS.  This is useful when an output is known not
 to contain any GLib or GTK+ binaries, and where wrapping would gratuitously
-add a dependency of that output on GLib and GTK+."
-  ;; Do not require bash to be present in the package inputs
-  ;; even when there is nothing to wrap.
-  ;; Also, calculate (sh) only once to prevent some I/O.
-  (define %sh (delay (search-input-file inputs "bin/bash")))
-  (define (sh) (force %sh))
+add a dependency of that output on GLib and GTK."
   (define handle-output
     (match-lambda
       ((output . directory)
        (unless (member output glib-or-gtk-wrap-excluded-outputs)
-         (let* ((bindir       (string-append directory "/bin"))
-                (libexecdir   (string-append directory "/libexec"))
-                (bin-list     (filter (negate wrapped-program?)
-                                      (append (find-files bindir ".*")
-                                          (find-files libexecdir ".*"))))
-                (datadirs     (data-directories
+         (let* ((datadirs     (data-directories
                                (alist-cons output directory inputs)))
-                (gtk-mod-dirs (gtk-module-directories
+                (confdirs     (conf-directories
                                (alist-cons output directory inputs)))
-                (gio-mod-dirs (gio-module-directories
+                (schemadirs   (gsettings-schema-directories
                                (alist-cons output directory inputs)))
-                (env-vars `(,@(if (not (null? datadirs))
-                                  (list `("XDG_DATA_DIRS" ":" prefix ,datadirs))
-                                  '())
-                            ,@(if (not (null? gtk-mod-dirs))
-                                  (list `("GTK_PATH" ":" prefix ,gtk-mod-dirs))
-                                  '())
-                            ,@(if (not (null? gio-mod-dirs))
-                                  (list `("GIO_EXTRA_MODULES" ":"
-                                          prefix ,gio-mod-dirs))
-                                  '()))))
-           (for-each (lambda (program)
-                       (apply wrap-program program #:sh (sh) env-vars))
-                     bin-list))))))
+                (gtk2-mod-dirs (gtk-module-directories
+                                (alist-cons output directory inputs)
+                                "2.0"))
+                (gtk3-mod-dirs (gtk-module-directories
+                                (alist-cons output directory inputs)
+                                "3.0"))
+                (gtk4-mod-dirs (gtk-module-directories
+                                (alist-cons output directory inputs)
+                                "4.0"))
+                (gio-mod-dirs (gio-module-directories
+                               (alist-cons output directory inputs))))
+           (when (not (null? datadirs))
+             (write-search-path-file directory "GUIX_XDG_DATA_DIRS"
+                                     (string-join datadirs ":")))
+           (when (not (null? confdirs))
+             (write-search-path-file directory "GUIX_XDG_CONFIG_DIRS"
+                                     (string-join confdirs ":")))
+           (when (not (null? schemadirs))
+             (write-search-path-file directory "GUIX_GSETTINGS_SCHEMA_DIR"
+                                     (string-join schemadirs ":")))
+           (when (not (null? gtk2-mod-dirs))
+             (write-search-path-file directory "GUIX_GTK2_PATH"
+                                     (string-join gtk2-mod-dirs ":")))
+           (when (not (null? gtk3-mod-dirs))
+             (write-search-path-file directory "GUIX_GTK3_PATH"
+                                     (string-join gtk3-mod-dirs ":")))
+           (when (not (null? gtk4-mod-dirs))
+             (write-search-path-file directory "GUIX_GTK4_PATH"
+                                     (string-join gtk4-mod-dirs ":")))
+           (when (not (null? gio-mod-dirs))
+             (write-search-path-file directory "GUIX_GIO_EXTRA_MODULES"
+                                     (string-join gio-mod-dirs ":"))))))))
 
   (for-each handle-output outputs))
 
-- 
2.47.1