[PATCH 2/2] profiles: Build GTK+ input module cache.

[Ricardo Wurmus <rekado@elephly.net>]

* guix/profiles.scm (gtk-im-modules): New procedure.
(%default-profile-hooks): Add it.
---
 guix/profiles.scm | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 78deeb7..1a522ae 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -723,6 +723,68 @@ 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-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))))))
+
+                ;; Union all the gtk immodules directories.
+                (mkdir-p (string-append #$output "/lib/gtk-" #$major ".0"))
+                (union-build destdir moddirs #:log-port (%make-void-port "w"))
+
+                ;; Generate a new 'immodules.cache' file.
+                (let ((pipe    (apply open-pipe*
+                                      OPEN_READ query
+                                      (map readlink (find-files destdir "\\.so$"))))
+                      (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 +906,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))
 
-- 
2.10.0