From e80c0f85ba3429d0a43830247a2212ed93f67d49 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 7 Dec 2015 23:23:46 +0100 Subject: [PATCH] gnu-maintenance: Add GNOME updater. * guix/gnu-maintenance.scm (ftp-server/directory)[quirks]: Remove glib. (false-if-ftp-error): New macro. (latest-release*): Use it. (non-emacs-gnu-package?): Rename to... (pure-gnu-package?): ... this. Add call to 'gnome-package?'. (%gnu-updater): Adjust accordingly. (gnome-package?, latest-gnome-release): New procedures. (%gnome-updater): New variable. * guix/scripts/refresh.scm (%updaters): Add %GNOME-UPDATER. * doc/guix.texi (Invoking guix refresh): Mention it. --- doc/guix.texi | 2 ++ guix/gnu-maintenance.scm | 62 +++++++++++++++++++++++++++++++++------- guix/scripts/refresh.scm | 4 ++- 3 files changed, 56 insertions(+), 12 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 4c525a6476..309548be88 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4342,6 +4342,8 @@ list of updaters). Currently, @var{updater} may be one of: @table @code @item gnu the updater for GNU packages; +@item gnome +the updater for GNOME packages; @item elpa the updater for @uref{http://elpa.gnu.org/, ELPA} packages; @item cran diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 7e990a50a8..5ca2923379 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -56,7 +56,8 @@ gnu-release-archive-types gnu-package-name->name+version - %gnu-updater)) + %gnu-updater + %gnome-updater)) ;;; Commentary: ;;; @@ -221,7 +222,6 @@ stored." ("mit-scheme" "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg") ("icecat" "ftp.gnu.org" "/gnu/gnuzilla") ("source-highlight" "ftp.gnu.org" "/gnu/src-highlite") - ("glib" "ftp.gnome.org" "/pub/gnome/sources/glib") ("gnutls" "ftp.gnutls.org" "/gcrypt/gnutls") ;; FIXME: ftp.texmacs.org is currently outdated; texmacs.org refers to @@ -406,19 +406,24 @@ right FTP server and directory for PACKAGE." #:directory directory rest))) -(define (latest-release* package) - "Like 'latest-release', but ignore FTP errors that might occur when PACKAGE -is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that -name (this is the case for \"emacs-auctex\", for instance.)" +(define-syntax-rule (false-if-ftp-error exp) + "Return #f if an FTP error is raise while evaluating EXP; return the result +of EXP otherwise." (catch 'ftp-error (lambda () - (latest-release package)) + exp) (lambda (key port . rest) (if (ftp-connection? port) (ftp-close port) (close-port port)) #f))) +(define (latest-release* package) + "Like 'latest-release', but ignore FTP errors that might occur when PACKAGE +is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that +name (this is the case for \"emacs-auctex\", for instance.)" + (false-if-ftp-error (latest-release package))) + (define %package-name-rx ;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses ;; "TeXmacs-X.Y-src", the `-src' suffix is allowed. @@ -431,17 +436,52 @@ name (this is the case for \"emacs-auctex\", for instance.)" (values name+version #f) (values (match:substring match 1) (match:substring match 2))))) -(define (non-emacs-gnu-package? package) - "Return true if PACKAGE is a non-Emacs GNU package. This excludes AucTeX, -for instance, whose releases are now uploaded to elpa.gnu.org." +(define (pure-gnu-package? package) + "Return true if PACKAGE is a non-Emacs and non-GNOME GNU package. This +excludes AucTeX, for instance, whose releases are now uploaded to +elpa.gnu.org, and all the GNOME packages." (and (not (string-prefix? "emacs-" (package-name package))) + (not (gnome-package? package)) (gnu-package? package))) +(define (gnome-package? package) + "Return true if PACKAGE is a GNOME package, hosted on gnome.org." + (define gnome-uri? + (match-lambda + ((? string? uri) + (string-prefix? "mirror://gnome/" uri)) + (_ + #f))) + + (match (package-source package) + ((? origin? origin) + (match (origin-uri origin) + ((? gnome-uri?) #t) + (_ #f))) + (_ #f))) + +(define (latest-gnome-release package) + "Return the latest release of PACKAGE, the name of a GNOME package." + (false-if-ftp-error + (latest-ftp-release package + #:server "ftp.gnome.org" + #:directory (string-append "/pub/gnome/sources/" + (match package + ("gconf" "GConf") + (x x)))))) + (define %gnu-updater (upstream-updater (name 'gnu) (description "Updater for GNU packages") - (pred non-emacs-gnu-package?) + (pred pure-gnu-package?) (latest latest-release*))) +(define %gnome-updater + (upstream-updater + (name 'gnome) + (description "Updater for GNOME packages") + (pred gnome-package?) + (latest latest-gnome-release))) + ;;; gnu-maintenance.scm ends here diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 2341ae6777..a5834d12cc 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -30,7 +30,8 @@ #:use-module (guix graph) #:use-module (guix scripts graph) #:use-module (guix monads) - #:use-module ((guix gnu-maintenance) #:select (%gnu-updater)) + #:use-module ((guix gnu-maintenance) + #:select (%gnu-updater %gnome-updater)) #:use-module (guix import elpa) #:use-module (guix import cran) #:use-module (guix gnupg) @@ -191,6 +192,7 @@ unavailable optional dependencies such as Guile-JSON." (define %updaters ;; List of "updaters" used by default. They are consulted in this order. (list-updaters %gnu-updater + %gnome-updater %elpa-updater %cran-updater ((guix import pypi) => %pypi-updater)))