[elpa] scratch/prettify-readme.org 1a42fb8 1/3: * elpa-admin.el: Export Org readmes to ASCII and HTML

[Stefan Monnier]

branch: scratch/prettify-readme.org
commit 1a42fb824b33b0c4f3a5c30d63d40e57d506a6ef
Author: Adam Porter <adam@alphapapa.net>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * elpa-admin.el: Export Org readmes to ASCII and HTML
    
    (elpaa--export-org, elpaa--section-to-plain-text,
    elpaa--section-to-html): New functions.
    
    (elpaa--org-export-options): New variable.
    
    (elpaa--get-section): Return (TYPE . CONTENT) cons.
    
    (elpaa--html-make-pkg): Export Org readmes to HTML and plain-text, and
    other readme formats to plain-text.
    
    (elpaa--get-README): Remove function.
    
    See discussion at
    <https://lists.gnu.org/archive/html/emacs-devel/2021-09/msg00108.html>.
    
    Thanks to Stefan Monnier for his guidance.
---
 elpa-admin.el | 180 +++++++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 135 insertions(+), 45 deletions(-)

diff --git a/elpa-admin.el b/elpa-admin.el
index ac72f2f..19a787e 100644
--- a/elpa-admin.el
+++ b/elpa-admin.el
@@ -69,6 +69,11 @@ to be installed and has only been tested on some Debian 
systems.")
 
 (defvar elpaa--debug nil)
 
+(defvar elpaa--org-export-options
+  '(:with-author nil :with-creator nil :with-broken-links t)
+  "Options used common to all Org export backends.
+See variable `org-export-options-alist'.")
+
 (unless (fboundp 'ignore-error)
   (defmacro ignore-error (condition &rest body)
     `(condition-case nil (progn ,@body) (,condition nil))))
@@ -1167,10 +1172,57 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
          (insert-file-contents mainsrcfile)
          (lm-header prop))))))
 
+(defun elpaa--section-to-plain-text (section)
+  "Return SECTION as plain text.
+SECTION should be a cons as returned by `elpaa--get-section',
+which see.  If SECTION's type is \"text/plain\" or
+\"text/markdown\", its contents are returned as-is.  If
+\"application/x-org\", its contents are exported to UTF-8 plain
+text with `elpaa--export-org', which see."
+  (pcase-exhaustive section
+    (`(,(or "text/plain" "text/markdown") . ,content)
+     content)
+    (`("text/x-org" . ,content)
+     (let ((temp-file (make-temp-file "elpaa--section-to-plain-text--")))
+       (unwind-protect
+           (progn
+             (with-temp-file temp-file
+               (insert content))
+             (elpaa--export-org temp-file 'ascii
+               :ext-plist (append '(:ascii-charset utf-8)
+                                  elpaa--org-export-options)))
+         (delete-file temp-file))))))
+
+(defun elpaa--section-to-html (section)
+  "Return SECTION as HTML.
+SECTION should be a cons as returned by `elpaa--get-section',
+which see.  If SECTION's type is \"text/plain\" or
+\"text/markdown\", its contents are escaped with
+`elpaa--html-quote' and wrapped in HTML PRE tags.  If
+\"application/x-org\", its contents are exported to HTML with
+`elpaa--export-org', which see."
+  (pcase-exhaustive section
+    (`(,(or "text/plain" "text/markdown") . ,content)
+     (concat "<pre>\n"
+             (elpaa--html-quote content)
+             "\n</pre>\n"))
+    (`("text/x-org" . ,content)
+     (let ((temp-file (make-temp-file "elpaa--section-to-html--")))
+       (unwind-protect
+           (progn
+             (with-temp-file temp-file
+               (insert content))
+             (elpaa--export-org temp-file 'html
+               :body-only t
+               :ext-plist elpaa--org-export-options))
+         (delete-file temp-file))))))
+
 (defun elpaa--get-section (header file srcdir pkg-spec)
-  "Return specified section as a string from SRCDIR for PKG-SPEC.
-If FILE is readable in SRCDIR, return its contents.  Otherwise
-return section under HEADER in package's main file."
+  "Return specified section for PKG-SPEC.
+Returns (TYPE . CONTENT) cons, where TYPE is a MIME-type string,
+and CONTENT is the content string.  If FILE is readable in
+SRCDIR, return its contents.  Otherwise return section under
+HEADER in package's main file."
   (when (consp file)
     (while (cdr-safe file)
       (setq file
@@ -1180,44 +1232,73 @@ return section under HEADER in package's main file."
     (when (consp file) (setq file (car file))))
   (cond
    ((file-readable-p (expand-file-name file srcdir))
-    (with-temp-buffer
-      (insert-file-contents (expand-file-name file srcdir))
-      (buffer-string)))
+    ;; Return FILE's contents.
+    (let ((type
+           (pcase (mailcap-extension-to-mime (file-name-extension file))
+             ((and `nil
+                   (guard (member-ignore-case
+                           (file-name-extension file) '("md" "markdown"))))
+              ;; `mailcap-extension-to-mime' returns nil for Markdown
+              ;; files, at least on Emacs 26.3.
+              "text/markdown")
+             (else else)))
+          (content (with-temp-buffer
+                     (insert-file-contents (expand-file-name file srcdir))
+                     (buffer-string))))
+      (cons type content)))
    ((file-readable-p (expand-file-name (elpaa--main-file pkg-spec) srcdir))
-    (with-temp-buffer
-      (insert-file-contents
-       (expand-file-name (elpaa--main-file pkg-spec) srcdir))
-      (emacs-lisp-mode) ;lm-section-start needs the outline-mode setting.
-      (let ((start (lm-section-start header)))
-        (when start
-          ;; FIXME: Emacs<28 had a bug in `lm-section-end', so cook up
-          ;; our own ad-hoc replacement.
-          (goto-char start) (forward-line 1)
-          (re-search-forward "^\\(;;;[^;\n]\\|[^; \n]\\)" nil t)
-          (insert
-           (prog1
-               (buffer-substring start (match-beginning 0))
-             (erase-buffer)))
-          (emacs-lisp-mode)
-          (goto-char (point-min))
-          (delete-region (point) (line-beginning-position 2))
-          (uncomment-region (point-min) (point-max))
-          (when (looking-at "^\\([ \t]*\n\\)+")
-            (replace-match ""))
-          (goto-char (point-max))
-          (skip-chars-backward " \t\n")
-          (delete-region (point) (point-max))
-          (buffer-string)))))))
-
-(defun elpaa--get-README (pkg-spec dir)
-  (elpaa--get-section
-   "Commentary" (elpaa--spec-get pkg-spec :readme
-                                 '("README" "README.rst"
-                                   ;; Most README.md files seem to be currently
-                                   ;; worse than the Commentary: section :-(
-                                   ;; "README.md"
-                                   "README.org"))
-   dir pkg-spec))
+    ;; Return specified section from package's main source file.
+    (let ((type "text/plain")
+          (content (with-temp-buffer
+                     (insert-file-contents
+                      (expand-file-name (elpaa--main-file pkg-spec) srcdir))
+                     (emacs-lisp-mode) ;lm-section-start needs the 
outline-mode setting.
+                     (let ((start (lm-section-start header)))
+                       (when start
+                         ;; FIXME: Emacs<28 had a bug in `lm-section-end', so 
cook up
+                         ;; our own ad-hoc replacement.
+                         (goto-char start) (forward-line 1)
+                         (re-search-forward "^\\(;;;[^;\n]\\|[^; \n]\\)" nil t)
+                         (insert
+                          (prog1
+                              (buffer-substring start (match-beginning 0))
+                            (erase-buffer)))
+                         (emacs-lisp-mode)
+                         (goto-char (point-min))
+                         (delete-region (point) (line-beginning-position 2))
+                         (uncomment-region (point-min) (point-max))
+                         (when (looking-at "^\\([ \t]*\n\\)+")
+                           (replace-match ""))
+                         (goto-char (point-max))
+                         (skip-chars-backward " \t\n")
+                         (delete-region (point) (point-max))
+                         (buffer-string))))))
+      (cons type content)))))
+
+(cl-defun elpaa--export-org (file backend &key body-only ext-plist)
+  "Return Org FILE as an exported string.
+BACKEND and EXT-PLIST are passed to `org-export-as', which see.
+Uses `elpaa--call-sandboxed', since exporting with Org may run
+arbitrary code."
+  (declare (indent defun))
+  (cl-check-type backend symbol)
+  (cl-assert (memq body-only '(nil t)) t
+             "BODY-ONLY may only be nil or t")
+  ;; "emacs --batch" loads site-init files, which may pollute output,
+  ;; so we write it to a temp file.
+  (let ((output-filename (make-temp-file "elpaa--export-org-")))
+    (unwind-protect
+        (progn
+          (with-temp-buffer
+            (elpaa--call-sandboxed
+             t "emacs" "--batch" "-l" (format "ox-%S" backend)
+             file
+             "--eval" (format "(write-region (org-export-as '%s nil nil %S 
'%S) nil %S)"
+                              backend body-only ext-plist output-filename)))
+          (with-temp-buffer
+            (insert-file-contents output-filename)
+            (buffer-string)))
+      (delete-file output-filename))))
 
 (defun elpaa--get-NEWS (pkg-spec dir)
   (let ((text
@@ -1313,11 +1394,20 @@ return section under HEADER in package's main file."
       (insert (format "<p>To install this package, run in Emacs:</p>
                        <pre>M-x <span class=\"kw\">package-install</span> RET 
<span class=\"kw\">%s</span> RET</pre>"
                       name))
-      (let ((rm (elpaa--get-README pkg-spec srcdir)))
-        (when rm
-          (write-region rm nil (concat name "-readme.txt"))
-          (insert "<h2>Full description</h2><pre>\n" (elpaa--html-quote rm)
-                  "\n</pre>\n")))
+      (let* ((package-readme-file-name
+              (elpaa--spec-get pkg-spec :readme
+                               '("README" "README.rst"
+                                 ;; Most README.md files seem to be currently
+                                 ;; worse than the Commentary: section :-(
+                                 ;; "README.md"
+                                 "README.org")))
+             (readme-section (elpaa--get-section "Commentary" 
package-readme-file-name
+                                                 srcdir pkg-spec))
+             (readme-content (elpaa--section-to-plain-text readme-section))
+             (page-content (elpaa--section-to-html readme-section))
+             (readme-output-filename (concat name "-readme.txt")))
+        (write-region readme-content nil readme-output-filename)
+        (insert "<h2>Full description</h2>\n" page-content))
       ;; (message "latest=%S; files=%S" latest files)
       (unless (< (length files) (if (zerop (length latest)) 1 2))
         (insert (format "<h2>Old versions</h2><table>\n"))