diff mbox

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

Message ID 20160922202827.22039-2-rekado@elephly.net
State New
Headers show

Commit Message

Ricardo Wurmus Sept. 22, 2016, 8:28 p.m. UTC
* guix/profiles.scm (gtk-im-modules): New procedure.
(%default-profile-hooks): Add it.
---
 guix/profiles.scm | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)

Comments

=?utf-8?B?5a6L5paH5q2m?= Sept. 25, 2016, 11:25 a.m. UTC | #1
Ricardo Wurmus <rekado@elephly.net> writes:

> * 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"))

I think there is no need to run `union-build'.  Other hooks use it
because they (eg: update-icon-cache, update-mime-databes) require input
and output files in a single directory.

> +
> +                ;; Generate a new 'immodules.cache' file.
> +                (let ((pipe    (apply open-pipe*
> +                                      OPEN_READ query
> +                                      (map readlink (find-files
> destdir "\\.so$"))))
and use 'moddirs' here should work.
Ricardo Wurmus Sept. 26, 2016, 5:56 a.m. UTC | #2
宋文武 <iyzsong@member.fsf.org> writes:

> Ricardo Wurmus <rekado@elephly.net> writes:
>
>> * 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"))
>
> I think there is no need to run `union-build'.  Other hooks use it
> because they (eg: update-icon-cache, update-mime-databes) require input
> and output files in a single directory.

You are right.  This is a left-over of previous experimentation.  I
previously tried to do without pipes and rewrite some environment
variables instead, but that needed a single directory, hence the union.

>> +
>> +                ;; Generate a new 'immodules.cache' file.
>> +                (let ((pipe    (apply open-pipe*
>> +                                      OPEN_READ query
>> +                                      (map readlink (find-files
>> destdir "\\.so$"))))
> and use 'moddirs' here should work.

Using “moddirs” directly won’t work because it’s a list of directories.
I added another definition of “modules”, which is a flattened list of
the result of “find-files” on all the directories.

I tested the resulting cache files and they work fine with our patched
versions of GTK.  (The simple GTK input methods e.g. for switching
between Qwerty and Dvorak no longer work, but that appears to be
unrelated.)

I’ll push the updated version of this patch in a moment.

~~ Ricardo
Ludovic Courtès Sept. 26, 2016, 11:04 a.m. UTC | #3
Ricardo Wurmus <rekado@elephly.net> skribis:

> * guix/profiles.scm (gtk-im-modules): New procedure.
> (%default-profile-hooks): Add it.

Very nice!

> +(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)))

Rather: (version-prefix gtk-version 1).

> +                ;; 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)))))))))

What about something along these lines instead:

  (define result
    (call-with-output-file "immodules.cache"
      (lambda (port)
        (close-fdes 1)
        (dup->fdes port 1)
        (system* query …))))

   ;; Fail when gtk-immodules-query fails.
   (zero? result)

> +    ;; 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))))

Simply:

  (let ((gexp (cond (gtk+ (build gtk+ "3.0.0"))
                    (gtk+-2 (built gtk+-2 …))
                    (else #f))))
    …)
                  
We should avoid the hardcoded version numbers though.

Otherwise LGTM.

Could you send an updated patch?

Thank you!

Ludo’.
Ricardo Wurmus Oct. 30, 2016, 7:05 a.m. UTC | #4
Hi Ludo,

I had already pushed the change by the time I got this email, and then I
forgot to reply to it in time.  While trying to clean up my massive Guix
inbox I stumbled upon this unreplied email.  My apologies for the delay!

Ludovic Courtès <ludo@gnu.org> writes:

> Ricardo Wurmus <rekado@elephly.net> skribis:
>
>> * guix/profiles.scm (gtk-im-modules): New procedure.
>> (%default-profile-hooks): Add it.
>
> Very nice!
>
>> +(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)))
>
> Rather: (version-prefix gtk-version 1).

Okay.

>> +                ;; 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)))))))))
>
> What about something along these lines instead:
>
>   (define result
>     (call-with-output-file "immodules.cache"
>       (lambda (port)
>         (close-fdes 1)
>         (dup->fdes port 1)
>         (system* query …))))
>
>    ;; Fail when gtk-immodules-query fails.
>    (zero? result)

This does indeed look nicer.  I’ll put this on my TODO list and revisit
the code at a later point in time.

>> +    ;; 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))))
>
> Simply:
>
>   (let ((gexp (cond (gtk+ (build gtk+ "3.0.0"))
>                     (gtk+-2 (built gtk+-2 …))
>                     (else #f))))
>     …)

Here I’m building one big gexp containing what’s needed for whatever
version of GTK is installed in the profile.  Your version would pick
only one of the expressions for a single version, which doesn’t cover
the case where both are installed.

> We should avoid the hardcoded version numbers though.

I agree but I don’t know how to avoid this elegantly.  These numbers
seem almost arbitrary.  Since we only have two major versions at this
point I don’t think it’s worth trying to generalise this.

~~ Ricardo
diff mbox

Patch

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))