me
/
guix
Archived
1
0
Fork 0
Code

build: qt-utils: Refactor the code to filter XDG_DATA_DIRS. 

This partially reinstate the reverted
c5fd1b0bd3.

* guix/build/qt-utils.scm (variables-for-wrapping)[collect-sub-dirs]:
Add 'selectors' parameter and honor it.  Change caller to handle selectors.

Modified-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
master
Ludovic Courtès 2021-07-02 13:49:00 -04:00 committed by Maxim Cournoyer
parent 86c9f5a5fa
commit 20cf23e4f8
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
1 changed files with 35 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
guix/build/qt-utils.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -36,40 +37,41 @@
;; contain any of the standard subdirectories. ;; contain any of the standard subdirectories.
(define (variables-for-wrapping base-directories output-directory) (define (variables-for-wrapping base-directories output-directory)
(define (collect-sub-dirs base-directories subdirectory-spec) (define (collect-sub-dirs base-directories subdirectory selectors)
(filter-map ;; Append SUBDIRECTORY and each of BASE-DIRECTORIES, and return the subset
(lambda (dir) ;; that exists and has at least one of the SELECTORS sub-directories,
(match ;; unless SELECTORS is the empty list.
subdirectory-spec (filter-map (lambda (dir)
((subdir) (let ((directory (string-append dir subdirectory)))
(and (directory-exists? (string-append dir subdir)) (and (directory-exists? directory)
(string-append dir (car subdirectory-spec)))) (or (null? selectors)
((subdir children) (any (lambda (selector)
(and (directory-exists?
(or (string-append directory selector)))
(and (string=? dir output-directory) selectors))
(directory-exists? (string-append dir subdir))) directory)))
(or-map base-directories))
(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
(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" ("/applications" "/fonts"
"/icons" "/mime"))
'("XDG_CONFIG_DIRS" suffix "/etc/xdg")
'("QT_PLUGIN_PATH" prefix "/lib/qt5/plugins")
'("QML2_IMPORT_PATH" prefix "/lib/qt5/qml")))))
(filter-map
(match-lambda
((variable type directory selectors ...)
(match (collect-sub-dirs base-directories directory selectors)
(()
#f)
(directories
`(,variable ,type ,directories)))))
;; These shall match the search-path-specification for Qt and KDE
;; libraries.
(list '("XDG_DATA_DIRS" suffix "/share"
;; These are "selectors": consider /share if and only if at least
;; one of these sub-directories exist. This avoids adding
;; irrelevant packages to XDG_DATA_DIRS just because they have a
;; /share sub-directory.
"/applications" "/cursors" "/fonts" "/icons" "/glib-2.0/schemas"
"/mime" "/sounds" "/themes" "/wallpapers")
'("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 (define* (wrap-qt-program* program #:key inputs output-dir
qt-wrap-excluded-inputs) qt-wrap-excluded-inputs)