Commit | Line | Data |
---|---|---|
be3425e5 FB |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch> | |
ca79e42e | 3 | ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> |
be3425e5 FB |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | (define-module (guix build glib-or-gtk-build-system) | |
21 | #:use-module ((guix build gnu-build-system) #:prefix gnu:) | |
22 | #:use-module (guix build utils) | |
23 | #:use-module (ice-9 match) | |
24 | #:use-module (ice-9 regex) | |
61771a79 | 25 | #:use-module (ice-9 ftw) |
be3425e5 | 26 | #:use-module (srfi srfi-1) |
4efdabb8 | 27 | #:use-module (srfi srfi-26) |
be3425e5 FB |
28 | #:export (%standard-phases |
29 | glib-or-gtk-build)) | |
30 | ||
31 | ;; Commentary: | |
32 | ;; | |
33 | ;; Builder-side code of the standard glib-or-gtk build procedure. | |
34 | ;; | |
35 | ;; Code: | |
36 | ||
37 | (define (subdirectory-exists? parent sub-directory) | |
38 | (directory-exists? (string-append parent sub-directory))) | |
39 | ||
40 | (define (directory-included? directory directories-list) | |
41 | "Is DIRECTORY included in DIRECTORIES-LIST?" | |
85dbd3dc | 42 | (fold (lambda (s p) (or (string-ci=? s directory) p)) |
be3425e5 FB |
43 | #f directories-list)) |
44 | ||
61771a79 FB |
45 | ;; We do not include $HOME/.guix-profile/gtk-v.0 (v=2 or 3) because we do not |
46 | ;; want to mix gtk+-2 and gtk+-3 modules. See | |
47 | ;; https://developer.gnome.org/gtk3/stable/gtk-running.html | |
be3425e5 FB |
48 | (define (gtk-module-directories inputs) |
49 | "Check for the existence of \"libdir/gtk-v.0\" in INPUTS. Return a list | |
50 | with all found directories." | |
85dbd3dc LC |
51 | (let* ((version |
52 | (if (string-match "gtk\\+-3" | |
be3425e5 FB |
53 | (or (assoc-ref inputs "gtk+") |
54 | (assoc-ref inputs "source") | |
55 | "gtk+-3")) ; we default to version 3 | |
56 | "3.0" | |
57 | "2.0")) | |
58 | (gtk-module | |
59 | (lambda (input prev) | |
60 | (let* ((in (match input | |
61 | ((_ . dir) dir) | |
62 | (_ ""))) | |
85dbd3dc | 63 | (libdir |
be3425e5 FB |
64 | (string-append in "/lib/gtk-" version))) |
65 | (if (and (directory-exists? libdir) | |
66 | (not (directory-included? libdir prev))) | |
67 | (cons libdir prev) | |
68 | prev))))) | |
69 | (fold gtk-module '() inputs))) | |
70 | ||
61771a79 FB |
71 | ;; See |
72 | ;; http://www.freedesktop.org/wiki/DesktopThemeSpec | |
73 | ;; http://freedesktop.org/wiki/Specifications/sound-theme-spec | |
74 | ;; http://freedesktop.org/wiki/Specifications/icon-theme-spec | |
ca79e42e | 75 | ;; |
61771a79 FB |
76 | ;; Currently desktop themes are not well supported and do not honor |
77 | ;; XDG_DATA_DIRS. One example is evince which only looks for desktop themes | |
78 | ;; in $HOME/.themes (for backward compatibility) and in XDG_DATA_HOME (which | |
79 | ;; defaults to $HOME/.local/share). One way to handle these applications | |
80 | ;; appears to be by making $HOME/.themes a symlink to | |
81 | ;; $HOME/.guix-profile/share/themes. | |
82 | (define (data-directories inputs) | |
83 | "Check for the existence of \"$datadir/glib-2.0/schemas\" or XDG themes data | |
84 | in INPUTS. Return a list with all found directories." | |
85 | (define (data-directory input previous) | |
be3425e5 FB |
86 | (let* ((in (match input |
87 | ((_ . dir) dir) | |
88 | (_ ""))) | |
89 | (datadir (string-append in "/share"))) | |
61771a79 FB |
90 | (if (and (or (subdirectory-exists? datadir "/glib-2.0/schemas") |
91 | (subdirectory-exists? datadir "/sounds") | |
92 | (subdirectory-exists? datadir "/themes") | |
93 | (subdirectory-exists? datadir "/cursors") | |
94 | (subdirectory-exists? datadir "/wallpapers") | |
ca79e42e LC |
95 | (subdirectory-exists? datadir "/icons") |
96 | (subdirectory-exists? datadir "/mime")) ;shared-mime-info | |
be3425e5 FB |
97 | (not (directory-included? datadir previous))) |
98 | (cons datadir previous) | |
99 | previous))) | |
100 | ||
61771a79 FB |
101 | (fold data-directory '() inputs)) |
102 | ||
103 | ;; All GIO modules are expected to be installed in GLib's $libdir/gio/modules | |
104 | ;; directory. That directory has to include a file called giomodule.cache | |
105 | ;; listing all available modules. GIO can be made aware of modules in other | |
106 | ;; directories with the help of the environment variable GIO_EXTRA_MODULES. | |
107 | ;; The official GIO documentation states that this environment variable should | |
108 | ;; only be used for testing and not in a production environment. However, it | |
109 | ;; appears that there is no other way of specifying multiple modules | |
110 | ;; directories (NIXOS also does use this variable). See | |
111 | ;; https://developer.gnome.org/gio/stable/running-gio-apps.html | |
112 | (define (gio-module-directories inputs) | |
113 | "Check for the existence of \"$libdir/gio/modules\" in the INPUTS and | |
114 | returns a list with all found directories." | |
115 | (define (gio-module-directory input previous) | |
116 | (let* ((in (match input | |
117 | ((_ . dir) dir) | |
118 | (_ ""))) | |
119 | (gio-mod-dir (string-append in "/lib/gio/modules"))) | |
120 | (if (and (directory-exists? gio-mod-dir) | |
121 | (not (directory-included? gio-mod-dir previous))) | |
122 | (cons gio-mod-dir previous) | |
123 | previous))) | |
124 | ||
125 | (fold gio-module-directory '() inputs)) | |
be3425e5 | 126 | |
73aa8ddb LC |
127 | (define* (wrap-all-programs #:key inputs outputs |
128 | (glib-or-gtk-wrap-excluded-outputs '()) | |
129 | #:allow-other-keys) | |
be3425e5 FB |
130 | "Implement phase \"glib-or-gtk-wrap\": look for GSettings schemas and |
131 | gtk+-v.0 libraries and create wrappers with suitably set environment variables | |
73aa8ddb LC |
132 | if found. |
133 | ||
134 | Wrapping is not applied to outputs whose name is listed in | |
135 | GLIB-OR-GTK-WRAP-EXCLUDED-OUTPUTS. This is useful when an output is known not | |
136 | to contain any GLib or GTK+ binaries, and where wrapping would gratuitously | |
137 | add a dependency of that output on GLib and GTK+." | |
c8b75695 LC |
138 | (define handle-output |
139 | (match-lambda | |
140 | ((output . directory) | |
73aa8ddb LC |
141 | (unless (member output glib-or-gtk-wrap-excluded-outputs) |
142 | (let* ((bindir (string-append directory "/bin")) | |
8b43df2b AW |
143 | (libexecdir (string-append directory "/libexec")) |
144 | (bin-list (append (find-files bindir ".*") | |
145 | (find-files libexecdir ".*"))) | |
61771a79 | 146 | (datadirs (data-directories |
73aa8ddb LC |
147 | (alist-cons output directory inputs))) |
148 | (gtk-mod-dirs (gtk-module-directories | |
149 | (alist-cons output directory inputs))) | |
61771a79 FB |
150 | (gio-mod-dirs (gio-module-directories |
151 | (alist-cons output directory inputs))) | |
152 | (data-env-var | |
153 | (if (not (null? datadirs)) | |
154 | `("XDG_DATA_DIRS" ":" prefix ,datadirs) | |
73aa8ddb LC |
155 | #f)) |
156 | (gtk-mod-env-var | |
157 | (if (not (null? gtk-mod-dirs)) | |
158 | `("GTK_PATH" ":" prefix ,gtk-mod-dirs) | |
61771a79 FB |
159 | #f)) |
160 | (gio-mod-env-var | |
161 | (if (not (null? gio-mod-dirs)) | |
162 | `("GIO_EXTRA_MODULES" ":" prefix ,gio-mod-dirs) | |
73aa8ddb LC |
163 | #f))) |
164 | (cond | |
61771a79 FB |
165 | ((and data-env-var gtk-mod-env-var gio-mod-env-var) |
166 | (for-each (cut wrap-program <> | |
167 | data-env-var | |
168 | gtk-mod-env-var | |
169 | gio-mod-env-var) | |
73aa8ddb | 170 | bin-list)) |
61771a79 FB |
171 | ((and data-env-var gtk-mod-env-var (not gio-mod-env-var)) |
172 | (for-each (cut wrap-program <> | |
173 | data-env-var | |
174 | gtk-mod-env-var) | |
73aa8ddb | 175 | bin-list)) |
61771a79 FB |
176 | ((and data-env-var (not gtk-mod-env-var) gio-mod-env-var) |
177 | (for-each (cut wrap-program <> | |
178 | data-env-var | |
179 | gio-mod-env-var) | |
180 | bin-list)) | |
181 | ((and (not data-env-var) gtk-mod-env-var gio-mod-env-var) | |
182 | (for-each (cut wrap-program <> | |
183 | gio-mod-env-var | |
184 | gtk-mod-env-var) | |
185 | bin-list)) | |
186 | ((and data-env-var (not gtk-mod-env-var) (not gio-mod-env-var)) | |
187 | (for-each (cut wrap-program <> | |
188 | data-env-var) | |
189 | bin-list)) | |
190 | ((and (not data-env-var) gtk-mod-env-var (not gio-mod-env-var)) | |
191 | (for-each (cut wrap-program <> | |
192 | gtk-mod-env-var) | |
193 | bin-list)) | |
194 | ((and (not data-env-var) (not gtk-mod-env-var) gio-mod-env-var) | |
195 | (for-each (cut wrap-program <> | |
196 | gio-mod-env-var) | |
73aa8ddb | 197 | bin-list)))))))) |
be3425e5 | 198 | |
c8b75695 LC |
199 | (for-each handle-output outputs) |
200 | #t) | |
201 | ||
202 | (define* (compile-glib-schemas #:key outputs #:allow-other-keys) | |
be3425e5 FB |
203 | "Implement phase \"glib-or-gtk-compile-schemas\": compile \"glib\" schemas |
204 | if needed." | |
c8b75695 LC |
205 | (every (match-lambda |
206 | ((output . directory) | |
207 | (let ((schemasdir (string-append directory | |
208 | "/share/glib-2.0/schemas"))) | |
209 | (if (and (directory-exists? schemasdir) | |
210 | (not (file-exists? | |
211 | (string-append schemasdir "/gschemas.compiled")))) | |
212 | (zero? (system* "glib-compile-schemas" schemasdir)) | |
213 | #t)))) | |
214 | outputs)) | |
be3425e5 | 215 | |
61771a79 FB |
216 | (define* (generate-icon-cache #:key outputs #:allow-other-keys) |
217 | "Implement phase \"glib-or-gtk-icon-cache\": generate icon cache if | |
218 | needed." | |
219 | (every (match-lambda | |
220 | ((output . directory) | |
221 | (let ((iconsdir (string-append directory | |
222 | "/share/icons"))) | |
f5895dab FB |
223 | (when (file-exists? iconsdir) |
224 | (with-directory-excursion iconsdir | |
225 | (for-each | |
226 | (lambda (dir) | |
227 | (unless (file-exists? | |
228 | (string-append iconsdir "/" dir "/" | |
229 | "icon-theme.cache")) | |
230 | (system* "gtk-update-icon-cache" | |
231 | "--ignore-theme-index" | |
232 | (string-append iconsdir "/" dir)))) | |
233 | (scandir "." | |
234 | (lambda (name) | |
235 | (and | |
236 | (not (equal? name ".")) | |
237 | (not (equal? name "..")) | |
238 | (equal? 'directory | |
239 | (stat:type (stat name))))))))) | |
61771a79 FB |
240 | #t))) |
241 | outputs)) | |
242 | ||
be3425e5 | 243 | (define %standard-phases |
f84218ac | 244 | (modify-phases gnu:%standard-phases |
f8503e2b LC |
245 | (add-after 'install 'glib-or-gtk-compile-schemas compile-glib-schemas) |
246 | (add-after 'install 'glib-or-gtk-icon-cache generate-icon-cache) | |
247 | (add-after 'install 'glib-or-gtk-wrap wrap-all-programs))) | |
be3425e5 FB |
248 | |
249 | (define* (glib-or-gtk-build #:key inputs (phases %standard-phases) | |
250 | #:allow-other-keys #:rest args) | |
251 | "Build the given package, applying all of PHASES in order." | |
252 | (apply gnu:gnu-build #:inputs inputs #:phases phases args)) | |
253 | ||
254 | ;;; glib-or-gtk-build-system.scm ends here |