region 内の HTML を escape/unescape #xyzzy

gistfile1.cl

;; region 内の HTML を escape/unescape。
;; 何回目の車輪の再発名かわからないけど、ググっても見つからなかったので書いた。

(defun auto-link-region (s e)
  (interactive "*r")
  (if (< e s) (rotatef s e))
  (save-excursion
    (save-restriction
      (narrow-to-region s e)
      (goto-char s)
      (while (scan-buffer ed::*clickable-uri-regexp* :regexp t)
        (goto-char (match-end 0))
        (replace-match "<a href=\"\\0\">\\0</a>")))))

(defparameter *html-escape-chars-alist*
  '(("<" . "&lt;")
    (">" . "&gt;")
    ("&" . "&amp;")
    ))

(defparameter *html-unescape-chars-alist*
  '(("&lt;" . "<")
    ("&gt;" . ">")
    ("&amp;" . "&")
    ("&nbsp;" . " ")
    ("&#39;" . "'")
    ("&quot;" . "\"")
    ))

(defun html-escape-region (s e)
  (interactive "*r")
  (html-escape-chars s e :escape t))

(defun html-unescape-region (s e)
  (interactive "*r")
  (html-escape-chars s e :escape nil))

(defun html-escape-chars (s e &key escape)
  (if (< e s) (rotatef s e))
  (save-excursion
    (save-restriction
      (narrow-to-region s e)
      (goto-char s)
      (let* ((mapping (if escape
                          *html-escape-chars-alist*
                        *html-unescape-chars-alist*))
             (regexp (format nil "\\(~{~A~^\\|~}\\)" (mapcar #'regexp-quote (mapcar #'car mapping)))))
        (while (scan-buffer regexp :regexp t)
          (let ((replacement (cdr (assoc (match-string 1) mapping :test #'string=))))
            (when replacement
              (replace-match replacement))))))))