01/02: build-system: emacs: Ensure that package descriptions are generated.

[guix-commits]

lilyp pushed a commit to branch master
in repository guix.

commit f38697f5f86de0ad5434b5c5679b6cff34c86797
Author: Andrew Tropin <andrew@trop.in>
AuthorDate: Thu Dec 9 12:01:46 2021 +0300

    build-system: emacs: Ensure that package descriptions are generated.
    
    This patch addresses the second part of <https://bugs.gnu.org/48331>.
    While existing -pkg.el files were previously installed, no such files
    were generated for packages lacking them, resulting in packages not
    being listed as installed and not being available towards
    “describe-package”.
    
    * guix/build/emacs-build-system.scm (find-root-library-file)
    (ensure-package-description): New variables.
    (%standard-phases): Add ‘ensure-package-description’.
    
    Signed-off-by: Liliana Marie Prikler <liliana.prikler@gmail.com>
---
 guix/build/emacs-build-system.scm | 77 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 76 insertions(+), 1 deletion(-)

diff --git a/guix/build/emacs-build-system.scm 
b/guix/build/emacs-build-system.scm
index ab77e57f33..6a6918bfdd 100644
--- a/guix/build/emacs-build-system.scm
+++ b/guix/build/emacs-build-system.scm
@@ -140,6 +140,79 @@ store in '.el' files."
           (substitute-program-names))))
     #t))
 
+(define (find-root-library-file name)
+  (let loop ((parts (string-split
+                     (package-name-version->elpa-name-version name) #\-))
+             (candidate ""))
+    (cond
+     ;; at least one version part is given, so we don't terminate "early"
+     ((null? parts) #f)
+     ((string-null? candidate) (loop (cdr parts) (car parts)))
+     ((file-exists? (string-append candidate ".el")) candidate)
+     (else
+      (loop (cdr parts) (string-append candidate "-" (car parts)))))))
+
+(define* (ensure-package-description #:key outputs #:allow-other-keys)
+  (define (write-pkg-file name)
+    (define summary-regexp
+      "^;;; [^ ]*\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$")
+    (define %write-pkg-file-form
+      `(progn
+        (require 'lisp-mnt)
+        (require 'package)
+
+        (defun build-package-desc-from-library (name)
+          (package-desc-from-define
+           name
+           ;; Workaround for malformed version string (for example "24 (beta)"
+           ;; in paredit.el), try to parse version obtained by lm-version,
+           ;; before trying to create package-desc.  Otherwise the whole 
process
+           ;; of generation -pkg.el will fail.
+           (condition-case
+            nil
+            (let ((version (lm-version)))
+              ;; raises an error if version is invalid
+              (and (version-to-list version) version))
+            (error "0.0.0"))
+           (or (save-excursion
+                (goto-char (point-min))
+                (and (re-search-forward ,summary-regexp nil t)
+                     (match-string-no-properties 1)))
+               package--default-summary)
+           (let ((require-lines (lm-header-multiline "package-requires")))
+             (and require-lines
+                  (package--prepare-dependencies
+                   (package-read-from-string
+                    (mapconcat 'identity require-lines " ")))))
+           :kind       'single
+           :url        (lm-homepage)
+           :keywords   (lm-keywords-list)
+           :maintainer (lm-maintainer)
+           :authors    (lm-authors)))
+
+        (defun generate-package-description-file (name)
+          (package-generate-description-file
+           (build-package-desc-from-library name)
+           (concat name "-pkg.el")))
+
+        (condition-case
+         err
+         (let ((name (file-name-base (buffer-file-name))))
+           (generate-package-description-file name)
+           (message (concat name "-pkg.el file generated.")))
+         (error
+          (message "There are some errors during generation of -pkg.el file:")
+          (message "%s" (error-message-string err))))))
+
+    (unless (file-exists? (string-append name "-pkg.el"))
+      (emacs-batch-edit-file (string-append name ".el")
+        %write-pkg-file-form)))
+
+  (let* ((out (assoc-ref outputs "out"))
+         (elpa-name-ver (store-directory->elpa-name-version out)))
+    (with-directory-excursion (elpa-directory out)
+      (and=> (find-root-library-file elpa-name-ver) write-pkg-file))))
+
 (define* (check #:key tests? (test-command '("make" "check"))
                 (parallel-tests? #t) #:allow-other-keys)
   "Run the tests by invoking TEST-COMMAND.
@@ -279,8 +352,10 @@ for libraries following the ELPA convention."
     (add-after 'make-autoloads 'enable-autoloads-compilation
       enable-autoloads-compilation)
     (add-after 'enable-autoloads-compilation 'patch-el-files patch-el-files)
+    (add-after 'patch-el-files 'ensure-package-description
+      ensure-package-description)
     ;; The .el files are byte compiled directly in the store.
-    (add-after 'patch-el-files 'build build)
+    (add-after 'ensure-package-description 'build build)
     (add-after 'build 'validate-compiled-autoloads validate-compiled-autoloads)
     (add-after 'validate-compiled-autoloads 'move-doc move-doc)))