Lispln/nonguix
1
0
Fork 0
mirror of https://gitlab.com/nonguix/nonguix.git synced 2024-11-22 08:28:09 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

multiarch-container: make-internal-script: Improve icd-symlink.

Browse source 
* nonguix/multiarch-container.scm (make-internal-script)[icd-symlink]: Allow
custom directory.
Rename to…
[file-symlink]: …this.
[get-files]: New procedure to simplify find-files use.

Signed-off-by: John Kehayias <john.kehayias@protonmail.com>
This commit is contained in:
Hilton Chain 2024-01-31 20:50:03 +08:00 committed by John Kehayias
parent 825f6ee783
commit 3cebd9c77b
No known key found for this signature in database
GPG key ID: 499097AE5EA815D9
1 changed files with 14 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
nonguix/multiarch-container.scm
View file

@ -455,7 +455,9 @@ application."
`((guix build utils)) `((guix build utils))
#~(begin #~(begin
(use-modules (guix build utils) (use-modules (guix build utils)
(ice-9 getopt-long)) (ice-9 getopt-long)
(srfi srfi-1)
(srfi srfi-26))
(define (path->str path) (define (path->str path)
(if (list? path) (if (list? path)
(string-join path "/") (string-join path "/")
@ -465,9 +467,13 @@ application."
(dest (path->str (cdr pair)))) (dest (path->str (cdr pair))))
(unless (file-exists? dest) (unless (file-exists? dest)
(symlink target dest)))) (symlink target dest))))
(define (icd-symlink file) (define (file-symlink file dir)
(mkdir-p dir)
(new-symlink (new-symlink
`(,file . ("/usr/share/vulkan/icd.d" ,(basename file))))) `(,file . (,dir ,(basename file)))))
;; Use stat to follow links from packages like MangoHud.
(define (get-files dir)
(find-files (path->str dir) #:stat stat))
(define fhs-option-spec (define fhs-option-spec
'((asound32 (value #f)))) '((asound32 (value #f))))
(let* ((guix-env (getenv "GUIX_ENVIRONMENT")) (let* ((guix-env (getenv "GUIX_ENVIRONMENT"))
@ -517,12 +523,11 @@ application."
((,union64 "share/vulkan/explicit_layer.d") . ((,union64 "share/vulkan/explicit_layer.d") .
"/usr/share/vulkan/explicit_layer.d"))) "/usr/share/vulkan/explicit_layer.d")))
(for-each (for-each
icd-symlink (cut file-symlink <> "/usr/share/vulkan/icd.d")
;; Use stat to follow links from packages like MangoHud. (append-map
`(,@(find-files (string-append union32 "/share/vulkan/icd.d") get-files
#:directories? #t #:stat stat) `((,union32 "share/vulkan/icd.d")
,@(find-files (string-append union64 "/share/vulkan/icd.d") (,union64 "share/vulkan/icd.d"))))
#:directories? #t #:stat stat)))
;; TODO: This is not the right place for this. ;; TODO: This is not the right place for this.
;; Newer versions of Steam won't startup if they can't copy to here ;; Newer versions of Steam won't startup if they can't copy to here
;; (previous would output this error but continue). ;; (previous would output this error but continue).