guix/build-system/glib-or-gtk.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
   4 ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
   5 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
   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-system glib-or-gtk)
  23   #:use-module (guix store)
  24   #:use-module (guix utils)
  25   #:use-module (guix gexp)
  26   #:use-module (guix monads)
  27   #:use-module (guix derivations)
  28   #:use-module (guix search-paths)
  29   #:use-module (guix build-system)
  30   #:use-module (guix build-system gnu)
  31   #:use-module (guix packages)
  32   #:use-module (ice-9 match)
  33   #:export (%glib-or-gtk-build-system-modules
  34             glib-or-gtk-build
  35             glib-or-gtk-cross-build
  36             glib-or-gtk-build-system))
  37
  38 ;; Commentary:
  39 ;;
  40 ;; This build system is an extension of the 'gnu-build-system'.  It
  41 ;; accomodates the needs of applications making use of glib or gtk+ (with "or"
  42 ;; to be interpreted in the mathematical sense).  This is achieved by adding
  43 ;; two phases run after the 'install' phase:
  44 ;;
  45 ;; 'glib-or-gtk-wrap' phase:
  46 ;;
  47 ;; a) This phase looks for GSettings schemas, GIO modules and theming data.
  48 ;; If any of these is found in any input package, then all programs in
  49 ;; "out/bin" are wrapped in scripts defining the nedessary environment
  50 ;; variables.
  51 ;;
  52 ;; b) Looks for the existence of "libdir/gtk-3.0" directories in all input
  53 ;; packages.  If any is found, then the environment variable "GTK_PATH" is
  54 ;; suitably set and added to the wrappers.  The variable "GTK_PATH" has been
  55 ;; preferred over "GTK_EXE_PREFIX" because the latter can only point to a
  56 ;; single directory, while we may need to point to several ones.
  57 ;;
  58 ;; 'glib-or-gtk-compile-schemas' phase:
  59 ;;
  60 ;; Looks for the presence of "out/share/glib-2.0/schemas".  If that directory
  61 ;; exists and does not include a file named "gschemas.compiled", then
  62 ;; "glib-compile-schemas" is run in that directory.
  63 ;;
  64 ;; Code:
  65
  66 (define %default-modules
  67   ;; Build-side modules made available in the build environment.
  68   '((guix build glib-or-gtk-build-system)
  69     (guix build utils)))
  70
  71 (define %glib-or-gtk-build-system-modules
  72   ;; Build-side modules imported and used by default.
  73   `((guix build glib-or-gtk-build-system)
  74     ,@%gnu-build-system-modules))
  75
  76 (define (default-glib)
  77   "Return the default glib package from which we use
  78 \"glib-compile-schemas\"."
  79   ;; Do not use `@' to avoid introducing circular dependencies.
  80   (let ((module (resolve-interface '(gnu packages glib))))
  81     (module-ref module 'glib)))
  82
  83 (define* (lower name
  84                 #:key source inputs native-inputs outputs system target
  85                 (glib (default-glib))
  86                 (implicit-inputs? #t)
  87                 (implicit-cross-inputs? #t)
  88                 (strip-binaries? #t)
  89                 #:allow-other-keys
  90                 #:rest arguments)
  91   "Return a bag for NAME."
  92   (define private-keywords
  93     `(#:glib #:inputs #:native-inputs
  94       #:outputs #:implicit-inputs? #:implicit-cross-inputs?
  95       ,@(if target '() '(#:target))))
  96
  97   (bag
  98     (name name)
  99     (system system) (target target)
 100     (host-inputs `(,@(if source
 101                          `(("source" ,source))
 102                          '())
 103                    ,@(if target
 104                          inputs
 105                          '())))
 106     (build-inputs `(,@native-inputs
 107                     ,@(if target '() inputs)
 108                     ("glib:bin" ,glib "bin") ; to compile schemas
 109                     ;; Keep standard inputs of gnu-build-system.
 110                     ,@(if (and target implicit-cross-inputs?)
 111                           (standard-cross-packages target 'host)
 112                           '())
 113                     ,@(if implicit-inputs?
 114                           (standard-packages)
 115                           '())))
 116     ;; Keep standard inputs of 'gnu-build-system'.
 117     (target-inputs (if (and target implicit-cross-inputs?)
 118                        (standard-cross-packages target 'target)
 119                        '()))
 120     (outputs outputs)
 121     (build (if target glib-or-gtk-cross-build glib-or-gtk-build))
 122     (arguments (strip-keyword-arguments private-keywords arguments))))
 123
 124 (define* (glib-or-gtk-build name inputs
 125                             #:key guile source
 126                             (outputs '("out"))
 127                             (search-paths '())
 128                             (configure-flags ''())
 129                             ;; Disable icon theme cache generation.
 130                             (make-flags ''("gtk_update_icon_cache=true"))
 131                             (out-of-source? #f)
 132                             (tests? #t)
 133                             (test-target "check")
 134                             (parallel-build? #t)
 135                             (parallel-tests? #t)
 136                             (validate-runpath? #t)
 137                             (patch-shebangs? #t)
 138                             (strip-binaries? #t)
 139                             (strip-flags ''("--strip-debug"))
 140                             (strip-directories ''("lib" "lib64" "libexec"
 141                                                   "bin" "sbin"))
 142                             (phases '(@ (guix build glib-or-gtk-build-system)
 143                                         %standard-phases))
 144                             (glib-or-gtk-wrap-excluded-outputs ''())
 145                             (system (%current-system))
 146                             (imported-modules %glib-or-gtk-build-system-modules)
 147                             (modules %default-modules)
 148                             allowed-references
 149                             disallowed-references)
 150   "Build SOURCE with INPUTS.  See GNU-BUILD for more details."
 151   (define build
 152     (with-imported-modules imported-modules
 153       #~(begin
 154           (use-modules #$@(sexp->gexp modules))
 155
 156           #$(with-build-variables inputs outputs
 157               #~(glib-or-gtk-build #:source #+source
 158                                    #:system #$system
 159                                    #:outputs %outputs
 160                                    #:inputs %build-inputs
 161                                    #:search-paths '#$(sexp->gexp
 162                                                       (map search-path-specification->sexp
 163                                                            search-paths))
 164                                    #:phases #$(if (pair? phases)
 165                                                   (sexp->gexp phases)
 166                                                   phases)
 167                                    #:glib-or-gtk-wrap-excluded-outputs
 168                                    #$glib-or-gtk-wrap-excluded-outputs
 169                                    #:configure-flags #$configure-flags
 170                                    #:make-flags #$make-flags
 171                                    #:out-of-source? #$out-of-source?
 172                                    #:tests? #$tests?
 173                                    #:test-target #$test-target
 174                                    #:parallel-build? #$parallel-build?
 175                                    #:parallel-tests? #$parallel-tests?
 176                                    #:validate-runpath? #$validate-runpath?
 177                                    #:patch-shebangs? #$patch-shebangs?
 178                                    #:strip-binaries? #$strip-binaries?
 179                                    #:strip-flags #$(sexp->gexp strip-flags)
 180                                    #:strip-directories
 181                                    #$(sexp->gexp strip-directories))))))
 182
 183
 184   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
 185                                                   system #:graft? #f)))
 186     (gexp->derivation name build
 187                       #:system system
 188                       #:target #f
 189                       #:graft? #f
 190                       #:allowed-references allowed-references
 191                       #:disallowed-references disallowed-references
 192                       #:guile-for-build guile)))
 193
 194 (define* (glib-or-gtk-cross-build name
 195                                   #:key
 196                                   target
 197                                   build-inputs target-inputs host-inputs
 198                                   guile source
 199                                   (outputs '("out"))
 200                                   (search-paths '())
 201                                   (native-search-paths '())
 202                                   (configure-flags ''())
 203                                   ;; Disable icon theme cache generation.
 204                                   (make-flags ''("gtk_update_icon_cache=true"))
 205                                   (out-of-source? #f)
 206                                   (tests? #f)
 207                                   (test-target "check")
 208                                   (parallel-build? #t)
 209                                   (parallel-tests? #t)
 210                                   (validate-runpath? #t)
 211                                   (make-dynamic-linker-cache? #f)
 212                                   (patch-shebangs? #t)
 213                                   (strip-binaries? #t)
 214                                   (strip-flags ''("--strip-debug"))
 215                                   (strip-directories ''("lib" "lib64" "libexec"
 216                                                         "bin" "sbin"))
 217                                   (phases '(@ (guix build glib-or-gtk-build-system)
 218                                               %standard-phases))
 219                                   (glib-or-gtk-wrap-excluded-outputs ''())
 220                                   (system (%current-system))
 221                                   (build (nix-system->gnu-triplet system))
 222                                   (imported-modules %glib-or-gtk-build-system-modules)
 223                                   (modules %default-modules)
 224                                   allowed-references
 225                                   disallowed-references)
 226   "Cross-build SOURCE with INPUTS.  See GNU-BUILD for more details."
 227   (define builder
 228     #~(begin
 229         (use-modules #$@(sexp->gexp modules))
 230
 231         (define %build-host-inputs
 232           #+(input-tuples->gexp build-inputs))
 233
 234         (define %build-target-inputs
 235           (append #$(input-tuples->gexp host-inputs)
 236                   #+(input-tuples->gexp target-inputs)))
 237
 238         (define %build-inputs
 239           (append %build-host-inputs %build-target-inputs))
 240
 241         (define %outputs
 242           #$(outputs->gexp outputs))
 243
 244         (glib-or-gtk-build #:source #+source
 245                            #:system #$system
 246                            #:build #$build
 247                            #:target #$target
 248                            #:outputs %outputs
 249                            #:inputs %build-target-inputs
 250                            #:native-inputs %build-host-inputs
 251                            #:search-paths '#$(sexp->gexp
 252                                               (map search-path-specification->sexp
 253                                                    search-paths))
 254                            #:native-search-paths '#$(sexp->gexp
 255                                                      (map search-path-specification->sexp
 256                                                           native-search-paths))
 257                            #:phases #$(if (pair? phases)
 258                                           (sexp->gexp phases)
 259                                           phases)
 260                            #:glib-or-gtk-wrap-excluded-outputs
 261                            #$glib-or-gtk-wrap-excluded-outputs
 262                            #:configure-flags #$configure-flags
 263                            #:make-flags #$make-flags
 264                            #:out-of-source? #$out-of-source?
 265                            #:tests? #$tests?
 266                            #:test-target #$test-target
 267                            #:parallel-build? #$parallel-build?
 268                            #:parallel-tests? #$parallel-tests?
 269                            #:validate-runpath? #$validate-runpath?
 270                            #:make-dynamic-linker-cache? #$make-dynamic-linker-cache?
 271                            #:patch-shebangs? #$patch-shebangs?
 272                            #:strip-binaries? #$strip-binaries?
 273                            #:strip-flags #$(sexp->gexp strip-flags)
 274                            #:strip-directories
 275                            #$(sexp->gexp strip-directories))))
 276
 277
 278   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
 279                                                   system #:graft? #f)))
 280     (gexp->derivation name builder
 281                       #:system system
 282                       #:target target
 283                       #:graft? #f
 284                       #:modules imported-modules
 285                       #:allowed-references allowed-references
 286                       #:disallowed-references disallowed-references
 287                       #:guile-for-build guile)))
 288
 289 (define glib-or-gtk-build-system
 290   (build-system
 291     (name 'glib-or-gtk)
 292     (description
 293      "The GNU Build System—i.e., ./configure && make && make install,
 294 augmented with definition of suitable environment variables for glib and gtk+
 295 in program wrappers.")
 296     (lower lower)))