django-kyr-tag-mode.el

;;; how to use
;; (add-hook 'html-mode-hook 'django-kyr-tag-mode)

;;(util-macro-install "dkt:")
;;; how to use
;; (add-hook 'html-mode-hook 'django-kyr-tag-mode)

;;(util-macro-install "dkt:")
(eval-when-compile (require 'cl))

(defmacro dkt:and-let*
  (bindings &rest body)
  "imported from srfi-2"
  (reduce (function
           (lambda (binding r)
             (let ((head (car binding)))
               (cond ((and (atom head) (symbolp head))
                      (\` (let ((\, binding)) (when (\, head) (\, r)))))
                     ((listp head)
                      (\` (when (\, head) (\, r))))
                     (t (error "and-let*: invalid head %s" head))))))
          bindings
          :from-end
           t
           :initial-value
            (\` (progn (\,@ body)))))
(put 'dkt:and-let* 'lisp-indent-function 1)

(defmacro dkt:aand
  (&rest args)
  "Anaphoric and. anaphorar is `it'"
  (cond ((null args)
         t)
        ((null (cdr args))
         (car args))
        (t (\` (dkt:aif (\, (car args)) (dkt:aand (\,@ (cdr args))))))))

(defmacro dkt:aif
  (test-form then-form &rest else-forms)
  "Anaphoric if. Temporary variable `it' is the result of test-form."
  (\` (let ((it (\, test-form))) (if it (\, then-form) (\,@ else-forms)))))
(put 'dkt:aif 'lisp-indent-function 2)

;;; internal settings

(add-to-list 'text-property-default-nonsticky '(django-tag . begin))
(add-to-list 'text-property-default-nonsticky '(django-tag . end))

(defvar django-kyr-tag-change-order-alist
  '(("{[^{%]" "{{" "}}")
    ("{{" "{%" "%}")
    ("{%" "{#" "#}")
    ("{%" "{" "}")))

(defun django-kyr-tag-insert-new-tag ()
  (insert (propertize "{" 'django-tag 'begin))
  (insert "  ")
  (insert (propertize "}" 'django-tag 'end)))

;;; utility function

(defalias 'dkt:text-property-any-forward  'text-property-any)
(defun dkt:text-property-any-backward (start end property value &optional object)
  "a backward version of `text-property-any`.
CATION: start > end.
if not found thene 1 is returned"
  (if (< start end)
      (error "dkt:text-property-any-backward: start > end !!!")
      (let ((pos start))
        (condition-case e 
            (loop while (> pos end)
                  when (dkt:aand (get-text-property pos property)
                             (equal value it))
                  return pos
                  do (setq pos (- pos 1))
                  finally return pos)
          (error 1)))))

(defun dkt:find-border-of-property-is-same (prop val delta)
  (let ((pos (point)))
    (condition-case err
        (while (dkt:aand (get-text-property pos prop) (equal it val))
          (setq pos (+ pos delta)))
      (error pos))
    pos))

;;; functions

;; function for delete tags
(defun django-kyr-tag-delete-current-begin-tag () (interactive)
  (dkt:and-let* ((end (dkt:find-border-of-property-is-same 'django-tag 'begin 1))
             (beg (+ 1 (dkt:find-border-of-property-is-same 'django-tag 'begin -1))))
    (delete-region beg end)))

(defun django-kyr-tag-delete-current-end-tag () (interactive)
  (dkt:and-let* ((end (dkt:find-border-of-property-is-same 'django-tag 'end 1))
             (beg (+ 1 (dkt:find-border-of-property-is-same 'django-tag 'end -1))))
    (delete-region beg end)))

;; function for get next state tags e.g. {{}} -> {%%}
(defun django-kyr-tag-get-next-tags ()
  (goto-char
   (dkt:text-property-any-backward (point) (point-min) 'django-tag 'begin))
  (goto-char (1+ (dkt:find-border-of-property-is-same 'django-tag 'begin -1)))
  (loop for (rx beg-tag end-tag) in django-kyr-tag-change-order-alist
        when (looking-at rx)
        return (values beg-tag end-tag)))

;; update tags state function e.g. {{ content-of-tag }} -> {% content-of-tag %}
(defun django-kyr-tag-update-tags () (interactive)
  (save-excursion
    ;; 次のタグを取得
    (destructuring-bind (beg-tag end-tag) (django-kyr-tag-get-next-tags)
      ;; {% などの前方のタグの更新
      (django-kyr-tag-delete-current-begin-tag) (insert (propertize beg-tag 'django-tag 'begin))
      
      ;; %} などの後方のタグの更新
      (goto-char
       (dkt:text-property-any-forward (point) (point-max) 'django-tag 'end))
      (django-kyr-tag-delete-current-end-tag)
      (insert (propertize end-tag 'django-tag 'end)))))

;;; interactive functions

(defun django-kyr-tag-type-{ (&optional force-update) (interactive "P")
  "this function bound at \"{\" key (in default), you type {, then update current template tags"
  (save-excursion
    (if (or force-update (get-text-property (point) 'django-tag))
        (django-kyr-tag-update-tags)
        (django-kyr-tag-insert-new-tag))))

;; preparing for using django-kyr-tag
(defun django-kyr-tag-init () (interactive)
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "{[{%#]?" nil t)
      (put-text-property (match-beginning 0) (match-end 0) 'django-tag 'begin))
    (goto-char (point-min))
    (while (re-search-forward "[{%#]?}" nil t)
      (put-text-property (match-beginning 0) (match-end 0) 'django-tag 'end))))

;;; define minor mode 

(define-minor-mode django-kyr-tag-mode "type { insert {{}} or {% %}"
  nil "<d-tag>" '(("{" . django-kyr-tag-type-{))
  ;; body
  (django-kyr-tag-init))

(provide 'django-kyr-tag-mode)

使い方

M-x django-kyr-tag-modeを実行してマイナーモードを有効にする。
その後、{をタイプするとちょっとだけ便利にカスタムタグなどが挿入できる。

使い方は3通り

1.  何も無いところで"{"とタイプ
    1.1 {  } が挿入される。
    1.2 この時もう一度、"{"とタイプ
    1.3 { } が {{}} に変わる。(以下、{を入力する度に{} -> {{}} -> {%%} -> {}と中身が変わる)
2. 既にバッファに存在するカスタムタグの{や}の文字の上で"{"とタイプ
    2.1 1.と同様にタグの種類が切り替わる。
3. 既にバッファに存在するカスタムタグの中で"C-u {"とタイプ
    3.1 1.と同様にタグの種類が切り替わる。
    (  {  ta|g  } ;; |はカーソル。この位置でC-u {とすると、 {{ ta|g }}　に)