term-handle-colors-array fix

[gnu-emacs] / lisp / subr.el

diff --git a/lisp/subr.el b/lisp/subr.el
index 74afd59f8d5d5d589da2179614c5a276ddac02de..eef8c46c7d61bf8914296eac1c942e247c077ff0 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1,7 +1,7 @@
 ;;; subr.el --- basic lisp subroutines for Emacs  -*- coding: utf-8 -*-
 
 ;;; subr.el --- basic lisp subroutines for Emacs  -*- coding: utf-8 -*-
 

-;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2013 Free Software
+;; Foundation, Inc.

 
 ;; Maintainer: FSF
 ;; Keywords: internal
 
 ;; Maintainer: FSF
 ;; Keywords: internal


@@ -80,6 +80,7 @@ For more information, see Info node `(elisp)Declaring Functions'."
 (defmacro noreturn (form)
   "Evaluate FORM, expecting it not to return.
 If FORM does return, signal an error."
 (defmacro noreturn (form)
   "Evaluate FORM, expecting it not to return.
 If FORM does return, signal an error."

+  (declare (debug t))

   `(prog1 ,form
      (error "Form marked with `noreturn' did return")))
 
   `(prog1 ,form
      (error "Form marked with `noreturn' did return")))
 


@@ -87,6 +88,7 @@ If FORM does return, signal an error."
   "Evaluate FORM, expecting a constant return value.
 This is the global do-nothing version.  There is also `testcover-1value'
 that complains if FORM ever does return differing values."
   "Evaluate FORM, expecting a constant return value.
 This is the global do-nothing version.  There is also `testcover-1value'
 that complains if FORM ever does return differing values."

+  (declare (debug t))

   form)
 
 (defmacro def-edebug-spec (symbol spec)
   form)
 
 (defmacro def-edebug-spec (symbol spec)


@@ -269,16 +271,23 @@ the return value (nil if RESULT is omitted).
          ,@(cdr (cdr spec))))))
 
 (defmacro declare (&rest _specs)
          ,@(cdr (cdr spec))))))
 
 (defmacro declare (&rest _specs)

-  "Do not evaluate any arguments and return nil.
-Treated as a declaration when used at the right place in a
-`defmacro' form.  \(See Info anchor `(elisp)Definition of declare'.)"
+  "Do not evaluate any arguments, and return nil.
+If a `declare' form appears as the first form in the body of a
+`defun' or `defmacro' form, SPECS specifies various additional
+information about the function or macro; these go into effect
+during the evaluation of the `defun' or `defmacro' form.
+
+The possible values of SPECS are specified by
+`defun-declarations-alist' and `macro-declarations-alist'."

   ;; FIXME: edebug spec should pay attention to defun-declarations-alist.
   nil)
 ))
 
 (defmacro ignore-errors (&rest body)
   "Execute BODY; if an error occurs, return nil.
   ;; FIXME: edebug spec should pay attention to defun-declarations-alist.
   nil)
 ))
 
 (defmacro ignore-errors (&rest body)
   "Execute BODY; if an error occurs, return nil.

-Otherwise, return result of last form in BODY."
+Otherwise, return result of last form in BODY.
+See also `with-demoted-errors' that does something similar
+without silencing all errors."

   (declare (debug t) (indent 0))
   `(condition-case nil (progn ,@body) (error nil)))
 \f
   (declare (debug t) (indent 0))
   `(condition-case nil (progn ,@body) (error nil)))
 \f


@@ -457,18 +466,18 @@ If TEST is omitted or nil, `equal' is used."
       (setq tail (cdr tail)))
     value))
 
       (setq tail (cdr tail)))
     value))
 

-(make-obsolete 'assoc-ignore-case 'assoc-string "22.1")

 (defun assoc-ignore-case (key alist)
   "Like `assoc', but ignores differences in case and text representation.
 KEY must be a string.  Upper-case and lower-case letters are treated as equal.
 Unibyte strings are converted to multibyte for comparison."
 (defun assoc-ignore-case (key alist)
   "Like `assoc', but ignores differences in case and text representation.
 KEY must be a string.  Upper-case and lower-case letters are treated as equal.
 Unibyte strings are converted to multibyte for comparison."

+  (declare (obsolete assoc-string "22.1"))

   (assoc-string key alist t))
 
   (assoc-string key alist t))
 

-(make-obsolete 'assoc-ignore-representation 'assoc-string "22.1")

 (defun assoc-ignore-representation (key alist)
   "Like `assoc', but ignores differences in text representation.
 KEY must be a string.
 Unibyte strings are converted to multibyte for comparison."
 (defun assoc-ignore-representation (key alist)
   "Like `assoc', but ignores differences in text representation.
 KEY must be a string.
 Unibyte strings are converted to multibyte for comparison."

+  (declare (obsolete assoc-string "22.1"))

   (assoc-string key alist nil))
 
 (defun member-ignore-case (elt list)
   (assoc-string key alist nil))
 
 (defun member-ignore-case (elt list)


@@ -1175,12 +1184,13 @@ be a list of the form returned by `event-start' and `event-end'."
   "Mocklisp-compatibility insert function.
 Like the function `insert' except that any argument that is a number
 is converted into a string by expressing it in decimal."
   "Mocklisp-compatibility insert function.
 Like the function `insert' except that any argument that is a number
 is converted into a string by expressing it in decimal."

+  (declare (obsolete insert "22.1"))

   (dolist (el args)
     (insert (if (integerp el) (number-to-string el) el))))
   (dolist (el args)
     (insert (if (integerp el) (number-to-string el) el))))

-(make-obsolete 'insert-string 'insert "22.1")

 
 

-(defun makehash (&optional test) (make-hash-table :test (or test 'eql)))
-(make-obsolete 'makehash 'make-hash-table "22.1")
+(defun makehash (&optional test)
+  (declare (obsolete make-hash-table "22.1"))
+  (make-hash-table :test (or test 'eql)))

 
 ;; These are used by VM and some old programs
 (defalias 'focus-frame 'ignore "")
 
 ;; These are used by VM and some old programs
 (defalias 'focus-frame 'ignore "")


@@ -1246,26 +1256,14 @@ is converted into a string by expressing it in decimal."
 (make-obsolete 'process-filter-multibyte-p nil "23.1")
 (make-obsolete 'set-process-filter-multibyte nil "23.1")
 
 (make-obsolete 'process-filter-multibyte-p nil "23.1")
 (make-obsolete 'set-process-filter-multibyte nil "23.1")
 

-(make-obsolete-variable
- 'mode-line-inverse-video
- "use the appropriate faces instead."
- "21.1")
-(make-obsolete-variable
- 'unread-command-char
- "use `unread-command-events' instead.  That variable is a list of events
-to reread, so it now uses nil to mean `no event', instead of -1."
- "before 19.15")
-

 ;; Lisp manual only updated in 22.1.
 (define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
   "before 19.34")
 
 ;; Lisp manual only updated in 22.1.
 (define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
   "before 19.34")
 

-(defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
-(make-obsolete-variable 'x-lost-selection-hooks
-                       'x-lost-selection-functions "22.1")
-(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
-(make-obsolete-variable 'x-sent-selection-hooks
-                       'x-sent-selection-functions "22.1")
+(define-obsolete-variable-alias 'x-lost-selection-hooks
+  'x-lost-selection-functions "22.1")
+(define-obsolete-variable-alias 'x-sent-selection-hooks
+  'x-sent-selection-functions "22.1")

 
 ;; This was introduced in 21.4 for pre-unicode unification.  That
 ;; usage was rendered obsolete in 23.1 which uses Unicode internally.
 
 ;; This was introduced in 21.4 for pre-unicode unification.  That
 ;; usage was rendered obsolete in 23.1 which uses Unicode internally.


@@ -1548,7 +1546,7 @@ if it is empty or a duplicate."
               (or keep-all
                   (not (equal (car history) newelt))))
       (if history-delete-duplicates
               (or keep-all
                   (not (equal (car history) newelt))))
       (if history-delete-duplicates

-         (delete newelt history))
+         (setq history (delete newelt history)))

       (setq history (cons newelt history))
       (when (integerp maxelt)
        (if (= 0 maxelt)
       (setq history (cons newelt history))
       (when (integerp maxelt)
        (if (= 0 maxelt)


@@ -1879,7 +1877,7 @@ This function makes or adds to an entry on `after-load-alist'."
                 ,form)))
       ;; Add FORM to the element unless it's already there.
       (unless (member form (cdr elt))
                 ,form)))
       ;; Add FORM to the element unless it's already there.
       (unless (member form (cdr elt))

-       (nconc elt (purecopy (list form)))))))
+       (nconc elt (list form))))))

 
 (defvar after-load-functions nil
   "Special hook run after loading a file.
 
 (defvar after-load-functions nil
   "Special hook run after loading a file.


@@ -1912,8 +1910,8 @@ This function is called directly from the C code."
   "Read the following input sexp, and run it whenever FILE is loaded.
 This makes or adds to an entry on `after-load-alist'.
 FILE should be the name of a library, with no directory name."
   "Read the following input sexp, and run it whenever FILE is loaded.
 This makes or adds to an entry on `after-load-alist'.
 FILE should be the name of a library, with no directory name."

+  (declare (obsolete eval-after-load "23.2"))

   (eval-after-load file (read)))
   (eval-after-load file (read)))

-(make-obsolete 'eval-next-after-load `eval-after-load "23.2")

 
 (defun display-delayed-warnings ()
   "Display delayed warnings from `delayed-warnings-list'.
 
 (defun display-delayed-warnings ()
   "Display delayed warnings from `delayed-warnings-list'.


@@ -2143,6 +2141,15 @@ any other non-digit terminates the character code and is then used as input."))
       (setq first nil))
     code))
 
       (setq first nil))
     code))
 

+(defvar read-passwd-map
+  ;; BEWARE: `defconst' would purecopy it, breaking the sharing with
+  ;; minibuffer-local-map along the way!
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map minibuffer-local-map)
+    (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570
+    map)
+  "Keymap used while reading passwords.")
+

 (defun read-passwd (prompt &optional confirm default)
   "Read a password, prompting with PROMPT, and return it.
 If optional CONFIRM is non-nil, read the password twice to make sure.
 (defun read-passwd (prompt &optional confirm default)
   "Read a password, prompting with PROMPT, and return it.
 If optional CONFIRM is non-nil, read the password twice to make sure.


@@ -2179,7 +2186,10 @@ by doing (clear-string STRING)."
           (lambda ()
             (setq minibuf (current-buffer))
             ;; Turn off electricity.
           (lambda ()
             (setq minibuf (current-buffer))
             ;; Turn off electricity.

-            (set (make-local-variable 'post-self-insert-hook) nil)
+            (setq-local post-self-insert-hook nil)
+            (setq-local buffer-undo-list t)
+            (setq-local select-active-regions nil)
+            (use-local-map read-passwd-map)

             (add-hook 'after-change-functions hide-chars-fun nil 'local))
         (unwind-protect
             (let ((enable-recursive-minibuffers t))
             (add-hook 'after-change-functions hide-chars-fun nil 'local))
         (unwind-protect
             (let ((enable-recursive-minibuffers t))


@@ -2237,7 +2247,8 @@ keyboard-quit events while waiting for a valid input."
     (error "Called `read-char-choice' without valid char choices"))
   (let (char done show-help (helpbuf " *Char Help*"))
     (let ((cursor-in-echo-area t)
     (error "Called `read-char-choice' without valid char choices"))
   (let (char done show-help (helpbuf " *Char Help*"))
     (let ((cursor-in-echo-area t)

-          (executing-kbd-macro executing-kbd-macro))
+          (executing-kbd-macro executing-kbd-macro)
+         (esc-flag nil))

       (save-window-excursion         ; in case we call help-form-show
        (while (not done)
          (unless (get-text-property 0 'face prompt)
       (save-window-excursion         ; in case we call help-form-show
        (while (not done)
          (unless (get-text-property 0 'face prompt)


@@ -2261,8 +2272,12 @@ keyboard-quit events while waiting for a valid input."
            ;; there are no more events in the macro.  Attempt to
            ;; get an event interactively.
            (setq executing-kbd-macro nil))
            ;; there are no more events in the macro.  Attempt to
            ;; get an event interactively.
            (setq executing-kbd-macro nil))

-          ((and (not inhibit-keyboard-quit) (eq char ?\C-g))
-           (keyboard-quit))))))
+          ((not inhibit-keyboard-quit)
+           (cond
+            ((and (null esc-flag) (eq char ?\e))
+             (setq esc-flag t))
+            ((memq char '(?\C-g ?\e))
+             (keyboard-quit))))))))

     ;; Display the question with the answer.  But without cursor-in-echo-area.
     (message "%s%s" prompt (char-to-string char))
     char))
     ;; Display the question with the answer.  But without cursor-in-echo-area.
     (message "%s%s" prompt (char-to-string char))
     char))


@@ -2314,11 +2329,19 @@ floating point support."
 PROMPT is the string to display to ask the question.  It should
 end in a space; `y-or-n-p' adds \"(y or n) \" to it.
 
 PROMPT is the string to display to ask the question.  It should
 end in a space; `y-or-n-p' adds \"(y or n) \" to it.
 

-No confirmation of the answer is requested; a single character is enough.
-Also accepts Space to mean yes, or Delete to mean no.  \(Actually, it uses
-the bindings in `query-replace-map'; see the documentation of that variable
-for more information.  In this case, the useful bindings are `act', `skip',
-`recenter', and `quit'.\)
+No confirmation of the answer is requested; a single character is
+enough.  SPC also means yes, and DEL means no.
+
+To be precise, this function translates user input into responses
+by consulting the bindings in `query-replace-map'; see the
+documentation of that variable for more information.  In this
+case, the useful bindings are `act', `skip', `recenter',
+`scroll-up', `scroll-down', and `quit'.
+An `act' response means yes, and a `skip' response means no.
+A `quit' response means to invoke `keyboard-quit'.
+If the user enters `recenter', `scroll-up', or `scroll-down'
+responses, perform the requested window recentering or scrolling
+and ask again.

 
 Under a windowing system a dialog box will be used if `last-nonmenu-event'
 is nil and `use-dialog-box' is non-nil."
 
 Under a windowing system a dialog box will be used if `last-nonmenu-event'
 is nil and `use-dialog-box' is non-nil."


@@ -2350,21 +2373,33 @@ is nil and `use-dialog-box' is non-nil."
                                "" " ")
                            "(y or n) "))
       (while
                                "" " ")
                            "(y or n) "))
       (while

-          (let* ((key
+          (let* ((scroll-actions '(recenter scroll-up scroll-down
+                                  scroll-other-window scroll-other-window-down))
+                (key

                   (let ((cursor-in-echo-area t))
                     (when minibuffer-auto-raise
                       (raise-frame (window-frame (minibuffer-window))))
                   (let ((cursor-in-echo-area t))
                     (when minibuffer-auto-raise
                       (raise-frame (window-frame (minibuffer-window))))

-                    (read-key (propertize (if (eq answer 'recenter)
+                    (read-key (propertize (if (memq answer scroll-actions)

                                               prompt
                                             (concat "Please answer y or n.  "
                                                     prompt))
                                           'face 'minibuffer-prompt)))))
             (setq answer (lookup-key query-replace-map (vector key) t))
             (cond
                                               prompt
                                             (concat "Please answer y or n.  "
                                                     prompt))
                                           'face 'minibuffer-prompt)))))
             (setq answer (lookup-key query-replace-map (vector key) t))
             (cond

-             ((memq answer '(skip act)) nil)
-             ((eq answer 'recenter) (recenter) t)
-             ((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
-             (t t)))
+            ((memq answer '(skip act)) nil)
+            ((eq answer 'recenter)
+             (recenter) t)
+            ((eq answer 'scroll-up)
+             (ignore-errors (scroll-up-command)) t)
+            ((eq answer 'scroll-down)
+             (ignore-errors (scroll-down-command)) t)
+            ((eq answer 'scroll-other-window)
+             (ignore-errors (scroll-other-window)) t)
+            ((eq answer 'scroll-other-window-down)
+             (ignore-errors (scroll-other-window-down)) t)
+            ((or (memq answer '(exit-prefix quit)) (eq key ?\e))
+             (signal 'quit nil) t)
+            (t t)))

         (ding)
         (discard-input))))
     (let ((ret (eq answer 'act)))
         (ding)
         (discard-input))))
     (let ((ret (eq answer 'act)))


@@ -2597,13 +2632,14 @@ When the hook runs, the temporary buffer is current.
 This hook is normally set up with a function to put the buffer in Help
 mode.")
 
 This hook is normally set up with a function to put the buffer in Help
 mode.")
 

-;; Avoid compiler warnings about this variable,
-;; which has a special meaning on certain system types.
-(defvar buffer-file-type nil
+(defvar-local buffer-file-type nil

   "Non-nil if the visited file is a binary file.
   "Non-nil if the visited file is a binary file.

-This variable is meaningful on MS-DOG and Windows NT.
+This variable is meaningful on MS-DOG and MS-Windows.

 On those systems, it is automatically local in every buffer.
 On those systems, it is automatically local in every buffer.

-On other systems, this variable is normally always nil.")
+On other systems, this variable is normally always nil.
+
+WARNING: This variable is obsolete and will disapper Real Soon Now.
+Don't use it!")

 
 ;; The `assert' macro from the cl package signals
 ;; `cl-assertion-failed' at runtime so always define it.
 
 ;; The `assert' macro from the cl package signals
 ;; `cl-assertion-failed' at runtime so always define it.


@@ -2647,6 +2683,10 @@ directory if it does not exist."
 \f
 ;;;; Misc. useful functions.
 
 \f
 ;;;; Misc. useful functions.
 

+(defsubst buffer-narrowed-p ()
+  "Return non-nil if the current buffer is narrowed."
+  (/= (- (point-max) (point-min)) (buffer-size)))
+

 (defun find-tag-default ()
   "Determine default tag to search for, based on text at point.
 If there is no plausible default, return nil."
 (defun find-tag-default ()
   "Determine default tag to search for, based on text at point.
 If there is no plausible default, return nil."


@@ -2910,8 +2950,8 @@ They default to the values of (point-min) and (point-max) in BUFFER."
 BUFFER may be a buffer or a buffer name.
 Arguments START and END are character positions specifying the substring.
 They default to the values of (point-min) and (point-max) in BUFFER.
 BUFFER may be a buffer or a buffer name.
 Arguments START and END are character positions specifying the substring.
 They default to the values of (point-min) and (point-max) in BUFFER.

-Strip text properties from the inserted text according to
-`yank-excluded-properties'."
+Before insertion, process text properties according to
+`yank-handled-properties' and `yank-excluded-properties'."

   ;; Since the buffer text should not normally have yank-handler properties,
   ;; there is no need to handle them here.
   (let ((opoint (point)))
   ;; Since the buffer text should not normally have yank-handler properties,
   ;; there is no need to handle them here.
   (let ((opoint (point)))


@@ -3110,6 +3150,46 @@ in which case `save-window-excursion' cannot help."
        (unwind-protect (progn ,@body)
          (set-window-configuration ,c)))))
 
        (unwind-protect (progn ,@body)
          (set-window-configuration ,c)))))
 

+(defun internal-temp-output-buffer-show (buffer)
+  "Internal function for `with-output-to-temp-buffer'."
+  (with-current-buffer buffer
+    (set-buffer-modified-p nil)
+    (goto-char (point-min)))
+
+  (if temp-buffer-show-function
+      (funcall temp-buffer-show-function buffer)
+    (with-current-buffer buffer
+      (let* ((window
+             (let ((window-combination-limit
+                  ;; When `window-combination-limit' equals
+                  ;; `temp-buffer' or `temp-buffer-resize' and
+                  ;; `temp-buffer-resize-mode' is enabled in this
+                  ;; buffer bind it to t so resizing steals space
+                  ;; preferably from the window that was split.
+                  (if (or (eq window-combination-limit 'temp-buffer)
+                          (and (eq window-combination-limit
+                                   'temp-buffer-resize)
+                               temp-buffer-resize-mode))
+                      t
+                    window-combination-limit)))
+               (display-buffer buffer)))
+            (frame (and window (window-frame window))))
+       (when window
+         (unless (eq frame (selected-frame))
+           (make-frame-visible frame))
+         (setq minibuffer-scroll-window window)
+         (set-window-hscroll window 0)
+         ;; Don't try this with NOFORCE non-nil!
+         (set-window-start window (point-min) t)
+         ;; This should not be necessary.
+         (set-window-point window (point-min))
+         ;; Run `temp-buffer-show-hook', with the chosen window selected.
+         (with-selected-window window
+           (run-hooks 'temp-buffer-show-hook))))))
+  ;; Return nil.
+  nil)
+
+;; Doc is very similar to with-temp-buffer-window.

 (defmacro with-output-to-temp-buffer (bufname &rest body)
   "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
 
 (defmacro with-output-to-temp-buffer (bufname &rest body)
   "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
 


@@ -3135,7 +3215,9 @@ with the buffer BUFNAME temporarily current.  It runs the hook
 `temp-buffer-show-hook' after displaying buffer BUFNAME, with that
 buffer temporarily current, and the window that was used to display it
 temporarily selected.  But it doesn't run `temp-buffer-show-hook'
 `temp-buffer-show-hook' after displaying buffer BUFNAME, with that
 buffer temporarily current, and the window that was used to display it
 temporarily selected.  But it doesn't run `temp-buffer-show-hook'

-if it uses `temp-buffer-show-function'."
+if it uses `temp-buffer-show-function'.
+
+See the related form `with-temp-buffer-window'."

   (declare (debug t))
   (let ((old-dir (make-symbol "old-dir"))
         (buf (make-symbol "buf")))
   (declare (debug t))
   (let ((old-dir (make-symbol "old-dir"))
         (buf (make-symbol "buf")))


@@ -3728,7 +3810,7 @@ from `standard-syntax-table' otherwise."
     table))
 
 (defun syntax-after (pos)
     table))
 
 (defun syntax-after (pos)

-  "Return the raw syntax of the char after POS.
+  "Return the raw syntax descriptor for the char after POS.

 If POS is outside the buffer's accessible portion, return nil."
   (unless (or (< pos (point-min)) (>= pos (point-max)))
     (let ((st (if parse-sexp-lookup-properties
 If POS is outside the buffer's accessible portion, return nil."
   (unless (or (< pos (point-min)) (>= pos (point-max)))
     (let ((st (if parse-sexp-lookup-properties


@@ -3737,7 +3819,12 @@ If POS is outside the buffer's accessible portion, return nil."
        (aref (or st (syntax-table)) (char-after pos))))))
 
 (defun syntax-class (syntax)
        (aref (or st (syntax-table)) (char-after pos))))))
 
 (defun syntax-class (syntax)

-  "Return the syntax class part of the syntax descriptor SYNTAX.
+  "Return the code for the syntax class described by SYNTAX.
+
+SYNTAX should be a raw syntax descriptor; the return value is a
+integer which encodes the corresponding syntax class.  See Info
+node `(elisp)Syntax Table Internals' for a list of codes.
+

 If SYNTAX is nil, return nil."
   (and syntax (logand (car syntax) 65535)))
 \f
 If SYNTAX is nil, return nil."
   (and syntax (logand (car syntax) 65535)))
 \f


@@ -3877,6 +3964,16 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
 \f
 (defun set-temporary-overlay-map (map &optional keep-pred)
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
 \f
 (defun set-temporary-overlay-map (map &optional keep-pred)

+  "Set MAP as a temporary keymap taking precedence over most other keymaps.
+Note that this does NOT take precedence over the \"overriding\" maps
+`overriding-terminal-local-map' and `overriding-local-map' (or the
+`keymap' text property).  Unlike those maps, if no match for a key is
+found in MAP, the normal key lookup sequence then continues.
+
+Normally, MAP is used only once.  If the optional argument
+KEEP-PRED is t, MAP stays active if a key from MAP is used.
+KEEP-PRED can also be a function of no arguments: if it returns
+non-nil then MAP stays active."

   (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
          (overlaysym (make-symbol "t"))
          (alist (list (cons overlaysym map)))
   (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
          (overlaysym (make-symbol "t"))
          (alist (list (cons overlaysym map)))


@@ -3889,6 +3986,7 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
                                   (lookup-key ',map
                                               (this-command-keys-vector))))
                             (t `(funcall ',keep-pred)))
                                   (lookup-key ',map
                                               (this-command-keys-vector))))
                             (t `(funcall ',keep-pred)))

+               (set ',overlaysym nil)   ;Just in case.

                (remove-hook 'pre-command-hook ',clearfunsym)
                (setq emulation-mode-map-alists
                      (delq ',alist emulation-mode-map-alists))))))
                (remove-hook 'pre-command-hook ',clearfunsym)
                (setq emulation-mode-map-alists
                      (delq ',alist emulation-mode-map-alists))))))