1 files changed, 20 insertions, 115 deletions
diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index 8e6db10ca1..d2486ee86c 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -1,7 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 David Craven <david@craven.ch>
-;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel@crazy-compilers.com>
-;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,116 +18,23 @@
 
 (define-module (guix build qt-utils)
   #:use-module (guix build utils)
-  #:use-module (ice-9 match)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
-  #:export (wrap-qt-program
-            wrap-all-qt-programs
-            %qt-wrap-excluded-inputs))
-
-(define %qt-wrap-excluded-inputs
-  '(list "cmake" "extra-cmake-modules" "qttools"))
-
-;; NOTE: Apart from standard subdirectories of /share, Qt also provides
-;; facilities for per-application data directories, such as
-;; /share/quassel. Thus, we include the output directory even if it doesn't
-;; contain any of the standard subdirectories.
-(define (variables-for-wrapping base-directories output-directory)
-
-  (define (collect-sub-dirs base-directories subdirectory-spec)
-    (filter-map
-     (lambda (dir)
-       (match
-        subdirectory-spec
-        ((subdir)
-         (and (directory-exists? (string-append dir subdir))
-              (string-append dir (car subdirectory-spec))))
-        ((subdir children)
-         (and
-          (or
-           (and (string=? dir output-directory)
-                (directory-exists? (string-append dir subdir)))
-           (or-map
-            (lambda (kid) (directory-exists? (string-append dir subdir kid)))
-            children))
-          (string-append dir subdir)))))
-     base-directories))
-
-  (filter
-   (lambda (var-to-wrap) (not (null? (last var-to-wrap))))
-   (map
-    (match-lambda
-     ((var kind . subdir-spec)
-      `(,var ,kind ,(collect-sub-dirs base-directories subdir-spec))))
-    (list
-     ;; these shall match the search-path-specification for Qt and KDE
-     ;; libraries
-     '("XDG_DATA_DIRS" suffix "/share" ("/applications" "/fonts"
-                                        "/icons" "/mime"))
-     '("XDG_CONFIG_DIRS" suffix "/etc/xdg")
-     '("QT_PLUGIN_PATH" prefix "/lib/qt5/plugins")
-     '("QML2_IMPORT_PATH" prefix "/lib/qt5/qml")))))
-
-
-(define* (wrap-qt-program* program #:key inputs output-dir
-                           qt-wrap-excluded-inputs)
-
-  (define input-directories
-    (filter-map
-     (match-lambda
-      ((label . directory)
-       (and (not (member label qt-wrap-excluded-inputs))
-            directory)))
-     inputs))
-
-  (let ((vars-to-wrap (variables-for-wrapping
-                       (cons output-dir input-directories)
-                       output-dir)))
-    (when (not (null? vars-to-wrap))
-      (apply wrap-program program vars-to-wrap))))
-
-
-(define* (wrap-qt-program program-name #:key inputs output
-                          (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs))
-  "Wrap the specified programm (which must reside in the OUTPUT's \"/bin\"
-directory) with suitably set environment variables.
-
-This is like qt-build-systems's phase \"qt-wrap\", but only the named program
-is wrapped."
-  (wrap-qt-program* (string-append output "/bin/" program-name)
-                    #:output-dir output #:inputs inputs
-                    #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs))
-
-
-(define* (wrap-all-qt-programs #:key inputs outputs
-                               (qt-wrap-excluded-outputs '())
-                               (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
-                               #:allow-other-keys)
-  "Implement qt-build-systems's phase \"qt-wrap\": look for executables in
-\"bin\", \"sbin\" and \"libexec\" of all outputs 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 output-dir)
-    (append-map
-     (lambda (dir)
-       (if (directory-exists? dir) (find-files dir ".*") (list)))
-     (list (string-append output-dir "/bin")
-           (string-append output-dir "/sbin")
-           (string-append output-dir "/libexec")
-           (string-append output-dir "/lib/libexec"))))
-
-  (define handle-output
-    (match-lambda
-     ((output . output-dir)
-      (unless (member output qt-wrap-excluded-outputs)
-        (for-each (cut wrap-qt-program* <>
-                       #:output-dir output-dir #:inputs inputs
-                       #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs)
-                  (find-files-to-wrap output-dir))))))
-
-  (for-each handle-output outputs)
-  #t)
+  #:export (wrap-qt-program))
+
+(define (wrap-qt-program out program)
+  (define (suffix env-var path)
+    (let ((env-val (getenv env-var)))
+      (if env-val (string-append env-val ":" path) path)))
+
+  (let ((qml-path        (suffix "QML2_IMPORT_PATH"
+                                 (string-append out "/lib/qt5/qml")))
+        (plugin-path     (suffix "QT_PLUGIN_PATH"
+                                 (string-append out "/lib/qt5/plugins")))
+        (xdg-data-path   (suffix "XDG_DATA_DIRS"
+                                 (string-append out "/share")))
+        (xdg-config-path (suffix "XDG_CONFIG_DIRS"
+                                 (string-append out "/etc/xdg"))))
+    (wrap-program (string-append out "/bin/" program)
+      `("QML2_IMPORT_PATH" = (,qml-path))
+      `("QT_PLUGIN_PATH" = (,plugin-path))
+      `("XDG_DATA_DIRS" = (,xdg-data-path))
+      `("XDG_CONFIG_DIRS" = (,xdg-config-path)))))