Re: [PATCH 1/4] guix: build/glib-or-gtk-build-system: Add support for GIO and XDG theming.

[宋文武]

Federico Beffa <address@hidden> writes:

> On Sun, Dec 21, 2014 at 11:54 AM, Ludovic Courtès <address@hidden> wrote:
>> Federico Beffa <address@hidden> skribis:
>>
>>> On Fri, Dec 19, 2014 at 1:56 PM, 宋文武 <address@hidden> wrote:
>>>> FYI, every apps will install icons into 'hicolor-icon-theme',
>>>> for it to work, we need regenerated the 'icon-theme.cache'
>>>> by `gtk-update-icon-cache`.
>>>
>>> The icon packages that I looked into are generating the cache by
>>> themselves at installation.  In any case, I think we can add a check
>>> similar to one we do for schemas, just in case some icon packages do
>>> not generate the cache.
>>
>> Agreed.
>
> Please find attached an updated patch.
>
> Regards,
> Fede
> From 4191ba9b8c86adaf9477e71a3a9f03cb04fc6528 Mon Sep 17 00:00:00 2001
> From: Federico Beffa <address@hidden>
> Date: Thu, 18 Dec 2014 20:58:18 +0100
> Subject: [PATCH 1/4] guix: build/glib-or-gtk-build-system: Add support for GIO
>  and XDG theming.
>
> * guix/build/glib-or-gtk-build-system.scm (data-directories): Rename
>   'schemas-directories' to 'data-directories' and add support for XDG theming
>   data.
>
> * guix/build/glib-or-gtk-build-system.scm (gio-module-directories): New
>   function.
>
> * guix/build/glib-or-gtk-build-system.scm (wrap-all-programs): Update names to
>   reflect that we are dealing with more types of data and not only with
>   schemas.  Add handling of GIO modules.
>
> * guix/build-system/glib-or-gtk.scm (lower): Import the 'bin' output of GLib
>   instead of 'out'.  This was an error since we need the program
>   'glib-compile-schemas'.  Update the description.
> ---
>  guix/build-system/glib-or-gtk.scm       |  30 ++++---
>  guix/build/glib-or-gtk-build-system.scm | 138 
> +++++++++++++++++++++++++++-----
>  2 files changed, 141 insertions(+), 27 deletions(-)
>
> diff --git a/guix/build-system/glib-or-gtk.scm 
> b/guix/build-system/glib-or-gtk.scm
> index 8091311..7a90587 100644
> --- a/guix/build-system/glib-or-gtk.scm
> +++ b/guix/build-system/glib-or-gtk.scm
> @@ -34,15 +34,14 @@
>  ;; This build system is an extension of the 'gnu-build-system'.  It
>  ;; accomodates the needs of applications making use of glib or gtk+ (with 
> "or"
>  ;; to be interpreted in the mathematical sense).  This is achieved by adding
> -;; two phases run after the 'install' phase:
> +;; three phases run after the 'install' phase:
>  ;;
>  ;; 'glib-or-gtk-wrap' phase:
>  ;;
> -;; a) This phase looks for GSettings schemas by verifying the existence of
> -;; path "datadir/glib-2.0/schemas" in all input packages.  If the path is
> -;; found in any package, then all programs in "out/bin" are wrapped in 
> scripts
> -;; where the environment variable "XDG_DATA_DIRS" is set and points to the
> -;; list of found schemas directories.
> +;; a) This phase looks for GSettings schemas, GIO modules and theming data.
> +;; If any of these is found in any input package, then all programs in
> +;; "out/bin" are wrapped in scripts defining the nedessary environment
> +;; variables.
>  ;;
>  ;; b) Looks for the existence of "libdir/gtk-3.0" directories in all input
>  ;; packages.  If any is found, then the environment variable "GTK_PATH" is
> @@ -56,6 +55,11 @@
>  ;; exists and does not include a file named "gschemas.compiled", then
>  ;; "glib-compile-schemas" is run in that directory.
>  ;;
> +;; 'glib-or-gtk-icon-cache' phase:
> +;;
> +;; Looks for the existence of icon themes and, if no cache exists, generate
> +;; the "icon-theme.cache" file.
> +;;
I think this won't do what we want.

The only icon theme we should be care is hicolor-icon-theme,
which just provide a layout and the name, every applications
will install icons under the name, and often with a invalid cache,
see thunar for example. The icon-theme.cache is invalid because it
just contain icons from thunar, but the right cache should contain all
icons of hicolor-icon-theme. Its usage is the same as info.dir for
texinfo. Currently, info.dir is generated for all packages in profile,
by code in (guix profiles). We should do the same for cache of hicolor
theme there.

See also:
https://lists.gnu.org/archive/html/guix-devel/2015-01/msg00027.html

>  ;; Code:
>  
>  (define %default-modules
> @@ -76,15 +80,22 @@
>    (let ((module (resolve-interface '(gnu packages glib))))
>      (module-ref module 'glib)))
>  
> +(define (default-gtk+)
> +  "Return the default gtk+ package from which we use
> +\"gtk-update-icon-cache\"."
> +  (let ((module (resolve-interface '(gnu packages gtk))))
> +    (module-ref module 'gtk+)))
> +
>  (define* (lower name
>                  #:key source inputs native-inputs outputs system target
> -                (glib (default-glib)) (implicit-inputs? #t)
> +                (glib (default-glib)) (gtk+ (default-gtk+))
> +                (implicit-inputs? #t)
>                  (strip-binaries? #t)
>                  #:allow-other-keys
>                  #:rest arguments)
>    "Return a bag for NAME."
>    (define private-keywords
> -    '(#:source #:target #:glib #:inputs #:native-inputs
> +    '(#:source #:target #:glib #:gtk+ #:inputs #:native-inputs
>        #:outputs #:implicit-inputs?))
>  
>    (and (not target)                               ;XXX: no cross-compilation
> @@ -95,7 +106,8 @@
>                                `(("source" ,source))
>                                '())
>                          ,@inputs))
> -         (build-inputs `(("glib:bin" ,glib)
> +         (build-inputs `(("glib:bin" ,glib "bin") ; to compile schemas
> +                         ("gtk+" ,gtk+)           ; to generate icon cache
>                           ,@(if implicit-inputs?
>                                 (standard-packages)
>                                 '())
> diff --git a/guix/build/glib-or-gtk-build-system.scm 
> b/guix/build/glib-or-gtk-build-system.scm
> index 9351a70..2fe7aa4 100644
> --- a/guix/build/glib-or-gtk-build-system.scm
> +++ b/guix/build/glib-or-gtk-build-system.scm
> @@ -22,6 +22,7 @@
>    #:use-module (guix build utils)
>    #:use-module (ice-9 match)
>    #:use-module (ice-9 regex)
> +  #:use-module (ice-9 ftw)
>    #:use-module (srfi srfi-1)
>    #:use-module (srfi srfi-26)
>    #:export (%standard-phases
> @@ -41,6 +42,9 @@
>    (fold (lambda (s p) (or (string-ci=? s directory) p))
>          #f directories-list))
>  
> +;; We do not include $HOME/.guix-profile/gtk-v.0 (v=2 or 3) because we do not
> +;; want to mix gtk+-2 and gtk+-3 modules.  See
> +;; https://developer.gnome.org/gtk3/stable/gtk-running.html
>  (define (gtk-module-directories inputs)
>    "Check for the existence of \"libdir/gtk-v.0\" in INPUTS.  Return a list
>  with all found directories."
> @@ -64,20 +68,60 @@ with all found directories."
>                    prev)))))
>      (fold gtk-module '() inputs)))
>  
> -(define (schemas-directories inputs)
> -  "Check for the existence of \"datadir/glib-2.0/schemas\" in INPUTS.  Return
> -a list with all found directories."
> -  (define (glib-schemas input previous)
> +;; See
> +;; http://www.freedesktop.org/wiki/DesktopThemeSpec
> +;; http://freedesktop.org/wiki/Specifications/sound-theme-spec
> +;; http://freedesktop.org/wiki/Specifications/icon-theme-spec
> +;; 
> +;; Currently desktop themes are not well supported and do not honor
> +;; XDG_DATA_DIRS.  One example is evince which only looks for desktop themes
> +;; in $HOME/.themes (for backward compatibility) and in XDG_DATA_HOME (which
> +;; defaults to $HOME/.local/share).  One way to handle these applications
> +;; appears to be by making $HOME/.themes a symlink to
> +;; $HOME/.guix-profile/share/themes.
Set GTK_DATA_PREFIX to $HOME/.guix-profile will work too.
Like in NixOS, we can set it to /run/current-system/profile.
> +(define (data-directories inputs)
> +  "Check for the existence of \"$datadir/glib-2.0/schemas\" or XDG themes 
> data
> +in INPUTS.  Return a list with all found directories."
> +  (define (data-directory input previous)
>      (let* ((in (match input
>                   ((_ . dir) dir)
>                   (_ "")))
>             (datadir (string-append in "/share")))
> -      (if (and (subdirectory-exists? datadir "/glib-2.0/schemas")
> +      (if (and (or (subdirectory-exists? datadir "/glib-2.0/schemas")
> +                   (subdirectory-exists? datadir "/sounds")
> +                   (subdirectory-exists? datadir "/themes")
> +                   (subdirectory-exists? datadir "/cursors")
> +                   (subdirectory-exists? datadir "/wallpapers")
> +                   (subdirectory-exists? datadir "/icons"))
And I don't think the sounds, themes, cursors, wallpapers and icons are
hard depends of a application, they are for all applications.
Why not set XDG_DATA_DIRS to /run/current-system/profile/share and
$HOME/.guix-profile/share in /etc/profile? (at gnu/system.scm)
So, install a theme package will work for all applications.

WTDY?
>                 (not (directory-included? datadir previous)))
>            (cons datadir previous)
>            previous)))
>  
> -  (fold glib-schemas '() inputs))
> +  (fold data-directory '() inputs))
> +
> +;; All GIO modules are expected to be installed in GLib's $libdir/gio/modules
> +;; directory.  That directory has to include a file called giomodule.cache
> +;; listing all available modules.  GIO can be made aware of modules in other
> +;; directories with the help of the environment variable GIO_EXTRA_MODULES.
> +;; The official GIO documentation states that this environment variable 
> should
> +;; only be used for testing and not in a production environment.  However, it
> +;; appears that there is no other way of specifying multiple modules
> +;; directories (NIXOS also does use this variable). See
> +;; https://developer.gnome.org/gio/stable/running-gio-apps.html
> +(define (gio-module-directories inputs)
> +  "Check for the existence of \"$libdir/gio/modules\" in the INPUTS and
> +returns a list with all found directories."
> +  (define (gio-module-directory input previous)
> +    (let* ((in (match input
> +                 ((_ . dir) dir)
> +                 (_ "")))
> +           (gio-mod-dir (string-append in "/lib/gio/modules")))
> +      (if (and (directory-exists? gio-mod-dir)
> +               (not (directory-included? gio-mod-dir previous)))
> +          (cons gio-mod-dir previous)
> +          previous)))
> +
> +  (fold gio-module-directory '() inputs))
>  
>  (define* (wrap-all-programs #:key inputs outputs
>                              (glib-or-gtk-wrap-excluded-outputs '())
> @@ -96,27 +140,57 @@ add a dependency of that output on GLib and GTK+."
>        (unless (member output glib-or-gtk-wrap-excluded-outputs)
>          (let* ((bindir       (string-append directory "/bin"))
>                 (bin-list     (find-files bindir ".*"))
> -               (schemas      (schemas-directories
> +               (datadirs     (data-directories
>                                (alist-cons output directory inputs)))
>                 (gtk-mod-dirs (gtk-module-directories
>                                (alist-cons output directory inputs)))
> -               (schemas-env-var
> -                (if (not (null? schemas))
> -                    `("XDG_DATA_DIRS" ":" prefix ,schemas)
> +               (gio-mod-dirs (gio-module-directories
> +                              (alist-cons output directory inputs)))
> +               (data-env-var
> +                (if (not (null? datadirs))
> +                    `("XDG_DATA_DIRS" ":" prefix ,datadirs)
>                      #f))
>                 (gtk-mod-env-var
>                  (if (not (null? gtk-mod-dirs))
>                      `("GTK_PATH" ":" prefix ,gtk-mod-dirs)
> +                    #f))
> +               (gio-mod-env-var 
> +                (if (not (null? gio-mod-dirs))
> +                    `("GIO_EXTRA_MODULES" ":" prefix ,gio-mod-dirs)
>                      #f)))
>            (cond
> -           ((and schemas-env-var gtk-mod-env-var)
> -            (for-each (cut wrap-program <> schemas-env-var gtk-mod-env-var)
> +           ((and data-env-var gtk-mod-env-var gio-mod-env-var)
> +            (for-each (cut wrap-program <>
> +                           data-env-var
> +                           gtk-mod-env-var
> +                           gio-mod-env-var)
>                        bin-list))
> -           (schemas-env-var
> -            (for-each (cut wrap-program <> schemas-env-var)
> +           ((and data-env-var gtk-mod-env-var (not gio-mod-env-var))
> +            (for-each (cut wrap-program <>
> +                           data-env-var
> +                           gtk-mod-env-var)
>                        bin-list))
> -           (gtk-mod-env-var
> -            (for-each (cut wrap-program <> gtk-mod-env-var)
> +           ((and data-env-var (not gtk-mod-env-var) gio-mod-env-var)
> +            (for-each (cut wrap-program <>
> +                           data-env-var
> +                           gio-mod-env-var)
> +                      bin-list))
> +           ((and (not data-env-var) gtk-mod-env-var gio-mod-env-var)
> +            (for-each (cut wrap-program <>
> +                           gio-mod-env-var
> +                           gtk-mod-env-var)
> +                      bin-list))
> +           ((and data-env-var (not gtk-mod-env-var) (not gio-mod-env-var))
> +            (for-each (cut wrap-program <>
> +                           data-env-var)
> +                      bin-list))
> +           ((and (not data-env-var) gtk-mod-env-var (not gio-mod-env-var))
> +            (for-each (cut wrap-program <>
> +                           gtk-mod-env-var)
> +                      bin-list))
> +           ((and (not data-env-var) (not gtk-mod-env-var) gio-mod-env-var)
> +            (for-each (cut wrap-program <>
> +                           gio-mod-env-var)
>                        bin-list))))))))
>  
>    (for-each handle-output outputs)
> @@ -136,12 +210,40 @@ if needed."
>                   #t))))
>           outputs))
>  
> +(define* (generate-icon-cache #:key outputs #:allow-other-keys)
> +  "Implement phase \"glib-or-gtk-icon-cache\": generate icon cache if
> +needed."
> +  (every (match-lambda
> +          ((output . directory)
> +           (let ((iconsdir (string-append directory
> +                                            "/share/icons")))
> +             (with-directory-excursion iconsdir
> +               (for-each
> +                (lambda (dir)
> +                  (unless (file-exists?
> +                           (string-append iconsdir "/" dir "/"
> +                                          "icon-theme.cache"))
> +                    (system* "gtk-update-icon-cache"
> +                             "--ignore-theme-index"
> +                             (string-append iconsdir "/" dir))))
> +                (scandir "."
> +                         (lambda (name)
> +                           (and
> +                            (not (equal? name "."))
> +                            (not (equal? name ".."))
> +                            (equal? 'directory
> +                                    (stat:type (stat name))))))))
> +             #t)))
> +         outputs))
> +
>  (define %standard-phases
>    (alist-cons-after
>     'install 'glib-or-gtk-wrap wrap-all-programs
>     (alist-cons-after
> -    'install 'glib-or-gtk-compile-schemas compile-glib-schemas
> -    gnu:%standard-phases)))
> +    'install 'glib-or-gtk-icon-cache generate-icon-cache
> +    (alist-cons-after
> +     'install 'glib-or-gtk-compile-schemas compile-glib-schemas
> +     gnu:%standard-phases))))
>  
>  (define* (glib-or-gtk-build #:key inputs (phases %standard-phases)
>                              #:allow-other-keys #:rest args)
> -- 
> 1.8.4
Thanks for working on this!

(Currently I have packaged some Xfce packages, but not fully working
due to miss icons, themes, etc.)