packages: Add 'package-upstream-name*'.
* guix/packages.scm (package-upstream-name*): New procedure. * tests/packages.scm ("package-upstream-name*"): New test. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
parent
a2f0297af0
commit
052faadde7
|
@ -89,6 +89,7 @@
|
|||
this-package
|
||||
package-name
|
||||
package-upstream-name
|
||||
package-upstream-name*
|
||||
package-version
|
||||
package-full-name
|
||||
package-source
|
||||
|
@ -691,6 +692,38 @@ it has in Guix."
|
|||
(or (assq-ref (package-properties package) 'upstream-name)
|
||||
(package-name package)))
|
||||
|
||||
(define (package-upstream-name* package)
|
||||
"Return the upstream name of PACKAGE, accounting for commonly-used
|
||||
package name prefixes in addition to the @code{upstream-name} property."
|
||||
(let ((namespaces (list "cl-"
|
||||
"ecl-"
|
||||
"emacs-"
|
||||
"ghc-"
|
||||
"go-"
|
||||
"guile-"
|
||||
"java-"
|
||||
"julia-"
|
||||
"lua-"
|
||||
"minetest-"
|
||||
"node-"
|
||||
"ocaml-"
|
||||
"perl-"
|
||||
"python-"
|
||||
"r-"
|
||||
"ruby-"
|
||||
"rust-"
|
||||
"sbcl-"
|
||||
"texlive-"))
|
||||
(name (package-name package)))
|
||||
(or (assq-ref (package-properties package) 'upstream-name)
|
||||
(let loop ((prefixes namespaces))
|
||||
(match prefixes
|
||||
(() name)
|
||||
((prefix rest ...)
|
||||
(if (string-prefix? prefix name)
|
||||
(substring name (string-length prefix))
|
||||
(loop rest))))))))
|
||||
|
||||
(define (hidden-package p)
|
||||
"Return a \"hidden\" version of P--i.e., one that 'fold-packages' and thus,
|
||||
user interfaces, ignores."
|
||||
|
|
|
@ -626,6 +626,10 @@
|
|||
(build-derivations %store (list drv))
|
||||
(call-with-input-file output get-string-all)))
|
||||
|
||||
(test-equal "package-upstream-name*"
|
||||
(package-upstream-name* (specification->package "guile-gcrypt"))
|
||||
"gcrypt")
|
||||
|
||||
|
||||
;;;
|
||||
;;; Source derivation with snippets.
|
||||
|
|
Reference in New Issue