[PATCH 1/4] guix: qt-build-system, qt-utils: Unify wrapping of qt-programs.

DoneSubmitted by Hartmut Goebel.
Details
2 participants
  • Hartmut Goebel
  • Hartmut Goebel
Owner
unassigned
Severity
normal
Merged with
H
H
Hartmut Goebel wrote on 11 Jan 15:41 +0100
e8cfff4ab1dd7f0c39875d22057e4ef45a10cc7b.1610376081.git.h.goebel@crazy-compilers.com
Unify (guix qt-build-system wrap-all-programs) and(guix qt-utils wrap-qt-program), so both behave the same.The functions now reside in qt-utils to make them easily available forpackages not using the qt-build-system.
* guix/build/qt-build-system.scm (variables-for-wrapping, wrap-all-programs): Move from here ...* guix/build/qt-utils.scm (variables-for-wrapping, wrap-all-qt-programs): ... to here. Base the later on (wrap-qt-program*): New function, carved out from old wrap-all-programs. (wrap-qt-program): Base on wrap-qt-program*, change arguments in an incompatible way.* gnu/packages/bittorrent.scm (qbittorrent)[arguments]<phases>{wrap-qt}: Adjust to new interface of wrap-qt-program.* gnu/packages/finance.scm (electron-cash): Likewise.* gnu/packages/geo.scm (qgis): Likewise.* gnu/packages/password-utils.scm (qtpass): Likewise.* gnu/packages/video.scm (openshot): Likewise.* gnu/packages/web-browsers.scm (kristall): Likewise.--- gnu/packages/bittorrent.scm | 6 +- gnu/packages/finance.scm | 8 ++- gnu/packages/geo.scm | 7 ++- gnu/packages/password-utils.scm | 6 +- gnu/packages/video.scm | 6 +- gnu/packages/web-browsers.scm | 5 +- guix/build-system/qt.scm | 1 + guix/build/qt-build-system.scm | 68 +-------------------- guix/build/qt-utils.scm | 105 ++++++++++++++++++++++++++------ 9 files changed, 113 insertions(+), 99 deletions(-)
Toggle diff (377 lines)diff --git a/gnu/packages/bittorrent.scm b/gnu/packages/bittorrent.scmindex 08e61d7ba2..6967eccec4 100644--- a/gnu/packages/bittorrent.scm+++ b/gnu/packages/bittorrent.scm@@ -10,6 +10,7 @@ ;;; Copyright © 2018 Nam Nguyen <namn@berkeley.edu> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019, 2020 Brett Gilio <brettg@gnu.org>+;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; ;;; This file is part of GNU Guix. ;;;@@ -447,8 +448,9 @@ desktops.") #:phases (modify-phases %standard-phases (add-after 'install 'wrap-qt- (lambda* (#:key outputs #:allow-other-keys)- (wrap-qt-program (assoc-ref outputs "out") "qbittorrent")+ (lambda* (#:key outputs inputs #:allow-other-keys)+ (let ((out (assoc-ref outputs "out")))+ (wrap-qt-program "qbittorrent" #:output out #:inputs inputs)) #t))))) (native-inputs `(("pkg-config" ,pkg-config)diff --git a/gnu/packages/finance.scm b/gnu/packages/finance.scmindex e7d58bbcc0..d71df60740 100644--- a/gnu/packages/finance.scm+++ b/gnu/packages/finance.scm@@ -2,7 +2,7 @@ ;;; Copyright © 2015, 2016 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>-;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>+;;; Copyright © 2016, 2020 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au> ;;; Copyright © 2017 Theodoros Foradis <theodoros@foradis.org> ;;; Copyright © 2017 Vasile Dumitrascu <va511e@yahoo.com>@@ -611,8 +611,10 @@ other machines/servers. Electrum does not download the Bitcoin blockchain.") (assoc-ref inputs "libsecp256k1") "/lib/libsecp256k1.so.0'"))))) (add-after 'install 'wrap-qt- (lambda* (#:key outputs #:allow-other-keys)- (wrap-qt-program (assoc-ref outputs "out") "electron-cash"))))))+ (lambda* (#:key outputs inputs #:allow-other-keys)+ (let ((out (assoc-ref outputs "out")))+ (wrap-qt-program "electron-cash" #:output out #:inputs inputs))+ #t))))) (home-page "https://electroncash.org/") (synopsis "Bitcoin Cash wallet") (descriptiondiff --git a/gnu/packages/geo.scm b/gnu/packages/geo.scmindex c682613ff1..a90db90084 100644--- a/gnu/packages/geo.scm+++ b/gnu/packages/geo.scm@@ -10,7 +10,7 @@ ;;; Copyright © 2019, 2020 Guillaume Le Vaillant <glv@posteo.net> ;;; Copyright © 2019, 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2019 Wiktor ┼╗elazny <wzelazny@vurv.cz>-;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>+;;; Copyright © 2019, 2020 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2020 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2020 Felix Gruber <felgru@posteo.net>@@ -2121,8 +2121,9 @@ growing set of geoscientific methods.") (add-after 'install 'wrap-python (assoc-ref python:%standard-phases 'wrap)) (add-after 'wrap-python 'wrap-qt- (lambda* (#:key outputs #:allow-other-keys)- (wrap-qt-program (assoc-ref outputs "out") "qgis")+ (lambda* (#:key outputs inputs #:allow-other-keys)+ (let ((out (assoc-ref outputs "out")))+ (wrap-qt-program "qgis" #:output out #:inputs inputs)) #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.scmindex bd411f59d0..9091010ed9 100644--- a/gnu/packages/password-utils.scm+++ b/gnu/packages/password-utils.scm@@ -29,6 +29,7 @@ ;;; Copyright © 2020 Jean-Baptiste Note <jean-baptiste.note@m4x.org> ;;; Copyright © 2020 Michael Rohleder <mike@rohleder.de> ;;; Copyright © 2020 Vinicius Monego <monego@posteo.net>+;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; ;;; This file is part of GNU Guix. ;;;@@ -664,8 +665,9 @@ key URIs using the standard otpauth:// scheme.") (install-file "qtpass.1" man) #t))) (add-after 'install 'wrap-qt- (lambda* (#:key outputs #:allow-other-keys)- (wrap-qt-program (assoc-ref outputs "out") "qtpass")+ (lambda* (#:key outputs inputs #:allow-other-keys)+ (let ((out (assoc-ref outputs "out")))+ (wrap-qt-program "qtpass" #:output out #:inputs inputs)) #t)) (add-before 'check 'check-setup ;; Make Qt render "offscreen", required for tests.diff --git a/gnu/packages/video.scm b/gnu/packages/video.scmindex 1f68208021..98b2ceaa30 100644--- a/gnu/packages/video.scm+++ b/gnu/packages/video.scm@@ -47,6 +47,7 @@ ;;; Copyright © 2020 Alexandru-Sergiu Marton <brown121407@posteo.ro> ;;; Copyright © 2020 Ivan Kozlov <kanichos@yandex.ru> ;;; Copyright © 2020 Antoine Côté <antoine.cote@posteo.net>+;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; ;;; This file is part of GNU Guix. ;;;@@ -4445,9 +4446,10 @@ API. It includes bindings for Python, Ruby, and other languages.") (setenv "HOME" "/tmp") #t)) (add-after 'install 'wrap-program- (lambda* (#:key outputs #:allow-other-keys)+ (lambda* (#:key outputs inputs #:allow-other-keys) (let ((out (assoc-ref outputs "out")))- (wrap-qt-program out "openshot-qt"))+ (wrap-qt-program "openshot-qt"+ #:output out #:inputs inputs)) #t))))) (home-page "https://www.openshot.org/") (synopsis "Video editor")diff --git a/gnu/packages/web-browsers.scm b/gnu/packages/web-browsers.scmindex b134d29782..1040e79593 100644--- a/gnu/packages/web-browsers.scm+++ b/gnu/packages/web-browsers.scm@@ -15,6 +15,7 @@ ;;; Copyright © 2020 Michael Rohleder <mike@rohleder.de> ;;; Copyright © 2020 Nicolò Balzarotti <nicolo@nixo.xyz> ;;; Copyright © 2020 Alexandru-Sergiu Marton <brown121407@posteo.ro>+;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; ;;; This file is part of GNU Guix. ;;;@@ -433,9 +434,9 @@ access.") "/share/fonts/truetype/NotoColorEmoji"))) #t)) (add-after 'install 'wrap-program- (lambda* (#:key outputs #:allow-other-keys)+ (lambda* (#:key outputs inputs #:allow-other-keys) (let ((out (assoc-ref outputs "out")))- (wrap-qt-program out "kristall"))+ (wrap-qt-program "kristall" #:output out #:inputs inputs)) #t))))) (native-inputs `(("breeze-stylesheet"diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scmindex 118022ec45..1bd89bfa4d 100644--- a/guix/build-system/qt.scm+++ b/guix/build-system/qt.scm@@ -53,6 +53,7 @@ (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)diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scmindex 005157b0a4..a6955ce4c2 100644--- a/guix/build/qt-build-system.scm+++ b/guix/build/qt-build-system.scm@@ -2,7 +2,7 @@ ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch> ;;; 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> ;;; ;;; This file is part of GNU Guix. ;;;@@ -22,6 +22,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)@@ -47,73 +48,10 @@ (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-programs)))+ (add-after 'install 'qt-wrap wrap-all-qt-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.scmindex d2486ee86c..3fbdb6be61 100644--- a/guix/build/qt-utils.scm+++ b/guix/build/qt-utils.scm@@ -1,5 +1,6 @@ ;;; 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> ;;; ;;; This file is part of GNU Guix. ;;;@@ -18,23 +19,87 @@ (define-module (guix build qt-utils) #:use-module (guix build utils)- #: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)))))+ #:use-module (ice-9 match)+ #:use-module (srfi srfi-1)+ #:use-module (srfi srfi-26)+ #:export (wrap-qt-program+ wrap-all-qt-programs))+++(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-qt-program* program #:key inputs output-dir)++ (define input-directories+ ;; FIXME: Filter out unwanted inputs, e.g. cmake+ (match inputs+ (((_ . dir) ...)+ dir)))++ (let ((vars-to-wrap (variables-for-wrapping+ (cons output-dir input-directories))))+ (when (not (null? vars-to-wrap))+ (apply wrap-program program vars-to-wrap))))+++(define* (wrap-qt-program program-name #:key inputs output)+ "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))+++(define* (wrap-all-qt-programs #:key inputs outputs+ (qt-wrap-excluded-outputs '())+ #: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)+ (find-files-to-wrap output-dir))))))++ (for-each handle-output outputs)+ #t)-- 2.21.3
H
H
Hartmut Goebel wrote on 11 Jan 16:46 +0100
(no subject)
(name . debbugs control)(address . control@debbugs.gnu.org)
ac7e562e-076e-57c7-d0b0-a4e3976f688f@goebel-consult.de
merge 45785 45784 45786 45787
H
H
Hartmut Goebel wrote on 29 Jan 23:07 +0100
Re: bug#45784: Acknowledgement ([PATCH 1/4] guix: qt-build-system, qt-utils: Unify wrapping of qt-programs.)
(address . 45784-close@debbugs.gnu.org)
9a92166f-342e-b306-190b-4965482e89f0@crazy-compilers.com
Pushed to staging as 104151f4f45f4bc3a816e3ad42256452932e0d8d
?