tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00
Code Activity

profiles: Use ‘with-imported-modules’.

Browse Source 
* guix/profiles.scm (fonts-dir-file)[build]: Wrap in ‘with-imported-modules’.
Remove #:modules argument to ‘gexp->derivation’.

Change-Id: I29d71d0ff61cf8b81796ad412f2f95b111f028a7
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Ludovic Courtès
2026-03-09 22:38:34 +01:00
parent be88f949b4
commit 0dc5e5e5bd
1 changed files with 54 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

106
guix/profiles.scm
View File

@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013-2025 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013-2026 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
@@ -1676,60 +1676,62 @@ files for the fonts of the @var{manifest} entries."
(module-ref (resolve-interface '(gnu packages xorg)) 'mkfontdir)) (module-ref (resolve-interface '(gnu packages xorg)) 'mkfontdir))
(define build (define build
#~(begin (with-imported-modules '((guix build utils)
(use-modules (srfi srfi-26) (guix build union))
(guix build utils) #~(begin
(guix build union)) (use-modules (srfi srfi-26)
(let ((fonts-dirs (filter file-exists? (guix build utils)
(map (cut string-append <> (guix build union))
"/share/fonts")
'#$(manifest-inputs manifest))))) (let ((fonts-dirs (filter file-exists?
(mkdir #$output) (map (cut string-append <>
(if (null? fonts-dirs) "/share/fonts")
(exit #t) '#$(manifest-inputs manifest)))))
(let* ((share-dir (string-append #$output "/share")) (mkdir #$output)
(fonts-dir (string-append share-dir "/fonts")) (if (null? fonts-dirs)
(mkfontscale (string-append #+mkfontscale (exit #t)
"/bin/mkfontscale")) (let* ((share-dir (string-append #$output "/share"))
(mkfontdir (string-append #+mkfontdir (fonts-dir (string-append share-dir "/fonts"))
"/bin/mkfontdir")) (mkfontscale (string-append #+mkfontscale
(empty-file? (lambda (filename) "/bin/mkfontscale"))
(call-with-ascii-input-file filename (mkfontdir (string-append #+mkfontdir
(lambda (p) "/bin/mkfontdir"))
(eqv? #\0 (read-char p)))))) (empty-file? (lambda (filename)
(fonts-dir-file "fonts.dir") (call-with-ascii-input-file filename
(fonts-scale-file "fonts.scale")) (lambda (p)
(mkdir-p share-dir) (eqv? #\0 (read-char p))))))
;; Create all sub-directories, because we may create fonts.dir (fonts-dir-file "fonts.dir")
;; and fonts.scale files in the sub-directories. (fonts-scale-file "fonts.scale"))
(union-build fonts-dir fonts-dirs (mkdir-p share-dir)
#:log-port (%make-void-port "w") ;; Create all sub-directories, because we may create fonts.dir
#:create-all-directories? #t) ;; and fonts.scale files in the sub-directories.
(let ((directories (find-files fonts-dir (union-build fonts-dir fonts-dirs
(lambda (file stat) #:log-port (%make-void-port "w")
(eq? 'directory (stat:type stat))) #:create-all-directories? #t)
#:directories? #t))) (let ((directories
(for-each (lambda (dir) (find-files fonts-dir
(with-directory-excursion dir (lambda (file stat)
(when (file-exists? fonts-scale-file) (eq? 'directory (stat:type stat)))
(delete-file fonts-scale-file)) #:directories? #t)))
(when (file-exists? fonts-dir-file) (for-each (lambda (dir)
(delete-file fonts-dir-file)) (with-directory-excursion dir
(unless (and (zero? (system* mkfontscale)) (when (file-exists? fonts-scale-file)
(zero? (system* mkfontdir))) (delete-file fonts-scale-file))
(exit #f)) (when (file-exists? fonts-dir-file)
(when (and (file-exists? fonts-scale-file) (delete-file fonts-dir-file))
(empty-file? fonts-scale-file)) (unless (and (zero? (system* mkfontscale))
(delete-file fonts-scale-file)) (zero? (system* mkfontdir)))
(when (and (file-exists? fonts-dir-file) (exit #f))
(empty-file? fonts-dir-file)) (when (and (file-exists? fonts-scale-file)
(delete-file fonts-dir-file)))) (empty-file? fonts-scale-file))
directories))))))) (delete-file fonts-scale-file))
(when (and (file-exists? fonts-dir-file)
(empty-file? fonts-dir-file))
(delete-file fonts-dir-file))))
directories))))))))
(gexp->derivation "fonts-dir" build (gexp->derivation "fonts-dir" build
#:system system #:system system
#:modules '((guix build utils)
(guix build union))
#:local-build? #t #:local-build? #t
#:substitutable? #f #:substitutable? #f
#:properties #:properties