Source

xemacsweb / release-mail-to-html.el

;;; Adrian Aichner (APA), aichner@ecf.teradyne.com, Teradyne GmbH, 2000-08-10.

(require 'psgml)
(require 'psgml-parse)                  ;;; for sgml-element-context-string
;;; APA: 'psgml-html does not provide itself.  Why not?
(load "psgml-html")                   ;;; for html-quote-region
;;; (require 'regexp-opt)

(provide 'release-mail-to-html)

(defgroup release-mail-to-html nil
  "Generate HTML content file for XEmacs website from release
announcement mails as formatted by XEmacs Release Engineer."
  :load 'release-mail-to-html
  :group nil)

(defcustom release-mail-to-html-preformatted-regexp
  "<pre xml:space=\"preserve\">\\(.*?\\(\n.*?\\)*\\)</pre>"
  "REGEXP matching preformatted HTML in the BETA-VERSION.content
buffer generated from beta release mail."
  :type '(regexp
          :custom-show t
          :documentation-shown t)
  :group 'release-mail-to-html)

(defcustom release-mail-to-html-header-regexp
  "^\\(\\(-\\|\\sw\\)+\\)[ \t]*:[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)\n"
  "REGEXP matching mail headers."
  :type '(regexp
          :custom-show t
          :documentation-shown t)
  :group 'release-mail-to-html)

(defcustom release-mail-to-html-release-regexp
  "^subject[ \t]*:[ \t]*XEmacs[ \t]+\\(.*\\)[ \t]+is[ \t]+released"
  "REGEXP matching mail subject header in an XEmacs beta release mail,
returning release number as match-string 1."
  :type '(regexp
          :custom-show t
          :documentation-shown t)
  :group 'release-mail-to-html)

(defcustom release-mail-to-html-summary-regexp
  "^.*Brief[ \t]+summary[ \t]+of[ \t]+changes[ \t]+to[ \t]+\\([^ \t]+\\)[ \t]+\\(\"[^\"]+\"\\)"
  "REGEXP matching the brief summary header of changes in an XEmacs
beta release mail."
  :type '(regexp
          :custom-show t
          :documentation-shown t)
  :group 'release-mail-to-html)

(defcustom release-mail-to-html-change-regexp
  "^-- \\(.*\\(\n[ \t]+.*\\)*\\)"
  "REGEXP matching a single change in the brief summary of changes in
an XEmacs beta release mail."
  :type '(regexp
          :custom-show t
          :documentation-shown t)
  :group 'release-mail-to-html)

(defcustom release-mail-to-html-changelog-record-regexp
  "[
]*[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[ \t]+\\(?:.*\\)[ \t]+\\(?:<[^>]+>\\)\\([
]*[ \t]+.*\\)+"
  "REGEXP matching one ChangeLog record for a (sub-)directory in an
XEmacs beta release mail."
  :type '(regexp
          :custom-show t
          :documentation-shown t)
  :group 'release-mail-to-html)

(defcustom release-mail-to-html-changelog-regexp
  (format "[\n]*-+[ \t]*ChangeLog[ \t]+entries[ \t]+from[ \t]+[^/]+/\\(.*/ChangeLog\\)[ \t]*-+\\(\\(%s\\)+\\)" release-mail-to-html-changelog-record-regexp)
  "REGEXP matching all ChangeLog records for a sub-directory in an
XEmacs beta release mail."
  :type '(regexp
          :custom-show t
          :documentation-shown t)
  :group 'release-mail-to-htm)

(defun release-mail-to-html (&optional buffer)
  "Create HTML from XEmacs release mail."
  (interactive
   (list
    (read-buffer "buffer containing release mail: " "*Article*" t)))
  (save-excursion
    (with-current-buffer
        (get-buffer-create buffer)
      (let (beta-version
            beta-name
            changes
            release-mail-to-html-changelog-alist)
        (goto-char (point-min))
        (if (re-search-forward
             release-mail-to-html-release-regexp nil t)
            (setq beta-version
                  (match-string 1)))
        (when (re-search-forward
               release-mail-to-html-summary-regexp nil t)
          (setq beta-version
                (match-string 1)
                beta-name
                (match-string 2))
          (while (re-search-forward
                  release-mail-to-html-change-regexp nil t)
            (setq changes
                  (append changes (list (match-string 1))))))
        (while (re-search-forward
                release-mail-to-html-changelog-regexp nil t)
          (setq release-mail-to-html-changelog-alist
                (append
                 release-mail-to-html-changelog-alist
                 (list
                  (cons
                   (match-string 1)
                   (match-string 2))))))
        (with-output-to-temp-buffer
            (format "%s.content" beta-version)
          (progn
            (princ
             (format "%%title%%
XEmacs %s Release
%%author%%
release-mail-to-html.el for Adrian Aichner
%%main%%
                        <h1>XEmacs %s Release</h1>
"
                     beta-version
                     beta-version))
            (if (and beta-version beta-name)
                (princ
                 (format "            <h2><a name=\"summary\" shape=\"rect\">Summary</a> of Changes to %s %s</h2>\n            <p>goto <a href=\"#changes\" shape=\"rect\">changes</a></p>\n" beta-version beta-name)))
            (when changes
              (princ "            <ul>\n")
              (mapc
               (function
                (lambda (c)
                  (princ (format "	    <li>%s</li>\n" c))))
               changes)
              (princ "	  </ul>\n"))
            (princ
             (format "            <h2><a name=\"changes\" shape=\"rect\">ChangeLogs</a> for Release %s %s of XEmacs</h2>
            <p>goto <a href=\"#summary\" shape=\"rect\">summary</a></p>
            <ul>
" beta-version beta-name))
            (mapc
             (function
              (lambda (l)
                (princ
                 (format
                  "	    <li><a href=\"#%s\" shape=\"rect\">%s</a></li>\n"
                  (replace-in-string (car l) "/" ":")
                  (car l)))))
             release-mail-to-html-changelog-alist)
            (princ
             "	  </ul>\n")
            (mapc
             (function
              (lambda (l)
                (princ
                 (format
                  "            <h2><a name=\"%s\" shape=\"rect\">%s</a></h2>
            <p>goto <a href=\"#changes\" shape=\"rect\">changes</a>, <a href=\"#summary\" shape=\"rect\">summary</a></p>
            <pre xml:space=\"preserve\">%s
            </pre>
"
                  (replace-in-string (car l) "/" ":")
                  (car l)
                  (cdr l)))))
             release-mail-to-html-changelog-alist)))
        (with-current-buffer
            (get-buffer
             (format "%s.content" beta-version))
          (goto-char (point-min))
          (while (re-search-forward
                  release-mail-to-html-preformatted-regexp
                  nil t)
            (html-quote-region
             (match-beginning 1)
             (match-end 1))))))))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.