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.
This commit is contained in:
Ludovic Courtès 2015-12-07 23:23:46 +01:00
parent e946f2ec92
commit e80c0f85ba
3 changed files with 56 additions and 12 deletions

@ -4342,6 +4342,8 @@ list of updaters). Currently, @var{updater} may be one of:
@table @code @table @code
@item gnu @item gnu
the updater for GNU packages; the updater for GNU packages;
@item gnome
the updater for GNOME packages;
@item elpa @item elpa
the updater for @uref{http://elpa.gnu.org/, ELPA} packages; the updater for @uref{http://elpa.gnu.org/, ELPA} packages;
@item cran @item cran

@ -56,7 +56,8 @@
gnu-release-archive-types gnu-release-archive-types
gnu-package-name->name+version gnu-package-name->name+version
%gnu-updater)) %gnu-updater
%gnome-updater))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -221,7 +222,6 @@ stored."
("mit-scheme" "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg") ("mit-scheme" "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg")
("icecat" "ftp.gnu.org" "/gnu/gnuzilla") ("icecat" "ftp.gnu.org" "/gnu/gnuzilla")
("source-highlight" "ftp.gnu.org" "/gnu/src-highlite") ("source-highlight" "ftp.gnu.org" "/gnu/src-highlite")
("glib" "ftp.gnome.org" "/pub/gnome/sources/glib")
("gnutls" "ftp.gnutls.org" "/gcrypt/gnutls") ("gnutls" "ftp.gnutls.org" "/gcrypt/gnutls")
;; FIXME: ftp.texmacs.org is currently outdated; texmacs.org refers to ;; FIXME: ftp.texmacs.org is currently outdated; texmacs.org refers to
@ -406,19 +406,24 @@ right FTP server and directory for PACKAGE."
#:directory directory #:directory directory
rest))) rest)))
(define (latest-release* package) (define-syntax-rule (false-if-ftp-error exp)
"Like 'latest-release', but ignore FTP errors that might occur when PACKAGE "Return #f if an FTP error is raise while evaluating EXP; return the result
is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that of EXP otherwise."
name (this is the case for \"emacs-auctex\", for instance.)"
(catch 'ftp-error (catch 'ftp-error
(lambda () (lambda ()
(latest-release package)) exp)
(lambda (key port . rest) (lambda (key port . rest)
(if (ftp-connection? port) (if (ftp-connection? port)
(ftp-close port) (ftp-close port)
(close-port port)) (close-port port))
#f))) #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 (define %package-name-rx
;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses ;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses
;; "TeXmacs-X.Y-src", the `-src' suffix is allowed. ;; "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 name+version #f)
(values (match:substring match 1) (match:substring match 2))))) (values (match:substring match 1) (match:substring match 2)))))
(define (non-emacs-gnu-package? package) (define (pure-gnu-package? package)
"Return true if PACKAGE is a non-Emacs GNU package. This excludes AucTeX, "Return true if PACKAGE is a non-Emacs and non-GNOME GNU package. This
for instance, whose releases are now uploaded to elpa.gnu.org." 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))) (and (not (string-prefix? "emacs-" (package-name package)))
(not (gnome-package? package))
(gnu-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 (define %gnu-updater
(upstream-updater (upstream-updater
(name 'gnu) (name 'gnu)
(description "Updater for GNU packages") (description "Updater for GNU packages")
(pred non-emacs-gnu-package?) (pred pure-gnu-package?)
(latest latest-release*))) (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 ;;; gnu-maintenance.scm ends here

@ -30,7 +30,8 @@
#:use-module (guix graph) #:use-module (guix graph)
#:use-module (guix scripts graph) #:use-module (guix scripts graph)
#:use-module (guix monads) #: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 elpa)
#:use-module (guix import cran) #:use-module (guix import cran)
#:use-module (guix gnupg) #:use-module (guix gnupg)
@ -191,6 +192,7 @@ unavailable optional dependencies such as Guile-JSON."
(define %updaters (define %updaters
;; List of "updaters" used by default. They are consulted in this order. ;; List of "updaters" used by default. They are consulted in this order.
(list-updaters %gnu-updater (list-updaters %gnu-updater
%gnome-updater
%elpa-updater %elpa-updater
%cran-updater %cran-updater
((guix import pypi) => %pypi-updater))) ((guix import pypi) => %pypi-updater)))