nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Ludovic Courtès 2017-01-28 00:11:33 +01:00
parent 21f4a7c116
commit 3b0fcc672d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
guix/gnu-maintenance.scm
View File

@ -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)))) #:server server
(false-if-ftp-error (latest-release name #:directory directory))))
#:server server
#: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))))

9
guix/packages.scm
View File

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