Merge remote-tracking branch 'upstream/master' into staging

1 files changed, 92 insertions, 1 deletions

diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scm
index a6955ce4c2..b0d6ddafac 100644
--- a/guix/build/qt-build-system.scm
+++ b/guix/build/qt-build-system.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
-;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;;
@@ -48,6 +48,97 @@
   (setenv "CTEST_OUTPUT_ON_FAILURE" "1")
   #t)
 
+(define (variables-for-wrapping base-directories)
+
+  (define (collect-sub-dirs base-directories file-type subdirectory
+                            selectors)
+    ;; Append SUBDIRECTORY and each of BASE-DIRECTORIES, and return the subset
+    ;; that exists and has at least one of the SELECTORS sub-directories,
+    ;; unless SELECTORS is the empty list.  FILE-TYPE should by 'directory or
+    ;; 'regular file.  For the later, it allows searching for plain files
+    ;; rather than directories.
+    (define exists? (match file-type
+                      ('directory directory-exists?)
+                      ('regular file-exists?)))
+
+    (filter-map (lambda (dir)
+                  (let ((directory (string-append dir subdirectory)))
+                    (and (exists? directory)
+                         (or (null? selectors)
+                             (any (lambda (selector)
+                                    (exists?
+                                     (string-append directory selector)))
+                                  selectors))
+                         directory)))
+                base-directories))
+
+  (filter-map
+   (match-lambda
+     ((variable file-type directory selectors ...)
+      (match (collect-sub-dirs base-directories file-type directory
+                               selectors)
+        (()
+         #f)
+        (directories
+         `(,variable = ,directories)))))
+
+   ;; These shall match the search-path-specification for Qt and KDE
+   ;; libraries.
+   (list '("XDG_DATA_DIRS" directory "/share"
+
+           ;; These are "selectors": consider /share if and only if at least
+           ;; one of these sub-directories exist.  This avoids adding
+           ;; irrelevant packages to XDG_DATA_DIRS just because they have a
+           ;; /share sub-directory.
+           "/glib-2.0/schemas" "/sounds" "/themes"
+           "/cursors" "/wallpapers" "/icons" "/mime")
+         '("XDG_CONFIG_DIRS" directory "/etc/xdg")
+         '("QT_PLUGIN_PATH" directory "/lib/qt5/plugins")
+         '("QML2_IMPORT_PATH"  directory "/lib/qt5/qml")
+         '("QTWEBENGINEPROCESS_PATH" regular
+           "/lib/qt5/libexec/QtWebEngineProcess"))))
+
+(define* (wrap-all-programs #:key inputs outputs
+                            (qt-wrap-excluded-outputs '())
+                            #:allow-other-keys)
+  "Implement phase \"qt-wrap\": look for GSettings schemas and
+gtk+-v.0 libraries and create wrappers with suitably set environment variables
+if found.
+
+Wrapping is not applied to outputs whose name is listed in
+QT-WRAP-EXCLUDED-OUTPUTS.  This is useful when an output is known not
+to contain any Qt binaries, and where wrapping would gratuitously
+add a dependency of that output on Qt."
+  (define (find-files-to-wrap directory)
+    (append-map
+     (lambda (dir)
+       (if (directory-exists? dir) (find-files dir ".*") (list)))
+     (list (string-append directory "/bin")
+           (string-append directory "/sbin")
+           (string-append directory "/libexec")
+           (string-append directory "/lib/libexec"))))
+
+  (define input-directories
+    ;; FIXME: Filter out unwanted inputs, e.g. cmake
+    (match inputs
+           (((_ . dir) ...)
+            dir)))
+
+  (define handle-output
+    (match-lambda
+     ((output . directory)
+      (unless (member output qt-wrap-excluded-outputs)
+        (let ((bin-list     (find-files-to-wrap directory))
+              (vars-to-wrap (variables-for-wrapping
+                             (append (list directory)
+                                     input-directories))))
+          (when (not (null? vars-to-wrap))
+            (for-each (cut apply wrap-program <> vars-to-wrap)
+                      bin-list)))))))
+
+  (for-each handle-output outputs)
+  #t)
+
 (define %standard-phases
   (modify-phases cmake:%standard-phases
     (add-before 'check 'check-setup check-setup)