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:
parent
e946f2ec92
commit
e80c0f85ba
@ -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)))
|
||||||
|
Loading…
Reference in New Issue
Block a user