parenthesis.elのコードをいじってみた(minor-mode版の作成)

parenthesis.elのコードを読んで、macroを使えば手軽に定義できるようになるんじゃないかなとか思いました。
そんなわけでてきとーにいじってみました。
あと、minor-modeにもしてみました。

parenthesis.elについて

http://d.hatena.ne.jp/khiker/20080118/parenthesis
http://d.hatena.ne.jp/trotr/20080119/1200736175

変更点

• minor-modeにした
  • parenthesis-modeを実行すると機能が有効になる
• set-parenthesis-interactively
  • その場で使用する関数を追加できる(anything使用）
• 関数の定義をmacroにした
  • defun-parenthesis
  • defun-parenthesis-double
• 関数のシンボル名を探す関数をalistを使った形に変えた
  • assocとかrassocとか使ってる

コード

;;元々 http://d.hatena.ne.jp/khiker/20080118/parenthesis
(require 'anything)

;;設定方法
;;(global-set-key parenthesis-mode-toggle-key 'parenthesis-mode)
;; (add-hook 'parenthesis-mode-hook
;; 	  (lambda ()
;; 	    (define-key parenthesis-mode-map [f3] 'set-parenthesis-interactively)))

;;挿入したい文字を追加したい場合
;;===例=======================
;; function-name : insert-paren
;; beg           : "("
;; end           : ")"
;;============================
;; .emacsなどで
;; (push  ?\( parenthesis-search-charactors)
;; (push "insert-paren" parenthesis-search-fuction-names)
;; (defun-parenthesis insert-paren "(" ")")
;; (parenthesis-make-list) ;;設定を更新

(defvar parenthesis-mode-toggle-key [f2])

(easy-mmode-define-minor-mode  parenthesis-mode
			       "minor-mode for parenthesis."
			       nil
			       "(parenthesis)"
			       '((parenthesis-mode-toggle-key . parenthesis-mode)))


;;parenthesis.elから
(defun insert-parenthesis-internal (arg open close &optional ignore-backslash)
  (if (or ignore-backslash
          (bobp)
          (/= (char-before) ?\\))
      (if (> arg 0)
          (progn
            (save-excursion
              (save-restriction
                (if mark-active
                    (narrow-to-region (region-beginning) (region-end))
                  (narrow-to-region (point) (point)))
                (goto-char (point-min))
                (dotimes (i arg) (insert open))
                (goto-char (point-max))
                (dotimes (i arg) (insert close))))
            (forward-char (* (length open) arg)))
        (dotimes (i (if (= arg 0) 1 (- arg))) (insert open)))
    (self-insert-command arg)))


(defun parenthesis-register-keys (str map)
  "register keys to local-map."
  (let (len ch)
    (setq len (length str))
    (dotimes (i len)
      (setq ch (aref str i))
      (message "%s" ch)
      (cond
       ((= ch ? )
        (setq i (1+ i))
        (when (and (> len i)
                   (setq ch (aref str i))
                   (parenthesis-search-function ch))
          (define-key map [ch] (parenthesis-search-function ch t))))
       ((member ch parenthesis-search-charactors)
        (define-key map (vector ch) (parenthesis-search-function ch)))
       (t
        nil)))))

;;ここまで

(defvar parenthesis-search-charactors '(?{ ?\[ ?\( ?' ?\" ?> ?'))
(defvar parenthesis-search-fuction-names '("insert-braces" "insert-bracketes" "insert-parens" "insert-single-quotation" "insert-double-quotation" "insert-angle" "insert-grave-and-quotation"))
(defvar parenthesis-search-list nil)
(defun parenthesis-make-list () (interactive)
  (setq parenthesis-search-list 
	(mapcar* #'cons parenthesis-search-charactors parenthesis-search-fuction-names)))
(parenthesis-make-list)

(defun parenthesis-search-function (ch &optional space)
  (let* ((modifier (if space "2" ""))
	(function-pair (assoc ch parenthesis-search-list)))
    (if function-pair
	(intern (concat (cdr function-pair) modifier))
      nil)))

(defun parenthesis-search-key (function)
  (let ((function-pair (rassoc function parenthesis-search-list)))
  (char-to-string (car function-pair))))

(defmacro defun-parenthesis (name beg end)
  `(defun ,name (arg)
     ,(format "A pair of brace(%s%s) is insert automatically." beg end)
     (interactive "p")
     (insert-parenthesis-internal arg ,beg ,end)))

(defmacro defun-parenthesis-double (name1 name2 beg end)
  `(progn (defun-parenthesis ,name1 ,beg ,end)
	  (defun-parenthesis ,name2 ,(concat beg " ") ,(concat " " end))))

;; (with-output-to-temp-buffer "d"
;;   (print (macroexpand '(defun-parenthesis-double insert-braces  insert-braces2 "{" "}"))))

;;関数の作成
(defun-parenthesis-double insert-braces insert-braces2 "{" "}")
(defun-parenthesis-double insert-brackets insert-brackets2 "[" "]")
(defun-parenthesis-double insert-parens insert-parens2 "(" ")")
(defun-parenthesis-double insert-single-quotation insert-single-quotation2 "'" "'")
(defun-parenthesis-double insert-double-quotation insert-double-quotation2 "\"" "\"")
(defun-parenthesis-double insert-angle insert-angle2 "<" ">")
(defun-parenthesis insert-grave-and-quotation "`" "'")

(defun set-parenthesis-interactively () (interactive)
  (let ((source '((name . "parenthesis")
		  (candidates . (lambda () (append parenthesis-search-fuction-names
						   (mapcar #'(lambda (x) (concat x "2"))
							   parenthesis-search-fuction-names))))
		  (action . (("setkey" . (lambda (f)
					   (let ((key (parenthesis-search-key f)))
					     (define-key parenthesis-mode-map key (intern f)))))
			     ("deletekey" . (lambda (f)
					      (let ((key (parenthesis-search-key f)))
						;;remove-する方法が分かっていない＞＜
						(define-key parenthesis-mode-map nil)))))))))
    (anything (list source))))

;;現在のkey-bindの状態を保存する方法は面倒なので未実装

(provide 'parenthesis-mode)

そういえば

コードをきれいに整形したり、ライセンスの表示とかしたことないなー。
何か面倒で。