diff --git a/gnu/packages/bittorrent.scm b/gnu/packages/bittorrent.scm index 6967eccec4..08e61d7ba2 100644 --- a/gnu/packages/bittorrent.scm +++ b/gnu/packages/bittorrent.scm @@ -10,7 +10,6 @@ ;;; Copyright © 2018 Nam Nguyen ;;; Copyright © 2018 Ricardo Wurmus ;;; Copyright © 2019, 2020 Brett Gilio -;;; Copyright © 2020 Hartmut Goebel ;;; ;;; This file is part of GNU Guix. ;;; @@ -448,9 +447,8 @@ (define-public qbittorrent #:phases (modify-phases %standard-phases (add-after 'install 'wrap-qt - (lambda* (#:key outputs inputs #:allow-other-keys) - (let ((out (assoc-ref outputs "out"))) - (wrap-qt-program "qbittorrent" #:output out #:inputs inputs)) + (lambda* (#:key outputs #:allow-other-keys) + (wrap-qt-program (assoc-ref outputs "out") "qbittorrent") #t))))) (native-inputs `(("pkg-config" ,pkg-config) diff --git a/gnu/packages/finance.scm b/gnu/packages/finance.scm index 1f1dadebb3..8ead37beb3 100644 --- a/gnu/packages/finance.scm +++ b/gnu/packages/finance.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2015, 2016 Andreas Enge ;;; Copyright © 2016, 2017, 2018 Efraim Flashner ;;; Copyright © 2016 Alex Griffin -;;; Copyright © 2016, 2020 Hartmut Goebel +;;; Copyright © 2016 Hartmut Goebel ;;; Copyright © 2017 Carlo Zancanaro ;;; Copyright © 2017 Theodoros Foradis ;;; Copyright © 2017 Vasile Dumitrascu @@ -611,10 +611,8 @@ (define-public electron-cash (assoc-ref inputs "libsecp256k1") "/lib/libsecp256k1.so.0'"))))) (add-after 'install 'wrap-qt - (lambda* (#:key outputs inputs #:allow-other-keys) - (let ((out (assoc-ref outputs "out"))) - (wrap-qt-program "electron-cash" #:output out #:inputs inputs)) - #t))))) + (lambda* (#:key outputs #:allow-other-keys) + (wrap-qt-program (assoc-ref outputs "out") "electron-cash")))))) (home-page "https://electroncash.org/") (synopsis "Bitcoin Cash wallet") (description diff --git a/gnu/packages/geo.scm b/gnu/packages/geo.scm index a90db90084..c682613ff1 100644 --- a/gnu/packages/geo.scm +++ b/gnu/packages/geo.scm @@ -10,7 +10,7 @@ ;;; Copyright © 2019, 2020 Guillaume Le Vaillant ;;; Copyright © 2019, 2020 Efraim Flashner ;;; Copyright © 2019 Wiktor Żelazny -;;; Copyright © 2019, 2020 Hartmut Goebel +;;; Copyright © 2019 Hartmut Goebel ;;; Copyright © 2020 Marius Bakke ;;; Copyright © 2020 Christopher Baines ;;; Copyright © 2020 Felix Gruber @@ -2121,9 +2121,8 @@ (define-public qgis (add-after 'install 'wrap-python (assoc-ref python:%standard-phases 'wrap)) (add-after 'wrap-python 'wrap-qt - (lambda* (#:key outputs inputs #:allow-other-keys) - (let ((out (assoc-ref outputs "out"))) - (wrap-qt-program "qgis" #:output out #:inputs inputs)) + (lambda* (#:key outputs #:allow-other-keys) + (wrap-qt-program (assoc-ref outputs "out") "qgis") #t)) (add-after 'wrap-qt 'wrap-gis (lambda* (#:key inputs outputs #:allow-other-keys) diff --git a/gnu/packages/password-utils.scm b/gnu/packages/password-utils.scm index c568efcf31..2053457375 100644 --- a/gnu/packages/password-utils.scm +++ b/gnu/packages/password-utils.scm @@ -29,7 +29,6 @@ ;;; Copyright © 2020 Jean-Baptiste Note ;;; Copyright © 2020 Michael Rohleder ;;; Copyright © 2020 Vinicius Monego -;;; Copyright © 2020 Hartmut Goebel ;;; ;;; This file is part of GNU Guix. ;;; @@ -665,9 +664,8 @@ (define-public qtpass (install-file "qtpass.1" man) #t))) (add-after 'install 'wrap-qt - (lambda* (#:key outputs inputs #:allow-other-keys) - (let ((out (assoc-ref outputs "out"))) - (wrap-qt-program "qtpass" #:output out #:inputs inputs)) + (lambda* (#:key outputs #:allow-other-keys) + (wrap-qt-program (assoc-ref outputs "out") "qtpass") #t)) (add-before 'check 'check-setup ;; Make Qt render "offscreen", required for tests. diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm index 8e9c82d587..cd049fb375 100644 --- a/gnu/packages/video.scm +++ b/gnu/packages/video.scm @@ -47,7 +47,6 @@ ;;; Copyright © 2020 Alexandru-Sergiu Marton ;;; Copyright © 2020 Ivan Kozlov ;;; Copyright © 2020 Antoine Côté -;;; Copyright © 2020 Hartmut Goebel ;;; ;;; This file is part of GNU Guix. ;;; @@ -4442,10 +4441,9 @@ (define-public openshot (setenv "HOME" "/tmp") #t)) (add-after 'install 'wrap-program - (lambda* (#:key outputs inputs #:allow-other-keys) + (lambda* (#:key outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out"))) - (wrap-qt-program "openshot-qt" - #:output out #:inputs inputs)) + (wrap-qt-program out "openshot-qt")) #t))))) (home-page "https://www.openshot.org/") (synopsis "Video editor") diff --git a/gnu/packages/web-browsers.scm b/gnu/packages/web-browsers.scm index 1040e79593..b134d29782 100644 --- a/gnu/packages/web-browsers.scm +++ b/gnu/packages/web-browsers.scm @@ -15,7 +15,6 @@ ;;; Copyright © 2020 Michael Rohleder ;;; Copyright © 2020 Nicolò Balzarotti ;;; Copyright © 2020 Alexandru-Sergiu Marton -;;; Copyright © 2020 Hartmut Goebel ;;; ;;; This file is part of GNU Guix. ;;; @@ -434,9 +433,9 @@ (define-public kristall "/share/fonts/truetype/NotoColorEmoji"))) #t)) (add-after 'install 'wrap-program - (lambda* (#:key outputs inputs #:allow-other-keys) + (lambda* (#:key outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out"))) - (wrap-qt-program "kristall" #:output out #:inputs inputs)) + (wrap-qt-program out "kristall")) #t))))) (native-inputs `(("breeze-stylesheet" diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm index e1368db1d9..118022ec45 100644 --- a/guix/build-system/qt.scm +++ b/guix/build-system/qt.scm @@ -3,7 +3,6 @@ ;;; Copyright © 2013 Cyril Roelandt ;;; Copyright © 2017 Ricardo Wurmus ;;; Copyright © 2019 Hartmut Goebel -;;; Copyright © 2020 Jakub Kądziołka ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,8 +22,6 @@ (define-module (guix build-system qt) #:use-module (guix store) #:use-module (guix utils) - #:use-module ((guix build qt-utils) - #:select (%qt-wrap-excluded-inputs)) #:use-module (guix derivations) #:use-module (guix search-paths) #:use-module (guix build-system) @@ -56,7 +53,6 @@ (define-module (guix build-system qt) (define %qt-build-system-modules ;; Build-side modules imported and used by default. `((guix build qt-build-system) - (guix build qt-utils) ,@%cmake-build-system-modules)) (define (default-cmake) @@ -128,7 +124,6 @@ (define* (qt-build store name inputs (phases '(@ (guix build qt-build-system) %standard-phases)) (qt-wrap-excluded-outputs ''()) - (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs) (system (%current-system)) (imported-modules %qt-build-system-modules) (modules '((guix build qt-build-system) @@ -152,7 +147,6 @@ (define builder search-paths) #:phases ,phases #:qt-wrap-excluded-outputs ,qt-wrap-excluded-outputs - #:qt-wrap-excluded-inputs ,qt-wrap-excluded-inputs #:configure-flags ,configure-flags #:make-flags ,make-flags #:out-of-source? ,out-of-source? diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scm index a6955ce4c2..005157b0a4 100644 --- a/guix/build/qt-build-system.scm +++ b/guix/build/qt-build-system.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2014 Federico Beffa ;;; Copyright © 2014, 2015 Ludovic Courtès ;;; Copyright © 2018 Mark H Weaver -;;; Copyright © 2019, 2020, 2021 Hartmut Goebel +;;; Copyright © 2019, 2020 Hartmut Goebel ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,7 +22,6 @@ (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,10 +47,73 @@ (define* (check-setup #:rest args) (setenv "CTEST_OUTPUT_ON_FAILURE" "1") #t) +(define (variables-for-wrapping base-directories) + + (define (collect-sub-dirs base-directories subdirectory) + (filter-map + (lambda (dir) + (let ((directory (string-append dir subdirectory))) + (if (directory-exists? directory) directory #f))) + base-directories)) + + (filter + (lambda (var-to-wrap) (not (null? (last var-to-wrap)))) + (map + (lambda (var-spec) + `(,(first var-spec) = ,(collect-sub-dirs base-directories (last var-spec)))) + (list + ;; these shall match the search-path-specification for Qt and KDE + ;; libraries + '("XDG_DATA_DIRS" "/share") + '("XDG_CONFIG_DIRS" "/etc/xdg") + '("QT_PLUGIN_PATH" "/lib/qt5/plugins") + '("QML2_IMPORT_PATH" "/lib/qt5/qml"))))) + +(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) - (add-after 'install 'qt-wrap wrap-all-qt-programs))) + (add-after 'install 'qt-wrap wrap-all-programs))) (define* (qt-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) 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 -;;; Copyright © 2019, 2020, 2021 Hartmut Goebel -;;; Copyright © 2020 Jakub Kądziołka ;;; ;;; 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)) + #:export (wrap-qt-program)) -(define %qt-wrap-excluded-inputs - '(list "cmake" "extra-cmake-modules" "qttools")) +(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))) -;; 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) + (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)))))