diff options
| -rw-r--r-- | guix/import/elpa.scm | 49 |
1 files changed, 41 insertions, 8 deletions
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index bb7d50dff8b..9f0a8a0adcf 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -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)))) |