gnu: Add gtk.

* gnu/packages/gtk.scm (gtk): New variable.
* gnu/packages/patches/gtk4-respect-GUIX_GTK4_PATH.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.

gnu/local.mk

@@ -1216,6 +1216,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/gtk3-respect-GUIX_GTK3_PATH.patch	\
   %D%/packages/patches/gtk3-respect-GUIX_GTK3_IM_MODULE_FILE.patch \
   %D%/packages/patches/gtk-doc-respect-xml-catalog.patch	 \
+  %D%/packages/patches/gtk4-respect-GUIX_GTK4_PATH.patch    \
   %D%/packages/patches/gtkglext-disable-disable-deprecated.patch \
   %D%/packages/patches/gtksourceview-2-add-default-directory.patch \
   %D%/packages/patches/gvfs-add-support-for-libplist-2.2.patch	\

gnu/packages/gtk.scm

@@ -93,11 +93,15 @@
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages pretty-print)
   #:use-module (gnu packages python)
+  #:use-module (gnu packages python-build)
   #:use-module (gnu packages python-xyz)
+  #:use-module (gnu packages gstreamer)
   #:use-module (gnu packages guile)
   #:use-module (gnu packages guile-xyz)
   #:use-module (gnu packages cups)
   #:use-module (gnu packages version-control)
+  #:use-module (gnu packages video)
+  #:use-module (gnu packages vulkan)
   #:use-module (gnu packages web)
   #:use-module (gnu packages xml)
   #:use-module (gnu packages xorg)
@@ -1119,6 +1123,178 @@ application suites.")
             (variable "GUIX_GTK3_PATH")
             (files '("lib/gtk-3.0")))))))
 
+(define-public gtk
+  (package
+    (name "gtk")
+    (version "4.2.1")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "mirror://gnome/sources/" name "/"
+                           (version-major+minor version)  "/"
+                           name "-" version ".tar.xz"))
+       (sha256
+        (base32 "1rh9fd5axf79pmd93hb2fmmflic5swcvqvq6vqghlgz4bmvnjc82"))
+       (patches
+        (search-patches "gtk4-respect-GUIX_GTK4_PATH.patch"))))
+    (build-system meson-build-system)
+    (outputs '("out" "bin" "doc"))
+    (arguments
+     `(#:configure-flags
+       (list
+        "-Dbroadway-backend=true"      ;for broadway display-backend
+        "-Dcloudproviders=enabled"     ;for cloud-providers support
+        "-Dtracker=enabled"            ;for filechooser search support
+        "-Dcolord=enabled"             ;for color printing support
+        ,@(if (%current-target-system)
+              ;; If true, gtkdoc-scangobj will try to execute a
+              ;; cross-compiled binary.
+              '("-Dgtk_doc=false")
+              '("-Dgtk_doc=true"))
+        "-Dman-pages=true")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'patch
+           (lambda* (#:key inputs native-inputs outputs #:allow-other-keys)
+             ;; Correct DTD resources of docbook.
+             (substitute* (find-files "docs" "\\.xml$")
+               (("http://www.oasis-open.org/docbook/xml/4.3/")
+                (string-append
+                 (assoc-ref (or native-inputs inputs) "docbook-xml-4.3")
+                 "/xml/dtd/docbook/")))
+             ;; Disable building of icon cache.
+             (substitute* "meson.build"
+               (("gtk_update_icon_cache: true")
+                "gtk_update_icon_cache: false"))
+             ;; Disable failing tests.
+             (substitute* (find-files "testsuite" "meson.build")
+               (("[ \t]*'empty-text.node',") "")
+               (("[ \t]*'testswitch.node',") "")
+               (("[ \t]*'widgetfactory.node',") ""))
+             (substitute* "testsuite/reftests/meson.build"
+               (("[ \t]*'label-wrap-justify.ui',") "")) ))
+         (add-before 'build 'set-cache
+           (lambda _
+             (setenv "XDG_CACHE_HOME" (getcwd))))
+         (add-before 'check 'pre-check
+           (lambda _
+             ;; Tests require a running X server.
+             (system "Xvfb :1 +extension GLX &")
+             (setenv "DISPLAY" ":1")
+             ;; Tests write to $HOME.
+             (setenv "HOME" (getcwd))
+             ;; Tests look for those variables.
+             (setenv "XDG_RUNTIME_DIR" (getcwd))
+             ;; For missing '/etc/machine-id'.
+             (setenv "DBUS_FATAL_WARNINGS" "0")))
+         (replace 'check
+           (lambda* (#:key tests? #:allow-other-keys)
+             (when tests?
+               (setenv "MESON_TESTTHREADS" "1")
+               ;; Run tests using the x11 setup,
+               ;; instead of the default wayland.
+               (invoke "meson" "test" "--setup=x11"))))
+         (add-after 'install 'move-files
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (bin (assoc-ref outputs "bin"))
+                    (doc (assoc-ref outputs "doc")))
+               (for-each mkdir-p
+                         (list
+                          (string-append bin "/bin")
+                          (string-append bin "/share/applications")
+                          (string-append bin "/share/icons")
+                          (string-append bin "/share/man")
+                          (string-append bin "/share/metainfo")
+                          (string-append doc "/share/doc")))
+               ;; Move programs and related files to output 'bin'.
+               (for-each (lambda (dir)
+                           (rename-file
+                            (string-append out dir)
+                            (string-append bin dir)))
+                         (list
+                          "/bin"
+                          "/share/applications"
+                          "/share/icons"
+                          "/share/man"
+                          "/share/metainfo"))
+               ;; Move HTML documentation to output 'doc'.
+               (rename-file
+                (string-append out "/share/doc")
+                (string-append doc "/share/doc"))))))))
+    (native-inputs
+     `(("docbook-xml-4.3" ,docbook-xml-4.3)
+       ("docbook-xsl" ,docbook-xsl)
+       ("gettext-minimal" ,gettext-minimal)
+       ("glib:bin" ,glib "bin")
+       ("gobject-introspection" ,gobject-introspection) ;for building introspection data
+       ("gtk-doc" ,gtk-doc)             ;for building documentation
+       ("intltool" ,intltool)
+       ("libxslt" ,libxslt)             ;for building man-pages
+       ("pkg-config" ,pkg-config)
+       ;; These python modules are required for building documentation.
+       ("python-jinja2" ,python-jinja2)
+       ("python-markdown" ,python-markdown)
+       ("python-markupsafe" ,python-markupsafe)
+       ("python-pygments" ,python-pygments)
+       ("python-toml" ,python-toml)
+       ("python-typogrify" ,python-typogrify)
+       ("sassc" ,sassc)                 ;for building themes
+       ("vala" ,vala)
+       ("xorg-server-for-tests" ,xorg-server-for-tests)))
+    (inputs
+     `(("colord" ,colord)               ;for color printing support
+       ("cups" ,cups)                   ;for CUPS print-backend
+       ("ffmpeg" ,ffmpeg)               ;for ffmpeg media-backend
+       ("fribidi" ,fribidi)
+       ("gstreamer" ,gstreamer)         ;for gstreamer media-backend
+       ("gst-plugins-bad" ,gst-plugins-bad) ;provides gstreamer-player
+       ("gst-plugins-base" ,gst-plugins-base) ;provides gstreamer-gl
+       ("harfbuzz" ,harfbuzz)
+       ("iso-codes" ,iso-codes)
+       ("json-glib" ,json-glib)
+       ("libcloudproviders" ,libcloudproviders) ;for cloud-providers support
+       ("librsvg" ,librsvg)
+       ("python" ,python)
+       ("rest" ,rest)
+       ("tracker" ,tracker)))          ;for filechooser search support
+    (propagated-inputs
+     ;; Following dependencies are referenced in .pc files.
+     `(("cairo" ,cairo)
+       ("fontconfig" ,fontconfig)
+       ("gdk-pixbuf+svg" ,gdk-pixbuf+svg)
+       ("glib" ,glib)
+       ("graphene" ,graphene)
+       ("libepoxy" ,libepoxy)
+       ("libx11" ,libx11)               ;for x11 display-backend
+       ("libxcomposite" ,libxcomposite)
+       ("libxcursor" ,libxcursor)
+       ("libxdamage" ,libxdamage)
+       ("libxext" ,libxext)
+       ("libxfixes" ,libxfixes)
+       ("libxi" ,libxi)
+       ("libxinerama" ,libxinerama)     ;for xinerama support
+       ("libxkbcommon" ,libxkbcommon)
+       ("libxrandr" ,libxrandr)
+       ("libxrender" ,libxrender)
+       ("pango" ,pango)
+       ("vulkan-headers" ,vulkan-headers)
+       ("vulkan-loader" ,vulkan-loader) ;for vulkan graphics API support
+       ("wayland" ,wayland)             ;for wayland display-backend
+       ("wayland-protocols" ,wayland-protocols)))
+    (native-search-paths
+     (list
+      (search-path-specification
+       (variable "GUIX_GTK4_PATH")
+       (files '("lib/gtk-4.0")))))
+    (search-paths native-search-paths)
+    (home-page "https://www.gtk.org/")
+    (synopsis "Cross-platform widget toolkit")
+    (description "GTK is a multi-platform toolkit for creating graphical user
+interfaces.  Offering a complete set of widgets, GTK is suitable for projects
+ranging from small one-off tools to complete application suites.")
+    (license license:lgpl2.1+)))
+
 ;;;
 ;;; Guile bindings.
 ;;;

gnu/packages/patches/gtk4-respect-GUIX_GTK4_PATH.patch

@@ -0,0 +1,51 @@
+From 889294a93fc6464c2c2919bc47f6fd85ec823363 Mon Sep 17 00:00:00 2001
+From: Raghav Gururajan <rg@raghavgururajan.name>
+Date: Tue, 18 May 2021 19:57:00 -0400
+Subject: [PATCH] [PATCH]: Honor GUIX_GTK4_PATH.
+
+This patch makes GTK look for additional modules in a list of directories
+specified by the environment variable "GUIX_GTK4_PATH". This can be used
+instead of "GTK_PATH" to make GTK find modules that are incompatible with
+other major versions of GTK.
+---
+ gtk/gtkmodules.c | 10 +++++++++-
+ 1 file changed, 9 insertions(+), 1 deletion(-)
+
+diff --git a/gtk/gtkmodules.c b/gtk/gtkmodules.c
+index aace5dcbc9..193b6a02e9 100644
+--- a/gtk/gtkmodules.c
++++ b/gtk/gtkmodules.c
+@@ -105,6 +105,7 @@ static char **
+ get_module_path (void)
+ {
+   const char *module_path_env;
++  const gchar *module_guix_gtk4_path_env;
+   const char *exe_prefix;
+   char *module_path;
+   char *default_dir;
+@@ -114,6 +115,7 @@ get_module_path (void)
+     return result;
+ 
+   module_path_env = g_getenv ("GTK_PATH");
++  module_guix_gtk4_path_env = g_getenv ("GUIX_GTK4_PATH");
+   exe_prefix = g_getenv ("GTK_EXE_PREFIX");
+ 
+   if (exe_prefix)
+@@ -121,7 +123,13 @@ get_module_path (void)
+   else
+     default_dir = g_build_filename (_gtk_get_libdir (), "gtk-4.0", NULL);
+ 
+-  if (module_path_env)
++  if (module_guix_gtk4_path_env && module_path_env)
++    module_path = g_build_path (G_SEARCHPATH_SEPARATOR_S,
++				module_guix_gtk4_path_env, module_path_env, default_dir, NULL);
++  else if (module_guix_gtk4_path_env)
++    module_path = g_build_path (G_SEARCHPATH_SEPARATOR_S,
++				module_guix_gtk4_path_env, default_dir, NULL);
++  else if (module_path_env)
+     module_path = g_build_path (G_SEARCHPATH_SEPARATOR_S,
+ 				module_path_env, default_dir, NULL);
+   else
+-- 
+2.31.1
+