diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/packages.scm | 69 |
1 files changed, 1 insertions, 68 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm index b309a7806d..64a695d970 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> +;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,9 +23,6 @@ #:use-module (guix packages) #:use-module (guix ui) #:use-module (guix utils) - #:use-module ((guix ftp-client) #:select (ftp-open)) - #:use-module (guix gnu-maintenance) - #:use-module (guix upstream) #:use-module (ice-9 ftw) #:use-module (ice-9 vlist) #:use-module (ice-9 match) @@ -46,8 +44,6 @@ find-best-packages-by-name find-newest-available-packages - check-package-freshness - specification->package specification->package+output)) @@ -280,69 +276,6 @@ return its return value." (lambda (k signum) (handler signum)))) -(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)) - (call-with-sigint-handler - (lambda () - (dynamic-wind - (const #f) - (lambda () exp) - (lambda () - ;; Clear the line. - (display #\cr (current-error-port)) - (display blank (current-error-port)) - (display #\cr (current-error-port)) - (force-output (current-error-port))))) - (lambda (signum) - (format (current-error-port) " interrupted by signal ~a~%" SIGINT) - #f)))) - -(define ftp-open* - ;; Memoizing version of `ftp-open'. The goal is to avoid initiating a new - ;; FTP connection for each package, esp. since most of them are to the same - ;; server. This has a noticeable impact when doing "guix upgrade -u". - (memoize ftp-open)) - -(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. - - (catch #t - (lambda () - (when (false-if-exception (gnu-package? package)) - (let ((name (package-name package)) - (full-name (package-full-name package))) - ;; XXX: This could work with non-GNU packages as well. However, - ;; GNU's FTP-based updater would be too slow if it weren't memoized, - ;; and the generic interface in (guix upstream) doesn't support - ;; that. - (match (waiting (latest-release name - #:ftp-open ftp-open* - #:ftp-close (const #f)) - (_ "looking for the latest release of GNU ~a...") name) - ((? upstream-source? source) - (let ((latest-version - (string-append (upstream-source-package source) "-" - (upstream-source-version source)))) - (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))))) - (lambda (key . args) - ;; Silently ignore networking errors rather than preventing - ;; installation. - (case key - ((getaddrinfo-error ftp-error) #f) - (else (apply throw key args)))))) - (define (specification->package spec) "Return a package matching SPEC. SPEC may be a package name, or a package name followed by a hyphen and a version number. If the version number is not |