aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-03-05 20:30:27 +0100
committerLudovic Courtès <ludo@gnu.org>2013-03-05 20:35:47 +0100
commitef010c0f3d414f7107de80e0835d1e347b04315b (patch)
tree356bc3ac554f76b9655b446c52c2599509f70370
parentc50cbfd61a540e120b922fa16bf6ab8533c37b0b (diff)
downloadpatches-ef010c0f3d414f7107de80e0835d1e347b04315b.tar
patches-ef010c0f3d414f7107de80e0835d1e347b04315b.tar.gz
guix package: Inform about new upstream versions of GNU packages.
* guix/gnu-maintenance.scm (gnu-package?): New procedure. * guix/scripts/package.scm (waiting): New macro. (check-package-freshness): New procedure. (guix-package)[process-actions]: Use it. * doc/guix.texi (Invoking guix package): Mention the feature.
-rw-r--r--doc/guix.texi6
-rw-r--r--guix/gnu-maintenance.scm14
-rw-r--r--guix/scripts/package.scm34
3 files changed, 54 insertions, 0 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index a07c277e70..1be172c3f6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -514,6 +514,12 @@ Thus, when installing MPC, the MPFR and GMP libraries also get installed
in the profile; removing MPC also removes MPFR and GMP---unless they had
also been explicitly installed independently.
+@c XXX: keep me up-to-date
+Besides, when installing a GNU package, the tool reports the
+availability of a newer upstream version. In the future, it may provide
+the option of installing directly from the upstream version, even if
+that version is not yet in the distribution.
+
@item --install-from-expression=@var{exp}
@itemx -e @var{exp}
Install the package @var{exp} evaluates to.
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 6475c386d3..981bb81919 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -29,7 +29,9 @@
#:use-module (system foreign)
#:use-module (guix ftp-client)
#:use-module (guix utils)
+ #:use-module (guix packages)
#:export (official-gnu-packages
+ gnu-package?
releases
latest-release
gnu-package-name->name+version))
@@ -74,6 +76,18 @@
(and=> (regexp-exec %package-line-rx line)
(cut match:substring <> 1)))
lst)))
+
+(define gnu-package?
+ (memoize
+ (lambda (package)
+ "Return true if PACKAGE is a GNU package. This procedure may access the
+network to check in GNU's database."
+ ;; TODO: Find a way to determine that a package is non-GNU without going
+ ;; through the network.
+ (let ((url (origin-uri (package-source package))))
+ (or (string-prefix? "mirror://gnu" url)
+ (member (package-name package) (official-gnu-packages)))))))
+
;;;
;;; Latest release.
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index ccca614d88..61b2f0570d 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -39,6 +39,7 @@
#:use-module (gnu packages)
#:use-module ((gnu packages base) #:select (guile-final))
#:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
+ #:use-module (guix gnu-maintenance)
#:export (guix-package))
(define %store
@@ -266,6 +267,38 @@ matching packages."
(assoc-ref (derivation-outputs drv) sub-drv))))
`(,name ,out))))))
+(define-syntax-rule (waiting exp fmt rest ...)
+ "Display the given message while EXP is being evaluated."
+ (let* ((message (format #f fmt rest ...))
+ (blank (make-string (string-length message) #\space)))
+ (display message (current-error-port))
+ (force-output (current-error-port))
+ (let ((result exp))
+ ;; Clear the line.
+ (display #\cr (current-error-port))
+ (display blank (current-error-port))
+ (display #\cr (current-error-port))
+ (force-output (current-error-port))
+ exp)))
+
+(define (check-package-freshness package)
+ "Check whether PACKAGE has a newer version available upstream, and report
+it."
+ ;; TODO: Automatically inject the upstream version when desired.
+ (when (gnu-package? package)
+ (let ((name (package-name package))
+ (full-name (package-full-name package)))
+ (match (waiting (latest-release name)
+ (_ "looking for the latest release of GNU ~a...") name)
+ ((latest-version . _)
+ (when (version>? latest-version full-name)
+ (format (current-error-port)
+ (_ "~a: note: using ~a \
+but ~a is available upstream~%")
+ (location->string (package-location package))
+ full-name latest-version)))
+ (_ #t)))))
+
;;;
;;; Command-line options.
@@ -547,6 +580,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
((name version sub-drv
(? package? package)
(deps ...))
+ (check-package-freshness package)
(package-derivation (%store) package))
(_ #f))
install))