01/64: gnu-maintenance: Add X.org updater.

[Andy Wingo]

wingo pushed a commit to branch wip-xorg-server-1.18
in repository guix.

commit 6ed739a8c7d45d7a6a4cabf493b1cbad80b48002
Author: Andy Wingo <address@hidden>
Date:   Thu Feb 18 20:50:02 2016 +0100

    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.
---
 doc/guix.texi            |    2 ++
 guix/gnu-maintenance.scm |   37 ++++++++++++++++++++++++++++++++++++-
 guix/scripts/refresh.scm |    3 ++-
 3 files changed, 40 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index bac7389..ed17a63 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4612,6 +4612,8 @@ list of updaters).  Currently, @var{updater} may be one 
of:
 the updater for GNU packages;
 @item gnome
 the updater for GNOME packages;
address@hidden xorg
+the updater for X.org 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 96fbfb7..9d720ca 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -33,6 +33,7 @@
   #:use-module (guix records)
   #:use-module (guix upstream)
   #:use-module (guix packages)
+  #:use-module (gnu packages)
   #:export (gnu-package-name
             gnu-package-mundane-name
             gnu-package-copyright-holder
@@ -57,7 +58,8 @@
             gnu-package-name->name+version
 
             %gnu-updater
-            %gnome-updater))
+            %gnome-updater
+            %xorg-updater))
 
 ;;; Commentary:
 ;;;
@@ -508,6 +510,32 @@ elpa.gnu.org, and all the GNOME packages."
                        ;; checksums.
                        #: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
   (upstream-updater
    (name 'gnu)
@@ -522,4 +550,11 @@ elpa.gnu.org, and all the GNOME packages."
    (pred gnome-package?)
    (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
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index f9e3f31..964fdcc 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -31,7 +31,7 @@
   #:use-module (guix scripts graph)
   #:use-module (guix monads)
   #: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 cran)
   #:use-module (guix gnupg)
@@ -193,6 +193,7 @@ unavailable optional dependencies such as Guile-JSON."
   ;; List of "updaters" used by default.  They are consulted in this order.
   (list-updaters %gnu-updater
                  %gnome-updater
+                 %xorg-updater
                  %elpa-updater
                  %cran-updater
                  %bioconductor-updater