From 62061d6be3614dd84a1d0034dd5946f7e54fbaea Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@igalia.com>
Date: Thu, 18 Feb 2016 20:50:02 +0100
Subject: 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.
---
 guix/gnu-maintenance.scm | 37 ++++++++++++++++++++++++++++++++++++-
 1 file changed, 36 insertions(+), 1 deletion(-)

(limited to 'guix/gnu-maintenance.scm')

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 96fbfb76b4..9d720ca030 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
-- 
cgit v1.2.3