diff options
| -rw-r--r-- | doc/guix.texi | 6 | ||||
| -rw-r--r-- | guix/gnu-maintenance.scm | 14 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 34 |
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)) |