Source

xemacsweb / release-mail-to-html.el

adriana 22a11a4 
















adriana 03b1b09 
adriana 22a11a4 










































































































adriana 03b1b09 
adriana 22a11a4 




adriana 03b1b09 
adriana 22a11a4 




adriana 03b1b09 
adriana 22a11a4 
adriana 03b1b09 
adriana 22a11a4 
adriana 03b1b09 

adriana 22a11a4 






adriana 03b1b09 

adriana 22a11a4 


adriana 03b1b09 
adriana 22a11a4 




adriana 03b1b09 


adriana 22a11a4 

adriana 03b1b09 
adriana 22a11a4 











;;; 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))))))))