From 4a706908491daafc0493ab15297665eb2b9fce4e Mon Sep 17 00:00:00 2001
From: Andrew Tropin <andrew@trop.in>
Date: Fri, 2 Sep 2022 08:23:18 +0300
Subject: [PATCH v3] build-system: emacs: Add build-documentation phase.

Allows to build info files from texinfo, org or other markup files.

* guix/build-system/emacs.scm (default-texinfo, default-pandoc): New variable.
(lower)[build-inputs]: Add texinfo and pandoc.
* guix/build/emacs-build-system.scm (build-documentantion): New variable.
* guix/build/emacs-utils.scm (build-documentantion-texinfo,
build-documentation-org, convert-documentation): New variable.
* gnu/packages/emacs-xyz.scm (emacs-orderless)[arguments]: Remove custom
documentation build phase.
(emacs-org)[arguments]: Remove build-documentation as it already builds
documentation with make.
---
 gnu/packages/emacs-xyz.scm        | 21 ++++++-------
 guix/build-system/emacs.scm       | 16 +++++++++-
 guix/build/emacs-build-system.scm | 42 +++++++++++++++++++++++++-
 guix/build/emacs-utils.scm        | 49 +++++++++++++++++++++++++++++++
 4 files changed, 114 insertions(+), 14 deletions(-)

diff --git a/gnu/packages/emacs-xyz.scm b/gnu/packages/emacs-xyz.scm
index 074d4d1c4c..f6fb76258b 100644
--- a/gnu/packages/emacs-xyz.scm
+++ b/gnu/packages/emacs-xyz.scm
@@ -2974,6 +2974,7 @@ (define-public emacs-auctex
        #:exclude '("^tests/" "^latex/README")
        #:phases
        (modify-phases %standard-phases
+         (delete 'build-documentation)
          (add-after 'unpack 'configure
            (lambda* (#:key inputs #:allow-other-keys)
              (emacs-substitute-variables "preview.el"
@@ -9155,17 +9156,6 @@ (define-public emacs-orderless
         (base32 "0m9nyz80j0qnn14drbgk8vn5yr7sv0z6yiz8w95ahcw2qwlgyjs7"))
        (file-name (git-file-name name version))))
     (build-system emacs-build-system)
-    (arguments
-     `(#:phases
-       (modify-phases %standard-phases
-         (add-after 'install 'makeinfo
-           (lambda* (#:key outputs #:allow-other-keys)
-             (invoke "makeinfo" "orderless.texi")
-             (install-file "orderless.info"
-                           (string-append (assoc-ref outputs "out")
-                                          "/share/info")))))))
-    (native-inputs
-     (list texinfo))
     (home-page "https://github.com/oantolin/orderless")
     (synopsis "Emacs completion style that matches multiple regexps in any order")
     (description "This package provides an orderless completion style that
@@ -13250,6 +13240,7 @@ (define-public emacs-org
        #:phases
        (modify-phases %standard-phases
          (delete 'build)
+         (delete 'build-documentation)
          (add-before 'check 'make
            (lambda _
              (invoke "make" (string-append "ORGVERSION=" ,version))))
@@ -17846,7 +17837,13 @@ (define-public emacs-esxml
      `(#:emacs ,emacs                   ;need libxml
        ;; XXX: Only the two following files are meant to be packaged.
        ;; Byte-compiling the others Elisp files leads to build errors anyway.
-       #:include (list "esxml.el" "esxml-query.el")))
+       #:include (list "esxml.el" "esxml-query.el")
+       #:phases (modify-phases %standard-phases
+                  (add-before 'build-documentation 'fix-readme-org
+                    (lambda _
+                      (substitute* "README.org"
+                        ;; Fix malformed src block
+                        (("^#\\+BEGIN_SRC\\s$") "#+BEGIN_SRC html")))))))
     (propagated-inputs
      (list emacs-kv))
     (home-page "https://github.com/tali713/esxml/")
diff --git a/guix/build-system/emacs.scm b/guix/build-system/emacs.scm
index 3df68789ff..61746f26a5 100644
--- a/guix/build-system/emacs.scm
+++ b/guix/build-system/emacs.scm
@@ -56,6 +56,18 @@ (define (default-emacs)
   (let ((emacs-mod (resolve-interface '(gnu packages emacs))))
     (module-ref emacs-mod 'emacs-minimal)))
 
+(define (default-texinfo)
+  "Return the default texinfo package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((texinfo-mod (resolve-interface '(gnu packages texinfo))))
+    (module-ref texinfo-mod 'texinfo)))
+
+(define (default-pandoc)
+  "Return the default pandoc package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((pandoc-mod (resolve-interface '(gnu packages haskell-xyz))))
+    (module-ref pandoc-mod 'pandoc)))
+
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
                 (emacs (default-emacs))
@@ -77,7 +89,9 @@ (define private-keywords
                         ;; Keep the standard inputs of 'gnu-build-system'.
                         ,@(standard-packages)))
          (build-inputs `(("emacs" ,emacs)
-                         ,@native-inputs))
+                         ,@native-inputs
+                         ("pandoc" ,(default-pandoc))
+                         ("texinfo" ,(default-texinfo))))
          (outputs outputs)
          (build emacs-build)
          (arguments (strip-keyword-arguments private-keywords arguments)))))
diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm
index 6a6918bfdd..fe03fa975c 100644
--- a/guix/build/emacs-build-system.scm
+++ b/guix/build/emacs-build-system.scm
@@ -274,6 +274,45 @@ (define (match-stripped-file action regex)
                            (install-file? file stat #:verbose? #t)))
       #f))))
 
+(define* (build-documentation #:key outputs #:allow-other-keys)
+  (let* ((out (assoc-ref outputs "out"))
+         (library-root (with-directory-excursion (elpa-directory out)
+                         (find-root-library-file
+                          (store-directory->elpa-name-version out))))
+         (texi-file-name (if library-root
+                             (string-append library-root ".texi")
+                             #f))
+
+         (readme-regexp (make-regexp "README.*" regexp/icase))
+         (readme-files (find-files "." readme-regexp))
+         (readme-file (match readme-files
+                        ((file . _) file)
+                        (_ #f)))
+
+         (texi-regexp (string-append library-root "\\.texi"))
+         (texinfo-files (find-files "." texi-regexp)))
+
+    (if (null? texinfo-files)
+        (cond
+         ((and readme-file (string-suffix? ".org" readme-file))
+          ((build-documentation-org #:files (list readme-file))))
+         ((and readme-file texi-file-name)
+          ((convert-documentation #:mapping
+                                  `((,readme-file . ,texi-file-name))))
+          ((build-documentation-texinfo
+            #:files (list texi-file-name)
+            ;; Some README.md can have missing levels of subheadings or
+            ;; incorrect links, this is why --force is used.  Examples of such
+            ;; READMEs: emacs-avy, emacs-git-gutter, emacs-f.
+            #:command  '("makeinfo" "--no-split" "--force"))))
+         (else #t))
+
+        ((build-documentation-texinfo #:files texinfo-files)))
+
+        (for-each (lambda (f)
+                    (install-file f (string-append out %install-dir)))
+                  (find-files "." "\\.info$"))))
+
 (define* (move-doc #:key outputs #:allow-other-keys)
   "Move info files from the ELPA package directory to the info directory."
   (let* ((out (assoc-ref outputs "out"))
@@ -357,7 +396,8 @@ (define %standard-phases
     ;; The .el files are byte compiled directly in the store.
     (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)))
+    (add-after 'validate-compiled-autoloads 'move-doc move-doc)
+    (add-before 'move-doc 'build-documentation build-documentation)))
 
 (define* (emacs-build #:key inputs (phases %standard-phases)
                       #:allow-other-keys #:rest args)
diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm
index 8ee547f2b3..b7e0a3e939 100644
--- a/guix/build/emacs-utils.scm
+++ b/guix/build/emacs-utils.scm
@@ -36,6 +36,10 @@ (define-module (guix build emacs-utils)
             emacs-batch-error?
             emacs-batch-error-message
 
+            build-documentation-texinfo
+            build-documentation-org
+            convert-documentation
+
             emacs-generate-autoloads
             emacs-byte-compile-directory
             emacs-header-parse
@@ -100,6 +104,51 @@ (define (emacs-batch-script expr)
                          (message (read-string (car error-pipe)))))))
     output))
 
+
+;;;
+;;; Helpers for generating frequently used phases.
+;;;
+
+(define* (build-documentation-texinfo
+          #:key
+          (files '())
+          (command '("makeinfo" "--no-split")))
+  "Don't forget to add texinfo into list of inputs for the package."
+  (lambda* (#:key outputs #:allow-other-keys)
+    (for-each (lambda (f) (apply invoke (append command (list f)))) files)))
+
+(define* (build-documentation-org
+          #:key
+          (files '()))
+  "This is a preferred way over pandoc, because it keeps the meta information
+from in-buffer org settings.  Don't forget to add texinfo and emacs into list
+of inputs for the package."
+  (lambda* (#:key outputs #:allow-other-keys)
+    (for-each (lambda (f)
+                (emacs-batch-script
+                 `(progn
+                   (require 'ox-texinfo)
+                   (find-file ,f)
+                   (let ((org-export-use-babel nil)
+                         (org-texinfo-info-process
+                          '("makeinfo --force --no-split %f")))
+                     (org-texinfo-export-to-info))))) files)))
+
+(define* (convert-documentation
+          #:key
+          (mapping '())
+          (command '("pandoc")))
+  "Don't forget to add pandoc into list of inputs for the package."
+  (lambda* (#:key outputs #:allow-other-keys)
+    (for-each (lambda (p) (apply invoke
+                                 (append command
+                                         (list (car p) "-o" (cdr p)))))
+              mapping)))
+
+;;;
+;;; Helpers for generating frequently used phases ends here.
+;;;
+
 (define (emacs-generate-autoloads name directory)
   "Generate autoloads for Emacs package NAME placed in DIRECTORY."
   (let* ((file (string-append directory "/" name "-autoloads.el"))
-- 
2.37.2

