Commits

Anonymous committed 3d21a8f

Initial release-mail-to-html.el implementation is complete <uzogklcw4.fsf@rapier.ecf.teradyne.com>

Comments (0)

Files changed (2)

+2001-01-22  Adrian Aichner  <adrian@xemacs.org>
+
+	* release-mail-to-html.el: Update docstrings and replace \s- by [ \t]
+	in regexps to avoid syntax table hacking.
+	* release-mail-to-html.el
+	(release-mail-to-html-preformatted-regexp): Improve.
+	* release-mail-to-html.el (release-mail-to-html-header-regexp):
+	Ditto.
+	* release-mail-to-html.el (release-mail-to-html-subject-regexp):
+	Ditto.
+	* release-mail-to-html.el
+	(release-mail-to-html-summary-header-regexp): Ditto.
+	* release-mail-to-html.el
+	(release-mail-to-html-summary-item-regexp): Ditto.
+	* release-mail-to-html.el
+	(release-mail-to-html-changelog-record-regexp): Ditto.
+	* release-mail-to-html.el (release-mail-to-html-changelog-regexp):
+	Ditto.
+	* release-mail-to-html.el (release-mail-to-html-patch-regexp):
+	Ditto.
+	* release-mail-to-html.el (release-mail-to-html): Handle stable
+	releases also and implement common look for beta and stable
+	release announcements on the web.
+	* release-mail-to-html.el (release-mail-markup-author): Mark as
+	internal.
+	* release-mail-to-html.el (release-mail-markup-url): Ditto.
+	* release-mail-to-html.el (release-mail-markup-subject): Ditto.
+	* release-mail-to-html.el (release-mail-index): Ditto.
+
+2001-01-20  Adrian Aichner  <adrian@xemacs.org>
+
+	* Makefile (FIND): New variable to specify find command under
+	Windows.
+	* Makefile (CONTENT_FILES): Use FIND.
+	* Makefile (HTML_FILES): Ditto.
+	* Makefile (clean): Ditto.
+	* batch-psgml-validate.el (batch-psgml-validate-buffer): Inhibit
+	file backups.
+	* release-mail-to-html.el (release-mail-to-html-patch-regexp):
+	* release-mail-to-html.el (release-mail-to-html): Warn, instead of
+	err on missing mail header.
+	* template-de.html: Fix website mirror presentation.
+	* template.html: Ditto.
+
 2001-01-21  Andrew J Cosgriff  <ajc@xemacs.org>
 
 	* index.content: Current stable release is 21.1.13.

release-mail-to-html.el

 
 (condition-case nil
     (progn
-      ;; Try to pull in required modules.
+      ;; Pull in required modules.
       ;; (require 'regexp-opt)
       (require 'psgml)
       (require 'psgml-parse)            ; for sgml-element-context-string
 
 (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."
+  "REGEXP matching preformatted HTML in the MAJOR.MINOR.PATCH.content
+buffer generated from XEmacs release mail."
   :type '(regexp
           :custom-show t
           :documentation-shown t)
   :group 'release-mail-to-html)
 
 (defcustom release-mail-to-html-header-regexp
-  "^\\(\\(-\\|\\sw\\)+\\)\\s-*:\\s-*\\(.*\\(\n\\s-+.*\\)*\\)\n"
+  "^\\(\\(-\\|\\sw\\)+\\)[ \t]*:[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)\n"
   "REGEXP matching mail headers."
   :type '(regexp
           :custom-show t
   :group 'release-mail-to-html)
 
 (defcustom release-mail-to-html-subject-regexp
-  "^subject\\s-*:\\s-*XEmacs\\s-+\\([0-9]+\\)\\.\\([0-9]+\\)\\(\\.\\([0-9]+\\)\\|\\s-+(patch\\s-+\\([0-9]+\\))\\)\\s-+\\(\\(\"[^\"]+\"\\)\\s-+\\)?\\(is\\|has\\s-+been\\)\\s-+released"
-  "REGEXP matching mail subject header in an XEmacs beta release mail,
-returning release number as match-string 1."
+  "^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\\s-+summary\\s-+of\\s-+changes\\s-+to\\s-+\\(\\S-+\\)\\s-+\\(\"[^\"]+\"\\)\n*"
+  "^.*Brief[ \t]+summary[ \t]+of[ \t]+changes[ \t]+to[ \t]+\\([^ \t]+\\)[ \t]+\\(\"[^\"]+\"\\)\n*"
   "REGEXP matching the brief summary header of changes in an XEmacs
-beta release mail."
+release mail, if present."
   :type '(regexp
           :custom-show t
           :documentation-shown t)
   :group 'release-mail-to-html)
 
 (defcustom release-mail-to-html-summary-item-regexp
-  "^-- \\(.*\\(\n\\s-+.*\\)*\\)\n*"
+  "^-- \\(.*\\(\n[ \t]+.*\\)*\\)\n*"
   "REGEXP matching a single change in the brief summary of changes in
-an XEmacs beta release mail."
+an XEmacs release mail, if present."
   :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\\}\\s-+\\(?:.*\\)\\s-+\\(?:<[^>]+>\\)\\(\n*\\s-+.*\\)+\n*"
+  "\n*[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[ \t]+\\(?:.*\\)[ \t]+\\(?:<[^>]+>\\)\\(\n*[ \t]+.*\\)+"
   "REGEXP matching one ChangeLog record for a (sub-)directory in an
-XEmacs beta release mail."
+XEmacs release mail, if present."
   :type '(regexp
           :custom-show t
           :documentation-shown t)
   :group 'release-mail-to-html)
 
 (defcustom release-mail-to-html-changelog-regexp
-  (format "\n*-+\\s-*ChangeLog\\s-+entries\\s-+from\\s-+[^/]+/\\(.*ChangeLog\\)\\s-*-+\\(\\(%s\\)+\\)\n*" release-mail-to-html-changelog-record-regexp)
+  (format "\n*-+[ \t]*ChangeLog[ \t]+entries[ \t]+from[ \t]+[^/]+/\\(.*ChangeLog\\)[ \t]*-+\\(\\(%s\\)+\\)\n*" release-mail-to-html-changelog-record-regexp)
   "REGEXP matching all ChangeLog records for a sub-directory in an
-XEmacs beta release mail."
+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
-  "^\\s-*From:\\s-*\\(.*\\)\\s-*\nSubject:\\s-*\\(.*\\)\\s-*\n\\S-*URL:\\s-*\\(.*\\)\\s-*$"
-  "REGEXP matching patch records in an XEmacs beta release mail."
+  "^From:[ \t]*\\(.*\\)[ \t]*\nSubject:[ \t]*\\(.*\\)[ \t]*\n[^ \t]*URL:[ \t]*\\(.*\\)[ \t]*\n*"
+  "REGEXP matching patch records in an XEmacs release mail, if
+present."
   :type '(regexp
           :custom-show t
           :documentation-shown t)
   :group 'release-mail-to-html)
 
 (defun release-mail-to-html (&optional buffer)
-  "Create HTML from XEmacs release mail."
+  "*Create HTML from XEmacs release mail.  BUFFER (defaulting to
+*Article*) needs to hold a standard release announcement for a stable
+or beta release of XEmacs, as mailed to <xemacs-announce@xemacs.org>
+or <xemacs-beta@xemacs.org> respectively.
+The HTML output is placed in a buffer named uniquely (see
+`generate-new-buffer-name'), based on the format
+MAJOR.MINOR.PATCH.content, where PATCH may be a BETA number instead.
+This is the standard filename used as genpage input to created to
+corresponding HTML file.  The actual name used for buffer is
+returned."
   (interactive
    (list
     (read-buffer "buffer containing release mail: " "*Article*" t)))
   (save-excursion
     (with-temp-buffer
       (insert-buffer buffer)
-      (modify-syntax-entry ?\n ">   " (syntax-table))
       (let (major-version
             minor-version
-            beta-version
+            patch-level
             xemacs-version
             code-name
             release-mail-summary-items
             release-mail-to-html-changelog-alist
             release-mail-to-html-patch-list
             release-mail-announcement
-            release-mail-index)
+            release-mail-index
+            content-buffer)
         (goto-char (point-min))
         ;; Extract version information from subject line.
         (when (re-search-forward
                 (match-string 1)
                 minor-version
                 (match-string 2)
-                beta-version
+                patch-level
                 (or
                  (match-string 4)
                  (match-string 5))
           (and
            major-version
            minor-version
-           beta-version
+           patch-level
            (setq xemacs-version
                  (format
                   "%s.%s.%s"
-                  major-version minor-version beta-version))))
+                  major-version minor-version patch-level))))
         ;; Extract summary items from announcement body.
         (when (re-search-forward
                release-mail-to-html-summary-header-regexp nil t)
             (delete-region
              (match-beginning 0)
              (match-end 0))))
+        (unless (and xemacs-version code-name)
+          (error "release-mail-to-html: %s fails to specify version for XEmacs to announce." buffer))
         ;; Extract changelog entries from announcement body.
         (while (re-search-forward
                 release-mail-to-html-changelog-regexp nil t)
            (match-end 0)))
         ;; Get remaining free-form announcement body.
         (goto-char (point-min))
-        (re-search-forward "\n\n" nil t)
-        ;; Process mail header.
-        (save-restriction
-          (narrow-to-region
-           (point-min)
-           (- (point) 1))
-          (goto-char (point-min))
-          (delete-non-matching-lines
-           release-mail-headers-to-keep-regexp))
+        (save-excursion
+          (replace-regexp "\n+\\'" "")) ; remove empty trailing lines.
+        (re-search-forward "^[^:]+:.*\n\n" nil t)
+        ;; 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))
+          (warn "release-mail-to-html: %s misses mail headers."
+                (buffer-name)))
+        (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
           (setq
            release-mail-index
            (cons "changes" release-mail-index)))
+        (when release-mail-summary-items
+          (setq
+           release-mail-index
+           (cons "summary" release-mail-index)))
         (when release-mail-announcement
           (setq
            release-mail-index
            (cons "announcement" release-mail-index)))
-        (when release-mail-summary-items
-          (setq
-           release-mail-index
-           (cons "summary" release-mail-index)))
+        (setq
+         content-buffer
+         (generate-new-buffer-name
+          (format "%s.content" xemacs-version)))
         ;; Generate XML/XHTML/HTML document.
         (with-output-to-temp-buffer
-            (format "%s.content" xemacs-version)
-          (progn
-            (princ
-             (format "%%title%%
+            content-buffer
+          (princ
+           (format "%%title%%
 XEmacs %s %s is Released
 %%author%%
 automatically generated from release announcement by release-mail-to-html.el
 %%main%%
 "
-                     xemacs-version
-                     code-name))
-            (when release-mail-announcement
-              (princ
-               (format
-                "            <h1><a name=\"announcement\" shape=\"rect\">XEmacs</a> %s %s is Released</h1>\n"
-                xemacs-version code-name))
-              (princ
-               (release-mail-index release-mail-index))
-              (princ
-               (format
-                "<pre xml:space=\"preserve\">\n%s</pre>\n"
-                release-mail-announcement)))
-            (when (and xemacs-version code-name release-mail-summary-items)
-              (princ
-               (format
-                "            <h1><a name=\"summary\" shape=\"rect\">Changes</a> in XEmacs %s %s</h1>\n"
-                xemacs-version code-name))
-              (princ
-               (release-mail-index release-mail-index))
-              (princ "            <ul>\n")
-              (mapc
-               (function
-                (lambda (c)
-                  (princ (format "	    <li>%s</li>\n" c))))
-               release-mail-summary-items)
-              (princ "	  </ul>\n"))
-            (when (and
                    xemacs-version
-                   code-name
-                   release-mail-to-html-changelog-alist)
-              (princ
-               (format
-                "            <h1><a name=\"changes\" shape=\"rect\">ChangeLogs</a> for XEmacs %s %s</h1>\n"
-                xemacs-version code-name))
-              (princ
-               (release-mail-index release-mail-index))
-              (princ
-               (format
-                "            <ul>\n"))
-              (mapc
-               (function
-                (lambda (l)
-                  (princ
-                   (format
-                    "	    <li>ChangeLog Entries from <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
-                    "            <h1>ChangeLog Entries from <a name=\"%s\" shape=\"rect\">%s</a></h1>\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\" shape=\"rect\">Patches</a> in XEmacs %s %s</h1>\n"
-                       xemacs-version code-name))
-              (princ
-               (release-mail-index release-mail-index))
-              (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"))
+                   code-name))
+          (when release-mail-announcement
             (princ
-             (release-mail-index release-mail-index))
-            ));; Quote HTML markup in preformatted sections.
+             (format
+              "          <h1><a name=\"announcement\" shape=\"rect\">XEmacs</a> %s %s is Released</h1>\n"
+              xemacs-version code-name))
+            (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 code-name release-mail-summary-items)
+            (princ
+             (format
+              "          <h1><a name=\"summary\" shape=\"rect\">Changes</a> in XEmacs %s %s</h1>\n"
+              xemacs-version code-name))
+            (princ
+             (release-mail-index release-mail-index "summary"))
+            (princ "          <ul>\n")
+            (mapc
+             (function
+              (lambda (c)
+                (princ (format "            <li>%s</li>\n" c))))
+             release-mail-summary-items)
+            (princ "          </ul>\n"))
+          (when (and
+                 xemacs-version
+                 code-name
+                 release-mail-to-html-changelog-alist)
+            (princ
+             (format
+              "          <h1><a name=\"changes\" shape=\"rect\">ChangeLogs</a> for XEmacs %s %s</h1>\n"
+              xemacs-version code-name))
+            (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\" 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>ChangeLog Entries from <a name=\"%s\" shape=\"rect\">%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\" shape=\"rect\">Patches</a> in XEmacs %s %s</h1>\n"
+                     xemacs-version code-name))
+            (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
-            (get-buffer
-             (format "%s.content" xemacs-version))
+            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))))))))
+             (match-end 1))))
+        content-buffer))))
 
 (defun release-mail-markup-author (author)
+  "internal function"
   (let
       ((components
         (mail-extract-address-components author)))
       (buffer-string))))
 
 (defun release-mail-markup-url (url)
+  "internal function"
   (if
       (string-match
        "\\`\\(http\\|ftp\\)://" url)
     url))
 
 (defun release-mail-markup-subject (subject)
+  "internal function"
   (with-temp-buffer
     (insert subject)
     (html-quote-region
     (insert "</strong>")
     (buffer-string)))
 
-(defun release-mail-index (items)
-  (when items
-    (with-temp-buffer
-      (insert "            <p>goto ")
-      (mapc
-       (function
-        (lambda (i)
-          (insert (format "<a href=\"#%s\" shape=\"rect\">%s</a>\n" i i))))
-       items)
-      (insert "</p>\n")
-      (goto-char (point-min))
-      (replace-regexp "</a>\n<a" "</a>,\n<a")
-      (buffer-string))))
+(defun release-mail-index (items &optional we-are-here)
+  "internal function"
+  (if items
+      (concat
+       "          <p>goto "
+       (mapconcat
+        (function
+         (lambda (i)
+           (if (and
+                we-are-here
+                (string= i we-are-here))
+               (format "%s" i)
+             (format "<a href=\"#%s\" shape=\"rect\">%s</a>" i i))))
+        items
+        ",\n            ")
+       "</p>\n")
+    ""))
 
 ;;; release-mail-to-html.el ends here