From: Hartmut Goebel <h.goebel@crazy-compilers.com>
To: 38440@debbugs.gnu.org
Subject: [bug#38440] [PATCH v2] guix: Add the 'qt' build system.
Date: Sat, 30 Nov 2019 23:17:07 +0100 [thread overview]
Message-ID: <20191130221707.26727-1-h.goebel@crazy-compilers.com> (raw)
In-Reply-To: <20191130215910.18891-1-h.goebel@crazy-compilers.com>
* guix/build-system/qt.scm, guix/build/qt-build-system.scm: New files.
* Makefile.am (MODULES): Add them.
* doc/guix.texi (Buiild systems): Add the new build system.
---
Makefile.am | 2 +
doc/guix.texi | 21 ++-
guix/build-system/qt.scm | 295 +++++++++++++++++++++++++++++++++
guix/build/qt-build-system.scm | 109 ++++++++++++
4 files changed, 426 insertions(+), 1 deletion(-)
create mode 100644 guix/build-system/qt.scm
create mode 100644 guix/build/qt-build-system.scm
diff --git a/Makefile.am b/Makefile.am
index b3f03d44c8..97f1ff514b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -132,6 +132,7 @@ MODULES = \
guix/build-system/perl.scm \
guix/build-system/python.scm \
guix/build-system/ocaml.scm \
+ guix/build-system/qt.scm \
guix/build-system/waf.scm \
guix/build-system/r.scm \
guix/build-system/rakudo.scm \
@@ -178,6 +179,7 @@ MODULES = \
guix/build/perl-build-system.scm \
guix/build/python-build-system.scm \
guix/build/ocaml-build-system.scm \
+ guix/build/qt-build-system.scm \
guix/build/r-build-system.scm \
guix/build/rakudo-build-system.scm \
guix/build/ruby-build-system.scm \
diff --git a/doc/guix.texi b/doc/guix.texi
index 23a30ce553..cf1d38afc9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -47,7 +47,7 @@ Copyright @copyright{} 2017 Thomas Danckaert@*
Copyright @copyright{} 2017 humanitiesNerd@*
Copyright @copyright{} 2017 Christopher Allan Webber@*
Copyright @copyright{} 2017, 2018 Marius Bakke@*
-Copyright @copyright{} 2017 Hartmut Goebel@*
+Copyright @copyright{} 2017, 2019 Hartmut Goebel@*
Copyright @copyright{} 2017, 2019 Maxim Cournoyer@*
Copyright @copyright{} 2017, 2018, 2019 Tobias Geerinckx-Rice@*
Copyright @copyright{} 2017 George Clemmer@*
@@ -6408,6 +6408,25 @@ passes flags specified by the @code{#:make-maker-flags} or
Which Perl package is used can be specified with @code{#:perl}.
@end defvr
+@defvr {Scheme Variable} qt-build-system
+This variable is exported by @code{(guix build-system qt)}. It
+is intended for use with applications using Qt or KDE.
+
+This build system adds the phase @code{qt-wrap} to the ones defined by
+@var{cmake-build-system}, after the @code{install} phase.
+
+This phase searches for Qt5 plugin paths, QML paths and some XDG in the inputs
+and output. In case some path is found, all programs in the output's
+@file{bin/}, @file{sbin/}, @file{libexec/} and @file{lib/libexec/} directories
+are wrapped in scripts defining the necessary environment variables.
+
+It is possible to exclude specific package outputs from that wrapping process
+by listing their names in the @code{#:qt-wrap-excluded-outputs} parameter.
+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, KDE,
+or such.
+@end defvr
+
@defvr {Scheme Variable} r-build-system
This variable is exported by @code{(guix build-system r)}. It
implements the build procedure used by @uref{https://r-project.org, R}
diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm
new file mode 100644
index 0000000000..b776845377
--- /dev/null
+++ b/guix/build-system/qt.scm
@@ -0,0 +1,295 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
+;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build-system qt)
+ #:use-module (guix store)
+ #:use-module (guix utils)
+ #:use-module (guix derivations)
+ #:use-module (guix search-paths)
+ #:use-module (guix build-system)
+ #:use-module (guix build-system cmake)
+ #:use-module (guix build-system gnu)
+ #:use-module (guix packages)
+ #:use-module (ice-9 match)
+ #:export (%qt-build-system-modules
+ qt-build
+ qt-build-system))
+
+;; Commentary:
+;;
+;; This build system is an extension of the 'cmake-build-system'. It
+;; accommodates the needs of Qt and KDE applications by adding a phase run
+;; after the 'install' phase:
+;;
+;; 'qt-wrap' phase:
+;;
+;; This phase looks for Qt5 plugin paths, QML paths and some XDG paths as well
+;; as the corresponding environment variables. If any of these is found in
+;; the output or if respective environment variables are set, then all
+;; programs in the output's "bin", "sbin", "libexec and "lib/libexec"
+;; directories are wrapped in scripts defining the necessary environment
+;; variables.
+;;
+;; Code:
+
+(define %qt-build-system-modules
+ ;; Build-side modules imported and used by default.
+ `((guix build qt-build-system)
+ ,@%cmake-build-system-modules))
+
+(define (default-cmake)
+ "Return the default CMake package."
+
+ ;; Do not use `@' to avoid introducing circular dependencies.
+ (let ((module (resolve-interface '(gnu packages cmake))))
+ (module-ref module 'cmake-minimal)))
+
+;; This barely is a copy from (guix build-system cmake), only adjusted to use
+;; the variables defined here.
+(define* (lower name
+ #:key source inputs native-inputs outputs system target
+ (cmake (default-cmake))
+ #:allow-other-keys
+ #:rest arguments)
+ "Return a bag for NAME."
+ (define private-keywords
+ `(#:source #:cmake #:inputs #:native-inputs #:outputs
+ ,@(if target '() '(#:target))))
+
+ (bag
+ (name name)
+ (system system)
+ (target target)
+ (build-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@`(("cmake" ,cmake))
+ ,@native-inputs
+ ,@(if target
+ ;; Use the standard cross inputs of
+ ;; 'gnu-build-system'.
+ (standard-cross-packages target 'host)
+ '())
+ ;; Keep the standard inputs of 'gnu-build-system'.
+ ,@(standard-packages)))
+ (host-inputs inputs)
+
+ ;; The cross-libc is really a target package, but for bootstrapping
+ ;; reasons, we can't put it in 'host-inputs'. Namely, 'cross-gcc' is a
+ ;; native package, so it would end up using a "native" variant of
+ ;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages
+ ;; would use a target variant (built with 'gnu-cross-build'.)
+ (target-inputs (if target
+ (standard-cross-packages target 'target)
+ '()))
+ (outputs outputs)
+ (build (if target qt-cross-build qt-build))
+ (arguments (strip-keyword-arguments private-keywords arguments))))
+
+
+(define* (qt-build store name inputs
+ #:key (guile #f)
+ (outputs '("out")) (configure-flags ''())
+ (search-paths '())
+ (make-flags ''())
+ (out-of-source? #t)
+ (build-type "RelWithDebInfo")
+ (tests? #t)
+ (test-target "test")
+ (parallel-build? #t) (parallel-tests? #f)
+ (validate-runpath? #t)
+ (patch-shebangs? #t)
+ (strip-binaries? #t)
+ (strip-flags ''("--strip-debug"))
+ (strip-directories ''("lib" "lib64" "libexec"
+ "bin" "sbin"))
+ (phases '(@ (guix build qt-build-system)
+ %standard-phases))
+ (qt-wrap-excluded-outputs ''())
+ (system (%current-system))
+ (imported-modules %qt-build-system-modules)
+ (modules '((guix build cmake-build-system)
+ (guix build utils))))
+ "Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE
+provides a 'CMakeLists.txt' file as its build system."
+ (define builder
+ `(begin
+ (use-modules ,@modules)
+ (cmake-build #:source ,(match (assoc-ref inputs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (source
+ source))
+ #:system ,system
+ #:outputs %outputs
+ #:inputs %build-inputs
+ #:search-paths ',(map search-path-specification->sexp
+ search-paths)
+ #:phases ,phases
+ #:qt-wrap-excluded-outputs ,qt-wrap-excluded-outputs
+ #:configure-flags ,configure-flags
+ #:make-flags ,make-flags
+ #:out-of-source? ,out-of-source?
+ #:build-type ,build-type
+ #:tests? ,tests?
+ #:test-target ,test-target
+ #:parallel-build? ,parallel-build?
+ #:parallel-tests? ,parallel-tests?
+ #:validate-runpath? ,validate-runpath?
+ #:patch-shebangs? ,patch-shebangs?
+ #:strip-binaries? ,strip-binaries?
+ #:strip-flags ,strip-flags
+ #:strip-directories ,strip-directories)))
+
+ (define guile-for-build
+ (match guile
+ ((? package?)
+ (package-derivation store guile system #:graft? #f))
+ (#f ; the default
+ (let* ((distro (resolve-interface '(gnu packages commencement)))
+ (guile (module-ref distro 'guile-final)))
+ (package-derivation store guile system #:graft? #f)))))
+
+ (build-expression->derivation store name builder
+ #:system system
+ #:inputs inputs
+ #:modules imported-modules
+ #:outputs outputs
+ #:guile-for-build guile-for-build))
+
+\f
+;;;
+;;; Cross-compilation.
+;;;
+
+(define* (qt-cross-build store name
+ #:key
+ target native-drvs target-drvs
+ (guile #f)
+ (outputs '("out"))
+ (configure-flags ''())
+ (search-paths '())
+ (native-search-paths '())
+ (make-flags ''())
+ (out-of-source? #t)
+ (build-type "RelWithDebInfo")
+ (tests? #f) ; nothing can be done
+ (test-target "test")
+ (parallel-build? #t) (parallel-tests? #f)
+ (validate-runpath? #t)
+ (patch-shebangs? #t)
+ (strip-binaries? #t)
+ (strip-flags ''("--strip-debug"
+ "--enable-deterministic-archives"))
+ (strip-directories ''("lib" "lib64" "libexec"
+ "bin" "sbin"))
+ (phases '(@ (guix build qt-build-system)
+ %standard-phases))
+ (system (%current-system))
+ (build (nix-system->gnu-triplet system))
+ (imported-modules %qt-build-system-modules)
+ (modules '((guix build cmake-build-system)
+ (guix build utils))))
+ "Cross-build NAME using CMAKE for TARGET, where TARGET is a GNU triplet and
+with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its
+build system."
+ (define builder
+ `(begin
+ (use-modules ,@modules)
+ (let ()
+ (define %build-host-inputs
+ ',(map (match-lambda
+ ((name (? derivation? drv) sub ...)
+ `(,name . ,(apply derivation->output-path drv sub)))
+ ((name path)
+ `(,name . ,path)))
+ native-drvs))
+
+ (define %build-target-inputs
+ ',(map (match-lambda
+ ((name (? derivation? drv) sub ...)
+ `(,name . ,(apply derivation->output-path drv sub)))
+ ((name (? package? pkg) sub ...)
+ (let ((drv (package-cross-derivation store pkg
+ target system)))
+ `(,name . ,(apply derivation->output-path drv sub))))
+ ((name path)
+ `(,name . ,path)))
+ target-drvs))
+
+ (cmake-build #:source ,(match (assoc-ref native-drvs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (source
+ source))
+ #:system ,system
+ #:build ,build
+ #:target ,target
+ #:outputs %outputs
+ #:inputs %build-target-inputs
+ #:native-inputs %build-host-inputs
+ #:search-paths ',(map search-path-specification->sexp
+ search-paths)
+ #:native-search-paths ',(map
+ search-path-specification->sexp
+ native-search-paths)
+ #:phases ,phases
+ #:configure-flags ,configure-flags
+ #:make-flags ,make-flags
+ #:out-of-source? ,out-of-source?
+ #:build-type ,build-type
+ #:tests? ,tests?
+ #:test-target ,test-target
+ #:parallel-build? ,parallel-build?
+ #:parallel-tests? ,parallel-tests?
+ #:validate-runpath? ,validate-runpath?
+ #:patch-shebangs? ,patch-shebangs?
+ #:strip-binaries? ,strip-binaries?
+ #:strip-flags ,strip-flags
+ #:strip-directories ,strip-directories))))
+
+ (define guile-for-build
+ (match guile
+ ((? package?)
+ (package-derivation store guile system #:graft? #f))
+ (#f ; the default
+ (let* ((distro (resolve-interface '(gnu packages commencement)))
+ (guile (module-ref distro 'guile-final)))
+ (package-derivation store guile system #:graft? #f)))))
+
+ (build-expression->derivation store name builder
+ #:system system
+ #:inputs (append native-drvs target-drvs)
+ #:outputs outputs
+ #:modules imported-modules
+ #:guile-for-build guile-for-build))
+
+(define qt-build-system
+ (build-system
+ (name 'qt)
+ (description
+ "The CMake build system augmented with definition of suitable environment
+variables for Qt and KDE in program wrappers.")
+ (lower lower)))
diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scm
new file mode 100644
index 0000000000..46fcad7848
--- /dev/null
+++ b/guix/build/qt-build-system.scm
@@ -0,0 +1,109 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; 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 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build qt-build-system)
+ #:use-module ((guix build cmake-build-system) #:prefix cmake:)
+ #:use-module (guix build utils)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
+ #:use-module (ice-9 ftw)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:export (%standard-phases
+ qt-build))
+
+;; Commentary:
+;;
+;; Builder-side code of the standard Qt build procedure.
+;;
+;; Code:
+
+(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 output)
+ 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-after 'install 'qt-wrap wrap-all-programs)))
+
+(define* (qt-build #:key inputs (phases %standard-phases)
+ #:allow-other-keys #:rest args)
+ "Build the given package, applying all of PHASES in order."
+ (apply cmake:cmake-build #:inputs inputs #:phases phases args))
--
2.21.0
prev parent reply other threads:[~2019-11-30 22:18 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-11-30 21:59 [bug#38440] [PATCH 0/5] Add the `qt` build-system Hartmut Goebel
2019-11-30 22:00 ` [bug#38440] [PATCH 1/5] guix: Add the 'qt' build system Hartmut Goebel
2019-11-30 22:00 ` [bug#38440] [PATCH 2/5] gnu: sddm: Use qt-build-system Hartmut Goebel
2019-11-30 22:00 ` [bug#38440] [PATCH 3/5] gnu: ktouch: " Hartmut Goebel
2019-11-30 22:00 ` [bug#38440] [PATCH 4/5] gnu: kdeconnect: " Hartmut Goebel
2019-11-30 22:00 ` [bug#38440] [PATCH 5/5] gnu: quaternion: " Hartmut Goebel
2019-11-30 22:15 ` [bug#38440] [PATCH 0/5] Add the `qt` build-system Brett Gilio
2019-12-01 19:28 ` bug#38440: " Hartmut Goebel
2019-11-30 22:17 ` Hartmut Goebel [this message]
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20191130221707.26727-1-h.goebel@crazy-compilers.com \
--to=h.goebel@crazy-compilers.com \
--cc=38440@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).