(url-http-mark-connection-as-free, url-http-find-free-connection):

[gnu-emacs] / lisp / paren.el

diff --git a/lisp/paren.el b/lisp/paren.el
index 53fc343c6d5536a3c7b4a1e970236ae2ca912f18..29506174c6b07485ef1ccd1c44fdd288b3762ffa 100644 (file)
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -1,6 +1,7 @@
-;;; paren.el --- highlight matching paren.
+;;; paren.el --- highlight matching paren

 
 

-;; Copyright (C) 1993, 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1996, 2001, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.

 
 ;; Author: rms@gnu.org
 ;; Maintainer: FSF
 
 ;; Author: rms@gnu.org
 ;; Maintainer: FSF


@@ -20,13 +21,17 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the

-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

-;; Load this and it will display highlighting on whatever
-;; paren matches the one before or after point.
+;; Put this into your ~/.emacs:
+
+;;  (show-paren-mode t)
+
+;; It will display highlighting on whatever paren matches the one
+;; before or after point.

 
 ;;; Code:
 
 
 ;;; Code:
 


@@ -40,20 +45,6 @@
 ;; This is the overlay used to highlight the closeparen right before point.
 (defvar show-paren-overlay-1 nil)
 
 ;; This is the overlay used to highlight the closeparen right before point.
 (defvar show-paren-overlay-1 nil)
 

-;;;###autoload
-(defcustom show-paren-mode nil
-  "*Toggle Show Paren mode.
-When Show Paren mode is enabled, any matching parenthesis is highlighted
-after `show-paren-delay' seconds of Emacs idle time.
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `show-paren-mode'."
-  :set (lambda (symbol value)
-        (show-paren-mode (or value 0)))
-  :initialize 'custom-initialize-default
-  :type 'boolean
-  :group 'paren-showing
-  :require 'paren)
-

 (defcustom show-paren-style 'parenthesis
   "*Style used when showing a matching paren.
 Valid styles are `parenthesis' (meaning show the matching paren),
 (defcustom show-paren-style 'parenthesis
   "*Style used when showing a matching paren.
 Valid styles are `parenthesis' (meaning show the matching paren),


@@ -69,49 +60,61 @@ otherwise)."
   :type '(number :tag "seconds")
   :group 'paren-showing)
 
   :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")
 (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."
+
+(defgroup paren-showing-faces nil
+  "Group for faces of Show Paren mode."
+  :group 'paren-showing

   :group 'faces
   :group 'faces

-  :group 'paren-showing)
+  :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)
+;; backward-compatibility alias
+(put 'show-paren-match-face 'face-alias 'show-paren-match)

 
 

-(defface show-paren-mismatch-face
+(defface show-paren-mismatch

   '((((class color)) (:foreground "white" :background "purple"))
   '((((class color)) (:foreground "white" :background "purple"))

-    (t (:reverse-video t)))
+    (t (:inverse-video t)))

   "Show Paren mode face used for a mismatching paren."
   "Show Paren mode face used for a mismatching paren."

-  :group 'faces
-  :group 'paren-showing)
+  :group 'paren-showing-faces)
+;; backward-compatibility alias
+(put 'show-paren-mismatch-face 'face-alias 'show-paren-mismatch)
+
+(defvar show-paren-highlight-openparen t
+  "*Non-nil turns on openparen highlighting when matching forward.")

 
 (defvar show-paren-idle-timer nil)
 
 ;;;###autoload
 
 (defvar show-paren-idle-timer nil)
 
 ;;;###autoload

-(defun show-paren-mode (&optional arg)
+(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."
   "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."

-  (interactive "P")
-  (let ((on-p (if arg
-                 (> (prefix-numeric-value arg) 0)
-               (not show-paren-mode))))
-    (setq show-paren-mode on-p)
-    ;; Turn off the usual paren-matching method
-    ;; when this one is turned on.
-    (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 on-p))
-
-    ;; Now enable or disable the mechanism.
+  :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))
     ;; First get rid of the old idle timer.
     (if show-paren-idle-timer
        (cancel-timer show-paren-idle-timer))


@@ -125,23 +128,22 @@ in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time."
       (setq show-paren-idle-timer (run-with-idle-timer
                                   show-paren-delay t
                                   'show-paren-function)))
       (setq show-paren-idle-timer (run-with-idle-timer
                                   show-paren-delay t
                                   'show-paren-function)))

-    (unless on-p
+    (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))
       (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)))))
+          (delete-overlay show-paren-overlay-1))))

 
 ;; Find the place to show, if there is one,
 ;; and show it until input arrives.
 (defun show-paren-function ()
   (if show-paren-mode
 
 ;; Find the place to show, if there is one,
 ;; and show it until input arrives.
 (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)))
+      (let ((oldpos (point))
+           (dir (cond ((eq (syntax-class (syntax-after (1- (point)))) 5) -1)
+                       ((eq (syntax-class (syntax-after (point)))      4) 1)))
+           pos mismatch face)

        ;;
        ;; Find the other end of the sexp.
        (when dir
        ;;
        ;; Find the other end of the sexp.
        (when dir


@@ -157,15 +159,31 @@ in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time."
              (condition-case ()
                  (setq pos (scan-sexps (point) dir))
                (error (setq pos t mismatch t)))
              (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)))
              ;; 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)))

-                 (when (/= (char-syntax (char-after beg)) ?\$)
+                 (unless (eq (syntax-class (syntax-after beg)) 8)

                    (setq mismatch
                    (setq mismatch

-                         (not (eq (char-before end)
-                                  ;; This can give nil.
-                                  (matching-paren (char-after beg)))))))))))
+                         (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)
        ;;
        ;; Highlight the other end of the sexp, or unhighlight if none.
        (if (not pos)


@@ -182,15 +200,15 @@ in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time."
              (progn
                (if show-paren-ring-bell-on-mismatch
                    (beep))
              (progn
                (if show-paren-ring-bell-on-mismatch
                    (beep))

-               (setq face 'show-paren-mismatch-face))
-           (setq face 'show-paren-match-face))
+               (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 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 (= dir 1) (integerp pos))
+         (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))
              (when (and show-paren-overlay-1
                         (overlay-buffer show-paren-overlay-1))
                (delete-overlay show-paren-overlay-1))


@@ -204,6 +222,7 @@ in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time."
                  (move-overlay show-paren-overlay-1 from to (current-buffer))
                (setq show-paren-overlay-1 (make-overlay from to)))
              ;; Always set the overlay face, since it varies.
                  (move-overlay show-paren-overlay-1 from to (current-buffer))
                (setq show-paren-overlay-1 (make-overlay from to)))
              ;; 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.
              (overlay-put show-paren-overlay-1 'face face)))
          ;;
          ;; Turn on highlighting for the matching paren, if found.


@@ -227,6 +246,7 @@ in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time."
              (setq show-paren-overlay (make-overlay from to))))
          ;;
          ;; Always set the overlay face, since it varies.
              (setq show-paren-overlay (make-overlay from to))))
          ;;
          ;; 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
          (overlay-put show-paren-overlay 'face face)))
     ;; show-paren-mode is nil in this buffer.
     (and show-paren-overlay


@@ -236,7 +256,5 @@ in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time."
 
 (provide 'paren)
 
 
 (provide 'paren)
 

-(if show-paren-mode
-    (show-paren-mode t))
-
+;; arch-tag: d0969b88-7ac0-4bd0-bd53-e73b892b86a9

 ;;; paren.el ends here
 ;;; paren.el ends here