GNU bug report logs - #45784
[PATCH 1/4] guix: qt-build-system, qt-utils: Unify wrapping of qt-programs.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 45784 in the body.
You can then email your comments to 45784 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Hartmut Goebel <h.goebel <at> crazy-compilers.com>
To: 45193 <at> debbugs.gnu.org,
	guix-patches <at> gnu.org
Subject: [PATCH 1/4] guix: qt-build-system,
 qt-utils: Unify wrapping of qt-programs.
Date: Mon, 11 Jan 2021 15:41:44 +0100

Unify (guix qt-build-system wrap-all-programs) and
(guix qt-utils wrap-qt-program), so both behave the same.
The functions now reside in qt-utils to make them easily available for
packages not using the qt-build-system.

* guix/build/qt-build-system.scm (variables-for-wrapping, wrap-all-programs):
  Move from here ...
* guix/build/qt-utils.scm (variables-for-wrapping, wrap-all-qt-programs):
  ... to here. Base the later on
  (wrap-qt-program*): New function, carved out from old wrap-all-programs.
  (wrap-qt-program): Base on wrap-qt-program*, change arguments in an
  incompatible way.
* gnu/packages/bittorrent.scm (qbittorrent)[arguments]<phases>{wrap-qt}:
  Adjust to new interface of wrap-qt-program.
* gnu/packages/finance.scm (electron-cash): Likewise.
* gnu/packages/geo.scm (qgis): Likewise.
* gnu/packages/password-utils.scm (qtpass): Likewise.
* gnu/packages/video.scm (openshot): Likewise.
* gnu/packages/web-browsers.scm (kristall): Likewise.
---
 gnu/packages/bittorrent.scm     |   6 +-
 gnu/packages/finance.scm        |   8 ++-
 gnu/packages/geo.scm            |   7 ++-
 gnu/packages/password-utils.scm |   6 +-
 gnu/packages/video.scm          |   6 +-
 gnu/packages/web-browsers.scm   |   5 +-
 guix/build-system/qt.scm        |   1 +
 guix/build/qt-build-system.scm  |  68 +--------------------
 guix/build/qt-utils.scm         | 105 ++++++++++++++++++++++++++------
 9 files changed, 113 insertions(+), 99 deletions(-)

diff --git a/gnu/packages/bittorrent.scm b/gnu/packages/bittorrent.scm
index 08e61d7ba2..6967eccec4 100644
--- a/gnu/packages/bittorrent.scm
+++ b/gnu/packages/bittorrent.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2018 Nam Nguyen <namn <at> berkeley.edu>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2019, 2020 Brett Gilio <brettg <at> gnu.org>
+;;; Copyright © 2020 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -447,8 +448,9 @@ desktops.")
        #:phases
        (modify-phases %standard-phases
          (add-after 'install 'wrap-qt
-           (lambda* (#:key outputs #:allow-other-keys)
-             (wrap-qt-program (assoc-ref outputs "out") "qbittorrent")
+           (lambda* (#:key outputs inputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (wrap-qt-program "qbittorrent" #:output out #:inputs inputs))
              #t)))))
     (native-inputs
      `(("pkg-config" ,pkg-config)
diff --git a/gnu/packages/finance.scm b/gnu/packages/finance.scm
index e7d58bbcc0..d71df60740 100644
--- a/gnu/packages/finance.scm
+++ b/gnu/packages/finance.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2015, 2016 Andreas Enge <andreas <at> enge.fr>
 ;;; Copyright © 2016, 2017, 2018 Efraim Flashner <efraim <at> flashner.co.il>
 ;;; Copyright © 2016 Alex Griffin <a <at> ajgrf.com>
-;;; Copyright © 2016 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
+;;; Copyright © 2016, 2020 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
 ;;; Copyright © 2017 Carlo Zancanaro <carlo <at> zancanaro.id.au>
 ;;; Copyright © 2017 Theodoros Foradis <theodoros <at> foradis.org>
 ;;; Copyright © 2017 Vasile Dumitrascu <va511e <at> yahoo.com>
@@ -611,8 +611,10 @@ other machines/servers.  Electrum does not download the Bitcoin blockchain.")
                                (assoc-ref inputs "libsecp256k1")
                                "/lib/libsecp256k1.so.0'")))))
          (add-after 'install 'wrap-qt
-           (lambda* (#:key outputs #:allow-other-keys)
-             (wrap-qt-program (assoc-ref outputs "out") "electron-cash"))))))
+           (lambda* (#:key outputs inputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (wrap-qt-program "electron-cash" #:output out #:inputs inputs))
+             #t)))))
     (home-page "https://electroncash.org/")
     (synopsis "Bitcoin Cash wallet")
     (description
diff --git a/gnu/packages/geo.scm b/gnu/packages/geo.scm
index c682613ff1..a90db90084 100644
--- a/gnu/packages/geo.scm
+++ b/gnu/packages/geo.scm
@@ -10,7 +10,7 @@
 ;;; Copyright © 2019, 2020 Guillaume Le Vaillant <glv <at> posteo.net>
 ;;; Copyright © 2019, 2020 Efraim Flashner <efraim <at> flashner.co.il>
 ;;; Copyright © 2019 Wiktor Żelazny <wzelazny <at> vurv.cz>
-;;; Copyright © 2019 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
+;;; Copyright © 2019, 2020 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
 ;;; Copyright © 2020 Marius Bakke <mbakke <at> fastmail.com>
 ;;; Copyright © 2020 Christopher Baines <mail <at> cbaines.net>
 ;;; Copyright © 2020 Felix Gruber <felgru <at> posteo.net>
@@ -2121,8 +2121,9 @@ growing set of geoscientific methods.")
          (add-after 'install 'wrap-python
            (assoc-ref python:%standard-phases 'wrap))
          (add-after 'wrap-python 'wrap-qt
-           (lambda* (#:key outputs #:allow-other-keys)
-             (wrap-qt-program (assoc-ref outputs "out") "qgis")
+           (lambda* (#:key outputs inputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (wrap-qt-program "qgis" #:output out #:inputs inputs))
              #t))
          (add-after 'wrap-qt 'wrap-gis
            (lambda* (#:key inputs outputs #:allow-other-keys)
diff --git a/gnu/packages/password-utils.scm b/gnu/packages/password-utils.scm
index bd411f59d0..9091010ed9 100644
--- a/gnu/packages/password-utils.scm
+++ b/gnu/packages/password-utils.scm
@@ -29,6 +29,7 @@
 ;;; Copyright © 2020 Jean-Baptiste Note <jean-baptiste.note <at> m4x.org>
 ;;; Copyright © 2020 Michael Rohleder <mike <at> rohleder.de>
 ;;; Copyright © 2020 Vinicius Monego <monego <at> posteo.net>
+;;; Copyright © 2020 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -664,8 +665,9 @@ key URIs using the standard otpauth:// scheme.")
                (install-file "qtpass.1" man)
                #t)))
          (add-after 'install 'wrap-qt
-           (lambda* (#:key outputs #:allow-other-keys)
-             (wrap-qt-program (assoc-ref outputs "out") "qtpass")
+           (lambda* (#:key outputs inputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (wrap-qt-program "qtpass" #:output out #:inputs inputs))
              #t))
          (add-before 'check 'check-setup
            ;; Make Qt render "offscreen", required for tests.
diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm
index 1f68208021..98b2ceaa30 100644
--- a/gnu/packages/video.scm
+++ b/gnu/packages/video.scm
@@ -47,6 +47,7 @@
 ;;; Copyright © 2020 Alexandru-Sergiu Marton <brown121407 <at> posteo.ro>
 ;;; Copyright © 2020 Ivan Kozlov <kanichos <at> yandex.ru>
 ;;; Copyright © 2020 Antoine Côté <antoine.cote <at> posteo.net>
+;;; Copyright © 2020 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -4445,9 +4446,10 @@ API.  It includes bindings for Python, Ruby, and other languages.")
                       (setenv "HOME" "/tmp")
                       #t))
                   (add-after 'install 'wrap-program
-                    (lambda* (#:key outputs #:allow-other-keys)
+                    (lambda* (#:key outputs inputs #:allow-other-keys)
                       (let ((out (assoc-ref outputs "out")))
-                        (wrap-qt-program out "openshot-qt"))
+                        (wrap-qt-program "openshot-qt"
+                                         #:output out #:inputs inputs))
                       #t)))))
     (home-page "https://www.openshot.org/")
     (synopsis "Video editor")
diff --git a/gnu/packages/web-browsers.scm b/gnu/packages/web-browsers.scm
index b134d29782..1040e79593 100644
--- a/gnu/packages/web-browsers.scm
+++ b/gnu/packages/web-browsers.scm
@@ -15,6 +15,7 @@
 ;;; Copyright © 2020 Michael Rohleder <mike <at> rohleder.de>
 ;;; Copyright © 2020 Nicolò Balzarotti <nicolo <at> nixo.xyz>
 ;;; Copyright © 2020 Alexandru-Sergiu Marton <brown121407 <at> posteo.ro>
+;;; Copyright © 2020 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -433,9 +434,9 @@ access.")
                    "/share/fonts/truetype/NotoColorEmoji")))
                #t))
            (add-after 'install 'wrap-program
-             (lambda* (#:key outputs #:allow-other-keys)
+             (lambda* (#:key outputs inputs #:allow-other-keys)
                (let ((out (assoc-ref outputs "out")))
-                 (wrap-qt-program out "kristall"))
+                 (wrap-qt-program "kristall" #:output out #:inputs inputs))
                #t)))))
       (native-inputs
        `(("breeze-stylesheet"
diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm
index 118022ec45..1bd89bfa4d 100644
--- a/guix/build-system/qt.scm
+++ b/guix/build-system/qt.scm
@@ -53,6 +53,7 @@
 (define %qt-build-system-modules
   ;; Build-side modules imported and used by default.
   `((guix build qt-build-system)
+    (guix build qt-utils)
     ,@%cmake-build-system-modules))
 
 (define (default-cmake)
diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scm
index 005157b0a4..a6955ce4c2 100644
--- a/guix/build/qt-build-system.scm
+++ b/guix/build/qt-build-system.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2014 Federico Beffa <beffa <at> fbengineering.ch>
 ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw <at> netris.org>
-;;; Copyright © 2019, 2020 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
+;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +22,7 @@
 (define-module (guix build qt-build-system)
   #:use-module ((guix build cmake-build-system) #:prefix cmake:)
   #:use-module (guix build utils)
+  #:use-module (guix build qt-utils)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 ftw)
@@ -47,73 +48,10 @@
   (setenv "CTEST_OUTPUT_ON_FAILURE" "1")
   #t)
 
-(define (variables-for-wrapping base-directories)
-
-  (define (collect-sub-dirs base-directories subdirectory)
-    (filter-map
-     (lambda (dir)
-       (let ((directory (string-append dir subdirectory)))
-         (if (directory-exists? directory) directory #f)))
-     base-directories))
-
-  (filter
-   (lambda (var-to-wrap) (not (null? (last var-to-wrap))))
-   (map
-    (lambda (var-spec)
-      `(,(first var-spec) = ,(collect-sub-dirs base-directories (last var-spec))))
-    (list
-     ;; these shall match the search-path-specification for Qt and KDE
-     ;; libraries
-     '("XDG_DATA_DIRS" "/share")
-     '("XDG_CONFIG_DIRS" "/etc/xdg")
-     '("QT_PLUGIN_PATH" "/lib/qt5/plugins")
-     '("QML2_IMPORT_PATH" "/lib/qt5/qml")))))
-
-(define* (wrap-all-programs #:key inputs outputs
-                            (qt-wrap-excluded-outputs '())
-                            #:allow-other-keys)
-  "Implement phase \"qt-wrap\": look for GSettings schemas and
-gtk+-v.0 libraries and create wrappers with suitably set environment variables
-if found.
-
-Wrapping is not applied to outputs whose name is listed in
-QT-WRAP-EXCLUDED-OUTPUTS.  This is useful when an output is known not
-to contain any Qt binaries, and where wrapping would gratuitously
-add a dependency of that output on Qt."
-  (define (find-files-to-wrap directory)
-    (append-map
-     (lambda (dir)
-       (if (directory-exists? dir) (find-files dir ".*") (list)))
-     (list (string-append directory "/bin")
-           (string-append directory "/sbin")
-           (string-append directory "/libexec")
-           (string-append directory "/lib/libexec"))))
-
-  (define input-directories
-    ;; FIXME: Filter out unwanted inputs, e.g. cmake
-    (match inputs
-           (((_ . dir) ...)
-            dir)))
-
-  (define handle-output
-    (match-lambda
-     ((output . directory)
-      (unless (member output qt-wrap-excluded-outputs)
-        (let ((bin-list     (find-files-to-wrap directory))
-              (vars-to-wrap (variables-for-wrapping
-                             (append (list directory)
-                                     input-directories))))
-          (when (not (null? vars-to-wrap))
-            (for-each (cut apply wrap-program <> vars-to-wrap)
-                      bin-list)))))))
-
-  (for-each handle-output outputs)
-  #t)
-
 (define %standard-phases
   (modify-phases cmake:%standard-phases
     (add-before 'check 'check-setup check-setup)
-    (add-after 'install 'qt-wrap wrap-all-programs)))
+    (add-after 'install 'qt-wrap wrap-all-qt-programs)))
 
 (define* (qt-build #:key inputs (phases %standard-phases)
                    #:allow-other-keys #:rest args)
diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index d2486ee86c..3fbdb6be61 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 David Craven <david <at> craven.ch>
+;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel <at> crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,23 +19,87 @@
 
 (define-module (guix build qt-utils)
   #:use-module (guix build utils)
-  #:export (wrap-qt-program))
-
-(define (wrap-qt-program out program)
-  (define (suffix env-var path)
-    (let ((env-val (getenv env-var)))
-      (if env-val (string-append env-val ":" path) path)))
-
-  (let ((qml-path        (suffix "QML2_IMPORT_PATH"
-                                 (string-append out "/lib/qt5/qml")))
-        (plugin-path     (suffix "QT_PLUGIN_PATH"
-                                 (string-append out "/lib/qt5/plugins")))
-        (xdg-data-path   (suffix "XDG_DATA_DIRS"
-                                 (string-append out "/share")))
-        (xdg-config-path (suffix "XDG_CONFIG_DIRS"
-                                 (string-append out "/etc/xdg"))))
-    (wrap-program (string-append out "/bin/" program)
-      `("QML2_IMPORT_PATH" = (,qml-path))
-      `("QT_PLUGIN_PATH" = (,plugin-path))
-      `("XDG_DATA_DIRS" = (,xdg-data-path))
-      `("XDG_CONFIG_DIRS" = (,xdg-config-path)))))
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (wrap-qt-program
+            wrap-all-qt-programs))
+
+
+(define (variables-for-wrapping base-directories)
+
+  (define (collect-sub-dirs base-directories subdirectory)
+    (filter-map
+     (lambda (dir)
+       (let ((directory (string-append dir subdirectory)))
+         (if (directory-exists? directory) directory #f)))
+     base-directories))
+
+  (filter
+   (lambda (var-to-wrap) (not (null? (last var-to-wrap))))
+   (map
+    (lambda (var-spec)
+      `(,(first var-spec) = ,(collect-sub-dirs base-directories (last var-spec))))
+    (list
+     ;; these shall match the search-path-specification for Qt and KDE
+     ;; libraries
+     '("XDG_DATA_DIRS" "/share")
+     '("XDG_CONFIG_DIRS" "/etc/xdg")
+     '("QT_PLUGIN_PATH" "/lib/qt5/plugins")
+     '("QML2_IMPORT_PATH" "/lib/qt5/qml")))))
+
+
+(define* (wrap-qt-program* program #:key inputs output-dir)
+
+  (define input-directories
+    ;; FIXME: Filter out unwanted inputs, e.g. cmake
+    (match inputs
+           (((_ . dir) ...)
+            dir)))
+
+  (let ((vars-to-wrap (variables-for-wrapping
+                       (cons output-dir input-directories))))
+    (when (not (null? vars-to-wrap))
+      (apply wrap-program program vars-to-wrap))))
+
+
+(define* (wrap-qt-program program-name #:key inputs output)
+  "Wrap the specified programm (which must reside in the OUTPUT's \"/bin\"
+directory) with suitably set environment variables.
+
+This is like qt-build-systems's phase \"qt-wrap\", but only the named program
+is wrapped."
+  (wrap-qt-program* (string-append output "/bin/" program-name)
+                    #:output-dir output #:inputs inputs))
+
+
+(define* (wrap-all-qt-programs #:key inputs outputs
+                               (qt-wrap-excluded-outputs '())
+                               #:allow-other-keys)
+  "Implement qt-build-systems's phase \"qt-wrap\": look for executables in
+\"bin\", \"sbin\" and \"libexec\" of all outputs and create wrappers with
+suitably set environment variables if found.
+
+Wrapping is not applied to outputs whose name is listed in
+QT-WRAP-EXCLUDED-OUTPUTS.  This is useful when an output is known not
+to contain any Qt binaries, and where wrapping would gratuitously
+add a dependency of that output on Qt."
+  (define (find-files-to-wrap output-dir)
+    (append-map
+     (lambda (dir)
+       (if (directory-exists? dir) (find-files dir ".*") (list)))
+     (list (string-append output-dir "/bin")
+           (string-append output-dir "/sbin")
+           (string-append output-dir "/libexec")
+           (string-append output-dir "/lib/libexec"))))
+
+  (define handle-output
+    (match-lambda
+     ((output . output-dir)
+      (unless (member output qt-wrap-excluded-outputs)
+        (for-each (cut wrap-qt-program* <>
+                       #:output-dir output-dir #:inputs inputs)
+                  (find-files-to-wrap output-dir))))))
+
+  (for-each handle-output outputs)
+  #t)
-- 
2.21.3

Message #12 received at 45784-close <at> debbugs.gnu.org (full text, mbox):

From: Hartmut Goebel <h.goebel <at> crazy-compilers.com>
To: 45784-close <at> debbugs.gnu.org
Subject: Re: bug#45784: Acknowledgement ([PATCH 1/4] guix: qt-build-system,
 qt-utils: Unify wrapping of qt-programs.)
Date: Fri, 29 Jan 2021 23:07:31 +0100

Pushed to staging as 104151f4f45f4bc3a816e3ad42256452932e0d8d

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.