| Message ID | 20160922202827.22039-2-rekado@elephly.net |
|---|---|
| State | New |
| Headers | show |
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.
宋文武 <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
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’.
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 --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))