(defgroup paren-showing nil
"Showing (un)matching of parens and expressions."
:prefix "show-paren-"
:group 'paren-matching)
(defvar show-paren-overlay nil)
(defvar show-paren-overlay-1 nil)
(defcustom show-paren-style 'parenthesis
"*Style used when showing a matching paren.
Valid styles are `parenthesis' (meaning show the matching paren),
`expression' (meaning show the entire expression enclosed by the paren) and
`mixed' (meaning show the matching paren if it is visible, and the expression
otherwise)."
:type '(choice (const parenthesis) (const expression) (const mixed))
:group 'paren-showing)
(defcustom show-paren-delay
(if (featurep 'lisp-float-type) (/ (float 1) (float 8)) 1)
"*Time in seconds to delay before showing a matching paren."
:type '(number :tag "seconds")
:group 'paren-showing)
(defcustom show-paren-priority 1000
"*Priority of paren highlighting overlays."
:type 'integer
:group 'paren-showing
:version "21.1")
(defcustom show-paren-ring-bell-on-mismatch nil
"*If non-nil, beep if mismatched paren is detected."
:type 'boolean
:group 'paren-showing
:version "20.3")
(defface show-paren-match-face
'((((class color)) (:background "turquoise"))
(t (:background "gray")))
"Show Paren mode face used for a matching paren."
:group 'faces
:group 'paren-showing)
(defface show-paren-mismatch-face
'((((class color)) (:foreground "white" :background "purple"))
(t (:reverse-video t)))
"Show Paren mode face used for a mismatching paren."
:group 'faces
:group 'paren-showing)
(defvar show-paren-idle-timer nil)
(define-minor-mode show-paren-mode
"Toggle Show Paren mode.
With prefix ARG, turn Show Paren mode on if and only if ARG is positive.
Returns the new status of Show Paren mode (non-nil means on).
When Show Paren mode is enabled, any matching parenthesis is highlighted
in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time."
:global t :group 'paren-showing
(if (local-variable-p 'show-paren-mode)
(make-local-variable 'blink-matching-paren-on-screen)
(kill-local-variable 'blink-matching-paren-on-screen))
(setq blink-matching-paren-on-screen (not show-paren-mode))
(if show-paren-idle-timer
(cancel-timer show-paren-idle-timer))
(setq show-paren-idle-timer nil)
(when (memq t (mapcar (lambda (buffer)
(with-current-buffer buffer
show-paren-mode))
(buffer-list)))
(setq show-paren-idle-timer (run-with-idle-timer
show-paren-delay t
'show-paren-function)))
(unless show-paren-mode
(and show-paren-overlay
(eq (overlay-buffer show-paren-overlay) (current-buffer))
(delete-overlay show-paren-overlay))
(and show-paren-overlay-1
(eq (overlay-buffer show-paren-overlay-1) (current-buffer))
(delete-overlay show-paren-overlay-1))))
(defun show-paren-function ()
(if show-paren-mode
(let (pos dir mismatch face (oldpos (point)))
(cond ((eq (char-syntax (preceding-char)) ?\))
(setq dir -1))
((eq (char-syntax (following-char)) ?\()
(setq dir 1)))
(when dir
(save-excursion
(save-restriction
(when blink-matching-paren-distance
(narrow-to-region
(max (point-min) (- (point) blink-matching-paren-distance))
(min (point-max) (+ (point) blink-matching-paren-distance))))
(condition-case ()
(setq pos (scan-sexps (point) dir))
(error (setq pos t mismatch t)))
(when (integerp pos)
(let ((beg (min pos oldpos)) (end (max pos oldpos)))
(when (/= (char-syntax (char-after beg)) ?\$)
(setq mismatch
(not (eq (char-before end)
(matching-paren (char-after beg)))))))))))
(if (not pos)
(progn
(and show-paren-overlay (overlay-buffer show-paren-overlay)
(delete-overlay show-paren-overlay))
(and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1)
(delete-overlay show-paren-overlay-1)))
(if mismatch
(progn
(if show-paren-ring-bell-on-mismatch
(beep))
(setq face 'show-paren-mismatch-face))
(setq face 'show-paren-match-face))
(if (and (= dir 1) (integerp pos))
(when (and show-paren-overlay-1
(overlay-buffer show-paren-overlay-1))
(delete-overlay show-paren-overlay-1))
(let ((from (if (= dir 1)
(point)
(forward-point -1)))
(to (if (= dir 1)
(forward-point 1)
(point))))
(if show-paren-overlay-1
(move-overlay show-paren-overlay-1 from to (current-buffer))
(setq show-paren-overlay-1 (make-overlay from to)))
(overlay-put show-paren-overlay-1 'priority show-paren-priority)
(overlay-put show-paren-overlay-1 'face face)))
(unless (integerp pos)
(delete-overlay show-paren-overlay))
(let ((to (if (or (eq show-paren-style 'expression)
(and (eq show-paren-style 'mixed)
(not (pos-visible-in-window-p pos))))
(point)
pos))
(from (if (or (eq show-paren-style 'expression)
(and (eq show-paren-style 'mixed)
(not (pos-visible-in-window-p pos))))
pos
(save-excursion
(goto-char pos)
(forward-point (- dir))))))
(if show-paren-overlay
(move-overlay show-paren-overlay from to (current-buffer))
(setq show-paren-overlay (make-overlay from to))))
(overlay-put show-paren-overlay 'priority show-paren-priority)
(overlay-put show-paren-overlay 'face face)))
(and show-paren-overlay
(delete-overlay show-paren-overlay))
(and show-paren-overlay-1
(delete-overlay show-paren-overlay-1))))
(provide 'paren)