diff options
| -rw-r--r-- | doc/guix.texi | 2 | ||||
| -rw-r--r-- | guix/gnu-maintenance.scm | 62 | ||||
| -rw-r--r-- | guix/scripts/refresh.scm | 4 |
3 files changed, 56 insertions, 12 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 4c525a6476..309548be88 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4342,6 +4342,8 @@ list of updaters). Currently, @var{updater} may be one of: @table @code @item gnu the updater for GNU packages; +@item gnome +the updater for GNOME 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 7e990a50a8..5ca2923379 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -56,7 +56,8 @@ gnu-release-archive-types gnu-package-name->name+version - %gnu-updater)) + %gnu-updater + %gnome-updater)) ;;; Commentary: ;;; @@ -221,7 +222,6 @@ stored." ("mit-scheme" "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg") ("icecat" "ftp.gnu.org" "/gnu/gnuzilla") ("source-highlight" "ftp.gnu.org" "/gnu/src-highlite") - ("glib" "ftp.gnome.org" "/pub/gnome/sources/glib") ("gnutls" "ftp.gnutls.org" "/gcrypt/gnutls") ;; FIXME: ftp.texmacs.org is currently outdated; texmacs.org refers to @@ -406,19 +406,24 @@ right FTP server and directory for PACKAGE." #:directory directory rest))) -(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.)" +(define-syntax-rule (false-if-ftp-error exp) + "Return #f if an FTP error is raise while evaluating EXP; return the result +of EXP otherwise." (catch 'ftp-error (lambda () - (latest-release package)) + exp) (lambda (key port . rest) (if (ftp-connection? port) (ftp-close port) (close-port port)) #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 ;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses ;; "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 (match:substring match 1) (match:substring match 2))))) -(define (non-emacs-gnu-package? package) - "Return true if PACKAGE is a non-Emacs GNU package. This excludes AucTeX, -for instance, whose releases are now uploaded to elpa.gnu.org." +(define (pure-gnu-package? package) + "Return true if PACKAGE is a non-Emacs and non-GNOME GNU package. This +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))) + (not (gnome-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 (upstream-updater (name 'gnu) (description "Updater for GNU packages") - (pred non-emacs-gnu-package?) + (pred pure-gnu-package?) (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 diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 2341ae6777..a5834d12cc 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -30,7 +30,8 @@ #:use-module (guix graph) #:use-module (guix scripts graph) #: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 cran) #:use-module (guix gnupg) @@ -191,6 +192,7 @@ unavailable optional dependencies such as Guile-JSON." (define %updaters ;; List of "updaters" used by default. They are consulted in this order. (list-updaters %gnu-updater + %gnome-updater %elpa-updater %cran-updater ((guix import pypi) => %pypi-updater))) |