guix/build/qt-build-system.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
   3 ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
   4 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
   5 ;;; Copyright © 2019, 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (guix build qt-build-system)
  23   #:use-module ((guix build cmake-build-system) #:prefix cmake:)
  24   #:use-module (guix build utils)
  25   #:use-module (ice-9 match)
  26   #:use-module (ice-9 regex)
  27   #:use-module (ice-9 ftw)
  28   #:use-module (srfi srfi-1)
  29   #:use-module (srfi srfi-26)
  30   #:export (%standard-phases
  31             qt-build))
  32
  33 ;; Commentary:
  34 ;;
  35 ;; Builder-side code of the standard Qt build procedure.
  36 ;;
  37 ;; Code:
  38
  39 (define* (check-setup #:rest args)
  40   ;; Make Qt render "offscreen". In many cases this allows to run tests
  41   ;; without starting a X11 server.
  42   (setenv "QT_QPA_PLATFORM" "offscreen")
  43   ;; Qt/KDE tests often need dbus (`dbus-launch …`) which is not fully
  44   ;; set-up the the build container.
  45   (setenv "DBUS_FATAL_WARNINGS" "0")
  46   ;; Set here to ease overwriting 'check (even if set there, too)
  47   (setenv "CTEST_OUTPUT_ON_FAILURE" "1")
  48   #t)
  49
  50 (define (variables-for-wrapping base-directories)
  51
  52   (define (collect-sub-dirs base-directories subdirectory)
  53     (filter-map
  54      (lambda (dir)
  55        (let ((directory (string-append dir subdirectory)))
  56          (if (directory-exists? directory) directory #f)))
  57      base-directories))
  58
  59   (filter
  60    (lambda (var-to-wrap) (not (null? (last var-to-wrap))))
  61    (map
  62     (lambda (var-spec)
  63       `(,(first var-spec) = ,(collect-sub-dirs base-directories (last var-spec))))
  64     (list
  65      ;; these shall match the search-path-specification for Qt and KDE
  66      ;; libraries
  67      '("XDG_DATA_DIRS" "/share")
  68      '("XDG_CONFIG_DIRS" "/etc/xdg")
  69      '("QT_PLUGIN_PATH" "/lib/qt5/plugins")
  70      '("QML2_IMPORT_PATH" "/lib/qt5/qml")))))
  71
  72 (define* (wrap-all-programs #:key inputs outputs
  73                             (qt-wrap-excluded-outputs '())
  74                             #:allow-other-keys)
  75   "Implement phase \"qt-wrap\": look for GSettings schemas and
  76 gtk+-v.0 libraries and create wrappers with suitably set environment variables
  77 if found.
  78
  79 Wrapping is not applied to outputs whose name is listed in
  80 QT-WRAP-EXCLUDED-OUTPUTS.  This is useful when an output is known not
  81 to contain any Qt binaries, and where wrapping would gratuitously
  82 add a dependency of that output on Qt."
  83   (define (find-files-to-wrap directory)
  84     (append-map
  85      (lambda (dir)
  86        (if (directory-exists? dir) (find-files dir ".*") (list)))
  87      (list (string-append directory "/bin")
  88            (string-append directory "/sbin")
  89            (string-append directory "/libexec")
  90            (string-append directory "/lib/libexec"))))
  91
  92   (define input-directories
  93     ;; FIXME: Filter out unwanted inputs, e.g. cmake
  94     (match inputs
  95            (((_ . dir) ...)
  96             dir)))
  97
  98   (define handle-output
  99     (match-lambda
 100      ((output . directory)
 101       (unless (member output qt-wrap-excluded-outputs)
 102         (let ((bin-list     (find-files-to-wrap directory))
 103               (vars-to-wrap (variables-for-wrapping
 104                              (append (list directory)
 105                                      input-directories))))
 106           (when (not (null? vars-to-wrap))
 107             (for-each (cut apply wrap-program <> vars-to-wrap)
 108                       bin-list)))))))
 109
 110   (for-each handle-output outputs)
 111   #t)
 112
 113 (define %standard-phases
 114   (modify-phases cmake:%standard-phases
 115     (add-before 'check 'check-setup check-setup)
 116     (add-after 'install 'qt-wrap wrap-all-programs)))
 117
 118 (define* (qt-build #:key inputs (phases %standard-phases)
 119                    #:allow-other-keys #:rest args)
 120   "Build the given package, applying all of PHASES in order."
 121   (apply cmake:cmake-build #:inputs inputs #:phases phases args))