profiles: Build GTK+ input module cache.
* guix/profiles.scm (gtk-im-modules): New procedure. (%default-profile-hooks): Add it.
This commit is contained in:
parent
2c9f4786c9
commit
7ddc178093
|
@ -4,6 +4,7 @@
|
|||
;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
|
||||
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
|
||||
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -723,6 +724,66 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
|
|||
#:substitutable? #f)
|
||||
(return #f))))
|
||||
|
||||
(define (gtk-im-modules manifest)
|
||||
"Return a derivation that builds the cache files for input method modules
|
||||
for both major versions of GTK+."
|
||||
|
||||
(mlet %store-monad ((gtk+ (manifest-lookup-package manifest "gtk+" "3"))
|
||||
(gtk+-2 (manifest-lookup-package manifest "gtk+" "2")))
|
||||
|
||||
(define (build gtk gtk-version)
|
||||
(let ((major (string-take gtk-version 1)))
|
||||
(with-imported-modules '((guix build utils)
|
||||
(guix build union)
|
||||
(guix build profiles)
|
||||
(guix search-paths)
|
||||
(guix records))
|
||||
#~(begin
|
||||
(use-modules (guix build utils)
|
||||
(guix build union)
|
||||
(guix build profiles)
|
||||
(ice-9 popen)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-26))
|
||||
|
||||
(let* ((prefix (string-append "/lib/gtk-" #$major ".0/"
|
||||
#$gtk-version))
|
||||
(query (string-append #$gtk "/bin/gtk-query-immodules-"
|
||||
#$major ".0"))
|
||||
(destdir (string-append #$output prefix))
|
||||
(moddirs (cons (string-append #$gtk prefix "/immodules")
|
||||
(filter file-exists?
|
||||
(map (cut string-append <> prefix "/immodules")
|
||||
'#$(manifest-inputs manifest)))))
|
||||
(modules (append-map (cut find-files <> "\\.so$")
|
||||
moddirs)))
|
||||
|
||||
;; Generate a new immodules cache file.
|
||||
(mkdir-p (string-append #$output prefix))
|
||||
(let ((pipe (apply open-pipe* OPEN_READ query modules))
|
||||
(outfile (string-append #$output prefix
|
||||
"/immodules-gtk" #$major ".cache")))
|
||||
(dynamic-wind
|
||||
(const #t)
|
||||
(lambda ()
|
||||
(call-with-output-file outfile
|
||||
(lambda (out)
|
||||
(while (not (eof-object? (peek-char pipe)))
|
||||
(write-char (read-char pipe) out))))
|
||||
#t)
|
||||
(lambda ()
|
||||
(close-pipe pipe)))))))))
|
||||
|
||||
;; Don't run the hook when there's nothing to do.
|
||||
(let ((gexp #~(begin
|
||||
#$(if gtk+ (build gtk+ "3.0.0") #t)
|
||||
#$(if gtk+-2 (build gtk+-2 "2.10.0") #t))))
|
||||
(if (or gtk+ gtk+-2)
|
||||
(gexp->derivation "gtk-im-modules" gexp
|
||||
#:local-build? #t
|
||||
#:substitutable? #f)
|
||||
(return #f)))))
|
||||
|
||||
(define (xdg-desktop-database manifest)
|
||||
"Return a derivation that builds the @file{mimeinfo.cache} database from
|
||||
desktop files. It's used to query what applications can handle a given
|
||||
|
@ -844,6 +905,7 @@ files for the truetype fonts of the @var{manifest} entries."
|
|||
ghc-package-cache-file
|
||||
ca-certificate-bundle
|
||||
gtk-icon-themes
|
||||
gtk-im-modules
|
||||
xdg-desktop-database
|
||||
xdg-mime-database))
|
||||
|
||||
|
|
Loading…
Reference in New Issue