Download
(defgroup joseph-autopair nil
" Autoinsert parentheses or other
things you defined in pairs."
:group 'convenience
:prefix "joseph-autopair-"
)
(defcustom joseph-autopair-alist
'( (emacs-lisp-mode . (
("\"" "\"")
("`" "'")
("(" ")")
("[" "]")
))
(lisp-interaction-mode . (
("\"" "\"")
("`" "'")
("(" ")")
("[" "]")
))
( c-mode . (
("\"" "\"" )
("'" "'")
("(" ")" )
("[" "]" )
("{" (joseph-autopair-newline-indent-insert "}"))
))
(java-mode . (
("\"" "\"")
("'" "'")
("(" ")")
("[" "]")
("{" (joseph-autopair-newline-indent-insert "}"))
))
(sh-mode . (
("if " (joseph-autopair-newline-indent-insert "fi"))
("begin " (progn
(insert " end")
(end-of-line)
))
)))
"doc."
:group 'joseph-autopair
)
(defcustom joseph-autopair-command
'(self-insert-command c-electric-brace c-electric-paren)
"command would trigger joseph auto pair"
:group 'joseph-autopair
)
(unless (functionp 'origin-backward-delete-char-untabify-1)
(defalias 'origin-backward-delete-char-untabify-1 (symbol-function 'backward-delete-char-untabify)))
(unless (functionp 'origin-delete-backward-char-1)
(defalias 'origin-delete-backward-char-1 (symbol-function 'backward-delete-char)))
(defvar joseph-autopair-selection nil)
(defvar joseph-autopair-selection-bounds nil)
(defun joseph-autopair-newline-indent-insert(str)
"insert new line and insert str ,put point on the
new line and indent the region."
(let((begin (point-at-bol))
end)
(newline)
(newline)
(insert str)
(setq end (point))
(forward-line -1)
(indent-region begin end)
(indent-according-to-mode)
)
)
(defun joseph-autopair-editing-find-head(string-list)
"using `looking-back' find which string in
`string-list' is before point,and return it."
(let (found-string head)
(while (and (not found-string) string-list)
(setq head (car-safe string-list))
(when (and (stringp head)
(looking-back (regexp-quote head)))
(setq found-string head))
(setq string-list (cdr-safe string-list))
)
found-string
))
(defun joseph-autopair-delete-backward-char
( N &optional KILLP)
(interactive "*p\nP")
(if (and (boundp 'major-mode)
(member major-mode (mapcar 'car joseph-autopair-alist)))
(let* ((mode-pair (cdr (assoc major-mode joseph-autopair-alist)))
(heads (mapcar 'car mode-pair))
(head (joseph-autopair-editing-find-head heads))
)
(when head
(let ((tail (nth 1 (assoc head mode-pair))))
(when (and (stringp tail) (not (eobp))
(looking-at tail))
(delete-char (length tail)
))
))
(origin-delete-backward-char-1 N KILLP)
)
(origin-delete-backward-char-1 N KILLP)
)
)
(defun joseph-autopair-backward-delete-char-untabify
( ARG &optional KILLP)
(interactive "*p\nP")
(if (and (boundp 'major-mode)
(member major-mode (mapcar 'car joseph-autopair-alist)))
(let* ((mode-pair (cdr (assoc major-mode joseph-autopair-alist)))
(heads (mapcar 'car mode-pair))
(head (joseph-autopair-editing-find-head heads))
)
(when head
(let ((tail (nth 1 (assoc head mode-pair))))
(when (and (stringp tail) (not (eobp))
(looking-at tail))
(delete-char (length tail)
))))
(origin-backward-delete-char-untabify-1 ARG KILLP)
)
(origin-backward-delete-char-untabify-1 ARG KILLP)
))
(defun joseph-autopair-before-change-function (beg last)
"hook for `before-change-function'"
(when (and mark-active
(boundp 'major-mode)
(member major-mode (mapcar 'car joseph-autopair-alist))
(member this-command joseph-autopair-command)
(not (equal (region-beginning)(region-end)))
)
(setq joseph-autopair-selection
(buffer-substring-no-properties (region-beginning)(region-end)))
(setq joseph-autopair-selection-bounds
(cons (region-beginning) (region-end)))))
(defun joseph-autopair-after-change-function (first last len)
(when (and (= len 0)
(boundp 'major-mode)
(member this-command joseph-autopair-command)
(member major-mode (mapcar 'car joseph-autopair-alist)))
(let* ( (mode-pair (cdr (assoc major-mode joseph-autopair-alist)))
(heads (mapcar 'car mode-pair))
(head (joseph-autopair-editing-find-head heads))
tail)
(if (and head
(not (and (stringp (setq tail (nth 1 (assoc head mode-pair))))
(string-equal head tail)
(looking-at (regexp-quote head)))))
(progn
(when joseph-autopair-selection
(insert joseph-autopair-selection)
(unless delete-selection-mode
(delete-region
(+ (length head ) (car joseph-autopair-selection-bounds))
(+ (length head ) (cdr joseph-autopair-selection-bounds)))
(forward-char (length joseph-autopair-selection))
)
(setq joseph-autopair-selection nil)
)
(joseph-autopair-insert-or-eval-tail (assoc head mode-pair))
)
(joseph-autopair-skip-tail first last mode-pair heads)
))))
(defun joseph-autopair-skip-tail (first last mode-pair heads)
"skip `tail'."
(let ((new-inserted (buffer-substring first last))
head
tail)
(origin-backward-delete-char-untabify-1 (length new-inserted))
(setq head (joseph-autopair-editing-find-head heads))
(if head
(progn
(setq tail (nth 1 (assoc head mode-pair)))
(if (and (stringp tail)
(looking-at (regexp-quote new-inserted))
(looking-at (regexp-quote tail)))
(forward-char (length tail))
(insert new-inserted)
)
)
(insert new-inserted)
)))
(defun joseph-autopair-insert-or-eval-tail(pair)
" if param `pair' is string insert it
if not ,eval it."
(let* ((tail (nth 1 pair)))
(if (stringp tail)
(save-excursion (insert tail))
(eval tail)
)
))
(defvar joseph-auto-pair-mode nil)
(defun toggle-joseph-auto-pair-mode()
(interactive)
(if (not joseph-auto-pair-mode)
(progn
(defalias 'backward-delete-char-untabify (symbol-function 'joseph-autopair-backward-delete-char-untabify))
(defalias 'backward-delete-char (symbol-function 'joseph-autopair-delete-backward-char))
(add-hook 'after-change-functions 'joseph-autopair-after-change-function)
(add-hook 'before-change-functions 'joseph-autopair-before-change-function)
(setq joseph-auto-pair-mode t)
(message "joseph auto pair mode enabled")
)
(defalias 'backward-delete-char-untabify (symbol-function 'origin-backward-delete-char-untabify-1))
(defalias 'backward-delete-char (symbol-function 'origin-delete-backward-char-1))
(remove-hook 'after-change-functions 'joseph-autopair-after-change-function)
(remove-hook 'before-change-functions 'joseph-autopair-before-change-function)
(setq joseph-auto-pair-mode nil)
(message " joseph auto pair mode disabled")
))
(provide 'joseph-autopair)