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:
		
							parent
							
								
									0e47b4e769
								
							
						
					
					
						commit
						62061d6be3
					
				
					 3 changed files with 40 additions and 2 deletions
				
			
		|  | @ -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 | ||||||
|  |  | ||||||
|  | @ -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 | ||||||
|  |  | ||||||
|  | @ -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 | ||||||
|  |  | ||||||
		Reference in a new issue