~ruther/guix-local

3b0fcc672d48ed67a807b20bde5d2f963c285074 — Ludovic Courtès 9 years ago 21f4a7c
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.
2 files changed, 15 insertions(+), 15 deletions(-)

M guix/gnu-maintenance.scm
M guix/packages.scm
M guix/gnu-maintenance.scm => guix/gnu-maintenance.scm +7 -14
@@ 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))))

M guix/packages.scm => guix/packages.scm +8 -1
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>


@@ 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."