X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7e570fbf3ef8ccd31df2651f5d2775c5697d5950..7e09ef09a479731d01b1ca46e94ddadd73ac98e3:/lisp/paren.el diff --git a/lisp/paren.el b/lisp/paren.el index ab856380d3..30314c2f9c 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -1,9 +1,9 @@ ;;; paren.el --- highlight matching paren -;; Copyright (C) 1993, 1996, 2001-2012 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1996, 2001-2015 Free Software Foundation, Inc. ;; Author: rms@gnu.org -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: languages, faces ;; This file is part of GNU Emacs. @@ -37,19 +37,13 @@ :prefix "show-paren-" :group 'paren-matching) -;; This is the overlay used to highlight the matching paren. -(defvar show-paren-overlay nil) -;; This is the overlay used to highlight the closeparen right before point. -(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) + :type '(choice (const parenthesis) (const expression) (const mixed))) (defcustom show-paren-delay 0.125 "Time in seconds to delay before showing a matching paren. @@ -62,52 +56,48 @@ active, you must toggle the mode off and on again for this to take effect." (set sym val) (show-paren-mode -1) (set sym val) - (show-paren-mode 1))) - :group 'paren-showing) + (show-paren-mode 1)))) (defcustom show-paren-priority 1000 "Priority of paren highlighting overlays." - :type 'integer - :group 'paren-showing + :type 'integer :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") -(defgroup paren-showing-faces nil - "Group for faces of Show Paren mode." - :group 'paren-showing - :group 'faces - :version "22.1") - -(defface show-paren-match - '((((class color) (background light)) - :background "turquoise") ; looks OK on tty (becomes cyan) - (((class color) (background dark)) - :background "steelblue3") ; looks OK on tty (becomes blue) - (((background dark)) - :background "grey50") - (t - :background "gray")) - "Show Paren mode face used for a matching paren." - :group 'paren-showing-faces) +(defcustom show-paren-when-point-inside-paren nil + "If non-nil, show parens when point is just inside one. +This will only be done when point isn't also just outside a paren." + :type 'boolean + :version "25.1") + +(defcustom show-paren-when-point-in-periphery nil + "If non-nil, show parens when point is in the line's periphery. +The periphery is at the beginning or end of a line or in any +whitespace there." + :type 'boolean + :version "25.1") + (define-obsolete-face-alias 'show-paren-match-face 'show-paren-match "22.1") -(defface show-paren-mismatch - '((((class color)) (:foreground "white" :background "purple")) - (t (:inverse-video t))) - "Show Paren mode face used for a mismatching paren." - :group 'paren-showing-faces) (define-obsolete-face-alias 'show-paren-mismatch-face 'show-paren-mismatch "22.1") -(defvar show-paren-highlight-openparen t - "Non-nil turns on openparen highlighting when matching forward.") +(defcustom show-paren-highlight-openparen t + "Non-nil turns on openparen highlighting when matching forward." + :type 'boolean) + +(defvar show-paren--idle-timer nil) +(defvar show-paren--overlay + (let ((ol (make-overlay (point) (point) nil t))) (delete-overlay ol) ol) + "Overlay used to highlight the matching paren.") +(defvar show-paren--overlay-1 + (let ((ol (make-overlay (point) (point) nil t))) (delete-overlay ol) ol) + "Overlay used to highlight the paren at point.") -(defvar show-paren-idle-timer nil) ;;;###autoload (define-minor-mode show-paren-mode @@ -120,155 +110,186 @@ Show Paren mode is a global minor mode. When enabled, any matching parenthesis is highlighted in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time." :global t :group 'paren-showing - ;; Enable or disable the mechanism. - ;; First get rid of the old idle timer. - (if show-paren-idle-timer - (cancel-timer show-paren-idle-timer)) - (setq show-paren-idle-timer nil) - ;; If show-paren-mode is enabled in some buffer now, - ;; set up a new timer. - (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)))) + ;; Enable or disable the mechanism. + ;; First get rid of the old idle timer. + (when show-paren--idle-timer + (cancel-timer show-paren--idle-timer) + (setq show-paren--idle-timer nil)) + (setq show-paren--idle-timer (run-with-idle-timer + show-paren-delay t + #'show-paren-function)) + (unless show-paren-mode + (delete-overlay show-paren--overlay) + (delete-overlay show-paren--overlay-1))) + +(defun show-paren--unescaped-p (pos) + "Determine whether the paren after POS is unescaped." + (save-excursion + (goto-char pos) + (= (logand (skip-syntax-backward "/\\") 1) 0))) + +(defun show-paren--categorize-paren (pos) + "Determine whether the character after POS has paren syntax, +and if so, return a cons (DIR . OUTSIDE), where DIR is 1 for an +open paren, -1 for a close paren, and OUTSIDE is the buffer +position of the outside of the paren. If the character isn't a +paren, or it is an escaped paren, return nil." + (cond + ((and (eq (syntax-class (syntax-after pos)) 4) + (show-paren--unescaped-p pos)) + (cons 1 pos)) + ((and (eq (syntax-class (syntax-after pos)) 5) + (show-paren--unescaped-p pos)) + (cons -1 (1+ pos))))) + +(defun show-paren--locate-near-paren () + "Locate an unescaped paren \"near\" point to show. +If one is found, return the cons (DIR . OUTSIDE), where DIR is 1 +for an open paren, -1 for a close paren, and OUTSIDE is the buffer +position of the outside of the paren. Otherwise return nil." + (let* ((ind-pos (save-excursion (back-to-indentation) (point))) + (eol-pos + (save-excursion + (end-of-line) (skip-chars-backward " \t" ind-pos) (point))) + (before (show-paren--categorize-paren (1- (point)))) + (after (show-paren--categorize-paren (point)))) + (cond + ;; Point is immediately outside a paren. + ((eq (car before) -1) before) + ((eq (car after) 1) after) + ;; Point is immediately inside a paren. + ((and show-paren-when-point-inside-paren before)) + ((and show-paren-when-point-inside-paren after)) + ;; Point is in the whitespace before the code. + ((and show-paren-when-point-in-periphery + (<= (point) ind-pos)) + (or (show-paren--categorize-paren ind-pos) + (show-paren--categorize-paren (1- eol-pos)))) + ;; Point is in the whitespace after the code. + ((and show-paren-when-point-in-periphery + (>= (point) eol-pos)) + (show-paren--categorize-paren (1- eol-pos)))))) + +(defvar show-paren-data-function #'show-paren--default + "Function to find the opener/closer \"near\" point and its match. +The function is called with no argument and should return either nil +if there's no opener/closer near point, or a list of the form +\(HERE-BEG HERE-END THERE-BEG THERE-END MISMATCH) +Where HERE-BEG..HERE-END is expected to be near point.") + +(defun show-paren--default () + (let* ((temp (show-paren--locate-near-paren)) + (dir (car temp)) + (outside (cdr temp)) + pos mismatch here-beg here-end) + ;; + ;; Find the other end of the sexp. + (when dir + (setq here-beg (if (eq dir 1) outside (1- outside)) + here-end (if (eq dir 1) (1+ outside) outside)) + (save-restriction + ;; Determine the range within which to look for a match. + (when blink-matching-paren-distance + (narrow-to-region + (max (point-min) (- (point) blink-matching-paren-distance)) + (min (point-max) (+ (point) blink-matching-paren-distance)))) + ;; Scan across one sexp within that range. + ;; Errors or nil mean there is a mismatch. + (condition-case () + (setq pos (scan-sexps outside dir)) + (error (setq pos t mismatch t))) + ;; Move back the other way and verify we get back to the + ;; starting point. If not, these two parens don't really match. + ;; Maybe the one at point is escaped and doesn't really count, + ;; or one is inside a comment. + (when (integerp pos) + (unless (condition-case () + (eq outside (scan-sexps pos (- dir))) + (error nil)) + (setq pos nil))) + ;; If found a "matching" paren, see if it is the right + ;; kind of paren to match the one we started at. + (if (not (integerp pos)) + (if mismatch (list here-beg here-end nil nil t)) + (let ((beg (min pos outside)) (end (max pos outside))) + (unless (eq (syntax-class (syntax-after beg)) 8) + (setq mismatch + (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))))))) + (list here-beg here-end + (if (= dir 1) (1- pos) pos) + (if (= dir 1) pos (1+ pos)) + mismatch))))))) ;; Find the place to show, if there is one, ;; and show it until input arrives. (defun show-paren-function () - (if show-paren-mode - (let* ((oldpos (point)) - (dir (cond ((eq (syntax-class (syntax-after (1- (point)))) 5) -1) - ((eq (syntax-class (syntax-after (point))) 4) 1))) - (unescaped - (when dir - ;; Verify an even number of quoting characters precede the paren. - ;; Follow the same logic as in `blink-matching-open'. - (= (if (= dir -1) 1 0) - (logand 1 (- (point) - (save-excursion - (if (= dir -1) (forward-char -1)) - (skip-syntax-backward "/\\") - (point))))))) - pos mismatch face) - ;; - ;; Find the other end of the sexp. - (when unescaped - (save-excursion - (save-restriction - ;; Determine the range within which to look for a match. - (when blink-matching-paren-distance - (narrow-to-region - (max (point-min) (- (point) blink-matching-paren-distance)) - (min (point-max) (+ (point) blink-matching-paren-distance)))) - ;; Scan across one sexp within that range. - ;; Errors or nil mean there is a mismatch. - (condition-case () - (setq pos (scan-sexps (point) dir)) - (error (setq pos t mismatch t))) - ;; Move back the other way and verify we get back to the - ;; starting point. If not, these two parens don't really match. - ;; Maybe the one at point is escaped and doesn't really count. - (when (integerp pos) - (unless (condition-case () - (eq (point) (scan-sexps pos (- dir))) - (error nil)) - (setq pos nil))) - ;; If found a "matching" paren, see if it is the right - ;; kind of paren to match the one we started at. - (when (integerp pos) - (let ((beg (min pos oldpos)) (end (max pos oldpos))) - (unless (eq (syntax-class (syntax-after beg)) 8) - (setq mismatch - (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)))))))))))) - ;; - ;; Highlight the other end of the sexp, or unhighlight if none. - (if (not pos) - (progn - ;; If not at a paren that has a match, - ;; turn off any previous paren highlighting. - (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))) - ;; - ;; Use the correct face. - (if mismatch - (progn - (if show-paren-ring-bell-on-mismatch - (beep)) - (setq face 'show-paren-mismatch)) - (setq face 'show-paren-match)) - ;; - ;; If matching backwards, highlight the closeparen - ;; before point as well as its matching open. - ;; If matching forward, and the openparen is unbalanced, - ;; highlight the paren at point to indicate misbalance. - ;; Otherwise, turn off any such highlighting. - (if (and (not show-paren-highlight-openparen) (= 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) - (- (point) 1))) - (to (if (= dir 1) - (+ (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 nil t))) - ;; Always set the overlay face, since it varies. - (overlay-put show-paren-overlay-1 'priority show-paren-priority) - (overlay-put show-paren-overlay-1 'face face))) - ;; - ;; Turn on highlighting for the matching paren, if found. - ;; If it's an unmatched paren, turn off any such highlighting. - (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) - (- (point) dir))))) - (if show-paren-overlay - (move-overlay show-paren-overlay from to (current-buffer)) - (setq show-paren-overlay (make-overlay from to nil t)))) - ;; - ;; Always set the overlay face, since it varies. - (overlay-put show-paren-overlay 'priority show-paren-priority) - (overlay-put show-paren-overlay 'face face))) - ;; show-paren-mode is nil in this buffer. - (and show-paren-overlay - (delete-overlay show-paren-overlay)) - (and show-paren-overlay-1 - (delete-overlay show-paren-overlay-1)))) + (let ((data (and show-paren-mode (funcall show-paren-data-function)))) + (if (not data) + (progn + ;; If show-paren-mode is nil in this buffer or if not at a paren that + ;; has a match, turn off any previous paren highlighting. + (delete-overlay show-paren--overlay) + (delete-overlay show-paren--overlay-1)) + + ;; Found something to highlight. + (let* ((here-beg (nth 0 data)) + (here-end (nth 1 data)) + (there-beg (nth 2 data)) + (there-end (nth 3 data)) + (mismatch (nth 4 data)) + (face + (if mismatch + (progn + (if show-paren-ring-bell-on-mismatch + (beep)) + 'show-paren-mismatch) + 'show-paren-match))) + ;; + ;; If matching backwards, highlight the closeparen + ;; before point as well as its matching open. + ;; If matching forward, and the openparen is unbalanced, + ;; highlight the paren at point to indicate misbalance. + ;; Otherwise, turn off any such highlighting. + (if (or (not here-beg) + (and (not show-paren-highlight-openparen) + (> here-end (point)) + (<= here-beg (point)) + (integerp there-beg))) + (delete-overlay show-paren--overlay-1) + (move-overlay show-paren--overlay-1 + here-beg here-end (current-buffer)) + ;; Always set the overlay face, since it varies. + (overlay-put show-paren--overlay-1 'priority show-paren-priority) + (overlay-put show-paren--overlay-1 'face face)) + ;; + ;; Turn on highlighting for the matching paren, if found. + ;; If it's an unmatched paren, turn off any such highlighting. + (if (not there-beg) + (delete-overlay show-paren--overlay) + (if (or (eq show-paren-style 'expression) + (and (eq show-paren-style 'mixed) + (let ((closest (if (< there-beg here-beg) + (1- there-end) (1+ there-beg)))) + (not (pos-visible-in-window-p closest))))) + (move-overlay show-paren--overlay + (if (< there-beg here-beg) here-end here-beg) + (if (< there-beg here-beg) there-beg there-end) + (current-buffer)) + (move-overlay show-paren--overlay + there-beg there-end (current-buffer))) + ;; Always set the overlay face, since it varies. + (overlay-put show-paren--overlay 'priority show-paren-priority) + (overlay-put show-paren--overlay 'face face)))))) (provide 'paren)