xemacsweb / release-mail-to-html.el

Diff from to

release-mail-to-html.el

   (t
    (error "please install/upgrade PSGML!")))
 
-
 (provide 'release-mail-to-html)
 
 (defgroup release-mail-to-html nil
   :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 MAJOR.MINOR.PATCH.content
-buffer generated from XEmacs release mail."
-  :type '(regexp
-          :custom-show t
-          :documentation-shown t)
+(defcustom release-mail-to-html-mail-buffer-name "*Article*"
+  "Name of buffer containing software release mail announcement of any
+  type defined in `release-mail-to-html-regexp-alist'."
+  :type 'string
   :group 'release-mail-to-html)
 
-(defcustom release-mail-headers-to-keep-regexp
-  (format "^\\(%s\\)"
-          (mapconcat
-           'identity
-           (list
-            "To:"
-            "Subject:"
-            "From:"
-            "Organization:"
-            "Date:"
-            "Message-ID:"
-            "Reply-To:"
-            )
-           "\\|"))
-  "REGEXP matching mail headers to keep from release notice."
-  :type '(regexp
-          :custom-show t
-          :documentation-shown t)
-  :group 'release-mail-to-html)
+(setq release-mail-to-html-regexp-alist
+      (list
+       (list
+	"XEmacs"
+	'release-mail-to-html-preformatted-regexp
+	(list
+	 "<pre xml:space=\"preserve\">\\(.*?\\(\n.*?\\)*\\)</pre>" :body 1)
+	'release-mail-to-html-headers-to-keep-regexp
+	(list
+	 (format "^\\(%s\\)"
+		 (mapconcat
+		  'identity
+		  (list
+		   "To:"
+		   "Subject:"
+		   "From:"
+		   "Organization:"
+		   "Date:"
+		   "Message-ID:"
+		   "Reply-To:"
+		   )
+		  "\\|")) :header-name 1)
+	'release-mail-to-html-header-regexp
+	(list
+	 "^\\(\\(-\\|\\sw\\)+\\)[ \t]*:[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)\n")
+	'release-mail-to-html-body-separator-regexp
+	(list
+	 "\n\\(--text follows this line--\\)?\n")
+	'release-mail-to-html-subject-regexp
+	(list
+	 "^subject[ \t]*:[ \t]*\\(?:\\[ANNOUNCE\\][ \t]*\\)?\\(XEmacs\\)[ \t]+\\([0-9]+\\)\\.\\([0-9]+\\)\\(\\.\\([0-9]+\\)\\|[ \t]+(patch[ \t]+\\([0-9]+\\))\\)[ \t]+\\(\\(\"[^\"]+\"\\)[ \t]+\\)?\\(is\\|has[ \t]+been\\)[ \t]+released"
+	 :type 1 :major 2 :minor 3 :beta 5 :patch 6 :code-name 8)
+	'release-mail-to-html-summary-header-regexp
+	(list
+	 "^.*Brief[ \t]+summary[ \t]+of[ \t]+changes[ \t]+to\\(?:[ \t]+XEmacs\\)?[ \t]+\\([^ \t]+\\)[ \t]+\\(\"[^\"]+\"\\)\n*"
+	 :version-name 1 :code-name 2)
+	'release-mail-to-html-summary-name-regexp
+	(list
+	 "\\=\\([^-].+\\)\n+" :summary-name 1)
+	'release-mail-to-html-summary-item-regexp
+	(list
+	 "\\=-- \\(.+\\(\n[ \t]+.*\\)*\\)\n*" :summary-item 1)
+	'release-mail-to-html-changelog-record-regexp
+	(list
+	 "\\=\n+[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[ \t]+\\(?:.*\\)[ \t]+\\(?:<[^>]+>\\)\\(\n+[ \t]+.*\\)+"
+	 :record 0)
+	'release-mail-to-html-changelog-regexp
+	(list
+	 "\n*-+[ \t]*ChangeLog[ \t]+entries[ \t]+from[ \t]+\\(.*\\)[ \t]+-+"
+	 :change-log-name 1)
+	'release-mail-to-html-patch-regexp
+	(list
+	 "^From:[ \t]*\\(.*\\)[ \t]*\nSubject:[ \t]*\\(.*\\)[ \t]*\n\\(.+\\)[ \t>]*\n+"
+	 :from 1 :subject 2 :reference 3)
+	)
+       (list
+	"XEmacs Packages"
+	'release-mail-to-html-preformatted-regexp
+	(list
+	 "<pre xml:space=\"preserve\">\\(.*?\\(\n.*?\\)*\\)</pre>" :body 1)
+	'release-mail-to-html-headers-to-keep-regexp
+	(list
+	 (format "^\\(%s\\)"
+		 (mapconcat
+		  'identity
+		  (list
+		   "To:"
+		   "Subject:"
+		   "From:"
+		   "Organization:"
+		   "Date:"
+		   "Message-ID:"
+		   "Reply-To:"
+		   )
+		  "\\|")) :header-name 1)
+	'release-mail-to-html-header-regexp
+	(list
+	 "^\\(\\(-\\|\\sw\\)+\\)[ \t]*:[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)\n")
+	'release-mail-to-html-body-separator-regexp
+	(list
+	 "\n\\(--text follows this line--\\)?\n")
+	'release-mail-to-html-subject-regexp
+	(list
+	 "^subject[ \t]*:[ \t]*\\(?:\\[ANNOUNCE\\][ \t]*\\)?\\(XEmacs Packages\\) have been \\(?:pre-\\)?released (\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?:-[0-9]\\{2\\}\\)?\\))"
+	 :type 1 :code-name 2)
+	'release-mail-to-html-summary-header-regexp
+	(list
+	 "^.*Brief[ \t]+summary[ \t]+of[ \t]+changes[ \t]+to\\(?:[ \t]+XEmacs\\)?[ \t]+\\([^ \t]+\\)[ \t]+\\(\"[^\"]+\"\\)\n*" :version-name 1 :code-name 2)
+	'release-mail-to-html-summary-name-regexp
+	(list
+	 "\\=\\([^-].+\\)\n+" :summary-name 1)
+	'release-mail-to-html-summary-item-regexp
+	(list
+	 "\\=-- \\(.+\\(\n[ \t]+.*\\)*\\)\n*" :summary-item 1)
+	'release-mail-to-html-changelog-record-regexp
+	(list
+	 "\\=\n+[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[ \t]+\\(?:.*\\)[ \t]+\\(?:<[^>]+>\\)\\(\n+[ \t]+.*\\)+"
+	 :record 0)
+	'release-mail-to-html-changelog-regexp
+	(list
+	 "\n*-+[ \t]*ChangeLog[ \t]+entries[ \t]+from[ \t]+\\(.*\\)[ \t]+-+"
+	 :change-log-name 1)
+	'release-mail-to-html-patch-regexp
+	(list
+	 "^From:[ \t]*\\(.*\\)[ \t]*\nSubject:[ \t]*\\(.*\\)[ \t]*\n\\(.+\\)[ \t>]*\n+"))))
 
-(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-body-separator-regexp
-  "\n\\(--text follows this line--\\)?\n"
-  "REGEXP matching separator between mail header and body.  This
-enables mail composition buffers to be used in addition to incoming
-mail mesasges.  The first sub-expression is to match the part of the
-separator to be removed from the release announcement."
-  :type '(regexp
-          :custom-show t
-          :documentation-shown t)
-  :group 'release-mail-to-html)
-
-(defcustom release-mail-to-html-subject-regexp
-  "^subject[ \t]*:[ \t]*XEmacs[ \t]+\\([0-9]+\\)\\.\\([0-9]+\\)\\(\\.\\([0-9]+\\)\\|[ \t]+(patch[ \t]+\\([0-9]+\\))\\)[ \t]+\\(\\(\"[^\"]+\"\\)[ \t]+\\)?\\(is\\|has[ \t]+been\\)[ \t]+released"
-  "REGEXP matching mail subject header in an XEmacs release mail.
-Version elements MAJOR, MINOR, BETA, PATCH, and CODENAME are matched
-as substrings 1, 2, 4, 5, and 7 respectively, as applicable.  See
-`match-string'."
-  :type '(regexp
-          :custom-show t
-          :documentation-shown t)
-  :group 'release-mail-to-html)
-
-(defcustom release-mail-to-html-summary-header-regexp
-  "^.*Brief[ \t]+summary[ \t]+of[ \t]+changes[ \t]+to\\(?:[ \t]+XEmacs\\)?[ \t]+\\([^ \t]+\\)[ \t]+\\(\"[^\"]+\"\\)\n*"
-  "REGEXP matching the brief summary header of changes in an XEmacs
-release mail, if present.
-Substring 1 should contain the XEmacs version after a successful
-match, substring 2 the XEmacs codename."
-  :type '(regexp
-          :custom-show t
-          :documentation-shown t)
-  :group 'release-mail-to-html)
-
-(defcustom release-mail-to-html-summary-name-regexp
-  "\\=\\([^-].+\\)\n+"
-  "REGEXP matching a heading in the brief summary of changes in
-an XEmacs release mail, if present at point.
-Substring 1 contains the text of the summary heading, if applicable.
-See `match-string'."
-  :type '(regexp
-          :custom-show t
-          :documentation-shown t)
-  :group 'release-mail-to-html)
-
-(defcustom release-mail-to-html-summary-item-regexp
-  "\\=-- \\(.+\\(\n[ \t]+.*\\)*\\)\n*"
-  "REGEXP matching a single change in the brief summary of changes in
-an XEmacs release mail, if present at point.
-Substring 1 contains the text of a single change item, if applicable.
-See `match-string'."
-  :type '(regexp
-          :custom-show t
-          :documentation-shown t)
-  :group 'release-mail-to-html)
-
-(defcustom release-mail-to-html-changelog-record-regexp
-  "\\=\n+[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[ \t]+\\(?:.*\\)[ \t]+\\(?:<[^>]+>\\)\\(\n+[ \t]+.*\\)+"
-  "REGEXP matching a single ChangeLog record in an XEmacs release
-mail, if present at point."
-  :type '(regexp
-          :custom-show t
-          :documentation-shown t)
-  :group 'release-mail-to-html)
-
-(defcustom release-mail-to-html-changelog-regexp
-  "\n*-+[ \t]*ChangeLog[ \t]+entries[ \t]+from[ \t]+\\(.*ChangeLog\\)[ \t]*-+"
-  "REGEXP matching a ChangeLog records header for a sub-directory in
-an XEmacs release mail, if present."
-  :type '(regexp
-          :custom-show t
-          :documentation-shown t)
-  :group 'release-mail-to-html)
-
-(defcustom release-mail-to-html-patch-regexp
-  "^From:[ \t]*\\(.*\\)[ \t]*\nSubject:[ \t]*\\(.*\\)[ \t]*\n[^ \t]*URL:[ \t]*\\([^>]+\\)[ \t>]*\n+"
-  "REGEXP matching patch records in an XEmacs release mail, if
-present.
-Patch description elements FROM, SUBJECT, and URL are matched
-as substrings 1, 2, and 3 respectively, as applicable.  See
-`match-string'."
-  :type '(regexp
-          :custom-show t
-          :documentation-shown t)
-  :group 'release-mail-to-html)
-
-(defun release-mail-to-html (&optional buffer)
+(defun release-mail-to-html (&optional buffer type)
   "*Create HTML from XEmacs release announcement mail.
 BUFFER (defaulting to *Article*) needs to hold a standard release
 announcement for a stable or beta release of XEmacs, as mailed to
 "
   (interactive
    (list
-    (read-buffer "buffer containing release mail: " "*Article*" t)))
-  (save-excursion
-    (with-temp-buffer
-      (insert-buffer buffer)
-      (let
-          (major-version
-           minor-version
-           patch-level
-           xemacs-version-from-subject
-           xemacs-version-from-summary
-           code-name-from-subject
-           code-name-from-summary
-           release-mail-to-html-summary-alist
-           release-mail-to-html-changelog-alist
-           release-mail-to-html-patch-list
-           release-mail-announcement
-           release-mail-index
-           content-buffer
-           (case-fold-search t))
-        (goto-char (point-min))
-        ;; Extract version information from subject line:
-        (when (re-search-forward
-               release-mail-to-html-subject-regexp nil t)
-          (setq major-version (match-string 1)
-                minor-version (match-string 2)
-                patch-level (or (match-string 4) (match-string 5))
-                code-name-from-subject (match-string 7))
-          (and
-           major-version minor-version patch-level
-           (setq xemacs-version-from-subject
-                 (format
-                  "%s.%s.%s" major-version minor-version patch-level))))
-        ;; Extract version information from brief summary of changes
-        ;; heading:
-        (when (re-search-forward
-               release-mail-to-html-summary-header-regexp nil t)
-          (setq xemacs-version-from-summary
-                (match-string 1))
-          (setq
-           code-name-from-summary (match-string 2))
-          (delete-region
-           (match-beginning 0) (match-end 0))
-          (unless
-              (string=
-               xemacs-version-from-summary
-               xemacs-version-from-subject)
-            (error
-             "release-mail-to-html: %s specifies different XEmacs versions as matched by %S and %S."
-             buffer
-             'release-mail-to-html-summary-header-regexp
-             'release-mail-to-html-subject-regexp))
-          (unless (string=
-                   code-name-from-summary code-name-from-subject)
-            (error
-             "release-mail-to-html: %s specifies different XEmacs codenames as matched by %S and %S."
-             buffer
-             'release-mail-to-html-summary-header-regexp
-             'release-mail-to-html-subject-regexp)))
-        (unless
-            (and xemacs-version-from-summary code-name-from-summary)
-          (error
-           "release-mail-to-html: %s fails to contain line matching %S."
-           buffer
-           'release-mail-to-html-summary-header-regexp))
-        ;; Extract summary entries from announcement body.
-        (let (summary-name
-              summary-items)
-          (while (re-search-forward
-                  release-mail-to-html-summary-name-regexp nil t)
-            (setq summary-name (match-string 1))
-            (delete-region
-             (match-beginning 0) (match-end 0))
-            (while (re-search-forward
-                    release-mail-to-html-summary-item-regexp nil t)
-              (setq summary-items
-                    (append summary-items
-                            (list (match-string 1))))
-              (delete-region
-               (match-beginning 0) (match-end 0)))
-            (setq release-mail-to-html-summary-alist
-                  (append
-                   release-mail-to-html-summary-alist
-                   (list
-                    (cons
-                     summary-name summary-items))))
-            (setq summary-name nil summary-items nil)))
-        ;; Extract changelog entries from announcement body.
-        (let (changelog-name
-              changelog-records)
-          (while (re-search-forward
-                  release-mail-to-html-changelog-regexp nil t)
-            (setq changelog-name (match-string 1))
-            (delete-region
-             (match-beginning 0)
-             (match-end 0))
-            (while (re-search-forward
-                    release-mail-to-html-changelog-record-regexp nil t)
-              (setq changelog-records
-                    (concat changelog-records (match-string 0)))
-              (delete-region
-               (match-beginning 0)
-               (match-end 0)))
-            (setq release-mail-to-html-changelog-alist
-                  (append
-                   release-mail-to-html-changelog-alist
-                   (list
-                    (cons
-                     changelog-name
-                     changelog-records))))
-            (setq changelog-name nil changelog-records nil)))
-        ;; Extract applied patches from announcement body.
-        (while (re-search-forward
-                release-mail-to-html-patch-regexp nil t)
-          (setq release-mail-to-html-patch-list
-                (append
-                 release-mail-to-html-patch-list
-                 (list
-                  (list
-                   (match-string 1)
-                   (match-string 2)
-                   (match-string 3)))))
-          (delete-region
-           (match-beginning 0)
-           (match-end 0)))
-        ;; Get remaining free-form announcement body.
-        (goto-char (point-min))
-        (save-excursion
-          (replace-regexp "\n+\\'" "")) ; remove empty trailing lines.
-        ;; Search forward to end of headers, as defined by
-        ;; `release-mail-to-html-body-separator-regexp'.
-        ;; Delete (match-string 1), which is the mail composition
-        ;; body/head separator.  This allows the XRE to update the
-        ;; website before sending the release announcement (time
-        ;; travel!).
-        (search-forward-regexp
-         release-mail-to-html-body-separator-regexp nil t)
-        (if
-            (match-string 1)
-            (delete-region
-             (match-beginning 1)
-             (match-end 1)))
-        ;; Process mail header, if any.
-        (if (> (point) (point-min))
-            (save-restriction
-              (narrow-to-region
-               (point-min)
-               (- (point) 1))
-              (goto-char (point-min))
-              (delete-non-matching-lines
-               release-mail-headers-to-keep-regexp))
-          (error "release-mail-to-html: %s misses mail headers." buffer))
-        (goto-char (point-min))
-        (setq release-mail-announcement
-              (buffer-substring
-               (point-min)
-               (point-max)))
-        ;; Generate list of index items
-        ;; APA: Make sure to keep this order the reverse of the actual
-        ;; document sections (because I cons here, adding to the head
-        ;; of the list).
-        (when release-mail-to-html-patch-list
-          (setq
-           release-mail-index
-           (cons "patches" release-mail-index)))
-        (when release-mail-to-html-changelog-alist
-          (setq
-           release-mail-index
-           (cons "changes" release-mail-index)))
-        (when release-mail-to-html-summary-alist
-          (setq
-           release-mail-index
-           (cons "summary" release-mail-index)))
-        (when release-mail-announcement
-          (setq
-           release-mail-index
-           (cons "announcement" release-mail-index)))
-        (setq
-         content-buffer
-         (generate-new-buffer-name
-          (format "%s.content" xemacs-version-from-subject)))
-        ;; Generate XML/XHTML/HTML document.
-        (with-output-to-temp-buffer
-            content-buffer
-          (princ
-           (format "%%title%%
-XEmacs %s %s is Released
+    (read-buffer "buffer containing release mail: "
+		 release-mail-to-html-mail-buffer-name t)))
+  (let (result
+	major-version
+	minor-version
+	patch-level
+	xemacs-version-from-subject
+	code-name-from-subject
+	subject)
+    (with-current-buffer
+	buffer
+      (mapc
+       (function
+	(lambda (type-entry)
+	  (setq result
+		(release-mail-to-html-match
+		 'release-mail-to-html-subject-regexp
+		 'point-min
+		 nil
+		 type-entry))
+	  (when result
+	    (setq major-version (plist-get result :major)
+		  minor-version (plist-get result :minor)
+		  patch-level (or 
+			       (plist-get result :patch)
+			       (plist-get result :beta))
+		  code-name-from-subject (plist-get result :code-name)
+		  subject (let ((raw-subject (match-string 0)))
+			    (when (string-match "^subject: " raw-subject)
+			      (replace-match "" t nil raw-subject))))
+	      (setq type (plist-get result :type)))))
+       release-mail-to-html-regexp-alist))
+    (when type
+      (save-excursion
+	(with-temp-buffer
+	  (insert-buffer buffer)
+	  (let
+	      (xemacs-version-from-summary
+	       code-name-from-summary
+	       release-mail-to-html-summary-alist
+	       release-mail-to-html-changelog-alist
+	       release-mail-to-html-patch-list
+	       release-mail-announcement
+	       release-mail-index
+	       content-buffer
+	       (case-fold-search t))
+	    (goto-char (point-min))
+	    ;; Extract version information from subject line:
+	    (and
+	     major-version minor-version patch-level
+	     (setq xemacs-version-from-subject
+		   (format
+		    "%s.%s.%s" major-version minor-version patch-level)))
+	    ;; Extract version information from brief summary of changes
+	    ;; heading:
+	    (release-mail-to-html-match
+	     'release-mail-to-html-body-separator-regexp
+	     'point-min
+	     nil
+	     (assoc type release-mail-to-html-regexp-alist))
+	    (when
+		(setq result
+		      (release-mail-to-html-match
+		       'release-mail-to-html-summary-header-regexp
+		       nil
+		       'delete
+		       (assoc type release-mail-to-html-regexp-alist)))
+	      (setq xemacs-version-from-summary 
+		    (plist-get result :version-name 1))
+	      (if (= (length xemacs-version-from-summary) 0)
+		  (error
+		   "release-mail-to-html: version is empty as matched by %S."
+		   'release-mail-to-html-summary-header-regexp))
+	      (setq
+	       code-name-from-summary (plist-get result :code-name))
+	      (if (= (length code-name-from-summary) 0)
+		  (error
+		   "release-mail-to-html: codename is empty as matched by %S."
+		   'release-mail-to-html-summary-header-regexp))
+	      (unless
+		  (string=
+		   xemacs-version-from-summary
+		   xemacs-version-from-subject)
+		(warn
+		 "release-mail-to-html: %s specifies different XEmacs versions as matched by %S and %S."
+		 buffer
+		 'release-mail-to-html-summary-header-regexp
+		 'release-mail-to-html-subject-regexp))
+	      (unless (string=
+		       code-name-from-summary code-name-from-subject)
+		(warn
+		 "release-mail-to-html: %s specifies different XEmacs codenames as matched by %S and %S."
+		 buffer
+		 'release-mail-to-html-summary-header-regexp
+		 'release-mail-to-html-subject-regexp))
+	      ;; Extract summary entries from announcement body.
+	      (let (summary-name
+		    summary-items)
+		(release-mail-to-html-match
+		 'release-mail-to-html-body-separator-regexp
+		 'point-min
+		 nil
+		 (assoc type release-mail-to-html-regexp-alist))
+		(while
+		    (setq result
+			  (release-mail-to-html-match
+			   'release-mail-to-html-summary-name-regexp
+			   nil
+			   'delete
+			   (assoc type release-mail-to-html-regexp-alist)))
+		  (setq summary-name (plist-get result :summary-name))
+		  (while
+		      (setq result
+			    (release-mail-to-html-match
+			     'release-mail-to-html-summary-item-regexp
+			     nil
+			     'delete
+			     (assoc type release-mail-to-html-regexp-alist)))
+		    (setq summary-items
+			  (append summary-items
+				  (list (plist-get result :summary-item)))))
+		  (setq release-mail-to-html-summary-alist
+			(append
+			 release-mail-to-html-summary-alist
+			 (list
+			  (cons
+			   summary-name summary-items))))
+		  (setq summary-name nil summary-items nil))))
+	    ;; Extract changelog entries from announcement body.
+	    (let (changelog-name
+		  changelog-records)
+	      (release-mail-to-html-match
+	       'release-mail-to-html-body-separator-regexp
+	       'point-min
+	       nil
+	       (assoc type release-mail-to-html-regexp-alist))
+	      (while
+		  (setq result
+			(release-mail-to-html-match
+			 'release-mail-to-html-changelog-regexp
+			 nil
+			 'delete
+			 (assoc type release-mail-to-html-regexp-alist)))
+		(setq changelog-name (plist-get result :change-log-name))
+		(while
+		    (setq result
+			  (release-mail-to-html-match
+			   'release-mail-to-html-changelog-record-regexp
+			   nil
+			   'delete
+			   (assoc type release-mail-to-html-regexp-alist)))
+		  (setq changelog-records
+			(concat changelog-records (plist-get result :record))))
+		(setq release-mail-to-html-changelog-alist
+		      (append
+		       release-mail-to-html-changelog-alist
+		       (list
+			(cons
+			 changelog-name
+			 changelog-records))))
+		(setq changelog-name nil changelog-records nil)))
+	    ;; Extract applied patches from announcement body.
+	    (release-mail-to-html-match
+	     'release-mail-to-html-body-separator-regexp
+	     'point-min
+	     nil
+	     (assoc type release-mail-to-html-regexp-alist))
+	    (while
+		(setq result
+		      (release-mail-to-html-match
+		       'release-mail-to-html-patch-regexp
+		       nil
+		       'delete
+		       (assoc type release-mail-to-html-regexp-alist)))
+	      (let ((patch-entry-min (match-beginning 0))
+		    (patch-entry-max (match-end 0)))
+		(setq release-mail-to-html-patch-list
+		      (append
+		       release-mail-to-html-patch-list
+		       (list
+			(list
+			 (plist-get result :from)
+			 (plist-get result :subject)
+;		       (sjt/message-id-to-url
+			 (plist-get result :reference)
+;			)
+			 ))))))
+	    ;; Get remaining free-form announcement body.
+	    (goto-char (point-min))
+	    (save-excursion
+	      (replace-regexp "\n+\\'" "")) ; remove empty trailing lines.
+	    ;; Search forward to end of headers, as defined by
+	    ;; `release-mail-to-html-body-separator-regexp'.
+	    ;; Delete (match-string 1), which is the mail composition
+	    ;; body/head separator.  This allows the XRE to update the
+	    ;; website before sending the release announcement (time
+	    ;; travel!).
+	    (setq result
+		  (release-mail-to-html-match
+		   'release-mail-to-html-body-separator-regexp
+		   nil
+		   'delete
+		   (assoc type release-mail-to-html-regexp-alist)))
+	    ;; Process mail header, if any.
+	    (if (> (point) (point-min))
+		(save-restriction
+		  (narrow-to-region
+		   (point-min)
+		   (- (point) 1))
+		  (goto-char (point-min))
+		  (delete-non-matching-lines
+		   (car
+		    (plist-get (cdr
+				(assoc type
+				       release-mail-to-html-regexp-alist))
+			       'release-mail-to-html-headers-to-keep-regexp))))
+	      (error "release-mail-to-html: %s misses mail headers." buffer))
+	    (goto-char (point-min))
+	    (setq release-mail-announcement
+		  (buffer-substring
+		   (point-min)
+		   (point-max)))
+	    ;; Generate list of index items
+	    ;; APA: Make sure to keep this order the reverse of the actual
+	    ;; document sections (because I cons here, adding to the head
+	    ;; of the list).
+	    (when release-mail-to-html-patch-list
+	      (setq
+	       release-mail-index
+	       (cons "patches" release-mail-index)))
+	    (when release-mail-to-html-changelog-alist
+	      (setq
+	       release-mail-index
+	       (cons "changes" release-mail-index)))
+	    (when release-mail-to-html-summary-alist
+	      (setq
+	       release-mail-index
+	       (cons "summary" release-mail-index)))
+	    (when release-mail-announcement
+	      (setq
+	       release-mail-index
+	       (cons "announcement" release-mail-index)))
+	    (setq
+	     content-buffer
+	     (generate-new-buffer-name
+	      (format "%s.content"
+		      (or
+		       xemacs-version-from-subject
+		       code-name-from-subject))))
+	    ;; Generate XML/XHTML/HTML document.
+	    (with-output-to-temp-buffer
+		content-buffer
+	      (princ
+	       (format "%%title%%
+%s
 %%author%%
 automatically generated from release announcement by release-mail-to-html.el
 %%main%%
 "
-                   xemacs-version-from-subject
-                   code-name-from-subject))
-          (when release-mail-announcement
-            (princ
-             (format
-              "          <h1><a name=\"announcement\">XEmacs</a> %s %s is Released</h1>\n"
-              xemacs-version-from-subject code-name-from-subject))
-            (princ
-             (release-mail-index release-mail-index "announcement"))
-            (princ
-             (format
-              "            <pre xml:space=\"preserve\">\n%s</pre>\n"
-              release-mail-announcement)))
-          (when
-              (and
-               xemacs-version-from-subject
-               code-name-from-subject
-               release-mail-to-html-summary-alist)
-            (princ
-             (format
-              "            <h1><a name=\"summary\">Changes</a> in XEmacs %s %s</h1>\n"
-              xemacs-version-from-subject code-name-from-subject))
-            (princ
-             (release-mail-index release-mail-index "summary"))
-            (mapc
-             ;; Handle a single summary of release-mail-to-html-summary-alist:
-             (function
-              (lambda (s)
-                (if (not (cdr s))
-                    ;; Print summary entry as paragraph, because it
-                    ;; has no summary items.
-                    (princ (format "            <p>%s</p>\n" (car s)))
-                  ;; Print summary name:
-                  (princ (format "            <h2>%s</h2>\n" (car s)))
-                  ;; Print summary items as unordered list:
-                  (princ (format "            <ul>\n"))
-                  ;; Handle list of summary items:
-                  (mapc
-                   ;; Handle single summary item:
-                   (function
-                    (lambda (sil)
-                      (princ (format "              <li>%s</li>\n" sil))))
-                   (cdr s))
-                  (princ (format "            </ul>\n")))))
-             release-mail-to-html-summary-alist))
-          (when (and
-                 xemacs-version-from-subject
-                 code-name-from-subject
-                 release-mail-to-html-changelog-alist)
-            (princ
-             (format
-              "            <h1><a name=\"changes\">ChangeLogs</a> for XEmacs %s %s</h1>\n"
-              xemacs-version-from-subject code-name-from-subject))
-            (princ
-             (release-mail-index release-mail-index "changes"))
-            (princ
-             (format
-              "            <ul>\n"))
-            (mapc
-             (function
-              (lambda (l)
-                (princ
-                 (format
-                  "              <li>ChangeLog Entries from <a href=\"#%s\">%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>ChangeLog Entries from <a name=\"%s\">%s</a></h2>\n%s            <pre xml:space=\"preserve\">%s</pre>\n"
-                  (replace-in-string (car l) "/" ":")
-                  (car l)
-                  (release-mail-index release-mail-index "")
-                  (cdr l)))))
-             release-mail-to-html-changelog-alist))
-          (when release-mail-to-html-patch-list
-            (princ
-             (format "          <h1><a name=\"patches\">Patches</a> in XEmacs %s %s</h1>\n"
-                     xemacs-version-from-subject code-name-from-subject))
-            (princ
-             (release-mail-index release-mail-index "patches"))
-            (princ "          <table border=\"0\">\n")
-            (princ "            <tr>\n")
-            (princ "              <td>\n")
-            (princ "                <table width=\"100%\" border=\"1\">\n")
-            (princ "                  <tr>\n")
-            (princ "                    <th width=\"20%\" rowspan=\"1\" colspan=\"1\">Author</th>\n")
-            (princ "                    <th rowspan=\"1\" colspan=\"1\">Subject</th>\n")
-            (princ "                  </tr>\n")
-            (princ "                  <tr>\n")
-            (princ "                    <th rowspan=\"1\" colspan=\"2\">Patch URL</th>\n")
-            (princ "                  </tr>\n")
-            (princ "                </table>\n")
-            (princ "              </td>\n")
-            (princ "            </tr>\n")
-            (mapc
-             (function
-              (lambda (c)
-                (princ "            <tr>\n")
-                (princ "              <td rowspan=\"1\" colspan=\"1\">\n")
-                (princ "                <table width=\"100%\" border=\"1\">\n")
-                (princ "                  <tr>\n")
-                (princ
-                 (format "                    <td width=\"20%%\" rowspan=\"1\" colspan=\"1\">%s</td>\n"
-                         (release-mail-markup-author
-                          (first c))))
-                (princ
-                 (format "                    <td rowspan=\"1\" colspan=\"1\">%s</td>\n"
-                         (release-mail-markup-subject (second c))))
-                (princ "                  </tr>\n")
-                (princ "                  <tr>\n")
-                (princ
-                 (format "                    <td rowspan=\"1\" colspan=\"2\">%s</td>\n"
-                         (release-mail-markup-url
-                          (third c))))
-                (princ "                  </tr>\n")
-                (princ "                </table>\n")
-                (princ "              </td>\n")
-                (princ "            </tr>\n")
-                ))
-             release-mail-to-html-patch-list)
-            (princ "          </table>\n"))
-          (princ
-           (release-mail-index release-mail-index)))
-        ;; Quote HTML markup in preformatted sections.
-        (with-current-buffer
-            content-buffer
-          (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))))
-        ;; Add Local variables for PSGML at end of content file.
-        (with-current-buffer
-            content-buffer
-          (goto-char (point-max))
-          (insert
-           (format
-            "\n<!-- Keep this comment at the end of the file\n%s %s
+		       subject))
+	      (when release-mail-announcement
+		(princ
+		 (format
+		  "          <h1><a name=\"announcement\">%s</a></h1>\n"
+		  subject))
+		(princ
+		 (release-mail-index release-mail-index "announcement"))
+		(princ
+		 (format
+		  "            <pre xml:space=\"preserve\">\n%s</pre>\n"
+		  release-mail-announcement)))
+	      (when
+		  (and
+		   (or
+		    xemacs-version-from-subject
+		    code-name-from-subject)
+		   release-mail-to-html-summary-alist)
+		(princ
+		 (format
+		  "            <h1><a name=\"summary\">Changes</a> in %s%s%s</h1>\n"
+		  type
+		  (concat " " xemacs-version-from-subject)
+		  (concat " "  code-name-from-subject)))
+		(princ
+		 (release-mail-index release-mail-index "summary"))
+		(mapc
+		 ;; Handle a single summary of release-mail-to-html-summary-alist:
+		 (function
+		  (lambda (s)
+		    (if (not (cdr s))
+			;; Print summary entry as paragraph, because it
+			;; has no summary items.
+			(princ (format "            <p>%s</p>\n" (car s)))
+		      ;; Print summary name:
+		      (princ (format "            <h2>%s</h2>\n" (car s)))
+		      ;; Print summary items as unordered list:
+		      (princ (format "            <ul>\n"))
+		      ;; Handle list of summary items:
+		      (mapc
+		       ;; Handle single summary item:
+		       (function
+			(lambda (sil)
+			  (princ (format "              <li>%s</li>\n" sil))))
+		       (cdr s))
+		      (princ (format "            </ul>\n")))))
+		 release-mail-to-html-summary-alist))
+	      (when (and
+		     (or
+		      xemacs-version-from-subject
+		      code-name-from-subject)
+		     release-mail-to-html-changelog-alist)
+		(princ
+		 (format
+		  "            <h1><a name=\"changes\">ChangeLogs</a> for %s%s%s</h1>\n"
+		  type
+		  (concat " " xemacs-version-from-subject)
+		  (concat " "  code-name-from-subject)))
+		(princ
+		 (release-mail-index release-mail-index "changes"))
+		(princ
+		 (format
+		  "            <ul>\n"))
+		(mapc
+		 (function
+		  (lambda (l)
+		    (princ
+		     (format
+		      "              <li>ChangeLog Entries from <a href=\"#%s\">%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>ChangeLog Entries from <a name=\"%s\">%s</a></h2>\n%s            <pre xml:space=\"preserve\">%s</pre>\n"
+		      (replace-in-string (car l) "/" ":")
+		      (car l)
+		      (release-mail-index release-mail-index "")
+		      (cdr l)))))
+		 release-mail-to-html-changelog-alist))
+	      (when release-mail-to-html-patch-list
+		(princ
+		 (format "          <h1><a name=\"patches\">Patches</a> in %s%s%s</h1>\n"
+			 type
+			 (concat " " xemacs-version-from-subject)
+			 (concat " "  code-name-from-subject)))
+		(princ
+		 (release-mail-index release-mail-index "patches"))
+		(princ "          <table border=\"0\">\n")
+		(princ "            <tr>\n")
+		(princ "              <td>\n")
+		(princ "                <table width=\"100%\" border=\"1\">\n")
+		(princ "                  <tr>\n")
+		(princ "                    <th width=\"20%\" rowspan=\"1\" colspan=\"1\">Author</th>\n")
+		(princ "                    <th rowspan=\"1\" colspan=\"1\">Subject</th>\n")
+		(princ "                  </tr>\n")
+		(princ "                  <tr>\n")
+		(princ "                    <th rowspan=\"1\" colspan=\"2\">Patch URL</th>\n")
+		(princ "                  </tr>\n")
+		(princ "                </table>\n")
+		(princ "              </td>\n")
+		(princ "            </tr>\n")
+		(mapc
+		 (function
+		  (lambda (c)
+		    (princ "            <tr>\n")
+		    (princ "              <td rowspan=\"1\" colspan=\"1\">\n")
+		    (princ "                <table width=\"100%\" border=\"1\">\n")
+		    (princ "                  <tr>\n")
+		    (princ
+		     (format "                    <td width=\"20%%\" rowspan=\"1\" colspan=\"1\">%s</td>\n"
+			     (release-mail-markup-author
+			      (first c))))
+		    (princ
+		     (format "                    <td rowspan=\"1\" colspan=\"1\">%s</td>\n"
+			     (release-mail-markup-subject (second c))))
+		    (princ "                  </tr>\n")
+		    (princ "                  <tr>\n")
+		    (princ
+		     (format "                    <td rowspan=\"1\" colspan=\"2\">%s</td>\n"
+			     (release-mail-markup-url
+			      (third c))))
+		    (princ "                  </tr>\n")
+		    (princ "                </table>\n")
+		    (princ "              </td>\n")
+		    (princ "            </tr>\n")
+		    ))
+		 release-mail-to-html-patch-list)
+		(princ "          </table>\n"))
+	      (princ
+	       (release-mail-index release-mail-index)))
+	    ;; Quote HTML markup in preformatted sections.
+	    (with-current-buffer
+		content-buffer
+	      (goto-char (point-min))
+	      (while
+		  (setq result
+			(release-mail-to-html-match
+			 'release-mail-to-html-preformatted-regexp
+			 nil
+			 nil
+			 (assoc type release-mail-to-html-regexp-alist)))
+		(html-quote-region
+		 (match-beginning 1)
+		 (match-end 1))))
+	    ;; Add Local variables for PSGML at end of content file.
+	    (with-current-buffer
+		content-buffer
+	      (goto-char (point-max))
+	      (insert
+	       (format
+		"\n<!-- Keep this comment at the end of the file\n%s %s
 mode: xml
 sgml-omittag:nil
 sgml-shorttag:nil
 sgml-local-ecat-files:nil
 End:
 -->\n"
-            ;; Disguise the local variable bit so that we don't enter
-            ;; xml-mode!
-            "Local"
-            "variables:")))
-        content-buffer))))
+		;; Disguise the local variable bit so that we don't enter
+		;; xml-mode in the emacs-lisp source file.
+		"Local"
+		"variables:")))
+	    content-buffer))))))
+
+(defun release-mail-to-html-match (kind goto delete args)
+  (let* ((case-fold-search t)
+	 (plist
+	  (plist-get (cdr args) kind))
+	 (regexp (car plist))
+	 (sub-matches-alist (plist-to-alist (cdr plist)))
+	 matches)
+    (cond
+     ((functionp goto)
+      (goto-char (funcall goto)))
+     ((stringp goto)
+      (goto-char (point-min))
+      (re-search-forward
+       goto
+       nil t))
+     ((null goto))
+     (t
+      (error
+       "release-mail-to-html-match: invalid goto argument (%S)" goto)))
+    (and
+     (re-search-forward
+      regexp
+      nil t)
+     sub-matches-alist
+     (setq matches
+	   (append
+	    (mapcar
+	     (function (lambda (matches)
+			 (cons (car matches) (match-string (cdr matches)))))
+	     sub-matches-alist)
+	    matches)))
+    (when
+	(and matches delete)
+      (delete-region
+       (match-beginning 0)
+       (match-end 0)))
+    (alist-to-plist matches)))
 
 (defun release-mail-markup-author (author)
   "internal function"
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.