guix/build/qt-utils.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 David Craven <david@craven.ch>
   3 ;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel@crazy-compilers.com>
   4 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
   5 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
   6 ;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
   7 ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
   8 ;;;
   9 ;;; This file is part of GNU Guix.
  10 ;;;
  11 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  12 ;;; under the terms of the GNU General Public License as published by
  13 ;;; the Free Software Foundation; either version 3 of the License, or (at
  14 ;;; your option) any later version.
  15 ;;;
  16 ;;; GNU Guix is distributed in the hope that it will be useful, but
  17 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;;; GNU General Public License for more details.
  20 ;;;
  21 ;;; You should have received a copy of the GNU General Public License
  22 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 (define-module (guix build qt-utils)
  25   #:use-module (guix build utils)
  26   #:use-module (ice-9 match)
  27   #:use-module (srfi srfi-1)
  28   #:use-module (srfi srfi-26)
  29   #:use-module (srfi srfi-71)
  30   #:export (wrap-qt-program
  31             wrap-all-qt-programs
  32             %qt-wrap-excluded-inputs))
  33
  34 (define %default-qt-major-version "5")
  35
  36 (define %qt-wrap-excluded-inputs
  37   '(list "cmake" "extra-cmake-modules" "qttools"))
  38
  39 ;; NOTE: Apart from standard subdirectories of /share, Qt also provides
  40 ;; facilities for per-application data directories, such as
  41 ;; /share/quassel. Thus, we include the output directory even if it doesn't
  42 ;; contain any of the standard subdirectories.
  43 (define* (variables-for-wrapping base-directories output-directory
  44                                  #:key
  45                                  (qt-major-version %default-qt-major-version))
  46
  47   (define (collect-sub-dirs base-directories file-type subdirectory selectors)
  48     ;; Append SUBDIRECTORY and each of BASE-DIRECTORIES, and return the subset
  49     ;; that exists and has at least one of the SELECTORS sub-directories,
  50     ;; unless SELECTORS is the empty list.  FILE-TYPE should by 'directory or
  51     ;; 'regular file.  For the later, it allows searching for plain files
  52     ;; rather than directories.
  53     (define exists? (match file-type
  54                       ('directory directory-exists?)
  55                       ('regular file-exists?)))
  56
  57     (filter-map (lambda (dir)
  58                   (let ((directory (string-append dir subdirectory)))
  59                     (and (exists? directory)
  60                          (or (null? selectors)
  61                              (any (lambda (selector)
  62                                     (exists?
  63                                      (string-append directory selector)))
  64                                   selectors))
  65                          directory)))
  66                 base-directories))
  67
  68   (filter-map
  69    (match-lambda
  70      ((variable type file-type directory selectors ...)
  71       (match (collect-sub-dirs base-directories file-type directory selectors)
  72         (()
  73          #f)
  74         (directories
  75          `(,variable ,type ,directories)))))
  76    ;; These shall match the search-path-specification for Qt and KDE
  77    ;; libraries.
  78    (list
  79     ;; The XDG environment variables are defined with the 'suffix type, which
  80     ;; allows the users to override or extend their value, so that custom icon
  81     ;; themes can be honored, for example.
  82     '("XDG_DATA_DIRS" suffix directory "/share"
  83       ;; These are "selectors": consider /share if and only if at least
  84       ;; one of these sub-directories exist.  This avoids adding
  85       ;; irrelevant packages to XDG_DATA_DIRS just because they have a
  86       ;; /share sub-directory.
  87       "/applications" "/cursors" "/fonts" "/icons" "/glib-2.0/schemas"
  88       "/mime" "/sounds" "/themes" "/wallpapers")
  89     '("XDG_CONFIG_DIRS" suffix directory "/etc/xdg")
  90     ;; We wrap exactly to avoid potentially mixing Qt5/Qt6 components, which
  91     ;; would cause warnings, perhaps problems.
  92     `("QT_PLUGIN_PATH" = directory
  93       ,(format #f "/lib/qt~a/plugins" qt-major-version))
  94     `("QML2_IMPORT_PATH" = directory
  95       ,(format #f "/lib/qt~a/qml" qt-major-version))
  96     ;; QTWEBENGINEPROCESS_PATH accepts a single value, which makes 'exact the
  97     ;; most suitable environment variable type for it.
  98     `("QTWEBENGINEPROCESS_PATH" = regular
  99       ,(format #f "/lib/qt~a/libexec/QtWebEngineProcess" qt-major-version)))))
 100
 101 (define* (wrap-qt-program* program #:key inputs output-dir
 102                            qt-wrap-excluded-inputs
 103                            (qt-major-version %default-qt-major-version))
 104
 105   (define input-directories
 106     (filter-map
 107      (match-lambda
 108       ((label . directory)
 109        (and (not (member label qt-wrap-excluded-inputs))
 110             directory)))
 111      inputs))
 112
 113   (let ((vars-to-wrap (variables-for-wrapping
 114                        (cons output-dir input-directories)
 115                        output-dir
 116                        #:qt-major-version qt-major-version)))
 117     (when (not (null? vars-to-wrap))
 118       (apply wrap-program program vars-to-wrap))))
 119
 120 (define* (wrap-qt-program program-name #:key inputs output
 121                           (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
 122                           (qt-major-version %default-qt-major-version))
 123   "Wrap the specified program (which must reside in the OUTPUT's \"/bin\"
 124 directory) with suitably set environment variables.
 125
 126 This is like qt-build-systems's phase \"qt-wrap\", but only the named program
 127 is wrapped."
 128   (wrap-qt-program* (string-append output "/bin/" program-name)
 129                     #:output-dir output #:inputs inputs
 130                     #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs
 131                     #:qt-major-version qt-major-version))
 132
 133 (define* (wrap-all-qt-programs #:key inputs outputs
 134                                qtbase
 135                                (qt-wrap-excluded-outputs '())
 136                                (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
 137                                #:allow-other-keys)
 138   "Implement qt-build-systems's phase \"qt-wrap\": look for executables in
 139 \"bin\", \"sbin\" and \"libexec\" of all outputs and create wrappers with
 140 suitably set environment variables if found.
 141
 142 Wrapping is not applied to outputs whose name is listed in
 143 QT-WRAP-EXCLUDED-OUTPUTS.  This is useful when an output is known not
 144 to contain any Qt binaries, and where wrapping would gratuitously
 145 add a dependency of that output on Qt."
 146   (define qt-major-version
 147     (let ((_ version (package-name->name+version
 148                       (strip-store-file-name qtbase))))
 149       (first (string-split version #\.))))
 150
 151   (define (find-files-to-wrap output-dir)
 152     (append-map
 153      (lambda (dir)
 154        (if (directory-exists? dir)
 155            (find-files dir (lambda (file stat)
 156                              (not (wrapped-program? file))))
 157            (list)))
 158      (list (string-append output-dir "/bin")
 159            (string-append output-dir "/sbin")
 160            (string-append output-dir "/libexec")
 161            (string-append output-dir "/lib/libexec"))))
 162
 163   (define handle-output
 164     (match-lambda
 165      ((output . output-dir)
 166       (unless (member output qt-wrap-excluded-outputs)
 167         (for-each (cut wrap-qt-program* <>
 168                        #:output-dir output-dir #:inputs inputs
 169                        #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs
 170                        #:qt-major-version qt-major-version)
 171                   (find-files-to-wrap output-dir))))))
 172
 173   (for-each handle-output outputs))