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

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
   4 ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (guix build-system glib-or-gtk)
  22   #:use-module (guix store)
  23   #:use-module (guix utils)
  24   #:use-module (guix derivations)
  25   #:use-module (guix search-paths)
  26   #:use-module (guix build-system)
  27   #:use-module (guix build-system gnu)
  28   #:use-module (guix packages)
  29   #:use-module (ice-9 match)
  30   #:export (%glib-or-gtk-build-system-modules
  31             glib-or-gtk-build
  32             glib-or-gtk-build-system))
  33
  34 ;; Commentary:
  35 ;;
  36 ;; This build system is an extension of the 'gnu-build-system'.  It
  37 ;; accomodates the needs of applications making use of glib or gtk+ (with "or"
  38 ;; to be interpreted in the mathematical sense).  This is achieved by adding
  39 ;; two phases run after the 'install' phase:
  40 ;;
  41 ;; 'glib-or-gtk-wrap' phase:
  42 ;;
  43 ;; a) This phase looks for GSettings schemas, GIO modules and theming data.
  44 ;; If any of these is found in any input package, then all programs in
  45 ;; "out/bin" are wrapped in scripts defining the nedessary environment
  46 ;; variables.
  47 ;;
  48 ;; b) Looks for the existence of "libdir/gtk-3.0" directories in all input
  49 ;; packages.  If any is found, then the environment variable "GTK_PATH" is
  50 ;; suitably set and added to the wrappers.  The variable "GTK_PATH" has been
  51 ;; preferred over "GTK_EXE_PREFIX" because the latter can only point to a
  52 ;; single directory, while we may need to point to several ones.
  53 ;;
  54 ;; 'glib-or-gtk-compile-schemas' phase:
  55 ;;
  56 ;; Looks for the presence of "out/share/glib-2.0/schemas".  If that directory
  57 ;; exists and does not include a file named "gschemas.compiled", then
  58 ;; "glib-compile-schemas" is run in that directory.
  59 ;;
  60 ;; Code:
  61
  62 (define %default-modules
  63   ;; Build-side modules made available in the build environment.
  64   '((guix build glib-or-gtk-build-system)
  65     (guix build utils)))
  66
  67 (define %glib-or-gtk-build-system-modules
  68   ;; Build-side modules imported and used by default.
  69   `((guix build glib-or-gtk-build-system)
  70     ,@%gnu-build-system-modules))
  71
  72 (define (default-glib)
  73   "Return the default glib package from which we use
  74 \"glib-compile-schemas\"."
  75   ;; Do not use `@' to avoid introducing circular dependencies.
  76   (let ((module (resolve-interface '(gnu packages glib))))
  77     (module-ref module 'glib)))
  78
  79 (define* (lower name
  80                 #:key source inputs native-inputs outputs system target
  81                 (glib (default-glib))
  82                 (implicit-inputs? #t)
  83                 (strip-binaries? #t)
  84                 #:allow-other-keys
  85                 #:rest arguments)
  86   "Return a bag for NAME."
  87   (define private-keywords
  88     '(#:source #:target #:glib #:inputs #:native-inputs
  89       #:outputs #:implicit-inputs?))
  90
  91   (and (not target)                               ;XXX: no cross-compilation
  92        (bag
  93          (name name)
  94          (system system)
  95          (host-inputs (if source
  96                           `(("source" ,source))
  97                           '()))
  98          (build-inputs `(,@native-inputs
  99                          ,@inputs
 100                          ("glib:bin" ,glib "bin") ; to compile schemas
 101                          ,@(if implicit-inputs?
 102                                (standard-packages)
 103                                '())))
 104          (outputs outputs)
 105          (build glib-or-gtk-build)
 106          (arguments (strip-keyword-arguments private-keywords arguments)))))
 107
 108 (define* (glib-or-gtk-build store name inputs
 109                             #:key (guile #f)
 110                             (outputs '("out"))
 111                             (search-paths '())
 112                             (configure-flags ''())
 113                             ;; Disable icon theme cache generation.
 114                             (make-flags ''("gtk_update_icon_cache=true"))
 115                             (out-of-source? #f)
 116                             (tests? #t)
 117                             (test-target "check")
 118                             (parallel-build? #t)
 119                             (parallel-tests? #t)
 120                             (validate-runpath? #t)
 121                             (patch-shebangs? #t)
 122                             (strip-binaries? #t)
 123                             (strip-flags ''("--strip-debug"))
 124                             (strip-directories ''("lib" "lib64" "libexec"
 125                                                   "bin" "sbin"))
 126                             (phases '(@ (guix build glib-or-gtk-build-system)
 127                                         %standard-phases))
 128                             (glib-or-gtk-wrap-excluded-outputs ''())
 129                             (system (%current-system))
 130                             (imported-modules %glib-or-gtk-build-system-modules)
 131                             (modules %default-modules)
 132                             allowed-references
 133                             disallowed-references)
 134   "Build SOURCE with INPUTS.  See GNU-BUILD for more details."
 135   (define canonicalize-reference
 136     (match-lambda
 137      ((? package? p)
 138       (derivation->output-path (package-derivation store p system)))
 139      (((? package? p) output)
 140       (derivation->output-path (package-derivation store p system)
 141                                output))
 142      ((? string? output)
 143       output)))
 144
 145   (define builder
 146     `(begin
 147        (use-modules ,@modules)
 148        (glib-or-gtk-build #:source ,(match (assoc-ref inputs "source")
 149                                       (((? derivation? source))
 150                                        (derivation->output-path source))
 151                                       ((source)
 152                                        source)
 153                                       (source
 154                                        source))
 155                           #:system ,system
 156                           #:outputs %outputs
 157                           #:inputs %build-inputs
 158                           #:search-paths ',(map search-path-specification->sexp
 159                                                 search-paths)
 160                           #:phases ,phases
 161                           #:glib-or-gtk-wrap-excluded-outputs
 162                            ,glib-or-gtk-wrap-excluded-outputs
 163                           #:configure-flags ,configure-flags
 164                           #:make-flags ,make-flags
 165                           #:out-of-source? ,out-of-source?
 166                           #:tests? ,tests?
 167                           #:test-target ,test-target
 168                           #:parallel-build? ,parallel-build?
 169                           #:parallel-tests? ,parallel-tests?
 170                           #:validate-runpath? ,validate-runpath?
 171                           #:patch-shebangs? ,patch-shebangs?
 172                           #:strip-binaries? ,strip-binaries?
 173                           #:strip-flags ,strip-flags
 174                           #:strip-directories ,strip-directories)))
 175
 176   (define guile-for-build
 177     (match guile
 178       ((? package?)
 179        (package-derivation store guile system #:graft? #f))
 180       (#f                                         ; the default
 181        (let* ((distro (resolve-interface '(gnu packages commencement)))
 182               (guile  (module-ref distro 'guile-final)))
 183          (package-derivation store guile system #:graft? #f)))))
 184
 185   (build-expression->derivation store name builder
 186                                 #:system system
 187                                 #:inputs inputs
 188                                 #:modules imported-modules
 189                                 #:outputs outputs
 190                                 #:allowed-references
 191                                 (and allowed-references
 192                                      (map canonicalize-reference
 193                                           allowed-references))
 194                                 #:disallowed-references
 195                                 (and disallowed-references
 196                                      (map canonicalize-reference
 197                                           disallowed-references))
 198                                 #:guile-for-build guile-for-build))
 199
 200 (define glib-or-gtk-build-system
 201   (build-system
 202     (name 'glib-or-gtk)
 203     (description
 204      "The GNU Build System—i.e., ./configure && make && make install,
 205 augmented with definition of suitable environment variables for glib and gtk+
 206 in program wrappers.")
 207     (lower lower)))