From f232d989fd90dc35b647da9db152d70b421f35a9 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 16 Sep 2022 14:17:14 +0200 Subject: [PATCH] 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. --- admin/admin.el | 211 ++++++++++++++++++++++++++++++------------------- 1 file changed, 130 insertions(+), 81 deletions(-) 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. -- 2.39.2