gnu-maintenance: Add X.org updater.

* guix/gnu-maintenance.scm (xorg-package?, latest-xorg-release): New
  private functions.
  (%xorg-updater): New public variable.

* guix/scripts/refresh.scm (%updaters): Add %xorg-updater.

* doc/guix.texi (Invoking guix refresh): Mention the new updater.
This commit is contained in:
Andy Wingo 2016-02-18 20:50:02 +01:00 committed by Mark H Weaver
parent 0e47b4e769
commit 62061d6be3
3 changed files with 40 additions and 2 deletions

View File

@ -4616,6 +4616,8 @@ list of updaters). Currently, @var{updater} may be one of:
the updater for GNU packages; the updater for GNU packages;
@item gnome @item gnome
the updater for GNOME packages; the updater for GNOME packages;
@item xorg
the updater for X.org 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

View File

@ -33,6 +33,7 @@
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix upstream) #:use-module (guix upstream)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (gnu packages)
#:export (gnu-package-name #:export (gnu-package-name
gnu-package-mundane-name gnu-package-mundane-name
gnu-package-copyright-holder gnu-package-copyright-holder
@ -57,7 +58,8 @@
gnu-package-name->name+version gnu-package-name->name+version
%gnu-updater %gnu-updater
%gnome-updater)) %gnome-updater
%xorg-updater))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -508,6 +510,32 @@ elpa.gnu.org, and all the GNOME packages."
;; checksums. ;; checksums.
#:file->signature (const #f)))) #:file->signature (const #f))))
(define (xorg-package? package)
"Return true if PACKAGE is an X.org package, developed by X.org."
(define xorg-uri?
(match-lambda
((? string? uri)
(string-prefix? "mirror://xorg/" uri))
(_
#f)))
(match (package-source package)
((? origin? origin)
(match (origin-uri origin)
((? xorg-uri?) #t)
(_ #f)))
(_ #f)))
(define (latest-xorg-release package)
"Return the latest release of PACKAGE, the name of an X.org package."
(let ((uri (string->uri (origin-uri (package-source (specification->package package))))))
(false-if-ftp-error
(latest-ftp-release
package
#:server "ftp.freedesktop.org"
#:directory
(string-append "/pub/xorg/" (dirname (uri-path uri)))))))
(define %gnu-updater (define %gnu-updater
(upstream-updater (upstream-updater
(name 'gnu) (name 'gnu)
@ -522,4 +550,11 @@ elpa.gnu.org, and all the GNOME packages."
(pred gnome-package?) (pred gnome-package?)
(latest latest-gnome-release))) (latest latest-gnome-release)))
(define %xorg-updater
(upstream-updater
(name 'xorg)
(description "Updater for X.org packages")
(pred xorg-package?)
(latest latest-xorg-release)))
;;; gnu-maintenance.scm ends here ;;; gnu-maintenance.scm ends here

View File

@ -32,7 +32,7 @@
#:use-module (guix scripts graph) #:use-module (guix scripts graph)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module ((guix gnu-maintenance) #:use-module ((guix gnu-maintenance)
#:select (%gnu-updater %gnome-updater)) #:select (%gnu-updater %gnome-updater %xorg-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)
@ -194,6 +194,7 @@ unavailable optional dependencies such as Guile-JSON."
;; 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 %gnome-updater
%xorg-updater
%elpa-updater %elpa-updater
%cran-updater %cran-updater
%bioconductor-updater %bioconductor-updater