indent-region-excluding-pre-with-html.el

;;; indent-region-excluding-pre-with-html.el ---     -*- lexical-binding: t; -*-

;; Copyright (C) 2016  osmatsuda

;; Author: osmatsuda <osmatsuda@gmail.com>
;; Keywords: wp

;; This program 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 of the License, or
;; (at your option) any later version.

;; This program 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:

;; Settings
;; (add-hook 'html-mode-hook 'set-indent-region-function-for-html)
;; (add-hook 'nxml-mode-hook 'set-indent-region-function-for-html)
;; (add-hook 'rng-schema-change-hook 'set-indent-region-function-for-html)

;;; Code:

(defun set-indent-region-function-for-html ()
  (if (or (string-match "HTML" (format-mode-line mode-name))
          (and
           (string-match "nXML" (format-mode-line mode-name))
           (and rng-current-schema-file-name
                (string-match "html" rng-current-schema-file-name))))
      (setq-local indent-region-function 'indent-region-excluding-pre-with-html)
    (setq-local indent-region-function nil)))

(defun indent-region-excluding-pre-with-html (start end)
  (save-excursion
    (setq end (copy-marker end))
    (goto-char start)
    (let ((pred-inside-of-pre-func
           (if (string-match "HTML" (format-mode-line mode-name))
                'predicate-inside-of-pre-with-sgml
             'predicate-inside-of-pre-with-nxml))
          line)
      (while (and (>= end (point))
                  (not (eobp)))
        (unless (and (bolp) (eolp))
          (setq line (buffer-substring-no-properties (line-beginning-position)
                                                     (line-end-position)))
          (if (string-match
               "\\(</pre>\\|<pre\\(?:[\s\t\n]\\|>\\)\\)"
               line)
              ;; including pre tag on the line
              (unless (eq 1 (string-match
                             "/"
                             (substring line
                                        (match-beginning 1)
                                        (match-end 1))))
                ;; not end tag
                (indent-according-to-mode))
            ;; no pre tag
            (unless (funcall pred-inside-of-pre-func)
              (indent-according-to-mode))))
        (forward-line 1)))
    (move-marker end nil)))

(defun predicate-inside-of-pre-with-sgml ()
  (save-excursion
    (let* ((last-point (point))
           (re-tag-name "<\\([a-z0-9]+\\)\\(?:[\s\t\n]\\|>\\|/\\)")
           (re-block-tags (regexp-opt (split-string "address article aside blockquote div dl fieldset figure footer form h1 h2 h3 h4 h5 h6 header hr main nav ol p pre section table ul li dd body head html")))
           (re-block-tag-names (concat "\\b" re-block-tags "\\b"))
           (re-block-end-tags (concat "</" re-block-tags ">"))
           tag)
      (catch 'return
        (when (and (looking-at re-tag-name)
                   (string-match re-block-tag-names
                                 (buffer-substring-no-properties (match-beginning 1)
                                                                 (match-end 1))))
          (throw 'return nil))
        (sgml-skip-tag-backward 1)
        (while (and (looking-at "<!")
                    (not (= last-point (point))))
          (setq last-point (point))
          (sgml-skip-tag-backward 1))
        (when (looking-back "\\`\n*") (throw 'return nil))
        (when (looking-at re-tag-name)
          (setq tag (buffer-substring-no-properties (match-beginning 1)
                                                    (match-end 1))))
        (when (and tag
                   (string-match re-block-end-tags
                                 (buffer-substring-no-properties (point)
                                                                 last-point)))
          (throw 'return nil))
        (while (not (or (= last-point (point))
                        (string-match re-block-tag-names tag)))
          (setq last-point (point))
          (sgml-skip-tag-backward 1)
          (when (looking-at re-tag-name)
            (setq tag (buffer-substring-no-properties (match-beginning 1)
                                                      (match-end 1)))))
        (when (null tag) (throw 'return nil))
        (numberp (string-match "\\<pre\\>" tag))))))

(defun predicate-inside-of-pre-with-nxml ()
  (save-excursion
    (let ((last-point (point))
          tag
          (re-tag-name "<\\([a-z0-9]+\\)\\(?:[\s\t\n]\\|>\\|/\\)")
          (re-block-tags (concat "\\b" (regexp-opt (split-string "address article aside blockquote div dl fieldset figure footer form h1 h2 h3 h4 h5 h6 header hr main nav ol p pre section table ul body head html")) "\\b")))
      (catch 'return
        (when (and (looking-at re-tag-name)
                   (string-match
                    re-block-tags
                    (buffer-substring-no-properties (match-beginning 1)
                                                    (match-end 1))))
          (throw 'return nil))
        (condition-case nil
            (nxml-backward-up-element)
          (error (throw 'return nil)))
        (when (looking-at re-tag-name)
          (setq tag (buffer-substring-no-properties (match-beginning 1)
                                                    (match-end 1))))
        (while (not (or (= last-point (point))
                        (string-match re-block-tags tag)))
          (setq last-point (point))
          (nxml-backward-up-element)
          (when (looking-at re-tag-name)
            (setq tag (buffer-substring-no-properties (match-beginning 1)
                                                      (match-end 1)))))
        (when (null tag) (throw 'return nil))
        (numberp (string-match "\\<pre\\>" tag))))))

(provide 'indent-region-excluding-pre-with-html)
;;; indent-region-excluding-pre-with-html.el ends here