Package: guix-patches;
View this message in rfc822 format
From: iyzsong <at> envs.net To: 75688 <at> debbugs.gnu.org Cc: 宋文武 <iyzsong <at> member.fsf.org>, Liliana Marie Prikler <liliana.prikler <at> gmail.com>, Maxim Cournoyer <maxim.cournoyer <at> gmail.com>, Vivien Kraus <vivien <at> planete-kraus.eu> Subject: [bug#75688] [PATCH v2 4/4] build: glib-or-gtk-build-system: Replace wrapper scripts with 'search-paths.d'. Date: Thu, 23 Jan 2025 14:28:58 +0800
From: 宋文武 <iyzsong <at> member.fsf.org>
* 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 | 165 ++++++++++++++----------
1 file changed, 94 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..a04c1b0616 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 <mhw <at> netris.org>
;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2025 宋文武 <iyzsong <at> envs.net>
;;;
;;; 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 variable)))))
+
(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,60 @@ (define (gio-module-directories inputs)
(fold gio-module-directory '() inputs))
+
(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 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 output "GUIX_XDG_DATA_DIRS"
+ (string-join datadirs ":")))
+ (when (not (null? confdirs))
+ (write-search-path-file output "GUIX_XDG_CONFIG_DIRS"
+ (string-join confdirs ":")))
+ (when (not (null? schemadirs))
+ (write-search-path-file output "GUIX_GSETTINGS_SCHEMA_DIR"
+ (string-join schemadirs ":")))
+ (when (not (null? gtk2-mod-dirs))
+ (write-search-path-file output "GUIX_GTK2_PATH"
+ (string-join gtk2-mod-dirs ":")))
+ (when (not (null? gtk3-mod-dirs))
+ (write-search-path-file output "GUIX_GTK3_PATH"
+ (string-join gtk3-mod-dirs ":")))
+ (when (not (null? gtk4-mod-dirs))
+ (write-search-path-file output "GUIX_GTK4_PATH"
+ (string-join gtk4-mod-dirs ":")))
+ (when (not (null? gio-mod-dirs))
+ (write-search-path-file output "GUIX_GIO_EXTRA_MODULES"
+ (string-join gio-mod-dirs ":"))))))))
(for-each handle-output outputs))
--
2.47.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.