emacs-28 5543aea1b2: Automate exporting etc/NEWS to HTML

[Stefan Kangas]

branch: emacs-28
commit 5543aea1b2b8c68481ae0ce2bb501d8484ef7f7c
Author: Stefan Kangas <stefankangas@gmail.com>
Commit: Stefan Kangas <stefankangas@gmail.com>

    Automate exporting etc/NEWS to HTML
    
    * admin/admin.el (make-news-html-file): New function.
    * .gitignore: Ignore generated "etc/NEWS*.html" file.
---
 .gitignore     |   1 +
 admin/admin.el | 130 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 131 insertions(+)

diff --git a/.gitignore b/.gitignore
index 2254b8a9c8..e48e359426 100644
--- a/.gitignore
+++ b/.gitignore
@@ -263,6 +263,7 @@ doc/misc/cc-mode.ss
 doc/misc/modus-themes.texi
 doc/misc/org.texi
 etc/DOC
+etc/NEWS*.html
 etc/refcards/emacsver.tex
 gnustmp*
 /info/
diff --git a/admin/admin.el b/admin/admin.el
index 67cbf85a32..12e6fcb7f8 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -770,6 +770,136 @@ Optional argument TYPE is type of output (nil means all)."
     (if (member type (list nil m))
        (make-manuals-dist--1 root m))))
 
+(defun make-news-html-file (root version)
+  "Convert the NEWS file into an HTML file."
+  (interactive (let ((root
+                      (if noninteractive
+                          (or (pop command-line-args-left)
+                              default-directory)
+                        (read-directory-name "Emacs root directory: "
+                                             source-directory nil t))))
+                 (list root
+                       (read-string "Version number: " emacs-version))))
+  (unless (file-exists-p (expand-file-name "src/emacs.c" root))
+    (user-error "%s doesn't seem to be the root of an Emacs source tree" root))
+  (let* ((dir (make-temp-file "emacs-news-file" t))
+         (orig (expand-file-name "etc/NEWS" root))
+         (new (expand-file-name (format "NEWS.%s.org" version) dir))
+         (html-file (format "%s.html" (file-name-base new)))
+         (copyright-years (format-time-string "%Y")))
+    (unwind-protect
+        (progn
+          (copy-file orig new)
+          (find-file new)
+
+          ;; Find the copyright range:
+          (goto-char (point-min))
+          (re-search-forward "^Copyright (C) \\([0-9-]+\\) Free Software 
Foundation, Inc.")
+          (setq copyright-years (match-string 1))
+
+          ;; Get rid of some unnecessary stuff:
+          (replace-regexp-in-region "^---$" "" (point-min) (point-max))
+          (replace-regexp-in-region "^\\+\\+\\+$" "" (point-min) (point-max))
+          (dolist (str '("\n"
+                         "GNU Emacs NEWS -- history of user-visible changes."
+                         "Temporary note:"
+                         "+++ indicates that all relevant manuals in doc/ have 
been updated."
+                         "--- means no change in the manuals is needed."
+                         "When you add a new item, use the appropriate mark if 
you are sure it"
+                         "applies, and please also update docstrings as 
needed."
+                         "You can narrow news to a specific version by calling 
'view-emacs-news'"
+                         "with a prefix argument or by typing 'C-u C-h C-n'."))
+            (replace-string-in-region str "" (point-min) (point-max)))
+
+          ;; Use Org-mode markers for <code>.
+          (replace-regexp-in-region
+           ;; This could probably be improved quite a bit...
+           (rx "'" (group (+ (not (any "'\n")))) "'")
+           "~\\1~" (point-min) (point-max))
+
+          ;; Format Emacs Lisp.
+          (while (re-search-forward "^    " nil t)
+            (backward-paragraph)
+            (insert "\n#+begin_src emacs-lisp")
+            (forward-paragraph)
+            (insert "#+end_src\n"))
+
+          ;; Insert Org-mode export headers.
+          (goto-char (point-min))
+          (insert (format
+                   "\
+#+title: GNU Emacs %s NEWS -- history of user-visible changes
+#+author:
+#+options: author:nil creator:nil toc:1 num:2 *:nil \\n:nil
+#+language: en
+#+HTML_LINK_HOME: https://www.gnu.org/software/emacs
+#+html_head_extra: <link rel=\"stylesheet\" type=\"text/css\" 
href=\"/mini.css\" media=\"handheld\" />
+#+html_head_extra: <link rel=\"stylesheet\" type=\"text/css\" 
href=\"/layout.min.css\" media=\"screen\" />
+#+html_head_extra: <link rel=\"stylesheet\" type=\"text/css\" 
href=\"/print.min.css\" media=\"print\" />
+
+#+BEGIN_EXPORT html
+<div style=\"float:right;margin-left:1em;padding:3px;border:0px 
solid;text-align:center\">
+<a href=\"/graphics/gnu-head.jpg\">
+<img src=\"/graphics/gnu-head-sm.jpg\" alt=\" [image of the head
+of a GNU] \" width=\"129\" height=\"122\"/>
+</a>
+</div>
+#+END_EXPORT\n\n"
+                   version))
+          (org-mode)
+          (let ((org-html-postamble
+                 (format
+                  "
+<p>
+Return to the <a href=\"/software/emacs/emacs.html\">GNU Emacs home page</a>.
+</p>
+
+<div id=\"footer\">
+<div class=\"unprintable\">
+
+<p>
+Please send FSF &amp; GNU inquiries to
+<a href=\"mailto:gnu@gnu.org\";>&lt;gnu@gnu.org&gt;</a>.
+There are also <a href=\"/contact/\">other ways to contact</a>
+the FSF.
+Broken links and other corrections or suggestions can be sent to
+<a href=\"mailto:bug-gnu-emacs@gnu.org\";>&lt;bug-gnu-emacs@gnu.org&gt;</a>.
+</p>
+</div>
+
+<p>
+    Copyright &copy; %s Free Software Foundation, Inc.
+</p>
+
+<p>This page is licensed under
+a <a href=\"https://creativecommons.org/licenses/by-sa/4.0\";>CC-BY-SA</a>
+license.</p>
+
+<!--#include virtual=\"/server/bottom-notes.html\" -->
+
+<p class=\"unprintable\">
+Updated:
+<!-- timestamp start -->
+$Date: %s $
+<!-- timestamp end -->
+</p>
+</div>
+</div>"
+                  copyright-years
+                  ;; e.g. "2022/09/13 09:13:13"
+                  (format-time-string "%Y/%M/%y %H:%m:%S"))))
+            ;; Actually export.
+            (org-html-export-to-html)
+            ;; Kill the .org buffer.
+            (kill-buffer (current-buffer))
+            ;; Move file into place.
+            (let ((old (expand-file-name html-file dir))
+                  (new (expand-file-name html-file (expand-file-name "etc" 
root))))
+              (delete-file new)
+              (copy-file old new)
+              (find-file new))))
+      (delete-directory dir t))))
+
 
 ;; Stuff to check new `defcustom's got :version tags.
 ;; Adapted from check-declare.el.