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.
This commit is contained in:
parent
21f4a7c116
commit
3b0fcc672d
|
@ -201,9 +201,7 @@ network to check in GNU's database."
|
||||||
|
|
||||||
(or (gnu-home-page? package)
|
(or (gnu-home-page? package)
|
||||||
(let ((url (and=> (package-source package) origin-uri))
|
(let ((url (and=> (package-source package) origin-uri))
|
||||||
(name (or (assq-ref (package-properties package)
|
(name (package-upstream-name package)))
|
||||||
'upstream-name)
|
|
||||||
(package-name package))))
|
|
||||||
(case (and (string? url) (mirror-type url))
|
(case (and (string? url) (mirror-type url))
|
||||||
((gnu) #t)
|
((gnu) #t)
|
||||||
((non-gnu) #f)
|
((non-gnu) #f)
|
||||||
|
@ -218,8 +216,7 @@ network to check in GNU's database."
|
||||||
|
|
||||||
(define (ftp-server/directory package)
|
(define (ftp-server/directory package)
|
||||||
"Return the FTP server and directory where PACKAGE's tarball are stored."
|
"Return the FTP server and directory where PACKAGE's tarball are stored."
|
||||||
(let ((name (or (assq-ref (package-properties package) 'upstream-name)
|
(let ((name (package-upstream-name package)))
|
||||||
(package-name package))))
|
|
||||||
(values (or (assoc-ref (package-properties package) 'ftp-server)
|
(values (or (assoc-ref (package-properties package) 'ftp-server)
|
||||||
"ftp.gnu.org")
|
"ftp.gnu.org")
|
||||||
(or (assoc-ref (package-properties package) 'ftp-directory)
|
(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.)"
|
\"emacs-auctex\", for instance.)"
|
||||||
(let-values (((server directory)
|
(let-values (((server directory)
|
||||||
(ftp-server/directory package)))
|
(ftp-server/directory package)))
|
||||||
(let ((name (or (assoc-ref (package-properties package) 'upstream-name)
|
(false-if-ftp-error (latest-release (package-upstream-name package)
|
||||||
(package-name package))))
|
|
||||||
(false-if-ftp-error (latest-release name
|
|
||||||
#:server server
|
#:server server
|
||||||
#:directory directory)))))
|
#:directory directory))))
|
||||||
|
|
||||||
(define %package-name-rx
|
(define %package-name-rx
|
||||||
;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses
|
;; 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
|
(define upstream-name
|
||||||
;; Some packages like "NetworkManager" have camel-case names.
|
;; Some packages like "NetworkManager" have camel-case names.
|
||||||
(or (assoc-ref (package-properties package) 'upstream-name)
|
(package-upstream-name package))
|
||||||
(package-name package)))
|
|
||||||
|
|
||||||
(false-if-ftp-error
|
(false-if-ftp-error
|
||||||
(latest-ftp-release upstream-name
|
(latest-ftp-release upstream-name
|
||||||
|
@ -531,8 +525,7 @@ source URLs starts with PREFIX."
|
||||||
(let ((uri (string->uri (origin-uri (package-source package)))))
|
(let ((uri (string->uri (origin-uri (package-source package)))))
|
||||||
(false-if-ftp-error
|
(false-if-ftp-error
|
||||||
(latest-ftp-release
|
(latest-ftp-release
|
||||||
(or (assoc-ref (package-properties package) 'upstream-name)
|
(package-upstream-name package)
|
||||||
(package-name package))
|
|
||||||
#:server "mirrors.mit.edu"
|
#:server "mirrors.mit.edu"
|
||||||
#:directory
|
#:directory
|
||||||
(string-append "/kde" (dirname (dirname (uri-path uri))))
|
(string-append "/kde" (dirname (dirname (uri-path uri))))
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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 © 2014, 2015 Mark H Weaver <mhw@netris.org>
|
||||||
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
|
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
|
||||||
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
|
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
|
||||||
|
@ -62,6 +62,7 @@
|
||||||
package
|
package
|
||||||
package?
|
package?
|
||||||
package-name
|
package-name
|
||||||
|
package-upstream-name
|
||||||
package-version
|
package-version
|
||||||
package-full-name
|
package-full-name
|
||||||
package-source
|
package-source
|
||||||
|
@ -296,6 +297,12 @@ name of its URI."
|
||||||
package)
|
package)
|
||||||
16)))))
|
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)
|
(define (hidden-package p)
|
||||||
"Return a \"hidden\" version of P--i.e., one that 'fold-packages' and thus,
|
"Return a \"hidden\" version of P--i.e., one that 'fold-packages' and thus,
|
||||||
user interfaces, ignores."
|
user interfaces, ignores."
|
||||||
|
|
Loading…
Reference in New Issue