mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
build-system/gnu: Add 'patch-dot-desktop-files' phase.
* guix/build/gnu-build-system.scm (patch-dot-desktop-files): New procedure. (%standard-phases): Add it. Co-authored-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
parent
c573f5a5a5
commit
d31860b9de
1 changed files with 42 additions and 0 deletions
|
@ -544,6 +544,47 @@ DOCUMENTATION-COMPRESSOR-FLAGS."
|
||||||
outputs)
|
outputs)
|
||||||
#t)
|
#t)
|
||||||
|
|
||||||
|
|
||||||
|
(define* (patch-dot-desktop-files #:key outputs inputs #:allow-other-keys)
|
||||||
|
"Replace any references to executables in '.desktop' files with their
|
||||||
|
absolute file names."
|
||||||
|
(define bin-directories
|
||||||
|
(append-map (match-lambda
|
||||||
|
((_ . directory)
|
||||||
|
(list (string-append directory "/bin")
|
||||||
|
(string-append directory "/sbin"))))
|
||||||
|
outputs))
|
||||||
|
|
||||||
|
(define (which program)
|
||||||
|
(or (search-path bin-directories program)
|
||||||
|
(begin
|
||||||
|
(format (current-error-port)
|
||||||
|
"warning: '.desktop' file refers to '~a', \
|
||||||
|
which cannot be found~%"
|
||||||
|
program)
|
||||||
|
program)))
|
||||||
|
|
||||||
|
(for-each (match-lambda
|
||||||
|
((_ . directory)
|
||||||
|
(let ((applications (string-append directory
|
||||||
|
"/share/applications")))
|
||||||
|
(when (directory-exists? applications)
|
||||||
|
(let ((files (find-files applications "\\.desktop$")))
|
||||||
|
(format #t "adjusting ~a '.desktop' files in ~s~%"
|
||||||
|
(length files) applications)
|
||||||
|
|
||||||
|
;; '.desktop' files contain translations and are always
|
||||||
|
;; UTF-8-encoded.
|
||||||
|
(with-fluids ((%default-port-encoding "UTF-8"))
|
||||||
|
(substitute* files
|
||||||
|
(("^Exec=([^/[:blank:]\r\n]*)(.*)$" _ binary rest)
|
||||||
|
(string-append "Exec=" (which binary) rest))
|
||||||
|
(("^TryExec=([^/[:blank:]\r\n]*)(.*)$" _ binary rest)
|
||||||
|
(string-append "TryExec="
|
||||||
|
(which binary) rest)))))))))
|
||||||
|
outputs)
|
||||||
|
#t)
|
||||||
|
|
||||||
(define %standard-phases
|
(define %standard-phases
|
||||||
;; Standard build phases, as a list of symbol/procedure pairs.
|
;; Standard build phases, as a list of symbol/procedure pairs.
|
||||||
(let-syntax ((phases (syntax-rules ()
|
(let-syntax ((phases (syntax-rules ()
|
||||||
|
@ -556,6 +597,7 @@ DOCUMENTATION-COMPRESSOR-FLAGS."
|
||||||
validate-runpath
|
validate-runpath
|
||||||
validate-documentation-location
|
validate-documentation-location
|
||||||
delete-info-dir-file
|
delete-info-dir-file
|
||||||
|
patch-dot-desktop-files
|
||||||
compress-documentation)))
|
compress-documentation)))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue