|
@@ -0,0 +1,145 @@
|
|
|
+;;; edit-server-htmlize.el --- (de)HTMLization hooks for edit-server.el
|
|
|
+
|
|
|
+;;; Copyright (C) 2013 Roland McGrath
|
|
|
+
|
|
|
+;; Author: Roland McGrath <roland@hack.frob.com>
|
|
|
+;; Maintainer: Roland McGrath <roland@hack.frob.com>
|
|
|
+;; Version: 0.2
|
|
|
+
|
|
|
+;; This file is not part of GNU Emacs.
|
|
|
+
|
|
|
+;; This file is free software; you can redistribute it and/or modify
|
|
|
+;; it under the terms of the GNU General Public License as published by
|
|
|
+;; the Free Software Foundation; either version 3, or (at your option)
|
|
|
+;; any later version.
|
|
|
+
|
|
|
+;; This file is distributed in the hope that it will be useful,
|
|
|
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
+;; GNU General Public License for more details.
|
|
|
+
|
|
|
+;; You should have received a copy of the GNU General Public License
|
|
|
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
+
|
|
|
+;;; Commentary:
|
|
|
+
|
|
|
+;; This is intended for use with edit-server.el and the corresponding
|
|
|
+;; "Edit with Emacs" extension for the Chromium/Google Chrome Web browser.
|
|
|
+;; See https://github.com/stsquad/emacs_chrome
|
|
|
+;;
|
|
|
+;; This provides some simple functions for deHTMLizing and reHTMLizing
|
|
|
+;; "plain text" as encoded by e.g. GMail composition boxes.
|
|
|
+
|
|
|
+;;; Code:
|
|
|
+
|
|
|
+;; (add-hook 'edit-server-start-hook 'edit-server-maybe-dehtmlize-buffer)
|
|
|
+;; (add-hook 'edit-server-done-hook 'edit-server-maybe-htmlize-buffer)
|
|
|
+
|
|
|
+
|
|
|
+(require 'edit-server)
|
|
|
+(require 'html2text)
|
|
|
+
|
|
|
+
|
|
|
+(defconst edit-server-htmlize-entity-alist
|
|
|
+ '(("<" . "<")
|
|
|
+ (">" . ">")
|
|
|
+ ("&" . "&"))
|
|
|
+ "Alist of strings that cannot safely appear inside an HTML <pre> element.
|
|
|
+This maps a string to its HTML entity string.")
|
|
|
+
|
|
|
+(defconst edit-server-htmlize-regexp
|
|
|
+ (mapconcat (lambda (pair) (concat "\\(" (regexp-quote (car pair)) "\\)"))
|
|
|
+ edit-server-htmlize-entity-alist
|
|
|
+ "\\|"))
|
|
|
+(defconst edit-server-htmlize-replacements
|
|
|
+ (apply 'vector (mapcar 'cdr edit-server-htmlize-entity-alist)))
|
|
|
+
|
|
|
+(defun edit-server-htmlize-replace (regexp replacements)
|
|
|
+ (save-match-data
|
|
|
+ (while (re-search-forward regexp nil t)
|
|
|
+ (let ((i 0))
|
|
|
+ (while (and (< i (length replacements))
|
|
|
+ (null (match-beginning (1+ i))))
|
|
|
+ (setq i (1+ i)))
|
|
|
+ (replace-match (aref replacements i) t t)))))
|
|
|
+
|
|
|
+(defun edit-server-htmlize-buffer ()
|
|
|
+ "Do a simple HTMLification of the buffer as plain text.
|
|
|
+This produces HTML intended to reproduce the original plain text contents
|
|
|
+of the buffer."
|
|
|
+ (interactive)
|
|
|
+ (save-excursion
|
|
|
+ (goto-char (point-min))
|
|
|
+ (insert "<pre>")
|
|
|
+ (edit-server-htmlize-replace edit-server-htmlize-regexp
|
|
|
+ edit-server-htmlize-replacements)
|
|
|
+ (goto-char (point-max))
|
|
|
+ (insert "</pre>")))
|
|
|
+
|
|
|
+;; XXX Modified from 23.3.1's gnus/html2text.el html2text,
|
|
|
+;; which wants to eat <br> and refill paragraphs.
|
|
|
+(defun edit-server-dehtmlize-buffer ()
|
|
|
+ "Convert HTML to plain text in the current buffer.
|
|
|
+This differs from \\[html2text] in that it doesn't refill paragraphs,
|
|
|
+but only turns <br> tags into line breaks."
|
|
|
+ (interactive)
|
|
|
+ (save-excursion
|
|
|
+ (let ((case-fold-search t)
|
|
|
+ (buffer-read-only nil))
|
|
|
+ (html2text-replace-string "<br>" "\n" (point-min) (point-max))
|
|
|
+ (html2text-remove-tags html2text-remove-tag-list)
|
|
|
+ (html2text-format-tags)
|
|
|
+ (html2text-remove-tags html2text-remove-tag-list2)
|
|
|
+ (edit-server-html2text-substitute)
|
|
|
+ (html2text-format-single-elements))))
|
|
|
+
|
|
|
+(defconst edit-server-html2text-substitute-regexp
|
|
|
+ (mapconcat (lambda (pair) (concat "\\(" (regexp-quote (car pair)) "\\)"))
|
|
|
+ html2text-replace-list
|
|
|
+ "\\|"))
|
|
|
+(defconst edit-server-html2text-substitute-replacements
|
|
|
+ (apply 'vector (mapcar 'cdr html2text-replace-list)))
|
|
|
+
|
|
|
+;; XXX Replacement for 23.3.1's gnus/html2text.el html2text-substitute,
|
|
|
+;; which is confounded by "&lt;" and the like.
|
|
|
+(defun edit-server-html2text-substitute ()
|
|
|
+ "See the variable `html2text-replace-list' for documentation."
|
|
|
+ (interactive)
|
|
|
+ (goto-char (point-min))
|
|
|
+ (edit-server-htmlize-replace edit-server-html2text-substitute-regexp
|
|
|
+ edit-server-html2text-substitute-replacements))
|
|
|
+
|
|
|
+;;;###autoload
|
|
|
+(defcustom edit-server-htmlize-url-regexp
|
|
|
+ (concat "^" (regexp-quote "mail.google.com/mail/"))
|
|
|
+ "*Regexp matching `edit-server-url' in a buffer that should be HTMLized.
|
|
|
+See `edit-server-maybe-htmlize-buffer'."
|
|
|
+ :type 'regexp
|
|
|
+ :group 'edit-server
|
|
|
+ :require 'edit-server-htmlize)
|
|
|
+
|
|
|
+;;;###autoload
|
|
|
+(defun edit-server-maybe-htmlize-buffer ()
|
|
|
+ "Possibly HTMLize the current buffer of plain text.
|
|
|
+This calls `edit-server-htmlize-buffer' if `edit-server-url'
|
|
|
+matches `edit-server-htmlize-url-regexp'.
|
|
|
+
|
|
|
+This is intended for use on `edit-server-done-hook'."
|
|
|
+ (interactive)
|
|
|
+ (if (string-match edit-server-htmlize-url-regexp edit-server-url)
|
|
|
+ (edit-server-htmlize-buffer)))
|
|
|
+
|
|
|
+;;;###autoload
|
|
|
+(defun edit-server-maybe-dehtmlize-buffer ()
|
|
|
+ "Possibly deHTMLize the current buffer into plain text.
|
|
|
+This calls `edit-server-dehtmlize-buffer' if `edit-server-url'
|
|
|
+matches `edit-server-htmlize-url-regexp'.
|
|
|
+
|
|
|
+This is intended for use on `edit-server-start-hook'."
|
|
|
+ (interactive)
|
|
|
+ (if (string-match edit-server-htmlize-url-regexp edit-server-url)
|
|
|
+ (edit-server-dehtmlize-buffer)))
|
|
|
+
|
|
|
+(provide 'edit-server-htmlize)
|
|
|
+
|
|
|
+;;; edit-server-htmlize.el ends here
|