06/09: packages: Add 'package-upstream-name' and use it.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 3b0fcc672d48ed67a807b20bde5d2f963c285074
Author: Ludovic Courtès <address@hidden>
Date:   Sat Jan 28 00:11:33 2017 +0100

    packages: Add 'package-upstream-name' and use it.
    
    * guix/packages.scm (package-upstream-name): New procedure.
    * guix/gnu-maintenance.scm (gnu-package?, ftp-server/directory)
    (latest-release*, latest-gnome-release)
    (latest-kde-release): Use it instead of the inline expression.
---
 guix/gnu-maintenance.scm |   21 +++++++--------------
 guix/packages.scm        |    9 ++++++++-
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 9c94992..e4151c6 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -201,9 +201,7 @@ network to check in GNU's database."
 
        (or (gnu-home-page? package)
            (let ((url  (and=> (package-source package) origin-uri))
-                 (name (or (assq-ref (package-properties package)
-                                     'upstream-name)
-                           (package-name package))))
+                 (name (package-upstream-name package)))
              (case (and (string? url) (mirror-type url))
                ((gnu) #t)
                ((non-gnu) #f)
@@ -218,8 +216,7 @@ network to check in GNU's database."
 
 (define (ftp-server/directory package)
   "Return the FTP server and directory where PACKAGE's tarball are stored."
-  (let ((name (or (assq-ref (package-properties package) 'upstream-name)
-                  (package-name package))))
+  (let ((name (package-upstream-name package)))
     (values (or (assoc-ref (package-properties package) 'ftp-server)
                 "ftp.gnu.org")
             (or (assoc-ref (package-properties package) 'ftp-directory)
@@ -433,11 +430,9 @@ hosted on ftp.gnu.org, or not under that name (this is the 
case for
 \"emacs-auctex\", for instance.)"
   (let-values (((server directory)
                 (ftp-server/directory package)))
-    (let ((name (or (assoc-ref (package-properties package) 'upstream-name)
-                    (package-name package))))
-      (false-if-ftp-error (latest-release name
-                                          #:server server
-                                          #:directory directory)))))
+    (false-if-ftp-error (latest-release (package-upstream-name package)
+                                        #:server server
+                                        #:directory directory))))
 
 (define %package-name-rx
   ;; Regexp for a package name, e.g., "foo-X.Y".  Since TeXmacs uses
@@ -506,8 +501,7 @@ source URLs starts with PREFIX."
 
   (define upstream-name
     ;; Some packages like "NetworkManager" have camel-case names.
-    (or (assoc-ref (package-properties package) 'upstream-name)
-        (package-name package)))
+    (package-upstream-name package))
 
   (false-if-ftp-error
    (latest-ftp-release upstream-name
@@ -531,8 +525,7 @@ source URLs starts with PREFIX."
   (let ((uri (string->uri (origin-uri (package-source package)))))
     (false-if-ftp-error
      (latest-ftp-release
-      (or (assoc-ref (package-properties package) 'upstream-name)
-          (package-name package))
+      (package-upstream-name package)
       #:server "mirrors.mit.edu"
       #:directory
       (string-append "/kde" (dirname (dirname (uri-path uri))))
diff --git a/guix/packages.scm b/guix/packages.scm
index beb958f..defde24 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès 
<address@hidden>
 ;;; Copyright © 2014, 2015 Mark H Weaver <address@hidden>
 ;;; Copyright © 2015 Eric Bavier <address@hidden>
 ;;; Copyright © 2016 Alex Kost <address@hidden>
@@ -62,6 +62,7 @@
             package
             package?
             package-name
+            package-upstream-name
             package-version
             package-full-name
             package-source
@@ -296,6 +297,12 @@ name of its URI."
                                                        package)
                                                       16)))))
 
+(define (package-upstream-name package)
+  "Return the upstream name of PACKAGE, which could be different from the name
+it has in Guix."
+  (or (assq-ref (package-properties package) 'upstream-name)
+      (package-name package)))
+
 (define (hidden-package p)
   "Return a \"hidden\" version of P--i.e., one that 'fold-packages' and thus,
 user interfaces, ignores."