GNU bug report logs - #26075
[PATCH -v3 1/2] build: union: Add create-all-directories? parameter to union-build

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 26075 in the body.
You can then email your comments to 26075 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Huang Ying <huang.ying.caritas <at> gmail.com>
To: guix-devel <at> gnu.org
Cc: Huang Ying <huang.ying.caritas <at> gmail.com>, guix-patches <at> gnu.org
Subject: [PATCH -v3 1/2] build: union: Add create-all-directories? parameter
 to union-build
Date: Sun, 12 Mar 2017 19:53:58 +0800

* 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

Message #8 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Huang Ying <huang.ying.caritas <at> gmail.com>
To: guix-devel <at> gnu.org
Cc: Huang Ying <huang.ying.caritas <at> gmail.com>, guix-patches <at> gnu.org
Subject: [PATCH -v3 2/2] guix: profiles: create fonts.dir/scale for all fonts
 directories
Date: Sun, 12 Mar 2017 19:53:59 +0800

* 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

Message #11 received at 26075 <at> debbugs.gnu.org (full text, mbox):

From: Danny Milosavljevic <dannym <at> scratchpost.org>
To: Huang Ying <huang.ying.caritas <at> gmail.com>
Cc: guix-devel <at> gnu.org, 26075 <at> debbugs.gnu.org
Subject: Re: bug#26075: [PATCH -v3 1/2] build: union: Add
 create-all-directories? parameter to union-build
Date: Wed, 15 Mar 2017 22:37:01 +0100

Both LGTM!

Message #14 received at 26075 <at> debbugs.gnu.org (full text, mbox):

From: "Huang\, Ying" <huang_ying_caritas <at> 163.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: guix-devel <at> gnu.org, Huang Ying <huang.ying.caritas <at> gmail.com>,
 26075 <at> debbugs.gnu.org
Subject: Re: bug#26075: [PATCH -v3 1/2] build: union: Add
 create-all-directories? parameter to union-build
Date: Fri, 24 Mar 2017 19:53:05 +0800

Hi, Ludo,

Any comment?

Best Regards,
Huang, Ying

Danny Milosavljevic <dannym <at> scratchpost.org> writes:

> Both LGTM!

Message #19 received at 26075-done <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: "Huang\, Ying" <huang_ying_caritas <at> 163.com>
Cc: guix-devel <at> gnu.org, 26075-done <at> debbugs.gnu.org,
 Huang Ying <huang.ying.caritas <at> gmail.com>
Subject: Re: bug#26075: [PATCH -v3 1/2] build: union: Add
 create-all-directories? parameter to union-build
Date: Sun, 26 Mar 2017 12:55:22 +0200

Hi!

I’ve pushed it with a copyright line for you, and with a unit test for
‘union-build’ with #:create-all-directories? #t:

  https://git.savannah.gnu.org/cgit/guix.git/commit/?id=addce19e2d38a197f5ea10eefb5f3cd25c3a52e7
  https://git.savannah.gnu.org/cgit/guix.git/commit/?id=0a5ce0d1df3befa2c4e018e84da3bd66c9eac48d

Thank you!

Ludo’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.