guix: qt-build-system, qt-utils: Unify wrapping of qt-programs.

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 for
packages 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.
This commit is contained in:
Hartmut Goebel 2020-12-25 23:02:18 +01:00 committed by Maxim Cournoyer
parent 1879b05f90
commit 7e24e1e58d
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
9 changed files with 111 additions and 97 deletions

View File

@ -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.
;;;
@ -448,8 +449,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)

View File

@ -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>
@ -618,8 +618,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")
(description

View File

@ -10,7 +10,7 @@
;;; Copyright © 2019, 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
;;; Copyright © 2019, 2020, 2021 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, 2021 Felix Gruber <felgru@posteo.net>
@ -2241,8 +2241,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)

View File

@ -31,6 +31,7 @@
;;; Copyright © 2020 Vinicius Monego <monego@posteo.net>
;;; Copyright © 2021 Stefan Reichör <stefan@xsteve.at>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -682,8 +683,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.

View File

@ -51,6 +51,7 @@
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 David Wilson <david@daviwil.com>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -4609,9 +4610,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")

View File

@ -18,6 +18,7 @@
;;; Copyright © 2021 Cage <cage-dev@twistfold.it>
;;; Copyright © 2021 Benoit Joly <benoit@benoitj.ca>
;;; Copyright © 2021 Alexander Krotov <krotov@iitp.ru>
;;; Copyright © 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -449,9 +450,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"

View File

@ -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)

View File

@ -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)

View File

@ -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))
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (wrap-qt-program
wrap-all-qt-programs))
(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)))))
(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)