Merge remote-tracking branch 'origin/master' into core-updates

3 files changed, 62 insertions, 8 deletions

diff --git a/guix/download.scm b/guix/download.scm
index 8f38a4f552..73c0e897b4 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -99,6 +100,7 @@
        "http://www.centervenus.com/mirrors/nongnu/"
        "http://download.savannah.gnu.org/releases-noredirect/")
       (sourceforge ; https://sourceforge.net/p/forge/documentation/Mirrors/
+       "http://downloads.sourceforge.net/project/"
        "http://ufpr.dl.sourceforge.net/project/"
        "http://heanet.dl.sourceforge.net/project/"
        "http://freefr.dl.sourceforge.net/project/"
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 77df6ad185..1adb143c16 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;;
@@ -756,10 +756,51 @@ entries.  It's used to query the MIME type of a given file."
                           #:substitutable? #f)
         (return #f))))
 
+(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."
+  (define mkfontscale
+    (module-ref (resolve-interface '(gnu packages xorg)) 'mkfontscale))
+
+  (define mkfontdir
+    (module-ref (resolve-interface '(gnu packages xorg)) 'mkfontdir))
+
+  (define build
+    #~(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)))))
+          (mkdir #$output)
+          (if (null? ttf-dirs)
+              (exit #t)
+              (let* ((fonts-dir   (string-append #$output "/share/fonts"))
+                     (ttf-dir     (string-append fonts-dir "/truetype"))
+                     (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))))))))))
+
+  (gexp->derivation "fonts-dir" build
+                    #:modules '((guix build utils)
+                                (guix build union))
+                    #:local-build? #t
+                    #:substitutable? #f))
+
 (define %default-profile-hooks
   ;; This is the list of derivation-returning procedures that are called by
   ;; default when making a non-empty profile.
   (list info-dir-file
+        fonts-dir-file
         ghc-package-cache-file
         ca-certificate-bundle
         gtk-icon-themes
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index d5e9197cc9..8aab1febb2 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -203,14 +203,25 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
 (define (check-inputs-should-be-native package)
   ;; Emit a warning if some inputs of PACKAGE are likely to belong to its
   ;; native inputs.
-  (let ((inputs (package-inputs package)))
+  (let ((linted package)
+        (inputs (package-inputs package))
+        (native-inputs '("pkg-config" "glib:bin" "intltool" "itstool")))
     (match inputs
-      (((labels packages . _) ...)
-       (when (member "pkg-config"
-                     (map package-name (filter package? packages)))
-        (emit-warning package
-                      (_ "pkg-config should probably be a native input")
-                      'inputs))))))
+      (((labels packages . outputs) ...)
+       (for-each (lambda (package output)
+                   (when (package? package)
+                     (let ((input (string-append
+                                   (package-name package)
+                                   (if (> (length output) 0)
+                                       (string-append ":" (car output))
+                                       ""))))
+                       (when (member input native-inputs)
+                         (emit-warning linted
+                                       (format #f (_ "'~a' should probably \
+be a native input")
+                                               input)
+                                       'inputs)))))
+                 packages outputs)))))
 
 (define (package-name-regexp package)
   "Return a regexp that matches PACKAGE's name as a word at the beginning of a