* [PATCH -v3 1/2] build: union: Add create-all-directories? parameter to union-build
@ 2017-03-12 11:53 Huang Ying
2017-03-12 11:53 ` [PATCH -v3 2/2] guix: profiles: create fonts.dir/scale for all fonts directories Huang Ying
2017-03-15 21:37 ` bug#26075: [PATCH -v3 1/2] build: union: Add create-all-directories? parameter to union-build Danny Milosavljevic
0 siblings, 2 replies; 5+ messages in thread
From: Huang Ying @ 2017-03-12 11:53 UTC (permalink / raw)
To: guix-devel; +Cc: guix-patches
* guix/build/union.scm (union-build): Add create-all-directories? keyword
parameter.
---
guix/build/union.scm | 16 +++++++++++-----
1 file changed, 11 insertions(+), 5 deletions(-)
diff --git a/guix/build/union.scm b/guix/build/union.scm
index 6640b5652..b852bc66e 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -73,9 +73,12 @@ identical, #f otherwise."
(loop)))))))))))))
(define* (union-build output inputs
- #:key (log-port (current-error-port)))
- "Build in the OUTPUT directory a symlink tree that is the union of all
-the INPUTS."
+ #:key (log-port (current-error-port))
+ (create-all-directories? #f))
+ "Build in the OUTPUT directory a symlink tree that is the union of all the
+INPUTS. As a special case, if CREATE-ALL-DIRECTORIES?, creates the
+subdirectories in the output directory to make sure the caller can modify them
+later."
(define (symlink* input output)
(format log-port "`~a' ~~> `~a'~%" input output)
@@ -104,8 +107,11 @@ the INPUTS."
(define (union output inputs)
(match inputs
((input)
- ;; There's only one input, so just make a link.
- (symlink* input output))
+ ;; There's only one input, so just make a link unless
+ ;; create-all-directories?.
+ (if (and create-all-directories? (file-is-directory? input))
+ (union-of-directories output inputs)
+ (symlink* input output)))
(_
(call-with-values (lambda () (partition file-is-directory? inputs))
(match-lambda*
--
2.12.0
^ permalink raw reply related [flat|nested] 5+ messages in thread* [PATCH -v3 2/2] guix: profiles: create fonts.dir/scale for all fonts directories
2017-03-12 11:53 [PATCH -v3 1/2] build: union: Add create-all-directories? parameter to union-build Huang Ying
@ 2017-03-12 11:53 ` Huang Ying
2017-03-15 21:37 ` bug#26075: [PATCH -v3 1/2] build: union: Add create-all-directories? parameter to union-build Danny Milosavljevic
1 sibling, 0 replies; 5+ messages in thread
From: Huang Ying @ 2017-03-12 11:53 UTC (permalink / raw)
To: guix-devel; +Cc: guix-patches
* guix/profiles.scm (fonts-dir-file): Create fonts.dir/scale files for all
fonts directories.
---
guix/profiles.scm | 60 ++++++++++++++++++++++++++++++++++++++++---------------
1 file changed, 44 insertions(+), 16 deletions(-)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index de82eae34..6fb101154 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -877,9 +877,12 @@ entries. It's used to query the MIME type of a given file."
#:substitutable? #f)
(return #f))))
+;; Several font packages may install font files into same directory, so
+;; fonts.dir and fonts.scale file should be generated here, instead of in
+;; packages.
(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))
@@ -891,29 +894,54 @@ files for the truetype fonts of the @var{manifest} entries."
(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)))))
+ (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)
+ ;; Create all sub-directories, because we may create fonts.dir
+ ;; and fonts.scale files in the sub-directories.
+ (union-build fonts-dir fonts-dirs
+ #:log-port (%make-void-port "w")
+ #:create-all-directories? #t)
+ (let ((directories (find-files fonts-dir
+ (lambda (file stat)
+ (eq? 'directory (stat:type stat)))
+ #:directories? #t)))
+ (for-each (lambda (dir)
+ (with-directory-excursion dir
+ (when (file-exists? fonts-scale-file)
+ (delete-file fonts-scale-file))
+ (when (file-exists? fonts-dir-file)
+ (delete-file fonts-dir-file))
+ (unless (and (zero? (system* mkfontscale))
+ (zero? (system* mkfontdir)))
+ (exit #f))
+ (when (empty-file? fonts-scale-file)
+ (delete-file fonts-scale-file))
+ (when (empty-file? fonts-dir-file)
+ (delete-file fonts-dir-file))))
+ directories)))))))
(gexp->derivation "fonts-dir" build
#:modules '((guix build utils)
- (guix build union))
+ (guix build union)
+ (srfi srfi-26))
#:local-build? #t
#:substitutable? #f))
--
2.12.0
^ permalink raw reply related [flat|nested] 5+ messages in thread* Re: bug#26075: [PATCH -v3 1/2] build: union: Add create-all-directories? parameter to union-build
2017-03-12 11:53 [PATCH -v3 1/2] build: union: Add create-all-directories? parameter to union-build Huang Ying
2017-03-12 11:53 ` [PATCH -v3 2/2] guix: profiles: create fonts.dir/scale for all fonts directories Huang Ying
@ 2017-03-15 21:37 ` Danny Milosavljevic
2017-03-24 11:53 ` Huang, Ying
1 sibling, 1 reply; 5+ messages in thread
From: Danny Milosavljevic @ 2017-03-15 21:37 UTC (permalink / raw)
To: Huang Ying; +Cc: guix-devel, 26075
Both LGTM!
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2017-03-26 10:55 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2017-03-12 11:53 [PATCH -v3 1/2] build: union: Add create-all-directories? parameter to union-build Huang Ying
2017-03-12 11:53 ` [PATCH -v3 2/2] guix: profiles: create fonts.dir/scale for all fonts directories Huang Ying
2017-03-15 21:37 ` bug#26075: [PATCH -v3 1/2] build: union: Add create-all-directories? parameter to union-build Danny Milosavljevic
2017-03-24 11:53 ` Huang, Ying
2017-03-26 10:55 ` Ludovic Courtès
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).