From: Stefan Kangas
Date: Fri, 16 Sep 2022 12:17:14 +0000 (+0200)
Subject: Improve HTML export of NEWS file
X-Git-Tag: emacs-28.3-rc1~85
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f232d989fd;p=emacs.git
Improve HTML export of NEWS file
* admin/admin.el (admin--org-export-headers-format)
(admin--org-html-postamble): New variables.
(admin--require-external-package): New function.
(make-news-html-file): Improve HTML export.
---
diff --git a/admin/admin.el b/admin/admin.el
index 12e6fcb7f8c..60b043a3516 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -770,69 +770,13 @@ 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 .
- (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
- "\
+(defvar admin--org-export-headers-format "\
#+title: GNU Emacs %s NEWS -- history of user-visible changes
#+author:
-#+options: author:nil creator:nil toc:1 num:2 *:nil \\n:nil
+#+options: author:nil creator:nil toc:1 num:2 *:nil \\n:t ^:nil tex:nil
#+language: en
-#+HTML_LINK_HOME: https://www.gnu.org/software/emacs
+#+HTML_LINK_HOME: /software/emacs
+#+HTML_LINK_UP: /software/emacs
#+html_head_extra:
#+html_head_extra:
#+html_head_extra:
@@ -844,12 +788,9 @@ Optional argument TYPE is type of output (nil means all)."
of a GNU] \" width=\"129\" height=\"122\"/>
-#+END_EXPORT\n\n"
- version))
- (org-mode)
- (let ((org-html-postamble
- (format
- "
+#+END_EXPORT\n\n")
+
+(defvar admin--org-html-postamble "
Return to the GNU Emacs home page.
@@ -884,21 +825,129 @@ $Date: %s $
-"
- 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))))
+")
+
+(defun admin--require-external-package (pkg)
+ (package-initialize)
+ (require pkg nil t)
+ (unless (featurep pkg)
+ (when (yes-or-no-p (format "Package \"%s\" is missing. Install now?" pkg))
+ (package-install pkg)
+ (require pkg nil t))))
+
+(defvar org-html-postamble)
+(defvar org-html-mathjax-template)
+(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 "Major version number: "
+ (number-to-string emacs-major-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))
+ (admin--require-external-package 'htmlize)
+ (let* ((orig (expand-file-name "etc/NEWS" root))
+ (new (expand-file-name (format "etc/NEWS.%s.org" version) root))
+ (html-file (format "%s.html" (file-name-base new)))
+ (copyright-years (format-time-string "%Y")))
+ (copy-file orig new t)
+ (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))
+
+ ;; Delete 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)))
+
+ ;; Escape some characters.
+ (replace-regexp-in-region (rx "$") "@@html:$@@" (point-min) (point-max))
+
+ ;; Use Org-mode markers for 'symbols', 'C-x k', etc.
+ (replace-regexp-in-region
+ (rx-let ((key (seq
+ ;; Modifier (optional)
+ (? (any "ACHMSs") "-")
+ (or
+ ;; single key
+ (not (any " \n"))
+ ;; "" and " "
+ (seq "<"
+ (+ (any "A-Za-z-"))
+ (+ (seq " " (+ (any "A-Za-z-"))))
+ ">")
+ "NUL" "RET" "LFD" "TAB"
+ "ESC" "SPC" "DEL")))
+ (email (seq (+ (not (any " @\n")))
+ "@"
+ (+ (not (any " @\n")))))
+ (lisp-symbol (regexp lisp-mode-symbol-regexp)))
+ (rx "'" (group
+ (or lisp-symbol
+ email
+ (seq "M-x " lisp-symbol)
+ (seq key (+ " " key))))
+ "'"))
+ "~\\1~" (point-min) (point-max))
+
+ ;; Format code blocks.
+ (while (re-search-forward "^ " nil t)
+ (let ((elisp-block (looking-at "(")))
+ (backward-paragraph)
+ (insert (if elisp-block
+ "\n#+BEGIN_SRC emacs-lisp"
+ "\n#+BEGIN_EXAMPLE"))
+ (forward-paragraph)
+ (insert (if elisp-block
+ "#+END_SRC\n"
+ "#+END_EXAMPLE\n"))))
+
+ ;; Delete buffer local variables.
+ (goto-char (point-max))
+ (when (re-search-backward "Local variables:")
+ (forward-line -1)
+ (delete-region (point) (point-max)))
+
+ ;; Insert Org-mode export headers.
+ (goto-char (point-min))
+ (insert (format admin--org-export-headers-format version))
+ (org-mode)
+ (save-buffer)
+
+ ;; Make the HTML export.
+ (let* ((org-html-postamble
+ (format admin--org-html-postamble
+ copyright-years
+ ;; e.g. "2022/09/13 09:13:13"
+ (format-time-string "%Y/%M/%y %H:%m:%S")))
+ (org-html-mathjax-template "")
+ (htmlize-output-type 'css))
+ (org-html-export-as-html))
+
+ ;; Write HTML to file.
+ (let ((new (expand-file-name html-file (expand-file-name "etc" root))))
+ (write-file new)
+ (unless noninteractive
+ (find-file new)
+ (html-mode))
+ (message "Successfully exported HTML to %s" new))))
;; Stuff to check new `defcustom's got :version tags.