mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2026-06-11 04:04:08 +02:00
import/elpa: Fix some GNU-devel imports.
elpa-version->string construct the version (needed later to construct the full package name to fetch the archive...) from the version numbers given as a list from archive-contents. This list representation is documented in emacs's version-to-list and version-regexp-alist docstrings. In these list, A negative integer specify a non-numeric part of a version. Different non-numeric may lead to the same negative integer (e.g. 1.2.CVS, 1.2cvs, 1.2_Cvs, ...). If there is a negative integer, we need to gather more information because the list version present in archive-contents is not enough to reconstruct the archive address. We parse the ATOM feed at elpa.gnu.org/devel/PACKAGE.xml Tested on all packages. only loc-changes does not have an ATOM feed. * guix/import/elpa.scm (elpa-version->string): New repo and name arguments, use version-from-elpa-devel-feed if needed. (fetch-elpa-package): Upgrade elpa-version->string call. (latest-release): Same. (version-from-elpa-devel-feed): New function. Change-Id: Ic446d81593d9e6422c20a1ac427438e540e963b0 Signed-off-by: Liliana Marie Prikler <liliana.prikler@gmail.com>
This commit is contained in:
committed by
Liliana Marie Prikler
parent
a9dc4b996f
commit
80da50edf1
+41
-8
@@ -10,6 +10,7 @@
|
||||
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
|
||||
;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
|
||||
;;; Copyright © 2025 jgart <jgart@dismail.de>
|
||||
;;; Copyright © 2026 Yarl Baudig <yarl-baudig@mailoo.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@@ -30,6 +31,8 @@
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module ((sxml simple) #:select (xml->sxml))
|
||||
#:use-module ((sxml xpath) #:select (sxpath))
|
||||
#:use-module (web uri)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9)
|
||||
@@ -153,14 +156,44 @@ REPO."
|
||||
(elpa-package-name package)
|
||||
(elpa-package-version package))))
|
||||
|
||||
(define (elpa-version->string elpa-version)
|
||||
|
||||
(define (version-from-elpa-devel-feed name)
|
||||
(define rgx
|
||||
(make-regexp
|
||||
(string-append "tag:elpa[.]gnu[.]org/?,"
|
||||
"[0-9]{4}-[0-9]{2}-[0-9]{2}:((nongnu-)?(devel|packages))/"
|
||||
(regexp-quote name)
|
||||
"[.]xml#v(.*)")))
|
||||
(define url (string-append (elpa-url 'gnu-devel) "/" name ".xml"))
|
||||
(info (G_ "Trying to figure out version using ~s.~%") url)
|
||||
(match
|
||||
(call-with-downloaded-file
|
||||
url
|
||||
(lambda (port)
|
||||
(false-if-exception
|
||||
(let ((sxml (xml->sxml port
|
||||
#:namespaces '((atom . "http://www.w3.org/2005/Atom"))
|
||||
#:trim-whitespace? #t)))
|
||||
(match:substring
|
||||
(regexp-exec rgx (last ((sxpath '(// atom:entry atom:id *text*)) sxml)))
|
||||
4)))))
|
||||
(#f (leave (G_ "Failed to get version for ~s.~%") name))
|
||||
(v v)))
|
||||
|
||||
(define (elpa-version->string elpa-version repo name)
|
||||
"Convert the package version as used in Emacs package files into a string."
|
||||
(if (pair? elpa-version)
|
||||
(let-values (((ms rest) (match elpa-version
|
||||
((ms . rest)
|
||||
(values ms rest)))))
|
||||
(fold (lambda (n s) (string-append s "." (number->string n)))
|
||||
(number->string ms) rest))
|
||||
(if (every positive? elpa-version)
|
||||
(let-values (((ms rest) (match elpa-version
|
||||
((ms . rest)
|
||||
(values ms rest)))))
|
||||
(fold (lambda (n s) (string-append s "." (number->string n)))
|
||||
(number->string ms) rest))
|
||||
(begin
|
||||
(info (G_ "Package version for ~s contains non numeric part.~%") name)
|
||||
(if (eq? 'gnu-devel repo)
|
||||
(version-from-elpa-devel-feed name)
|
||||
#f)))
|
||||
#f))
|
||||
|
||||
(define (package-home-page alist)
|
||||
@@ -201,7 +234,7 @@ include VERSION."
|
||||
(match pkg
|
||||
((name version reqs synopsis kind . rest)
|
||||
(let* ((name (symbol->string name))
|
||||
(ver (elpa-version->string version))
|
||||
(ver (elpa-version->string version repo name))
|
||||
(url (package-source-url kind name ver repo)))
|
||||
(make-elpa-package name ver
|
||||
(ensure-list reqs) synopsis kind
|
||||
@@ -424,7 +457,7 @@ type '<elpa-package>'."
|
||||
(info
|
||||
(let* ((version (match info
|
||||
((name raw-version . _)
|
||||
(elpa-version->string raw-version))))
|
||||
(elpa-version->string raw-version repo name))))
|
||||
(url (match info
|
||||
((_ raw-version reqs synopsis kind . rest)
|
||||
(package-source-url kind name version repo))))
|
||||
|
||||
Reference in New Issue
Block a user