From: Huang Ying <huang.ying.cari...@gmail.com>
* guix/profiles.scm (fonts-dir-file): Create fonts.dir/scale files for all
fonts directories.
Suggested-by: 宋文武 <iyzs...@member.fsf.org>
---
guix/profiles.scm | 56 ++++++++++++++++++++++++++++++++++++++-----------------
1 file changed, 39 insertions(+), 17 deletions(-)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index de82eae34..7c1b552ad 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -879,7 +879,7 @@ entries. It's used to query the MIME type of a given file."
(define (fonts-dir-file manifest)
"Return a derivation that builds the @file{fonts.dir} and @file{fonts.scale}
-files for the truetype fonts of the @var{manifest} entries."
+files for the fonts of the @var{manifest} entries."
(define mkfontscale
(module-ref (resolve-interface '(gnu packages xorg)) 'mkfontscale))
@@ -890,30 +890,52 @@ files for the truetype fonts of the @var{manifest}
entries."
#~(begin
(use-modules (srfi srfi-26)
(guix build utils)
- (guix build union))
- (let ((ttf-dirs (filter file-exists?
- (map (cut string-append <>
- "/share/fonts/truetype")
- '#$(manifest-inputs manifest)))))
+ (guix build union)
+ (ice-9 ftw))
+ (let ((fonts-dirs (filter file-exists?
+ (map (cut string-append <>
+ "/share/fonts")
+ '#$(manifest-inputs manifest)))))
(mkdir #$output)
- (if (null? ttf-dirs)
+ (if (null? fonts-dirs)
(exit #t)
- (let* ((fonts-dir (string-append #$output "/share/fonts"))
- (ttf-dir (string-append fonts-dir "/truetype"))
+ (let* ((share-dir (string-append #$output "/share"))
+ (fonts-dir (string-append share-dir "/fonts"))
(mkfontscale (string-append #+mkfontscale
"/bin/mkfontscale"))
(mkfontdir (string-append #+mkfontdir
- "/bin/mkfontdir")))
- (mkdir-p fonts-dir)
- (union-build ttf-dir ttf-dirs
- #:log-port (%make-void-port "w"))
- (with-directory-excursion ttf-dir
- (exit (and (zero? (system* mkfontscale))
- (zero? (system* mkfontdir))))))))))
+ "/bin/mkfontdir"))
+ (empty-file? (lambda (filename)
+ (call-with-ascii-input-file filename
+ (lambda (p)
+ (eqv? #\0 (read-char p))))))
+ (fonts-dir-file "fonts.dir")
+ (fonts-scale-file "fonts.scale"))
+ (mkdir-p share-dir)
+ (union-build fonts-dir fonts-dirs
+ #:log-port (%make-void-port "w")
+ #:create-all-directory? #t)
+ (ftw fonts-dir
+ (lambda (dir statinfo flag)
+ (and (eq? flag 'directory)
+ (with-directory-excursion dir
+ (and (file-exists? fonts-scale-file)
+ (delete-file fonts-scale-file))
+ (and (file-exists? fonts-dir-file)
+ (delete-file fonts-dir-file))
+ (system* mkfontscale)
+ (system* mkfontdir)
+ (and (empty-file? fonts-scale-file)
+ (delete-file fonts-scale-file))
+ (and (empty-file? fonts-dir-file)
+ (delete-file fonts-dir-file))))
+ #t)))))))
(gexp->derivation "fonts-dir" build
#:modules '((guix build utils)
- (guix build union))
+ (guix build union)
+ (srfi srfi-26)
+ (ice-9 ftw))
#:local-build? #t
#:substitutable? #f))
--
2.11.1
