~ruther/guix-local

e80c0f85ba3429d0a43830247a2212ed93f67d49 — Ludovic Courtès 10 years ago e946f2e
gnu-maintenance: Add GNOME updater.

* guix/gnu-maintenance.scm (ftp-server/directory)[quirks]: Remove glib.
(false-if-ftp-error): New macro.
(latest-release*): Use it.
(non-emacs-gnu-package?): Rename to...
(pure-gnu-package?): ... this.  Add call to 'gnome-package?'.
(%gnu-updater): Adjust accordingly.
(gnome-package?, latest-gnome-release): New procedures.
(%gnome-updater): New variable.
* guix/scripts/refresh.scm (%updaters): Add %GNOME-UPDATER.
* doc/guix.texi (Invoking guix refresh): Mention it.
3 files changed, 56 insertions(+), 12 deletions(-)

M doc/guix.texi
M guix/gnu-maintenance.scm
M guix/scripts/refresh.scm
M doc/guix.texi => doc/guix.texi +2 -0
@@ 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

M guix/gnu-maintenance.scm => guix/gnu-maintenance.scm +51 -11
@@ 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

M guix/scripts/refresh.scm => guix/scripts/refresh.scm +3 -1
@@ 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)))