inparen.el

;; inparen.el --- Highlight parentheses and the inside of them.

;;; Setup:

;;    (require 'inparen)
;;    (global-inparen-mode t)

;;; Code:

(require 'paren)
(eval-when-compile
  (require 'cl))

(defgroup inparen nil
  "Highlight parentheses and the inside of them."
  :group 'paren-matching)

(defcustom inparen-highlight-only-paren nil
  "If non-nil, highlight only a paren except the inside of it."
  :type 'boolean
  :group 'inparen)

(defcustom inparen-disable-modes
  '(compilation-mode fundamental-mode grep-mode occur-mode)
  "List of major modes in which `inparen-mode' is disabled."
  :type '(repeat symbol)
  :group 'inparen)

(defface inparen-in-paren-face
  '((t (:background "gray30")))
  "Face used for the inside of parens."
  :group 'inparen)

(defface inparen-match-paren-face
  '((t (:background "gray50")))
  "Face used for a matching paren."
  :group 'inparen)

(defface inparen-mismatch-paren-face
  '((t (:inherit 'show-paren-mismatch)))
  "Face used for a mismatching paren."
  :group 'inparen)

(defvar inparen-op nil
  "Point at open-paren.
If matching it is not detected, return nil.")
(defvar inparen-cp nil
  "Point at close-paren.
If matching it is not detected, return nil.")
(defvar inparen-overlays (loop repeat 3 collect (make-overlay 1 1 nil t))
  "List of overlays.
Its form is (IN-PAREN-OV OPEN-PAREN-OV CLOSE-PAREN-OV).")

(defun inparen-parse ()
  "Return a pair of points, which form is
\(OPEN-PAREN-PT CLOSE-PAREN-PT).
If parse has failed, return a pair of nil."
  (let ((parse-sexp-ignore-comments t))
    (save-excursion
      (condition-case nil
          (list (setq inparen-op (progn (up-list -1) (point)))
                (setq inparen-cp (progn (forward-list) (point))))
        (error (list (setq inparen-op nil)
                     (setq inparen-cp nil)))))))

(defun inparen-mismatch-p ()
  "Return non-nil, if parens are mismatched."
  (let ((beg inparen-op)
        (end inparen-cp))
    ;; copied from paren.el
    (unless (eq (syntax-class (syntax-after beg)) 8)
      (not (or (eq (char-before end)
                   ;; This can give nil.
                   (cdr (syntax-after beg)))
               (eq (char-after beg)
                   ;; This can give nil.
                   (cdr (syntax-after (1- end))))
               ;; The cdr might hold a new paren-class
               ;; info rather than a matching-char info,
               ;; in which case the two CDRs should match.
               (eq (cdr (syntax-after (1- end)))
                   (cdr (syntax-after beg))))))))

(defun inparen-delete-ovrelays ()
  (mapc 'delete-overlay inparen-overlays))

(defun inparen-update ()
  "Update overlays if needed."
  (inparen-delete-ovrelays)
  (multiple-value-bind (beg end ip op cp)
      (append (inparen-parse) inparen-overlays)
    (when (and beg end)
      (move-overlay ip (1+ beg) (1- end))
      (move-overlay op beg (1+ beg))
      (move-overlay cp (1- end) end)
      ;; put faces
      (overlay-put ip 'face (unless inparen-highlight-only-paren
                              'inparen-in-paren-face))
      (let ((face (if (inparen-mismatch-p)
                      'inparen-mismatch-paren-face
                    'inparen-match-paren-face)))
        (overlay-put op 'face face)
        (overlay-put cp 'face face)))))

(defun inparen-manipulate-region (func &optional only-in-paren)
  "Manipulate region from open-paren to close-paren by FUNC.
If ONLY-IN-PAREN is non-nil, manipulate except parens."
  (when (and inparen-op inparen-cp)
    (if only-in-paren
        (funcall func (1+ inparen-op) (1- inparen-cp))
      (funcall func inparen-op inparen-cp))))

(defun inparen-delete (&optional arg)
  (interactive "P")
  (inparen-manipulate-region 'delete-region arg))
(defun inparen-cut (&optional arg)
  (interactive "P")
  (inparen-manipulate-region 'kill-region arg))
(defun inparen-copy (&optional arg)
  (interactive "P")
  (inparen-manipulate-region 'kill-ring-save arg))

(defvar inparen-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-c C-p C-d") 'inparen-delete)
    (define-key map (kbd "C-c C-p C-x") 'inparen-cut)
    (define-key map (kbd "C-c C-p C-c") 'inparen-copy)
    map)
  "Keymap for `inparen-mode'.")

(define-minor-mode inparen-mode
  "Toggle Inparen mode."
  :lighter " inp"
  :keymap inparen-mode-map
  :group 'inparen
  (if inparen-mode
      (add-hook 'post-command-hook 'inparen-update nil t)
    (remove-hook 'post-command-hook 'inparen-update t)
    (setq inparen-op nil inparen-cp nil)
    (inparen-delete-ovrelays)))

(defun inparen-mode-maybe ()
  (unless (or (minibufferp)
              (memq major-mode inparen-disable-modes))
    (inparen-mode 1)))

(define-global-minor-mode global-inparen-mode
  inparen-mode inparen-mode-maybe
  :group 'inparen)

(provide 'inparen)
;;; inparen.el ends here