Enable the hook only if window-system.

Clear blink-paren-function at the same time.
(show-paren-command-hook): If after a closeparen,
highlight that closeparen as well as matching open.
Use a different color for a mismatch, if color screen.

1 files changed, 71 insertions, 44 deletions

diff --git a/lisp/paren.el b/lisp/paren.el
index 221c6aaf5d4..c96efcd1863 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -28,69 +28,96 @@
 
 ;;; Code:
 
+;; 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)
+
+(defvar show-paren-mismatch-face nil)
 
 ;; Find the place to show, if there is one,
 ;; and show it until input arrives.
 (defun show-paren-command-hook ()
   (if window-system
       (let (pos dir mismatch (oldpos (point))
-                (face (if (face-equal 'highlight 'region)
-                          'underline 'highlight)))
+                (face 'region))
         (cond ((eq (char-syntax (following-char)) ?\()
                (setq dir 1))
               ((eq (char-syntax (preceding-char)) ?\))
                (setq dir -1)))
-        (save-excursion
-          (save-restriction
-            ;; Determine the range within which to look for a match.
-            (if 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.
-            (condition-case ()
-                (setq pos (scan-sexps (point) dir))
-              (error nil))
-            ;; See if the "matching" paren is the right kind of paren
-            ;; to match the one we started at.
-            (if pos
-                (let ((beg (min pos oldpos)) (end (max pos oldpos)))
-                  (and (/= (char-syntax (char-after beg)) ?\$)
-                       (setq mismatch
-                             (/= (char-after (1- end))
-                                 (logand (lsh (aref (syntax-table)
-                                                    (char-after beg))
-                                              -8)
-                                         255))))))
-            ;; If they don't properly match, don't show.
-            (if mismatch
-                (progn
-                  (message "Paren mismatch")
-    ;;;       (setq pos nil)
-                  ))))
+        (if dir
+            (save-excursion
+              (save-restriction
+                ;; Determine the range within which to look for a match.
+                (if 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.
+                (condition-case ()
+                    (setq pos (scan-sexps (point) dir))
+                  (error nil))
+                ;; See if the "matching" paren is the right kind of paren
+                ;; to match the one we started at.
+                (if pos
+                    (let ((beg (min pos oldpos)) (end (max pos oldpos)))
+                      (and (/= (char-syntax (char-after beg)) ?\$)
+                           (setq mismatch
+                                 (/= (char-after (1- end))
+                                     (logand (lsh (aref (syntax-table)
+                                                        (char-after beg))
+                                                  -8)
+                                             255))))))
+                ;; If they don't properly match, use a different face,
+                ;; or print a message.
+                (if mismatch
+                    (progn
+                      (and (null show-paren-mismatch-face)
+                           (x-display-color-p)
+                           (or (setq show-paren-mismatch-face
+                                     (internal-find-face 'paren-mismatch))
+                               (progn
+                                 (setq show-paren-mismatch-face
+                                       (make-face 'paren-mismatch))
+                                 (set-face-background 'paren-mismatch 'purple))))
+                      (if show-paren-mismatch-face
+                          (setq face show-paren-mismatch-face)
+                        (message "Paren mismatch"))))
+                )))
         (cond (pos
+               (if (= dir -1)
+                   ;; If matching backwards, highlight the closeparen
+                   ;; before point as well as its matching open.
+                   (progn
+                     (if show-paren-overlay-1
+                         (move-overlay show-paren-overlay-1 (+ (point) dir) (point))
+                       (setq show-paren-overlay-1
+                             (make-overlay (- pos dir) pos)))
+                     (overlay-put show-paren-overlay-1 'face face))
+                 ;; Otherwise, turn off any such highlighting.
+                 (and show-paren-overlay-1
+                      (overlay-buffer show-paren-overlay-1)
+                      (delete-overlay show-paren-overlay-1)))
+               ;; Turn on highlighting for the matching paren.
                (if show-paren-overlay
                    (move-overlay show-paren-overlay (- pos dir) pos)
                  (setq show-paren-overlay
                        (make-overlay (- pos dir) pos)))
-               (overlay-put show-paren-overlay 'face face)
-    ;;; This is code to blink the highlighting.
-    ;;; It is desirable to avoid this because
-    ;;; it would interfere with auto-save and gc when idle.
-;;;        (while (sit-for 1)
-;;;          (overlay-put show-paren-overlay
-;;;                       'face
-;;;                       (if (overlay-get show-paren-overlay
-;;;                                        'face)
-;;;                           nil face)))
-               )
+               (overlay-put show-paren-overlay 'face face))
               (t
+               ;; 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)))))))
+                    (delete-overlay show-paren-overlay))
+               (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1)
+                    (delete-overlay show-paren-overlay-1)))))))
 
-(add-hook 'post-command-hook 'show-paren-command-hook)
+(if window-system
+    (progn
+      (setq blink-paren-function nil)
+      (add-hook 'post-command-hook 'show-paren-command-hook)))
 
 (provide 'paren)