[Arcana] edit-server-htmlize.el

Roland McGrath roland at frob.com
Thu Mar 14 17:18:34 CDT 2013


If any of you (like I do for work mail) use the GMail web interface and the
"Edit with Emacs" Chrome extension for all the composition/reply boxes
(with default to plain text mode) and have been bitten by a recent revamp
of the GMail composition stuff in which "plain text" now means "render the
HTML to plain text when you send it" rather than using actual plain text in
the UI, you want this.

This audience should be advised that I initially used defmacro to define
the two autoloaded functions (exactly as defined here down to the
docstrings) like:

(edit-server-htmlize-maybe-by-url edit-server-maybe-htmlize-buffer
  "Possibly HTMLize the current buffer of plain text."
  edit-server-htmlize-buffer edit-server-done-hook)

and then tried defadvice on make-autoload to make it macroexpand the form
before autoload generation, but failed somehow to make that advice actually
do anything (and didn't even save either the defadvice or the defmacro,
lost in kill-ring truncation, what a maroon!) before giving up and just
manually expanding them.  (Well, actually I evaluated macroexpand on what
I'd written and then manually replaced nil with () and added line breaks
and C-M-q'd each.  I'm not a glutton for punishment, jeez.)


Thanks,
Roland


;;; edit-server-htmlize.el -- (de)HTMLization hooks for edit-server.el

;;; Copyright (C) 2013 Roland McGrath

;; Author: Roland McGrath <roland at hack.frob.com>
;; Maintainer: Roland McGrath <roland at hack.frob.com>
;; Version: 0.1

;; 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
(defvar 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'.")

;;;###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





More information about the Arcana mailing list