display-couple-parenthesis Elispの対応するカッコを情報をミニバッファに表示する。

display-couple-parenthesis.el

(defvar display-couple-parenthesis-type "token")
(defvar display-couple-parenthesis-process nil)
(defvar display-couple-parenthesis-interval 0.5)

;; 表示を行表示に切り替える
(defun switch-display-couple-parenthesis-line ()
  "switch display couple parenthesis type to line"
  (interactive)
  (setq display-couple-parenthesis-type "line"))

;; 表示をトークン表示に切り替える
(defun switch-display-couple-parenthesis-token ()
  "switch display couple parenthesis type to line"
  (interactive)
  (setq display-couple-parenthesis-type "token"))

;; 対応する括弧とトークンを表示する
(defun display-couple-parenthesis ()
 "display couple pre parenthesis
this function is called by timer"
 (interactive)
 (when
     (equal ")" (buffer-substring (point) (+ 1 (point))))
   (cond 
    ((equal "token" display-couple-parenthesis-type)
     (message (couple-parenthesis-token))
     )
    ((equal "line" display-couple-parenthesis-type)
     (message (couple-parenthesis-line))
     ))))

;; 括弧のカウンターの数を増やす
(defun increment-parenthesis ()
 "This function is used when count parenthesis
return: count"
 (setq count-parenthesis (+ count-parenthesis 1)))

;; 括弧のカウンターの数を減らす
(defun decrement-parenthesis ()
 "This function is used when count parenthesis
return: count"
 (setq count-parenthesis (- count-parenthesis 1)))

;; バッファに対して戻りながら"("か")"のカウントを変更する
(defun re-search-parenthesis ()
 (interactive)
 (let (result)
   (re-search-backward "(\\|)" nil t)
   (if (equal ")" (match-string 0))
       (setq result (increment-parenthesis))
     (setq result (decrement-parenthesis)))
   result))

;; 対応する括弧のトークンを返す
(defun couple-parenthesis-token ()
 (interactive)
 (setq current-point (point))
 (setq count-parenthesis 1)
 (while (< 0 (re-search-parenthesis)))
 (forward-char)
 (setq pre-parenthesis (concat "(" (elisp-current-token)))
 (goto-char current-point)
 pre-parenthesis)

;; 対応する括弧の行を返す
(defun couple-parenthesis-line ()
 (interactive)
 (let (current-point begin-point end-point line-token)
   (setq current-point (point))
   (setq count-parenthesis 1)
   (while (< 0 (re-search-parenthesis)))
   (setq begin-point (point))
   (re-search-forward ")\\|\n" nil t)
   (forward-char -1)
   (setq end-point (point))
   (setq pre-parenthesis
         (buffer-substring-no-properties begin-point end-point))
   (when (equal current-point end-point)
     (setq pre-parenthesis (concat pre-parenthesis ")")))
   (goto-char current-point)
   pre-parenthesis))

(defconst elisp-symbol-regexp "[A-Za-z_+-][A-Za-z_0-9\\+-]*)?"
 "Regexp matching tag name.")

;; カーソル位置のElisp-tokenを返す
(defun elisp-current-token ()
 (cond
  ((looking-at "[A-Za-z_+-]")
   (while (looking-at "[A-Za-z_0-9\\+-]")
     (forward-char -1))
   (forward-char 1))
  (t
   (while (looking-at "[ \t]")
     (forward-char 1))))
 (if (looking-at elisp-symbol-regexp)
     (match-string-substring 0) nil))

(defun elisp-current-token ()
 (cond
  ((looking-at "[A-Za-z_+-]")
   (while (looking-at "[A-Za-z_0-9\\+-]")
     (forward-char -1))
   (forward-char 1))
  (t
   (while (looking-at "[ \t]")
     (forward-char 1))))
 (if (looking-at elisp-symbol-regexp)
     (match-string-substring 0) nil))

(defun match-string-substring (n)
  (buffer-substring (match-beginning n) (match-end n)))

(defun toggle-display-couple-parenthesis-process()
  "対応括弧の表示/非表示の切り替え"
  (interactive)
  (cond 
   (display-couple-parenthesis-process
    (cancel-timer display-couple-parenthesis-process)
    (setq display-couple-parenthesis-process nil))
   (t
    (setq display-couple-parenthesis-process
          (run-with-timer t display-couple-parenthesis-interval
                          'display-couple-parenthesis)))))

(toggle-display-couple-parenthesis-process)

;;途中に"("や")"があった場合に正常に挙動しない。
;;  スタックを実装することによって回避する必要がある。
;; スタックの実装は試みたが、"のスタック化と"のエスケープと
;; コメント内での括弧の回避をやらないと。
;; 
;; 行番号の表示は要検討
;; 
;; 行表示の際に、)が来るまで見ているので複数括弧が
;; 行の中にある場合に切れてしまう
;; 
;; 行表示の際に、look-atを使っていないからか色表示されない。
;;