* lisp/subr.el (pop): Use `car-safe'.
[bpt/emacs.git] / lisp / subr.el
index fe9de83..0a28d47 100644 (file)
@@ -170,12 +170,16 @@ PLACE must be a generalized variable whose value is a list.
 If the value is nil, `pop' returns nil but does not actually
 change the list."
   (declare (debug (gv-place)))
-  (list 'car
-        (if (symbolp place)
-            ;; So we can use `pop' in the bootstrap before `gv' can be used.
-            (list 'prog1 place (list 'setq place (list 'cdr place)))
-          (gv-letplace (getter setter) place
-            `(prog1 ,getter ,(funcall setter `(cdr ,getter)))))))
+  ;; We use `car-safe' here instead of `car' because the behavior is the same
+  ;; (if it's not a cons cell, the `cdr' would have signaled an error already),
+  ;; but `car-safe' is total, so the byte-compiler can safely remove it if the
+  ;; result is not used.
+  `(car-safe
+    ,(if (symbolp place)
+         ;; So we can use `pop' in the bootstrap before `gv' can be used.
+         (list 'prog1 place (list 'setq place (list 'cdr place)))
+       (gv-letplace (getter setter) place
+         `(prog1 ,getter ,(funcall setter `(cdr ,getter)))))))
 
 (defmacro when (cond &rest body)
   "If COND yields non-nil, do BODY, else return nil.
@@ -312,6 +316,26 @@ result of an actual problem."
   (while t
     (signal 'user-error (list (apply #'format format args)))))
 
+(defun define-error (name message &optional parent)
+  "Define NAME as a new error signal.
+MESSAGE is a string that will be output to the echo area if such an error
+is signaled without being caught by a `condition-case'.
+PARENT is either a signal or a list of signals from which it inherits.
+Defaults to `error'."
+  (unless parent (setq parent 'error))
+  (let ((conditions
+         (if (consp parent)
+             (apply #'nconc
+                    (mapcar (lambda (parent)
+                              (cons parent
+                                    (or (get parent 'error-conditions)
+                                        (error "Unknown signal `%s'" parent))))
+                            parent))
+           (cons parent (get parent 'error-conditions)))))
+    (put name 'error-conditions
+         (delete-dups (copy-sequence (cons name conditions))))
+    (when message (put name 'error-message message))))
+
 ;; We put this here instead of in frame.el so that it's defined even on
 ;; systems where frame.el isn't loaded.
 (defun frame-configuration-p (object)
@@ -1206,6 +1230,11 @@ is converted into a string by expressing it in decimal."
   (declare (obsolete make-hash-table "22.1"))
   (make-hash-table :test (or test 'eql)))
 
+(defun log10 (x)
+  "Return (log X 10), the log base 10 of X."
+  (declare (obsolete log "24.4"))
+  (log x 10))
+
 ;; These are used by VM and some old programs
 (defalias 'focus-frame 'ignore "")
 (make-obsolete 'focus-frame "it does nothing." "22.1")
@@ -1493,9 +1522,10 @@ other hooks, such as major mode hooks, can do the job."
       ;; FIXME: Something like this could be used for `set' as well.
       (if (or (not (eq 'quote (car-safe list-var)))
               (special-variable-p (cadr list-var))
-              (and append compare-fn))
+              (not (macroexp-const-p append)))
           exp
         (let* ((sym (cadr list-var))
+               (append (eval append))
                (msg (format "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'"
                             sym))
                ;; Big ugly hack so we only output a warning during
@@ -1508,13 +1538,17 @@ other hooks, such as major mode hooks, can do the job."
                           (when (assq sym byte-compile--lexical-environment)
                             (byte-compile-log-warning msg t :error))))
                (code
-                (if append
-                    (macroexp-let2 macroexp-copyable-p x element
-                    `(unless (member ,x ,sym)
-                       (setq ,sym (append ,sym (list ,x)))))
-                  (require 'cl-lib)
-                  `(cl-pushnew ,element ,sym
-                               :test ,(or compare-fn '#'equal)))))
+                (macroexp-let2 macroexp-copyable-p x element
+                  `(unless ,(if compare-fn
+                                (progn
+                                  (require 'cl-lib)
+                                  `(cl-member ,x ,sym :test ,compare-fn))
+                              ;; For bootstrapping reasons, don't rely on
+                              ;; cl--compiler-macro-member for the base case.
+                              `(member ,x ,sym))
+                     ,(if append
+                          `(setq ,sym (append ,sym (list ,x)))
+                        `(push ,x ,sym))))))
           (if (not (macroexp--compiling-p))
               code
             `(progn
@@ -1975,7 +2009,7 @@ any other terminator is used itself as input.
 The optional argument PROMPT specifies a string to use to prompt the user.
 The variable `read-quoted-char-radix' controls which radix to use
 for numeric input."
-  (let ((message-log-max nil) done (first t) (code 0) char translated)
+  (let ((message-log-max nil) done (first t) (code 0) translated)
     (while (not done)
       (let ((inhibit-quit first)
            ;; Don't let C-h get the help message--only help function keys.
@@ -1985,20 +2019,14 @@ for numeric input."
 or the octal character code.
 RET terminates the character code and is discarded;
 any other non-digit terminates the character code and is then used as input."))
-       (setq char (read-event (and prompt (format "%s-" prompt)) t))
+       (setq translated (read-key (and prompt (format "%s-" prompt))))
        (if inhibit-quit (setq quit-flag nil)))
-      ;; Translate TAB key into control-I ASCII character, and so on.
-      ;; Note: `read-char' does it using the `ascii-character' property.
-      ;; We should try and use read-key instead.
-      (let ((translation (lookup-key local-function-key-map (vector char))))
-       (setq translated (if (arrayp translation)
-                            (aref translation 0)
-                          char)))
       (if (integerp translated)
          (setq translated (char-resolve-modifiers translated)))
       (cond ((null translated))
            ((not (integerp translated))
-            (setq unread-command-events (list char)
+            (setq unread-command-events
+                   (listify-key-sequence (this-single-command-raw-keys))
                   done t))
            ((/= (logand translated ?\M-\^@) 0)
             ;; Turn a meta-character into a character with the 0200 bit set.
@@ -2017,7 +2045,8 @@ any other non-digit terminates the character code and is then used as input."))
            ((and (not first) (eq translated ?\C-m))
             (setq done t))
            ((not first)
-            (setq unread-command-events (list char)
+            (setq unread-command-events
+                   (listify-key-sequence (this-single-command-raw-keys))
                   done t))
            (t (setq code translated
                     done t)))
@@ -2181,6 +2210,7 @@ An obsolete, but still supported form is
 where the optional arg MILLISECONDS specifies an additional wait period,
 in milliseconds; this was useful when Emacs was built without
 floating point support."
+  (declare (advertised-calling-convention (seconds &optional nodisp) "22.1"))
   (if (numberp nodisp)
       (setq seconds (+ seconds (* 1e-3 nodisp))
             nodisp obsolete)
@@ -2195,7 +2225,10 @@ floating point support."
     (or nodisp (redisplay)))
    (t
     (or nodisp (redisplay))
-    (let ((read (read-event nil nil seconds)))
+    ;; FIXME: we should not read-event here at all, because it's much too
+    ;; difficult to reliably "undo" a read-event by pushing it onto
+    ;; unread-command-events.
+    (let ((read (read-event nil t seconds)))
       (or (null read)
          (progn
            ;; If last command was a prefix arg, e.g. C-u, push this event onto
@@ -2205,7 +2238,6 @@ floating point support."
                (setq read (cons t read)))
            (push read unread-command-events)
            nil))))))
-(set-advertised-calling-convention 'sit-for '(seconds &optional nodisp) "22.1")
 
 (defun y-or-n-p (prompt)
   "Ask user a \"y or n\" question.  Return t if answer is \"y\".
@@ -2235,7 +2267,8 @@ is nil and `use-dialog-box' is non-nil."
     (cond
      (noninteractive
       (setq prompt (concat prompt
-                           (if (eq ?\s (aref prompt (1- (length prompt))))
+                           (if (or (zerop (length prompt))
+                                   (eq ?\s (aref prompt (1- (length prompt)))))
                                "" " ")
                            "(y or n) "))
       (let ((temp-prompt prompt))
@@ -2252,7 +2285,8 @@ is nil and `use-dialog-box' is non-nil."
            (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
      (t
       (setq prompt (concat prompt
-                           (if (eq ?\s (aref prompt (1- (length prompt))))
+                           (if (or (zerop (length prompt))
+                                   (eq ?\s (aref prompt (1- (length prompt)))))
                                "" " ")
                            "(y or n) "))
       (while
@@ -2444,11 +2478,12 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
                 (recenter (/ (window-height) 2))))
           (message (or message "Type %s to continue editing.")
                    (single-key-description exit-char))
-         (let ((event (read-event)))
+         (let ((event (read-key)))
            ;; `exit-char' can be an event, or an event description list.
            (or (eq event exit-char)
                (eq event (event-convert-list exit-char))
-               (setq unread-command-events (list event)))))
+               (setq unread-command-events
+                      (append (this-single-command-raw-keys))))))
       (delete-overlay ol))))
 
 \f
@@ -2515,11 +2550,6 @@ 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.")
 
-;; The `assert' macro from the cl package signals
-;; `cl-assertion-failed' at runtime so always define it.
-(put 'cl-assertion-failed 'error-conditions '(error))
-(put 'cl-assertion-failed 'error-message (purecopy "Assertion failed"))
-
 (defconst user-emacs-directory
   (if (eq system-type 'ms-dos)
       ;; MS-DOS cannot have initial dot.
@@ -2739,6 +2769,13 @@ Otherwise, return nil."
       (setq object (indirect-function object t)))
   (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
 
+(defun macrop (object)
+  "Non-nil if and only if OBJECT is a macro."
+  (let ((def (indirect-function object t)))
+    (when (consp def)
+      (or (eq 'macro (car def))
+          (and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
+
 (defun field-at-pos (pos)
   "Return the field at position POS, taking stickiness etc into account."
   (let ((raw-field (get-char-property (field-beginning pos) 'field)))
@@ -3523,7 +3560,7 @@ likely to have undesired semantics.")
 ;; defaulted, OMIT-NULLS should be treated as t.  Simplifying the logical
 ;; expression leads to the equivalent implementation that if SEPARATORS
 ;; is defaulted, OMIT-NULLS is treated as t.
-(defun split-string (string &optional separators omit-nulls)
+(defun split-string (string &optional separators omit-nulls trim)
   "Split STRING into substrings bounded by matches for SEPARATORS.
 
 The beginning and end of STRING, and each match for SEPARATORS, are
@@ -3541,17 +3578,50 @@ that for the default value of SEPARATORS leading and trailing whitespace
 are effectively trimmed).  If nil, all zero-length substrings are retained,
 which correctly parses CSV format, for example.
 
+If TRIM is non-nil, it should be a regular expression to match
+text to trim from the beginning and end of each substring.  If trimming
+makes the substring empty, it is treated as null.
+
+If you want to trim whitespace from the substrings, the reliably correct
+way is using TRIM.  Making SEPARATORS match that whitespace gives incorrect
+results when there is whitespace at the start or end of STRING.  If you
+see such calls to `split-string', please fix them.
+
 Note that the effect of `(split-string STRING)' is the same as
 `(split-string STRING split-string-default-separators t)'.  In the rare
 case that you wish to retain zero-length substrings when splitting on
 whitespace, use `(split-string STRING split-string-default-separators)'.
 
 Modifies the match data; use `save-match-data' if necessary."
-  (let ((keep-nulls (not (if separators omit-nulls t)))
-       (rexp (or separators split-string-default-separators))
-       (start 0)
-       notfirst
-       (list nil))
+  (let* ((keep-nulls (not (if separators omit-nulls t)))
+        (rexp (or separators split-string-default-separators))
+        (start 0)
+        this-start this-end
+        notfirst
+        (list nil)
+        (push-one
+         ;; Push the substring in range THIS-START to THIS-END
+         ;; onto LIST, trimming it and perhaps discarding it.
+         (lambda ()
+           (when trim
+             ;; Discard the trim from start of this substring.
+             (let ((tem (string-match trim string this-start)))
+               (and (eq tem this-start)
+                    (setq this-start (match-end 0)))))
+
+           (when (or keep-nulls (< this-start this-end))
+             (let ((this (substring string this-start this-end)))
+
+               ;; Discard the trim from end of this substring.
+               (when trim
+                 (let ((tem (string-match (concat trim "\\'") this 0)))
+                   (and tem (< tem (length this))
+                        (setq this (substring this 0 tem)))))
+
+               ;; Trimming could make it empty; check again.
+               (when (or keep-nulls (> (length this) 0))
+                 (push this list)))))))
+
     (while (and (string-match rexp string
                              (if (and notfirst
                                       (= start (match-beginning 0))
@@ -3559,15 +3629,15 @@ Modifies the match data; use `save-match-data' if necessary."
                                  (1+ start) start))
                (< start (length string)))
       (setq notfirst t)
-      (if (or keep-nulls (< start (match-beginning 0)))
-         (setq list
-               (cons (substring string start (match-beginning 0))
-                     list)))
-      (setq start (match-end 0)))
-    (if (or keep-nulls (< start (length string)))
-       (setq list
-             (cons (substring string start)
-                   list)))
+      (setq this-start start this-end (match-beginning 0)
+           start (match-end 0))
+
+      (funcall push-one))
+
+    ;; Handle the substring at the end of STRING.
+    (setq this-start start this-end (length string))
+    (funcall push-one)
+
     (nreverse list)))
 
 (defun combine-and-quote-strings (strings &optional separator)
@@ -3729,6 +3799,8 @@ Return nil if there isn't one."
 (defun eval-after-load (file form)
   "Arrange that if FILE is loaded, FORM will be run immediately afterwards.
 If FILE is already loaded, evaluate FORM right now.
+FORM can be an Elisp expression (in which case it's passed to `eval'),
+or a function (in which case it's passed to `funcall' with no argument).
 
 If a matching file is loaded again, FORM will be evaluated again.
 
@@ -3756,43 +3828,61 @@ Usually FILE is just a library name like \"font-lock\" or a feature name
 like 'font-lock.
 
 This function makes or adds to an entry on `after-load-alist'."
+  (declare (compiler-macro
+            (lambda (whole)
+              (if (eq 'quote (car-safe form))
+                  ;; Quote with lambda so the compiler can look inside.
+                  `(eval-after-load ,file (lambda () ,(nth 1 form)))
+                whole))))
   ;; Add this FORM into after-load-alist (regardless of whether we'll be
   ;; evaluating it now).
   (let* ((regexp-or-feature
          (if (stringp file)
               (setq file (purecopy (load-history-regexp file)))
             file))
-        (elt (assoc regexp-or-feature after-load-alist)))
+        (elt (assoc regexp-or-feature after-load-alist))
+         (func
+          (if (functionp form) form
+            ;; Try to use the "current" lexical/dynamic mode for `form'.
+            (eval `(lambda () ,form) lexical-binding))))
     (unless elt
       (setq elt (list regexp-or-feature))
       (push elt after-load-alist))
-    ;; Make sure `form' is evalled in the current lexical/dynamic code.
-    (setq form `(funcall ',(eval `(lambda () ,form) lexical-binding)))
     ;; Is there an already loaded file whose name (or `provide' name)
     ;; matches FILE?
     (prog1 (if (if (stringp file)
                   (load-history-filename-element regexp-or-feature)
                 (featurep file))
-              (eval form))
-      (when (symbolp regexp-or-feature)
-       ;; For features, the after-load-alist elements get run when `provide' is
-       ;; called rather than at the end of the file.  So add an indirection to
-       ;; make sure that `form' is really run "after-load" in case the provide
-       ;; call happens early.
-       (setq form
-             `(if load-file-name
-                  (let ((fun (make-symbol "eval-after-load-helper")))
-                    (fset fun `(lambda (file)
-                                 (if (not (equal file ',load-file-name))
-                                     nil
-                                   (remove-hook 'after-load-functions ',fun)
-                                   ,',form)))
-                    (add-hook 'after-load-functions fun))
-                ;; Not being provided from a file, run form right now.
-                ,form)))
-      ;; Add FORM to the element unless it's already there.
-      (unless (member form (cdr elt))
-       (nconc elt (list form))))))
+              (funcall func))
+      (let ((delayed-func
+             (if (not (symbolp regexp-or-feature)) func
+               ;; For features, the after-load-alist elements get run when
+               ;; `provide' is called rather than at the end of the file.
+               ;; So add an indirection to make sure that `func' is really run
+               ;; "after-load" in case the provide call happens early.
+               (lambda ()
+                 (if (not load-file-name)
+                     ;; Not being provided from a file, run func right now.
+                     (funcall func)
+                   (let ((lfn load-file-name)
+                         ;; Don't use letrec, because equal (in
+                         ;; add/remove-hook) would get trapped in a cycle.
+                         (fun (make-symbol "eval-after-load-helper")))
+                     (fset fun (lambda (file)
+                                 (when (equal file lfn)
+                                   (remove-hook 'after-load-functions fun)
+                                   (funcall func))))
+                     (add-hook 'after-load-functions fun)))))))
+        ;; Add FORM to the element unless it's already there.
+        (unless (member delayed-func (cdr elt))
+          (nconc elt (list delayed-func)))))))
+
+(defmacro with-eval-after-load (file &rest body)
+  "Execute BODY after FILE is loaded.
+FILE is normally a feature name, but it can also be a file name,
+in case that file does not provide any feature."
+  (declare (indent 1) (debug t))
+  `(eval-after-load ,file (lambda () ,@body)))
 
 (defvar after-load-functions nil
   "Special hook run after loading a file.
@@ -3804,12 +3894,11 @@ name of the file just loaded.")
 ABS-FILE, a string, should be the absolute true name of a file just loaded.
 This function is called directly from the C code."
   ;; Run the relevant eval-after-load forms.
-  (mapc #'(lambda (a-l-element)
-           (when (and (stringp (car a-l-element))
-                      (string-match-p (car a-l-element) abs-file))
-             ;; discard the file name regexp
-             (mapc #'eval (cdr a-l-element))))
-       after-load-alist)
+  (dolist (a-l-element after-load-alist)
+    (when (and (stringp (car a-l-element))
+               (string-match-p (car a-l-element) abs-file))
+      ;; discard the file name regexp
+      (mapc #'funcall (cdr a-l-element))))
   ;; Complain when the user uses obsolete files.
   (when (string-match-p "/obsolete/[^/]*\\'" abs-file)
     (run-with-timer 0 nil
@@ -3828,6 +3917,7 @@ FILE should be the name of a library, with no directory name."
   (declare (obsolete eval-after-load "23.2"))
   (eval-after-load file (read)))
 
+\f
 (defun display-delayed-warnings ()
   "Display delayed warnings from `delayed-warnings-list'.
 Used from `delayed-warnings-hook' (which see)."
@@ -3861,6 +3951,12 @@ By default, this hook contains functions to consolidate the
 warnings listed in `delayed-warnings-list', display them, and set
 `delayed-warnings-list' back to nil.")
 
+(defun delay-warning (type message &optional level buffer-name)
+  "Display a delayed warning.
+Aside from going through `delayed-warnings-list', this is equivalent
+to `display-warning'."
+  (push (list type message level buffer-name) delayed-warnings-list))
+
 \f
 ;;;; invisibility specs
 
@@ -3980,10 +4076,14 @@ backwards ARG times if negative."
 \f
 ;;;; Text clones
 
-(defun text-clone-maintain (ol1 after beg end &optional _len)
+(defvar text-clone--maintaining nil)
+
+(defun text-clone--maintain (ol1 after beg end &optional _len)
   "Propagate the changes made under the overlay OL1 to the other clones.
 This is used on the `modification-hooks' property of text clones."
-  (when (and after (not undo-in-progress) (overlay-start ol1))
+  (when (and after (not undo-in-progress)
+             (not text-clone--maintaining)
+             (overlay-start ol1))
     (let ((margin (if (overlay-get ol1 'text-clone-spreadp) 1 0)))
       (setq beg (max beg (+ (overlay-start ol1) margin)))
       (setq end (min end (- (overlay-end ol1) margin)))
@@ -4014,7 +4114,7 @@ This is used on the `modification-hooks' property of text clones."
                (tail (- (overlay-end ol1) end))
                (str (buffer-substring beg end))
                (nothing-left t)
-               (inhibit-modification-hooks t))
+               (text-clone--maintaining t))
            (dolist (ol2 (overlay-get ol1 'text-clones))
              (let ((oe (overlay-end ol2)))
                (unless (or (eq ol1 ol2) (null oe))
@@ -4025,7 +4125,7 @@ This is used on the `modification-hooks' property of text clones."
                    (unless (> mod-beg (point))
                      (save-excursion (insert str))
                      (delete-region mod-beg (point)))
-                   ;;(overlay-put ol2 'modification-hooks '(text-clone-maintain))
+                   ;;(overlay-put ol2 'modification-hooks '(text-clone--maintain))
                    ))))
            (if nothing-left (delete-overlay ol1))))))))
 
@@ -4056,17 +4156,18 @@ clone should be incorporated in the clone."
                             (>= pt-end (point-max))
                             (>= start (point-max)))
                         0 1))
+         ;; FIXME: Reuse overlays at point to extend dups!
         (ol1 (make-overlay (- start start-margin) (+ end end-margin) nil t))
         (ol2 (make-overlay (- (point) start-margin) (+ pt-end end-margin) nil t))
         (dups (list ol1 ol2)))
-    (overlay-put ol1 'modification-hooks '(text-clone-maintain))
+    (overlay-put ol1 'modification-hooks '(text-clone--maintain))
     (when spreadp (overlay-put ol1 'text-clone-spreadp t))
     (when syntax (overlay-put ol1 'text-clone-syntax syntax))
     ;;(overlay-put ol1 'face 'underline)
     (overlay-put ol1 'evaporate t)
     (overlay-put ol1 'text-clones dups)
     ;;
-    (overlay-put ol2 'modification-hooks '(text-clone-maintain))
+    (overlay-put ol2 'modification-hooks '(text-clone--maintain))
     (when spreadp (overlay-put ol2 'text-clone-spreadp t))
     (when syntax (overlay-put ol2 'text-clone-syntax syntax))
     ;;(overlay-put ol2 'face 'underline)
@@ -4121,22 +4222,6 @@ I is the index of the frame after FRAME2.  It should return nil
 if those frames don't seem special and otherwise, it should return
 the number of frames to skip (minus 1).")
 
-(defmacro internal--called-interactively-p--get-frame (n)
-  ;; `sym' will hold a global variable, which will be used kind of like C's
-  ;; "static" variables.
-  (let ((sym (make-symbol "base-index")))
-    `(progn
-       (defvar ,sym)
-       (unless (boundp ',sym)
-         (let ((i 1))
-           (while (not (eq (indirect-function (nth 1 (backtrace-frame i)) t)
-                           (indirect-function 'called-interactively-p)))
-             (setq i (1+ i)))
-           (setq ,sym i)))
-       ;; (unless (eq (nth 1 (backtrace-frame ,sym)) 'called-interactively-p)
-       ;;   (error "called-interactively-p: %s is out-of-sync!" ,sym))
-       (backtrace-frame (+ ,sym ,n)))))
-
 (defun called-interactively-p (&optional kind)
   "Return t if the containing function was called by `call-interactively'.
 If KIND is `interactive', then only return t if the call was made
@@ -4171,7 +4256,7 @@ command is called from a keyboard macro?"
            (get-next-frame
             (lambda ()
               (setq frame nextframe)
-              (setq nextframe (internal--called-interactively-p--get-frame i))
+              (setq nextframe (backtrace-frame i 'called-interactively-p))
               ;; (message "Frame %d = %S" i nextframe)
               (setq i (1+ i)))))
       (funcall get-next-frame) ;; Get the first frame.
@@ -4234,33 +4319,25 @@ use `called-interactively-p'."
   (declare (obsolete called-interactively-p "23.2"))
   (called-interactively-p 'interactive))
 
-(defun function-arity (f &optional num)
-  "Return the (MIN . MAX) arity of F.
-If the maximum arity is infinite, MAX is `many'.
-F can be a function or a macro.
-If NUM is non-nil, return non-nil iff F can be called with NUM args."
-  (if (symbolp f) (setq f (indirect-function f)))
-  (if (eq (car-safe f) 'macro) (setq f (cdr f)))
-  (let ((res
-        (if (subrp f)
-            (let ((x (subr-arity f)))
-              (if (eq (cdr x) 'unevalled) (cons (car x) 'many)))
-          (let* ((args (if (consp f) (cadr f) (aref f 0)))
-                 (max (length args))
-                 (opt (memq '&optional args))
-                 (rest (memq '&rest args))
-                 (min (- max (length opt))))
-            (if opt
-                (cons min (if rest 'many (1- max)))
-              (if rest
-                  (cons (- max (length rest)) 'many)
-                (cons min max)))))))
-    (if (not num)
-       res
-      (and (>= num (car res))
-          (or (eq 'many (cdr res)) (<= num (cdr res)))))))
-
-(defun set-temporary-overlay-map (map &optional keep-pred)
+(defun internal-push-keymap (keymap symbol)
+  (let ((map (symbol-value symbol)))
+    (unless (memq keymap map)
+      (unless (memq 'add-keymap-witness (symbol-value symbol))
+        (setq map (make-composed-keymap nil (symbol-value symbol)))
+        (push 'add-keymap-witness (cdr map))
+        (set symbol map))
+      (push keymap (cdr map)))))
+
+(defun internal-pop-keymap (keymap symbol)
+  (let ((map (symbol-value symbol)))
+    (when (memq keymap map)
+      (setf (cdr map) (delq keymap (cdr map))))
+    (let ((tail (cddr map)))
+      (and (or (null tail) (keymapp tail))
+           (eq 'add-keymap-witness (nth 1 map))
+           (set symbol tail)))))
+
+(defun set-temporary-overlay-map (map &optional keep-pred on-exit)
   "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
@@ -4270,29 +4347,32 @@ 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)))
-         (clearfun
-          ;; FIXME: Use lexical-binding.
-          `(lambda ()
-             (unless ,(cond ((null keep-pred) nil)
-                            ((eq t keep-pred)
-                             `(eq this-command
-                                  (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))))))
-    (set overlaysym overlaysym)
-    (fset clearfunsym clearfun)
-    (add-hook 'pre-command-hook clearfunsym)
-    ;; FIXME: That's the keymaps with highest precedence, except for
-    ;; the `keymap' text-property ;-(
-    (push alist emulation-mode-map-alists)))
+non-nil then MAP stays active.
+
+Optional ON-EXIT argument is a function that is called after the
+deactivation of MAP."
+  (let ((clearfun (make-symbol "clear-temporary-overlay-map")))
+    ;; Don't use letrec, because equal (in add/remove-hook) would get trapped
+    ;; in a cycle.
+    (fset clearfun
+          (lambda ()
+            ;; FIXME: Handle the case of multiple temporary-overlay-maps
+            ;; E.g. if isearch and C-u both use temporary-overlay-maps, Then
+            ;; the lifetime of the C-u should be nested within the isearch
+            ;; overlay, so the pre-command-hook of isearch should be
+            ;; suspended during the C-u one so we don't exit isearch just
+            ;; because we hit 1 after C-u and that 1 exits isearch whereas it
+            ;; doesn't exit C-u.
+            (unless (cond ((null keep-pred) nil)
+                          ((eq t keep-pred)
+                           (eq this-command
+                               (lookup-key map (this-command-keys-vector))))
+                          (t (funcall keep-pred)))
+              (remove-hook 'pre-command-hook clearfun)
+              (internal-pop-keymap map 'overriding-terminal-local-map)
+              (when on-exit (funcall on-exit)))))
+    (add-hook 'pre-command-hook clearfun)
+    (internal-push-keymap map 'overriding-terminal-local-map)))
 
 ;;;; Progress reporters.
 
@@ -4475,20 +4555,6 @@ convenience wrapper around `make-progress-reporter' and friends.
        nil ,@(cdr (cdr spec)))))
 
 \f
-;;;; Support for watching filesystem events.
-
-(defun file-notify-handle-event (event)
-  "Handle file system monitoring event.
-If EVENT is a filewatch event, call its callback.
-Otherwise, signal a `filewatch-error'."
-  (interactive "e")
-  (if (and (eq (car event) 'file-notify)
-          (>= (length event) 3))
-      (funcall (nth 2 event) (nth 1 event))
-    (signal 'filewatch-error
-           (cons "Not a valid file-notify event" event))))
-
-\f
 ;;;; Comparing version strings.
 
 (defconst version-separator "."