unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / Atom feed
* bug#45193: [PATCH 2/4] guix: qt-utils: Wrapped executables honor user's envvars.
  2021-01-11 14:41 [bug#45784] [PATCH 1/4] guix: qt-build-system, qt-utils: Unify wrapping of qt-programs Hartmut Goebel
@ 2021-01-11 14:41 ` Hartmut Goebel
  2021-01-11 14:41 ` bug#45193: [PATCH 3/4] build-system: qt: Exclude useless inputs from wrapped variables Hartmut Goebel
  2021-01-11 14:41 ` [bug#45787] [PATCH 4/4] guix: qt-utils: Don't include useless inputs in " Hartmut Goebel
  2 siblings, 0 replies; 4+ messages in thread
From: Hartmut Goebel @ 2021-01-11 14:41 UTC (permalink / raw)
  To: 45193, guix-patches

Prior to this change, wrappers did set the specified environment variables to
a fixed value, overwriting any user settings. This inhibited propagating
e.g. XDG_DATA_DIRS from a profile to the application.

Now user environment variables are prefixed (if the variable defines some
"binary" search path, e.g. QT_PLUGIN_PATH) or suffixed (if the variable
defines some config or data search path, e.g. XDG_DATA_DIRS). The code could
also allow to overwrite, anyhow currently no variable is defined like this.

* guix/build/qt-utils.scm (variables-for-wrapping): For each env-var to
  be wrapped, specify whether it should prefix, suffix or overwrite the
  user's variable.
---
 guix/build/qt-utils.scm | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index 3fbdb6be61..030059522d 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -39,14 +39,15 @@
    (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 (first var-spec) (second var-spec)
+            (collect-sub-dirs base-directories (third 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")))))
+     '("XDG_DATA_DIRS" suffix "/share")
+     '("XDG_CONFIG_DIRS" suffix "/etc/xdg")
+     '("QT_PLUGIN_PATH" prefix "/lib/qt5/plugins")
+     '("QML2_IMPORT_PATH" prefix "/lib/qt5/qml")))))
 
 
 (define* (wrap-qt-program* program #:key inputs output-dir)
-- 
2.21.3





^ permalink raw reply	[flat|nested] 4+ messages in thread

* bug#45193: [PATCH 3/4] build-system: qt: Exclude useless inputs from wrapped variables.
  2021-01-11 14:41 [bug#45784] [PATCH 1/4] guix: qt-build-system, qt-utils: Unify wrapping of qt-programs Hartmut Goebel
  2021-01-11 14:41 ` bug#45193: [PATCH 2/4] guix: qt-utils: Wrapped executables honor user's envvars Hartmut Goebel
@ 2021-01-11 14:41 ` Hartmut Goebel
  2021-01-11 14:41 ` [bug#45787] [PATCH 4/4] guix: qt-utils: Don't include useless inputs in " Hartmut Goebel
  2 siblings, 0 replies; 4+ messages in thread
From: Hartmut Goebel @ 2021-01-11 14:41 UTC (permalink / raw)
  To: 45193, guix-patches; +Cc: Jakub Kądziołka

From: Jakub Kądziołka <kuba@kadziolka.net>

* guix/build-system/qt.scm (qt-build)[qt-wrap-excluded-inputs]: New argument.
* guix/build/qt-utils.scm (%qt-wrap-excluded-inputs): New variable.
  (wrap-qt-program*)[qt-wrap-excluded-inputs]: New argument. Filter excluded
  inputs.
  (wrap-qt-program)[qt-wrap-excluded-inputs]: New argument.
  (wrap-all-qt-programs)[qt-wrap-excluded-inputs]: New argument.

Co-authored-by: Hartmut Goebel <h.goebel@crazy-compilers.com>
---
 guix/build-system/qt.scm |  5 +++++
 guix/build/qt-utils.scm  | 29 ++++++++++++++++++++---------
 2 files changed, 25 insertions(+), 9 deletions(-)

diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm
index 1bd89bfa4d..e1368db1d9 100644
--- a/guix/build-system/qt.scm
+++ b/guix/build-system/qt.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +23,8 @@
 (define-module (guix build-system qt)
   #:use-module (guix store)
   #:use-module (guix utils)
+  #:use-module ((guix build qt-utils)
+                #:select (%qt-wrap-excluded-inputs))
   #:use-module (guix derivations)
   #:use-module (guix search-paths)
   #:use-module (guix build-system)
@@ -125,6 +128,7 @@
                    (phases '(@ (guix build qt-build-system)
                                %standard-phases))
                    (qt-wrap-excluded-outputs ''())
+                   (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
                    (system (%current-system))
                    (imported-modules %qt-build-system-modules)
                    (modules '((guix build qt-build-system)
@@ -148,6 +152,7 @@ provides a 'CMakeLists.txt' file as its build system."
                                        search-paths)
                  #:phases ,phases
                  #:qt-wrap-excluded-outputs ,qt-wrap-excluded-outputs
+                 #:qt-wrap-excluded-inputs ,qt-wrap-excluded-inputs
                  #:configure-flags ,configure-flags
                  #:make-flags ,make-flags
                  #:out-of-source? ,out-of-source?
diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index 030059522d..a03b09f05e 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,8 +24,11 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (wrap-qt-program
-            wrap-all-qt-programs))
+            wrap-all-qt-programs
+            %qt-wrap-excluded-inputs))
 
+(define %qt-wrap-excluded-inputs
+  '(list "cmake" "extra-cmake-modules" "qttools"))
 
 (define (variables-for-wrapping base-directories)
 
@@ -50,13 +54,16 @@
      '("QML2_IMPORT_PATH" prefix "/lib/qt5/qml")))))
 
 
-(define* (wrap-qt-program* program #:key inputs output-dir)
+(define* (wrap-qt-program* program #:key inputs output-dir
+                           qt-wrap-excluded-inputs)
 
   (define input-directories
-    ;; FIXME: Filter out unwanted inputs, e.g. cmake
-    (match inputs
-           (((_ . dir) ...)
-            dir)))
+    (filter-map
+     (match-lambda
+      ((label . directory)
+       (and (not (member label qt-wrap-excluded-inputs))
+            directory)))
+     inputs))
 
   (let ((vars-to-wrap (variables-for-wrapping
                        (cons output-dir input-directories))))
@@ -64,18 +71,21 @@
       (apply wrap-program program vars-to-wrap))))
 
 
-(define* (wrap-qt-program program-name #:key inputs output)
+(define* (wrap-qt-program program-name #:key inputs output
+                          (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs))
   "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))
+                    #:output-dir output #:inputs inputs
+                    #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs))
 
 
 (define* (wrap-all-qt-programs #:key inputs outputs
                                (qt-wrap-excluded-outputs '())
+                               (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
                                #: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
@@ -99,7 +109,8 @@ add a dependency of that output on Qt."
      ((output . output-dir)
       (unless (member output qt-wrap-excluded-outputs)
         (for-each (cut wrap-qt-program* <>
-                       #:output-dir output-dir #:inputs inputs)
+                       #:output-dir output-dir #:inputs inputs
+                       #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs)
                   (find-files-to-wrap output-dir))))))
 
   (for-each handle-output outputs)
-- 
2.21.3





^ permalink raw reply	[flat|nested] 4+ messages in thread

* [bug#45784] [PATCH 1/4] guix: qt-build-system, qt-utils: Unify wrapping of qt-programs.
@ 2021-01-11 14:41 Hartmut Goebel
  2021-01-11 14:41 ` bug#45193: [PATCH 2/4] guix: qt-utils: Wrapped executables honor user's envvars Hartmut Goebel
                   ` (2 more replies)
  0 siblings, 3 replies; 4+ messages in thread
From: Hartmut Goebel @ 2021-01-11 14:41 UTC (permalink / raw)
  To: 45193, 45784

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@berkeley.edu>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019, 2020 Brett Gilio <brettg@gnu.org>
+;;; Copyright © 2020 Hartmut Goebel <h.goebel@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@enge.fr>
 ;;; Copyright © 2016, 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
-;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2016, 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
 ;;; Copyright © 2017 Theodoros Foradis <theodoros@foradis.org>
 ;;; Copyright © 2017 Vasile Dumitrascu <va511e@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@posteo.net>
 ;;; Copyright © 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Wiktor Żelazny <wzelazny@vurv.cz>
-;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2019, 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2020 Felix Gruber <felgru@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@m4x.org>
 ;;; Copyright © 2020 Michael Rohleder <mike@rohleder.de>
 ;;; Copyright © 2020 Vinicius Monego <monego@posteo.net>
+;;; Copyright © 2020 Hartmut Goebel <h.goebel@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@posteo.ro>
 ;;; Copyright © 2020 Ivan Kozlov <kanichos@yandex.ru>
 ;;; Copyright © 2020 Antoine Côté <antoine.cote@posteo.net>
+;;; Copyright © 2020 Hartmut Goebel <h.goebel@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@rohleder.de>
 ;;; Copyright © 2020 Nicolò Balzarotti <nicolo@nixo.xyz>
 ;;; Copyright © 2020 Alexandru-Sergiu Marton <brown121407@posteo.ro>
+;;; Copyright © 2020 Hartmut Goebel <h.goebel@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@fbengineering.ch>
 ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2019, 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel@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@craven.ch>
+;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel@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





^ permalink raw reply	[flat|nested] 4+ messages in thread

* [bug#45787] [PATCH 4/4] guix: qt-utils: Don't include useless inputs in wrapped variables.
  2021-01-11 14:41 [bug#45784] [PATCH 1/4] guix: qt-build-system, qt-utils: Unify wrapping of qt-programs Hartmut Goebel
  2021-01-11 14:41 ` bug#45193: [PATCH 2/4] guix: qt-utils: Wrapped executables honor user's envvars Hartmut Goebel
  2021-01-11 14:41 ` bug#45193: [PATCH 3/4] build-system: qt: Exclude useless inputs from wrapped variables Hartmut Goebel
@ 2021-01-11 14:41 ` Hartmut Goebel
  2 siblings, 0 replies; 4+ messages in thread
From: Hartmut Goebel @ 2021-01-11 14:41 UTC (permalink / raw)
  To: 45193, 45787; +Cc: Jakub Kądziołka

From: Jakub Kądziołka <kuba@kadziolka.net>

Include only those inputs into XDG_DATA_DIRS having
some subdirectory of /share which is typically used by Qt.

* guix/build/qt-utils.scm (variables-for-wrapping): Take the
  output directory as an argument for special handling. Check for
  subdirectories of /share used by Qt before including inputs in
  XDG_DATA_DIRS.
  (wrap-qt-program*): Pass the output directory to variables-for-wrapping.

Co-authored-by: Hartmut Goebel <h.goebel@crazy-compilers.com>
---
 guix/build/qt-utils.scm | 36 +++++++++++++++++++++++++++---------
 1 file changed, 27 insertions(+), 9 deletions(-)

diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index a03b09f05e..8e6db10ca1 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -30,25 +30,42 @@
 (define %qt-wrap-excluded-inputs
   '(list "cmake" "extra-cmake-modules" "qttools"))
 
-(define (variables-for-wrapping base-directories)
+;; NOTE: Apart from standard subdirectories of /share, Qt also provides
+;; facilities for per-application data directories, such as
+;; /share/quassel. Thus, we include the output directory even if it doesn't
+;; contain any of the standard subdirectories.
+(define (variables-for-wrapping base-directories output-directory)
 
-  (define (collect-sub-dirs base-directories subdirectory)
+  (define (collect-sub-dirs base-directories subdirectory-spec)
     (filter-map
      (lambda (dir)
-       (let ((directory (string-append dir subdirectory)))
-         (if (directory-exists? directory) directory #f)))
+       (match
+        subdirectory-spec
+        ((subdir)
+         (and (directory-exists? (string-append dir subdir))
+              (string-append dir (car subdirectory-spec))))
+        ((subdir children)
+         (and
+          (or
+           (and (string=? dir output-directory)
+                (directory-exists? (string-append dir subdir)))
+           (or-map
+            (lambda (kid) (directory-exists? (string-append dir subdir kid)))
+            children))
+          (string-append dir subdir)))))
      base-directories))
 
   (filter
    (lambda (var-to-wrap) (not (null? (last var-to-wrap))))
    (map
-    (lambda (var-spec)
-      (list (first var-spec) (second var-spec)
-            (collect-sub-dirs base-directories (third var-spec))))
+    (match-lambda
+     ((var kind . subdir-spec)
+      `(,var ,kind ,(collect-sub-dirs base-directories subdir-spec))))
     (list
      ;; these shall match the search-path-specification for Qt and KDE
      ;; libraries
-     '("XDG_DATA_DIRS" suffix "/share")
+     '("XDG_DATA_DIRS" suffix "/share" ("/applications" "/fonts"
+                                        "/icons" "/mime"))
      '("XDG_CONFIG_DIRS" suffix "/etc/xdg")
      '("QT_PLUGIN_PATH" prefix "/lib/qt5/plugins")
      '("QML2_IMPORT_PATH" prefix "/lib/qt5/qml")))))
@@ -66,7 +83,8 @@
      inputs))
 
   (let ((vars-to-wrap (variables-for-wrapping
-                       (cons output-dir input-directories))))
+                       (cons output-dir input-directories)
+                       output-dir)))
     (when (not (null? vars-to-wrap))
       (apply wrap-program program vars-to-wrap))))
 
-- 
2.21.3





^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2021-01-11 14:45 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-01-11 14:41 [bug#45784] [PATCH 1/4] guix: qt-build-system, qt-utils: Unify wrapping of qt-programs Hartmut Goebel
2021-01-11 14:41 ` bug#45193: [PATCH 2/4] guix: qt-utils: Wrapped executables honor user's envvars Hartmut Goebel
2021-01-11 14:41 ` bug#45193: [PATCH 3/4] build-system: qt: Exclude useless inputs from wrapped variables Hartmut Goebel
2021-01-11 14:41 ` [bug#45787] [PATCH 4/4] guix: qt-utils: Don't include useless inputs in " Hartmut Goebel

unofficial mirror of guix-patches@gnu.org 

This inbox may be cloned and mirrored by anyone:

	git clone --mirror https://yhetil.org/guix-patches/1 guix-patches/git/1.git

	# If you have public-inbox 1.1+ installed, you may
	# initialize and index your mirror using the following commands:
	public-inbox-init -V2 guix-patches guix-patches/ https://yhetil.org/guix-patches \
		guix-patches@gnu.org
	public-inbox-index guix-patches

Example config snippet for mirrors.
Newsgroup available over NNTP:
	nntp://news.yhetil.org/yhetil.gnu.guix.patches


AGPL code for this site: git clone http://ou63pmih66umazou.onion/public-inbox.git