Merge branch 'master' into core-updates

1 files changed, 4 insertions, 103 deletions

diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scm
index ec7ceb38bd..c63bd5ed21 100644
--- a/guix/build/qt-build-system.scm
+++ b/guix/build/qt-build-system.scm
@@ -1,8 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
-;;; Copyright © 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2019, 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -23,6 +23,7 @@
 (define-module (guix build qt-build-system)
   #:use-module ((guix build cmake-build-system) #:prefix cmake:)
   #:use-module (guix build utils)
+  #:use-module (guix build qt-utils)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 ftw)
@@ -48,110 +49,10 @@
   (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 (lambda (file stat)
-                             (not (wrapped-program? file))))
-           '()))
-     (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)))
-
-  ;; 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))
-
-  (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 <> #:sh (sh) 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)
-    (add-after 'install 'qt-wrap wrap-all-programs)))
+    (add-after 'install 'qt-wrap wrap-all-qt-programs)))
 
 (define* (qt-build #:key inputs (phases %standard-phases)
                    #:allow-other-keys #:rest args)