* progmodes/sql.el Version 3.3

[bpt/emacs.git] / lisp / electric.el

diff --git a/lisp/electric.el b/lisp/electric.el
index 3d7c1fd..351468f 100644 (file)
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -1,6 +1,7 @@
 ;;; electric.el --- window maker and Command loop for `electric' modes
 
 ;;; electric.el --- window maker and Command loop for `electric' modes
 

-;; Copyright (C) 1985-1986, 1995, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1995, 2001-2013 Free Software Foundation,
+;; Inc.

 
 ;; Author: K. Shane Hartman
 ;; Maintainer: FSF
 
 ;; Author: K. Shane Hartman
 ;; Maintainer: FSF


@@ -38,8 +39,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

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

 ;; This loop is the guts for non-standard modes which retain control
 ;; until some event occurs.  It is a `do-forever', the only way out is
 ;; to throw.  It assumes that you have set up the keymap, window, and
 ;; This loop is the guts for non-standard modes which retain control
 ;; until some event occurs.  It is a `do-forever', the only way out is
 ;; to throw.  It assumes that you have set up the keymap, window, and


@@ -85,7 +84,7 @@
              (eq last-input-event ?\C-g))
          (progn (setq unread-command-events nil
                       prefix-arg nil)
              (eq last-input-event ?\C-g))
          (progn (setq unread-command-events nil
                       prefix-arg nil)

-                ;; If it wasn't cancelling a prefix character, then quit.
+                ;; If it wasn't canceling a prefix character, then quit.

                 (if (or (= (length (this-command-keys)) 1)
                         (not inhibit-quit)) ; safety
                     (progn (ding)
                 (if (or (= (length (this-command-keys)) 1)
                         (not inhibit-quit)) ; safety
                     (progn (ding)


@@ -199,6 +198,12 @@ Returns nil when we can't find this char."
 (defvar electric-indent-chars '(?\n)
   "Characters that should cause automatic reindentation.")
 
 (defvar electric-indent-chars '(?\n)
   "Characters that should cause automatic reindentation.")
 

+(defvar electric-indent-functions nil
+  "Special hook run to decide whether to auto-indent.
+Each function is called with one argument (the inserted char), with
+point right after that char, and it should return t to cause indentation,
+`no-indent' to prevent indentation or nil to let other functions decide.")
+

 (defun electric-indent-post-self-insert-function ()
   ;; FIXME: This reindents the current line, but what we really want instead is
   ;; to reindent the whole affected text.  That's the current line for simple
 (defun electric-indent-post-self-insert-function ()
   ;; FIXME: This reindents the current line, but what we really want instead is
   ;; to reindent the whole affected text.  That's the current line for simple


@@ -208,13 +213,22 @@ Returns nil when we can't find this char."
   ;; There might be a way to get it working by analyzing buffer-undo-list, but
   ;; it looks challenging.
   (let (pos)
   ;; There might be a way to get it working by analyzing buffer-undo-list, but
   ;; it looks challenging.
   (let (pos)

-    (when (and (memq last-command-event electric-indent-chars)
-               ;; Don't reindent while inserting spaces at beginning of line.
-               (or (not (memq last-command-event '(?\s ?\t)))
-                   (save-excursion (skip-chars-backward " \t") (not (bolp))))
-               (setq pos (electric--after-char-pos))
-               ;; Not in a string or comment.
-               (not (nth 8 (save-excursion (syntax-ppss pos)))))
+    (when (and
+           electric-indent-mode
+           ;; Don't reindent while inserting spaces at beginning of line.
+           (or (not (memq last-command-event '(?\s ?\t)))
+               (save-excursion (skip-chars-backward " \t") (not (bolp))))
+           (setq pos (electric--after-char-pos))
+           (save-excursion
+             (goto-char pos)
+             (let ((act (or (run-hook-with-args-until-success
+                             'electric-indent-functions
+                             last-command-event)
+                            (memq last-command-event electric-indent-chars))))
+               (not
+                (or (memq act '(nil no-indent))
+                    ;; In a string or comment.
+                    (unless (eq act 'do-indent) (nth 8 (syntax-ppss))))))))

       ;; For newline, we want to reindent both lines and basically behave like
       ;; reindent-then-newline-and-indent (whose code we hence copied).
       (when (< (1- pos) (line-beginning-position))
       ;; For newline, we want to reindent both lines and basically behave like
       ;; reindent-then-newline-and-indent (whose code we hence copied).
       (when (< (1- pos) (line-beginning-position))


@@ -222,7 +236,7 @@ Returns nil when we can't find this char."
           (save-excursion
             (unless (memq indent-line-function
                           '(indent-relative indent-to-left-margin
           (save-excursion
             (unless (memq indent-line-function
                           '(indent-relative indent-to-left-margin

-                            indent-relative-maybe))
+                                            indent-relative-maybe))

               ;; Don't reindent the previous line if the indentation function
               ;; is not a real one.
               (goto-char before)
               ;; Don't reindent the previous line if the indentation function
               ;; is not a real one.
               (goto-char before)


@@ -246,32 +260,36 @@ With a prefix argument ARG, enable Electric Indent mode if ARG is
 positive, and disable it otherwise.  If called from Lisp, enable
 the mode if ARG is omitted or nil.
 
 positive, and disable it otherwise.  If called from Lisp, enable
 the mode if ARG is omitted or nil.
 

-Electric Indent mode is a global minor mode.  When enabled,
-reindentation is triggered whenever you insert a character listed
-in `electric-indent-chars'."
+This is a global minor mode.  When enabled, it reindents whenever
+the hook `electric-indent-functions' returns non-nil, or you
+insert a character from `electric-indent-chars'."

   :global t
   :group 'electricity
   :global t
   :group 'electricity

-  (if electric-indent-mode
-      (add-hook 'post-self-insert-hook
-                #'electric-indent-post-self-insert-function)
-    (remove-hook 'post-self-insert-hook
-                 #'electric-indent-post-self-insert-function))
-  ;; FIXME: electric-indent-mode and electric-layout-mode interact
-  ;; in non-trivial ways.  It turns out that electric-indent-mode works
-  ;; better if it is run *after* electric-layout-mode's hook.
-  (when (memq #'electric-layout-post-self-insert-function
-              (memq #'electric-indent-post-self-insert-function
-                    (default-value 'post-self-insert-hook)))
-    (remove-hook 'post-self-insert-hook
-                 #'electric-layout-post-self-insert-function)
+  (if (not electric-indent-mode)
+      (remove-hook 'post-self-insert-hook
+                   #'electric-indent-post-self-insert-function)
+    ;; post-self-insert-hooks interact in non-trivial ways.
+    ;; It turns out that electric-indent-mode generally works better if run
+    ;; late, but still before blink-paren.

     (add-hook 'post-self-insert-hook
     (add-hook 'post-self-insert-hook

-              #'electric-layout-post-self-insert-function)))
+              #'electric-indent-post-self-insert-function
+              'append)
+    ;; FIXME: Ugly!
+    (let ((bp (memq #'blink-paren-post-self-insert-function
+                    (default-value 'post-self-insert-hook))))
+      (when (memq #'electric-indent-post-self-insert-function bp)
+        (setcar bp #'electric-indent-post-self-insert-function)
+        (setcdr bp (cons #'blink-paren-post-self-insert-function
+                         (delq #'electric-indent-post-self-insert-function
+                               (cdr bp))))))))

 
 ;; Electric pairing.
 
 (defcustom electric-pair-pairs
   '((?\" . ?\"))
   "Alist of pairs that should be used regardless of major mode."
 
 ;; Electric pairing.
 
 (defcustom electric-pair-pairs
   '((?\" . ?\"))
   "Alist of pairs that should be used regardless of major mode."

+  :group 'electricity
+  :version "24.1"

   :type '(repeat (cons character character)))
 
 (defcustom electric-pair-skip-self t
   :type '(repeat (cons character character)))
 
 (defcustom electric-pair-skip-self t


@@ -280,45 +298,84 @@ When inserting a closing paren character right before the same character,
 just skip that character instead, so that hitting ( followed by ) results
 in \"()\" rather than \"())\".
 This can be convenient for people who find it easier to hit ) than C-f."
 just skip that character instead, so that hitting ( followed by ) results
 in \"()\" rather than \"())\".
 This can be convenient for people who find it easier to hit ) than C-f."

+  :group 'electricity
+  :version "24.1"

   :type 'boolean)
 
   :type 'boolean)
 

+(defcustom electric-pair-inhibit-predicate
+  #'electric-pair-default-inhibit
+  "Predicate to prevent insertion of a matching pair.
+The function is called with a single char (the opening char just inserted).
+If it returns non-nil, then `electric-pair-mode' will not insert a matching
+closer."
+  :version "24.4"
+  :type '(choice
+          (const :tag "Default" electric-pair-default-inhibit)
+          (const :tag "Always pair" ignore)
+          function))
+
+(defun electric-pair-default-inhibit (char)
+  (or
+   ;; I find it more often preferable not to pair when the
+   ;; same char is next.
+   (eq char (char-after))
+   ;; Don't pair up when we insert the second of "" or of ((.
+   (and (eq char (char-before))
+       (eq char (char-before (1- (point)))))
+   ;; I also find it often preferable not to pair next to a word.
+   (eq (char-syntax (following-char)) ?w)))
+
+(defun electric-pair-syntax (command-event)
+  (let ((x (assq command-event electric-pair-pairs)))
+    (cond
+     (x (if (eq (car x) (cdr x)) ?\" ?\())
+     ((rassq command-event electric-pair-pairs) ?\))
+     ((nth 8 (syntax-ppss))
+      (with-syntax-table text-mode-syntax-table (char-syntax command-event)))
+     (t (char-syntax command-event)))))
+
+(defun electric-pair--insert (char)
+  (let ((last-command-event char)
+       (blink-matching-paren nil)
+       (electric-pair-mode nil))
+    (self-insert-command 1)))
+

 (defun electric-pair-post-self-insert-function ()
 (defun electric-pair-post-self-insert-function ()

-  (let* ((syntax (and (eq (char-before) last-command-event) ; Sanity check.
-                      electric-pair-mode
-                      (let ((x (assq last-command-event electric-pair-pairs)))
-                        (cond
-                         (x (if (eq (car x) (cdr x)) ?\" ?\())
-                         ((rassq last-command-event electric-pair-pairs) ?\))
-                         (t (char-syntax last-command-event))))))
-         ;; FIXME: when inserting the closer, we should maybe use
-         ;; self-insert-command, although it may prove tricky running
-         ;; post-self-insert-hook recursively, and we wouldn't want to trigger
-         ;; blink-matching-open.
+  (let* ((pos (and electric-pair-mode (electric--after-char-pos)))
+        (syntax (and pos (electric-pair-syntax last-command-event)))

          (closer (if (eq syntax ?\()
                      (cdr (or (assq last-command-event electric-pair-pairs)
                               (aref (syntax-table) last-command-event)))
                    last-command-event)))
     (cond
          (closer (if (eq syntax ?\()
                      (cdr (or (assq last-command-event electric-pair-pairs)
                               (aref (syntax-table) last-command-event)))
                    last-command-event)))
     (cond

+     ((null pos) nil)

      ;; Wrap a pair around the active region.
      ((and (memq syntax '(?\( ?\" ?\$)) (use-region-p))
      ;; Wrap a pair around the active region.
      ((and (memq syntax '(?\( ?\" ?\$)) (use-region-p))

-      (if (> (mark) (point))
+      ;; FIXME: To do this right, we'd need a post-self-insert-function
+      ;; so we could add-function around it and insert the closer after
+      ;; all the rest of the hook has run.
+      (if (>= (mark) (point))
+         (goto-char (mark))
+       ;; We already inserted the open-paren but at the end of the
+       ;; region, so we have to remove it and start over.
+       (delete-region (1- pos) (point))
+       (save-excursion

           (goto-char (mark))
           (goto-char (mark))

-        ;; We already inserted the open-paren but at the end of the region,
-        ;; so we have to remove it and start over.
-        (delete-char -1)
-        (save-excursion
-          (goto-char (mark))
-          (insert last-command-event)))
+          (electric-pair--insert last-command-event)))
+      ;; Since we're right after the closer now, we could tell the rest of
+      ;; post-self-insert-hook that we inserted `closer', but then we'd get
+      ;; blink-paren to kick in, which is annoying.
+      ;;(setq last-command-event closer)

       (insert closer))
      ;; Backslash-escaped: no pairing, no skipping.
      ((save-excursion
       (insert closer))
      ;; Backslash-escaped: no pairing, no skipping.
      ((save-excursion

-        (goto-char (1- (point)))
+        (goto-char (1- pos))

         (not (zerop (% (skip-syntax-backward "\\") 2))))
       nil)
      ;; Skip self.
      ((and (memq syntax '(?\) ?\" ?\$))
            electric-pair-skip-self
         (not (zerop (% (skip-syntax-backward "\\") 2))))
       nil)
      ;; Skip self.
      ((and (memq syntax '(?\) ?\" ?\$))
            electric-pair-skip-self

-           (eq (char-after) last-command-event))
+           (eq (char-after pos) last-command-event))

       ;; This is too late: rather than insert&delete we'd want to only skip (or
       ;; insert in overwrite mode).  The difference is in what goes in the
       ;; undo-log and in the intermediate state which might be visible to other
       ;; This is too late: rather than insert&delete we'd want to only skip (or
       ;; insert in overwrite mode).  The difference is in what goes in the
       ;; undo-log and in the intermediate state which might be visible to other


@@ -327,13 +384,12 @@ This can be convenient for people who find it easier to hit ) than C-f."
      ;; Insert matching pair.
      ((not (or (not (memq syntax `(?\( ?\" ?\$)))
                overwrite-mode
      ;; Insert matching pair.
      ((not (or (not (memq syntax `(?\( ?\" ?\$)))
                overwrite-mode

-               ;; I find it more often preferable not to pair when the
-               ;; same char is next.
-               (eq last-command-event (char-after))
-               (eq last-command-event (char-before (1- (point))))
-               ;; I also find it often preferable not to pair next to a word.
-               (eq (char-syntax (following-char)) ?w)))
-      (save-excursion (insert closer))))))
+               (funcall electric-pair-inhibit-predicate last-command-event)))
+      (save-excursion (electric-pair--insert closer))))))
+
+(defun electric-pair-will-use-region ()
+  (and (use-region-p)
+       (memq (electric-pair-syntax last-command-event) '(?\( ?\" ?\$))))

 
 ;;;###autoload
 (define-minor-mode electric-pair-mode
 
 ;;;###autoload
 (define-minor-mode electric-pair-mode


@@ -344,14 +400,21 @@ the mode if ARG is omitted or nil.
 
 Electric Pair mode is a global minor mode.  When enabled, typing
 an open parenthesis automatically inserts the corresponding
 
 Electric Pair mode is a global minor mode.  When enabled, typing
 an open parenthesis automatically inserts the corresponding

-closing parenthesis.  \(Likewise for brackets, etc.)"
+closing parenthesis.  \(Likewise for brackets, etc.)
+
+See options `electric-pair-pairs' and `electric-pair-skip-self'."

   :global t
   :group 'electricity
   (if electric-pair-mode
   :global t
   :group 'electricity
   (if electric-pair-mode

-      (add-hook 'post-self-insert-hook
-                #'electric-pair-post-self-insert-function)
+      (progn
+       (add-hook 'post-self-insert-hook
+                 #'electric-pair-post-self-insert-function)
+       (add-hook 'self-insert-uses-region-functions
+                 #'electric-pair-will-use-region))

     (remove-hook 'post-self-insert-hook
     (remove-hook 'post-self-insert-hook

-                 #'electric-pair-post-self-insert-function)))
+                 #'electric-pair-post-self-insert-function)
+    (remove-hook 'self-insert-uses-region-functions
+                 #'electric-pair-will-use-region)))

 
 ;; Automatically add newlines after/before/around some chars.
 
 
 ;; Automatically add newlines after/before/around some chars.
 


@@ -359,8 +422,8 @@ closing parenthesis.  \(Likewise for brackets, etc.)"
   "List of rules saying where to automatically insert newlines.
 Each rule has the form (CHAR . WHERE) where CHAR is the char
 that was just inserted and WHERE specifies where to insert newlines
   "List of rules saying where to automatically insert newlines.
 Each rule has the form (CHAR . WHERE) where CHAR is the char
 that was just inserted and WHERE specifies where to insert newlines

-and can be: nil, `before', `after', `around', or a function that returns
-one of those symbols.")
+and can be: nil, `before', `after', `around', or a function of no
+arguments that returns one of those symbols.")

 
 (defun electric-layout-post-self-insert-function ()
   (let* ((rule (cdr (assq last-command-event electric-layout-rules)))
 
 (defun electric-layout-post-self-insert-function ()
   (let* ((rule (cdr (assq last-command-event electric-layout-rules)))


@@ -371,16 +434,16 @@ one of those symbols.")
                (not (nth 8 (save-excursion (syntax-ppss pos)))))
       (let ((end (copy-marker (point) t)))
         (goto-char pos)
                (not (nth 8 (save-excursion (syntax-ppss pos)))))
       (let ((end (copy-marker (point) t)))
         (goto-char pos)

-        (case (if (functionp rule) (funcall rule) rule)
+        (pcase (if (functionp rule) (funcall rule) rule)

           ;; FIXME: we used `newline' down here which called
           ;; self-insert-command and ran post-self-insert-hook recursively.
           ;; It happened to make electric-indent-mode work automatically with
           ;; electric-layout-mode (at the cost of re-indenting lines
           ;; multiple times), but I'm not sure it's what we want.
           ;; FIXME: we used `newline' down here which called
           ;; self-insert-command and ran post-self-insert-hook recursively.
           ;; It happened to make electric-indent-mode work automatically with
           ;; electric-layout-mode (at the cost of re-indenting lines
           ;; multiple times), but I'm not sure it's what we want.

-          (before (goto-char (1- pos)) (skip-chars-backward " \t")
+          (`before (goto-char (1- pos)) (skip-chars-backward " \t")

                   (unless (bolp) (insert "\n")))
                   (unless (bolp) (insert "\n")))

-          (after  (insert "\n"))       ; FIXME: check eolp before inserting \n?
-          (around (save-excursion
+          (`after  (insert "\n"))      ; FIXME: check eolp before inserting \n?
+          (`around (save-excursion

                     (goto-char (1- pos)) (skip-chars-backward " \t")
                     (unless (bolp) (insert "\n")))
                   (insert "\n")))      ; FIXME: check eolp before inserting \n?
                     (goto-char (1- pos)) (skip-chars-backward " \t")
                     (unless (bolp) (insert "\n")))
                   (insert "\n")))      ; FIXME: check eolp before inserting \n?


@@ -388,7 +451,11 @@ one of those symbols.")
 
 ;;;###autoload
 (define-minor-mode electric-layout-mode
 
 ;;;###autoload
 (define-minor-mode electric-layout-mode

-  "Automatically insert newlines around some chars."
+  "Automatically insert newlines around some chars.
+With a prefix argument ARG, enable Electric Layout mode if ARG is
+positive, and disable it otherwise.  If called from Lisp, enable
+the mode if ARG is omitted or nil.
+The variable `electric-layout-rules' says when and how to insert newlines."

   :global t
   :group 'electricity
   (if electric-layout-mode
   :global t
   :group 'electricity
   (if electric-layout-mode