;;; edit-server-htmlize.el --- (de)HTMLization hooks for edit-server.el ;;; Copyright (C) 2013 Roland McGrath ;; Author: Roland McGrath ;; Maintainer: Roland McGrath ;; 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 . ;;; 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
 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 "
")
    (edit-server-htmlize-replace edit-server-htmlize-regexp
                                 edit-server-htmlize-replacements)
    (goto-char (point-max))
    (insert "
"))) ;; XXX Modified from 23.3.1's gnus/html2text.el html2text, ;; which wants to eat
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
tags into line breaks." (interactive) (save-excursion (let ((case-fold-search t) (buffer-read-only nil)) (html2text-replace-string "
" "\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