admin/admin.el: Add some code for deploying web manuals.

author: Chong Yidong <cyd@stupidchicken.com> 2011-03-12 22:50:33 -0500
committer: Chong Yidong <cyd@stupidchicken.com> 2011-03-12 22:50:33 -0500
commit: 8d9101d850b5ad006ce41a231f294ea6de93986a (patch)
tree: 9873c1925a2f085c972d1cde617496c49e5bec1b /admin
parent: 9d05d1ba20797a7478a7ed68ff88452cb4f8c4c8 (diff)
download: emacs-8d9101d850b5ad006ce41a231f294ea6de93986a.tar.gz
1 files changed, 230 insertions, 0 deletions
diff --git a/admin/admin.el b/admin/admin.el
index 717bfee702d..70958ce1a76 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -212,6 +212,236 @@ Root must be the root of an Emacs source tree."
                    "\\\\def\\\\year{")
                  "\\([0-9]\\{4\\}\\)}.+%.+copyright year"))))))
 
+;;; Various bits of magic for generating the web manuals
+
+(defun make-manuals (root)
+  "Generate the web manuals for the Emacs webpage."
+  (interactive "DEmacs root directory: ")
+  (let* ((dest (expand-file-name "manual" root))
+	 (html-node-dir (expand-file-name "html_node" dest))
+	 (html-mono-dir (expand-file-name "html_mono" dest))
+	 (txt-dir (expand-file-name "text" dest))
+	 (dvi-dir (expand-file-name "dvi" dest))
+	 (ps-dir (expand-file-name "ps" dest)))
+    (when (file-directory-p dest)
+      (if (y-or-n-p (format "Directory %s exists, delete it first?" dest))
+	  (delete-directory dest t)
+	(error "Aborted")))
+    (make-directory dest)
+    (make-directory html-node-dir)
+    (make-directory html-mono-dir)
+    (make-directory txt-dir)
+    (make-directory dvi-dir)
+    (make-directory ps-dir)
+    ;; Emacs manual
+    (let ((texi (expand-file-name "doc/emacs/emacs.texi" root)))
+      (manual-html-node texi (expand-file-name "emacs" html-node-dir))
+      (manual-html-mono texi (expand-file-name "emacs.html" html-mono-dir))
+      (manual-txt texi (expand-file-name "emacs.txt" txt-dir))
+      (manual-pdf texi (expand-file-name "emacs.pdf" dest))
+      (manual-dvi texi (expand-file-name "emacs.dvi" dvi-dir)
+      		  (expand-file-name "emacs.ps" ps-dir)))
+    ;; Lisp manual
+    (let ((texi (expand-file-name "doc/lispref/elisp.texi" root)))
+      (manual-html-node texi (expand-file-name "elisp" html-node-dir))
+      (manual-html-mono texi (expand-file-name "elisp.html" html-mono-dir))
+      (manual-txt texi (expand-file-name "elisp.txt" txt-dir))
+      (manual-pdf texi (expand-file-name "elisp.pdf" dest))
+      (manual-dvi texi (expand-file-name "elisp.dvi" dvi-dir)
+      		  (expand-file-name "elisp.ps" ps-dir)))
+    (message "Manuals created in %s" dest)))
+
+(defconst manual-doctype-string
+  "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
+\"http://www.w3.org/TR/html4/loose.dtd\">\n\n")
+
+(defconst manual-meta-string
+  "<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\">
+<link rev=\"made\" href=\"mailto:webmasters@gnu.org\">
+<link rel=\"icon\" type=\"image/png\" href=\"/graphics/gnu-head-mini.png\">
+<meta name=\"ICBM\" content=\"42.256233,-71.006581\">
+<meta name=\"DC.title\" content=\"gnu.org\">\n\n")
+
+(defconst manual-style-string "<style type=\"text/css\">
+@import url('/style.css');\n</style>\n")
+
+(defun manual-html-mono (texi-file dest)
+  "Run Makeinfo on TEXI-FILE, emitting mono HTML output to DEST.
+This function also edits the HTML files so that they validate as
+HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using
+the @import directive."
+  (call-process "makeinfo" nil nil nil
+		"--html" "--no-split" texi-file "-o" dest)
+  (with-temp-buffer
+    (insert-file-contents dest)
+    (setq buffer-file-name dest)
+    (manual-html-fix-headers)
+    (manual-html-fix-index-1)
+    (manual-html-fix-index-2 t)
+    (manual-html-fix-node-div)
+    (goto-char (point-max))
+    (re-search-backward "</body>[\n \t]*</html>")
+    (insert "</div>\n\n")
+    (save-buffer)))
+
+(defun manual-html-node (texi-file dir)
+  "Run Makeinfo on TEXI-FILE, emitting per-node HTML output to DIR.
+This function also edits the HTML files so that they validate as
+HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using
+the @import directive."
+  (unless (file-exists-p texi-file)
+    (error "Manual file %s not found" texi-file))
+  (call-process "makeinfo" nil nil nil
+		"--html" texi-file "-o" dir)
+  ;; Loop through the node files, fixing them up.
+  (dolist (f (directory-files dir nil "\\.html\\'"))
+    (let (opoint)
+      (with-temp-buffer
+	(insert-file-contents (expand-file-name f dir))
+	(setq buffer-file-name (expand-file-name f dir))
+	(if (looking-at "<meta http-equiv")
+	    ;; Ignore those HTML files that are just redirects.
+	    (set-buffer-modified-p nil)
+	  (manual-html-fix-headers)
+	  (if (equal f "index.html")
+	      (let (copyright-text)
+		(manual-html-fix-index-1)
+		;; Move copyright notice to the end.
+		(re-search-forward "[ \t]*<p>Copyright &copy;")
+		(setq opoint (match-beginning 0))
+		(re-search-forward "</blockquote>")
+		(setq copyright-text (buffer-substring opoint (point)))
+		(delete-region opoint (point))
+		(manual-html-fix-index-2)
+		(insert copyright-text "\n</div>\n"))
+	    ;; For normal nodes, give the header div a blue bg.
+	    (manual-html-fix-node-div))
+	  (save-buffer))))))
+
+(defun manual-txt (texi-file dest)
+  "Run Makeinfo on TEXI-FILE, emitting plaintext output to DEST."
+  (call-process "makeinfo" nil nil nil
+		"--plaintext" "--no-split" texi-file "-o" dest)
+  (shell-command (concat "gzip -c " dest " > " (concat dest ".gz"))))
+
+(defun manual-pdf (texi-file dest)
+  "Run texi2pdf on TEXI-FILE, emitting plaintext output to DEST."
+  (call-process "texi2pdf" nil nil nil texi-file "-o" dest))
+
+(defun manual-dvi (texi-file dest ps-dest)
+  "Run texi2dvi on TEXI-FILE, emitting dvi output to DEST.
+Also generate postscript output in PS-DEST."
+  (call-process "texi2dvi" nil nil nil texi-file "-o" dest)
+  (call-process "dvips" nil nil nil dest "-o" ps-dest)
+  (call-process "gzip" nil nil nil dest)
+  (call-process "gzip" nil nil nil ps-dest))
+
+(defun manual-html-fix-headers ()
+  "Fix up HTML headers for the Emacs manual in the current buffer."
+  (let (opoint)
+    (insert manual-doctype-string)
+    (search-forward "<head>\n")
+    (insert manual-meta-string)
+    (search-forward "<meta")
+    (setq opoint (match-beginning 0))
+    (re-search-forward "<!--")
+    (goto-char (match-beginning 0))
+    (delete-region opoint (point))
+    (insert manual-style-string)
+    (search-forward "<meta http-equiv=\"Content-Style")
+    (setq opoint (match-beginning 0))
+    (search-forward "</head>")
+    (delete-region opoint (match-beginning 0))))
+
+(defun manual-html-fix-node-div ()
+  "Fix up HTML \"node\" divs in the current buffer."
+  (let (opoint div-end)
+    (while (search-forward "<div class=\"node\">" nil t)
+      (replace-match
+       "<div class=\"node\" style=\"background-color:#DDDDFF\">"
+       t t)
+      (setq opoint (point))
+      (re-search-forward "</div>")
+      (setq div-end (match-beginning 0))
+      (goto-char opoint)
+      (if (search-forward "<hr>" div-end 'move)
+	  (replace-match "" t t)))))
+
+(defun manual-html-fix-index-1 ()
+  (let (opoint)
+    (re-search-forward "<body>\n\\(<h1 class=\"settitle\\)")
+    (setq opoint (match-beginning 1))
+    (search-forward "<h2 class=\"unnumbered")
+    (goto-char (match-beginning 0))
+    (delete-region opoint (point))
+    (insert "<div id=\"content\" class=\"inner\">\n\n")))
+
+(defun manual-html-fix-index-2 (&optional table-workaround)
+  "Replace the index list in the current buffer with a HTML table."
+  (let (done open-td tag desc)
+    ;; Convert the list that Makeinfo made into a table.
+    (search-forward "<ul class=\"menu\">")
+    (replace-match "<table style=\"float:left\" width=\"100%\">")
+    (forward-line 1)
+    (while (not done)
+      (cond
+       ((or (looking-at "<li>\\(<a.+</a>\\):[ \t]+\\(.*\\)$")
+	    (looking-at "<li>\\(<a.+</a>\\)$"))
+	(setq tag (match-string 1))
+	(setq desc (match-string 2))
+	(replace-match "" t t)
+	(when open-td
+	  (save-excursion
+	    (forward-char -1)
+	    (skip-chars-backward " ")
+	    (delete-region (point) (line-end-position))
+	    (insert "</td>\n  </tr>")))
+	(insert "  <tr>\n    ")
+	(if table-workaround
+	    ;; This works around a Firefox bug in the mono file.
+	    (insert "<td bgcolor=\"white\">")
+	  (insert "<td>"))
+	(insert tag "</td>\n    <td>" (or desc ""))
+	(setq open-td t))
+       ((eq (char-after) ?\n)
+	(delete-char 1)
+	;; Negate the following `forward-line'.
+	(forward-line -1))
+       ((looking-at "<!-- ")
+	(search-forward "-->"))
+       ((looking-at "<p>[- ]*The Detailed Node Listing[- \n]*")
+	(replace-match "  </td></tr></table>\n
+<h3>Detailed Node Listing</h3>\n\n" t t)
+	(search-forward "<p>")
+	(search-forward "<p>")
+	(goto-char (match-beginning 0))
+	(skip-chars-backward "\n ")
+	(setq open-td nil)
+	(insert "</p>\n\n<table  style=\"float:left\" width=\"100%\">"))
+       ((looking-at "</li></ul>")
+	(replace-match "" t t))
+       ((looking-at "<p>")
+	(replace-match "" t t)
+	(when open-td
+	  (insert "  </td></tr>")
+	  (setq open-td nil))
+	(insert "  <tr>
+    <th colspan=\"2\" align=\"left\" style=\"text-align:left\">")
+	(re-search-forward "</p>[ \t\n]*<ul class=\"menu\">")
+	(replace-match "  </th></tr>"))
+       ((looking-at "[ \t]*</ul>[ \t]*$")
+	(replace-match
+	 (if open-td
+	     "  </td></tr>\n</table>"
+	   "</table>") t t)
+	(setq done t))
+       (t
+	(if (eobp)
+	    (error "Parse error in %s" f))
+	(unless open-td
+	  (setq done t))))
+      (forward-line 1))))
+
 (provide 'admin)
 
 ;;; admin.el ends here
author	Chong Yidong <cyd@stupidchicken.com>	2011-03-12 22:50:33 -0500
committer	Chong Yidong <cyd@stupidchicken.com>	2011-03-12 22:50:33 -0500
commit	8d9101d850b5ad006ce41a231f294ea6de93986a (patch)
tree	9873c1925a2f085c972d1cde617496c49e5bec1b /admin
parent	9d05d1ba20797a7478a7ed68ff88452cb4f8c4c8 (diff)
download	emacs-8d9101d850b5ad006ce41a231f294ea6de93986a.tar.gz