]> code.delx.au - gnu-emacs/blobdiff - lisp/subr.el
Merge from origin/emacs-24
[gnu-emacs] / lisp / subr.el
index 5d945047da6868ca4ffdeeb66fb9eec393a7cbf4..53ad2729a10073f6e0447e2ccd121627b9bd2435 100644 (file)
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2014 Free Software
 ;; Foundation, Inc.
 
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: internal
 ;; Package: emacs
 
@@ -169,7 +169,8 @@ change the list."
          ;; 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)))))))
+         (macroexp-let2 macroexp-copyable-p x getter
+           `(prog1 ,x ,(funcall setter `(cdr ,x))))))))
 
 (defmacro when (cond &rest body)
   "If COND yields non-nil, do BODY, else return nil.
@@ -265,7 +266,9 @@ 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'."
+`defun-declarations-alist' and `macro-declarations-alist'.
+
+For more information, see info node `(elisp)Declare Form'."
   ;; FIXME: edebug spec should pay attention to defun-declarations-alist.
   nil)
 
@@ -332,6 +335,7 @@ Any list whose car is `frame-configuration' is assumed to be a frame
 configuration."
   (and (consp object)
        (eq (car object) 'frame-configuration)))
+
 \f
 ;;;; List functions.
 
@@ -364,12 +368,15 @@ If N is bigger than the length of LIST, return LIST."
          (nthcdr (1- (safe-length list)) list))))
 
 (defun butlast (list &optional n)
-  "Return a copy of LIST with the last N elements removed."
+  "Return a copy of LIST with the last N elements removed.
+If N is omitted or nil, the last element is removed from the
+copy."
   (if (and n (<= n 0)) list
     (nbutlast (copy-sequence list) n)))
 
 (defun nbutlast (list &optional n)
-  "Modifies LIST to remove the last N elements."
+  "Modifies LIST to remove the last N elements.
+If N is omitted or nil, remove the last element."
   (let ((m (length list)))
     (or n (setq n 1))
     (and (< n m)
@@ -377,6 +384,13 @@ If N is bigger than the length of LIST, return LIST."
           (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
           list))))
 
+(defun zerop (number)
+  "Return t if NUMBER is zero."
+  ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because
+  ;; = has a byte-code.
+  (declare (compiler-macro (lambda (_) `(= 0 ,number))))
+  (= 0 number))
+
 (defun delete-dups (list)
   "Destructively remove `equal' duplicates from LIST.
 Store the result in LIST and return it.  LIST must be a proper list.
@@ -542,6 +556,15 @@ Elements of ALIST that are not conses are ignored."
        (setq tail tail-cdr))))
   alist)
 
+(defun alist-get (key alist &optional default remove)
+  "Get the value associated to KEY in ALIST.
+DEFAULT is the value to return if KEY is not found in ALIST.
+REMOVE, if non-nil, means that when setting this element, we should
+remove the entry if the new value is `eql' to DEFAULT."
+  (ignore remove) ;;Silence byte-compiler.
+  (let ((x (assq key alist)))
+    (if x (cdr x) default)))
+
 (defun remove (elt seq)
   "Return a copy of SEQ with all occurrences of ELT removed.
 SEQ must be a list, vector, or string.  The comparison is done with `equal'."
@@ -1016,38 +1039,37 @@ in the current Emacs session, then this function may return nil."
 
 (defun event-start (event)
   "Return the starting position of EVENT.
-EVENT should be a click, drag, or key press event.
-If it is a key press event, the return value has the form
-    (WINDOW POS (0 . 0) 0)
-If it is a click or drag event, it has the form
-   (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
-    IMAGE (DX . DY) (WIDTH . HEIGHT))
-The `posn-' functions access elements of such lists.
-For more information, see Info node `(elisp)Click Events'.
-
-If EVENT is a mouse or key press or a mouse click, this is the
-position of the event.  If EVENT is a drag, this is the starting
-position of the drag."
+EVENT should be a mouse click, drag, or key press event.  If
+EVENT is nil, the value of `posn-at-point' is used instead.
+
+The following accessor functions are used to access the elements
+of the position:
+
+`posn-window': The window the event is in.
+`posn-area': A symbol identifying the area the event occurred in,
+or nil if the event occurred in the text area.
+`posn-point': The buffer position of the event.
+`posn-x-y': The pixel-based coordinates of the event.
+`posn-col-row': The estimated column and row corresponding to the
+position of the event.
+`posn-actual-col-row': The actual column and row corresponding to the
+position of the event.
+`posn-string': The string object of the event, which is either
+nil or (STRING . POSITION)'.
+`posn-image': The image object of the event, if any.
+`posn-object': The image or string object of the event, if any.
+`posn-timestamp': The time the event occurred, in milliseconds.
+
+For more information, see Info node `(elisp)Click Events'."
   (if (consp event) (nth 1 event)
     (or (posn-at-point)
         (list (selected-window) (point) '(0 . 0) 0))))
 
 (defun event-end (event)
-  "Return the ending location of EVENT.
+  "Return the ending position of EVENT.
 EVENT should be a click, drag, or key press event.
-If EVENT is a key press event, the return value has the form
-    (WINDOW POS (0 . 0) 0)
-If EVENT is a click event, this function is the same as
-`event-start'.  For click and drag events, the return value has
-the form
-   (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
-    IMAGE (DX . DY) (WIDTH . HEIGHT))
-The `posn-' functions access elements of such lists.
-For more information, see Info node `(elisp)Click Events'.
-
-If EVENT is a mouse or key press or a mouse click, this is the
-position of the event.  If EVENT is a drag, this is the starting
-position of the drag."
+
+See `event-start' for a description of the value returned."
   (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
     (or (posn-at-point)
         (list (selected-window) (point) '(0 . 0) 0))))
@@ -1115,7 +1137,7 @@ pixels.  POSITION should be a list of the form returned by
   "Return the nominal column and row in POSITION, measured in characters.
 The column and row values are approximations calculated from the x
 and y coordinates in POSITION and the frame's default character width
-and height.
+and default line height, including spacing.
 For a scroll-bar event, the result column is 0, and the row
 corresponds to the vertical position of the click in the scroll bar.
 POSITION should be a list of the form returned by the `event-start'
@@ -1144,18 +1166,20 @@ and `event-end' functions."
              ((null spacing)
               (setq spacing 0)))
        (cons (/ (car pair) (frame-char-width frame))
-             (- (/ (cdr pair) (+ (frame-char-height frame) spacing))
-                (if (null (with-current-buffer (window-buffer window)
-                            header-line-format))
-                    0 1))))))))
+             (/ (cdr pair) (+ (frame-char-height frame) spacing))))))))
 
 (defun posn-actual-col-row (position)
-  "Return the actual column and row in POSITION, measured in characters.
-These are the actual row number in the window and character number in that row.
+  "Return the window row number in POSITION and character number in that row.
+
 Return nil if POSITION does not contain the actual position; in that case
-`posn-col-row' can be used to get approximate values.
+\`posn-col-row' can be used to get approximate values.
 POSITION should be a list of the form returned by the `event-start'
-and `event-end' functions."
+and `event-end' functions.
+
+This function does not account for the width on display, like the
+number of visual columns taken by a TAB or image.  If you need
+the coordinates of POSITION in character units, you should use
+\`posn-col-row', not this function."
   (nth 6 position))
 
 (defsubst posn-timestamp (position)
@@ -1459,7 +1483,7 @@ Each hook function definition is used to construct the FUN passed
 to the next hook function, if any.  The last (or \"outermost\")
 FUN is then called once."
   (declare (indent 2) (debug (form sexp body))
-           (obsolete "use a <foo>-function variable modified by add-function."
+           (obsolete "use a <foo>-function variable modified by `add-function'."
                      "24.4"))
   ;; We need those two gensyms because CL's lexical scoping is not available
   ;; for function arguments :-(
@@ -1497,8 +1521,8 @@ FUN is then called once."
 
 (defun add-to-list (list-var element &optional append compare-fn)
   "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
-The test for presence of ELEMENT is done with `equal',
-or with COMPARE-FN if that's non-nil.
+The test for presence of ELEMENT is done with `equal', or with
+COMPARE-FN if that's non-nil.
 If ELEMENT is added, it is added at the beginning of the list,
 unless the optional argument APPEND is non-nil, in which case
 ELEMENT is added at the end.
@@ -1506,14 +1530,15 @@ ELEMENT is added at the end.
 The return value is the new value of LIST-VAR.
 
 This is handy to add some elements to configuration variables,
-but please do not abuse it in Elisp code, where you are usually better off
-using `push' or `cl-pushnew'.
-
-If you want to use `add-to-list' on a variable that is not defined
-until a certain package is loaded, you should put the call to `add-to-list'
-into a hook function that will be run only after loading the package.
-`eval-after-load' provides one way to do this.  In some cases
-other hooks, such as major mode hooks, can do the job."
+but please do not abuse it in Elisp code, where you are usually
+better off using `push' or `cl-pushnew'.
+
+If you want to use `add-to-list' on a variable that is not
+defined until a certain package is loaded, you should put the
+call to `add-to-list' into a hook function that will be run only
+after loading the package.  `eval-after-load' provides one way to
+do this.  In some cases other hooks, such as major mode hooks,
+can do the job."
   (declare
    (compiler-macro
     (lambda (exp)
@@ -1810,7 +1835,7 @@ If TYPE is nil, then any kind of definition is acceptable.  If
 TYPE is `defun', `defvar', or `defface', that specifies function
 definition, variable definition, or face definition only."
   (if (and (or (null type) (eq type 'defun))
-          (symbolp symbol) (fboundp symbol)
+          (symbolp symbol)
           (autoloadp (symbol-function symbol)))
       (nth 1 (symbol-function symbol))
     (let ((files load-history)
@@ -1984,7 +2009,14 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
               (or (cdr (assq 'tool-bar global-map))
                   (lookup-key global-map [tool-bar])))
              map))
-         (aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0))
+          (let* ((keys
+                  (catch 'read-key (read-key-sequence-vector prompt nil t)))
+                 (key (aref keys 0)))
+            (if (and (> (length keys) 1)
+                     (memq key '(mode-line header-line
+                                 left-fringe right-fringe)))
+                (aref keys 1)
+              key)))
       (cancel-timer timer)
       (use-global-map old-global-map))))
 
@@ -2003,6 +2035,7 @@ If optional CONFIRM is non-nil, read the password twice to make sure.
 Optional DEFAULT is a default password to use instead of empty input.
 
 This function echoes `.' for each character that the user types.
+You could let-bind `read-hide-char' to another hiding character, though.
 
 Once the caller uses the password, it can erase the password
 by doing (clear-string STRING)."
@@ -2027,7 +2060,7 @@ by doing (clear-string STRING)."
                                      beg)))
              (dotimes (i (- end beg))
                (put-text-property (+ i beg) (+ 1 i beg)
-                                  'display (string ?.)))))
+                                  'display (string (or read-hide-char ?.))))))
           minibuf)
       (minibuffer-with-setup-hook
           (lambda ()
@@ -2041,7 +2074,8 @@ by doing (clear-string STRING)."
            (setq-local show-paren-mode nil)            ;bug#16091.
             (add-hook 'after-change-functions hide-chars-fun nil 'local))
         (unwind-protect
-            (let ((enable-recursive-minibuffers t))
+            (let ((enable-recursive-minibuffers t)
+                 (read-hide-char (or read-hide-char ?.)))
               (read-string prompt nil t default)) ; t = "no history"
           (when (buffer-live-p minibuf)
             (with-current-buffer minibuf
@@ -2132,7 +2166,7 @@ keyboard-quit events while waiting for a valid input."
     char))
 
 (defun sit-for (seconds &optional nodisp obsolete)
-  "Perform redisplay, then wait for SECONDS seconds or until input is available.
+  "Redisplay, then wait for SECONDS seconds.  Stop when input is available.
 SECONDS may be a floating-point value.
 \(On operating systems that do not support waiting for fractions of a
 second, floating-point values are rounded down to the nearest integer.)
@@ -2148,6 +2182,10 @@ 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"))
+  ;; This used to be implemented in C until the following discussion:
+  ;; http://lists.gnu.org/archive/html/emacs-devel/2006-07/msg00401.html
+  ;; Then it was moved here using an implementation based on an idle timer,
+  ;; which was then replaced by the use of read-event.
   (if (numberp nodisp)
       (setq seconds (+ seconds (* 1e-3 nodisp))
             nodisp obsolete)
@@ -2165,19 +2203,28 @@ floating point support."
     ;; 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)))
+    ;; For bug#14782, we need read-event to do the keyboard-coding-system
+    ;; decoding (hence non-nil as second arg under POSIX ttys).
+    ;; For bug#15614, we need read-event not to inherit-input-method.
+    ;; So we temporarily suspend input-method-function.
+    (let ((read (let ((input-method-function nil))
+                  (read-event nil t seconds))))
       (or (null read)
          (progn
-           ;; If last command was a prefix arg, e.g. C-u, push this event onto
-           ;; unread-command-events as (t . EVENT) so it will be added to
-           ;; this-command-keys by read-key-sequence.
-           (if (eq overriding-terminal-local-map universal-argument-map)
-               (setq read (cons t read)))
-           (push read unread-command-events)
+            ;; https://lists.gnu.org/archive/html/emacs-devel/2006-10/msg00394.html
+            ;; We want `read' appear in the next command's this-command-event
+            ;; but not in the current one.
+            ;; By pushing (cons t read), we indicate that `read' has not
+            ;; yet been recorded in this-command-keys, so it will be recorded
+            ;; next time it's read.
+            ;; And indeed the `seconds' argument to read-event correctly
+            ;; prevented recording this event in the current command's
+            ;; this-command-keys.
+           (push (cons t read) unread-command-events)
            nil))))))
 
 ;; Behind display-popup-menus-p test.
-(declare-function x-popup-dialog "xmenu.c" (position contents &optional header))
+(declare-function x-popup-dialog "menu.c" (position contents &optional header))
 
 (defun y-or-n-p (prompt)
   "Ask user a \"y or n\" question.  Return t if answer is \"y\".
@@ -2203,14 +2250,16 @@ is nil and `use-dialog-box' is non-nil."
   ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
   ;; where all the keys were unbound (i.e. it somehow got triggered
   ;; within read-key, apparently).  I had to kill it.
-  (let ((answer 'recenter))
+  (let ((answer 'recenter)
+       (padded (lambda (prompt &optional dialog)
+                 (let ((l (length prompt)))
+                   (concat prompt
+                           (if (or (zerop l) (eq ?\s (aref prompt (1- l))))
+                               "" " ")
+                           (if dialog "" "(y or n) "))))))
     (cond
      (noninteractive
-      (setq prompt (concat prompt
-                           (if (or (zerop (length prompt))
-                                   (eq ?\s (aref prompt (1- (length prompt)))))
-                               "" " ")
-                           "(y or n) "))
+      (setq prompt (funcall padded prompt))
       (let ((temp-prompt prompt))
        (while (not (memq answer '(act skip)))
          (let ((str (read-string temp-prompt)))
@@ -2221,14 +2270,10 @@ is nil and `use-dialog-box' is non-nil."
      ((and (display-popup-menus-p)
           (listp last-nonmenu-event)
           use-dialog-box)
-      (setq answer
-           (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
+      (setq prompt (funcall padded prompt t)
+           answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
      (t
-      (setq prompt (concat prompt
-                           (if (or (zerop (length prompt))
-                                   (eq ?\s (aref prompt (1- (length prompt)))))
-                               "" " ")
-                           "(y or n) "))
+      (setq prompt (funcall padded prompt))
       (while
           (let* ((scroll-actions '(recenter scroll-up scroll-down
                                   scroll-other-window scroll-other-window-down))
@@ -2261,9 +2306,7 @@ is nil and `use-dialog-box' is non-nil."
         (discard-input))))
     (let ((ret (eq answer 'act)))
       (unless noninteractive
-        ;; FIXME this prints one too many spaces, since prompt
-        ;; already ends in a space.  Eg "... (y or n)  y".
-        (message "%s %s" prompt (if ret "y" "n")))
+        (message "%s%c" prompt (if ret ?y ?n)))
       ret)))
 
 \f
@@ -2856,23 +2899,21 @@ COMMAND is the shell command to run.
 An old calling convention accepted any number of arguments after COMMAND,
 which were just concatenated to COMMAND.  This is still supported but strongly
 discouraged."
-   ;; We used to use `exec' to replace the shell with the command,
-   ;; but that failed to handle (...) and semicolon, etc.
+  (declare (advertised-calling-convention (name buffer command) "23.1"))
+  ;; We used to use `exec' to replace the shell with the command,
+  ;; but that failed to handle (...) and semicolon, etc.
   (start-process name buffer shell-file-name shell-command-switch
                 (mapconcat 'identity args " ")))
-(set-advertised-calling-convention 'start-process-shell-command
-                                   '(name buffer command) "23.1")
 
 (defun start-file-process-shell-command (name buffer &rest args)
   "Start a program in a subprocess.  Return the process object for it.
 Similar to `start-process-shell-command', but calls `start-file-process'."
+  (declare (advertised-calling-convention (name buffer command) "23.1"))
   (start-file-process
    name buffer
    (if (file-remote-p default-directory) "/bin/sh" shell-file-name)
    (if (file-remote-p default-directory) "-c" shell-command-switch)
    (mapconcat 'identity args " ")))
-(set-advertised-calling-convention 'start-file-process-shell-command
-                                   '(name buffer command) "23.1")
 
 (defun call-process-shell-command (command &optional infile buffer display
                                           &rest args)
@@ -2888,13 +2929,18 @@ STDERR-FILE may be nil (discard standard error output),
 t (mix it with ordinary output), or a file name string.
 
 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
-Remaining arguments are strings passed as additional arguments for COMMAND.
 Wildcards and redirection are handled as usual in the shell.
 
 If BUFFER is 0, `call-process-shell-command' returns immediately with value nil.
 Otherwise it waits for COMMAND to terminate and returns a numeric exit
 status or a signal description string.
-If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
+
+An old calling convention accepted any number of arguments after DISPLAY,
+which were just concatenated to COMMAND.  This is still supported but strongly
+discouraged."
+  (declare (advertised-calling-convention
+            (command &optional infile buffer display) "24.5"))
   ;; We used to use `exec' to replace the shell with the command,
   ;; but that failed to handle (...) and semicolon, etc.
   (call-process shell-file-name
@@ -2906,6 +2952,8 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
                                           &rest args)
   "Process files synchronously in a separate process.
 Similar to `call-process-shell-command', but calls `process-file'."
+  (declare (advertised-calling-convention
+            (command &optional infile buffer display) "24.5"))
   (process-file
    (if (file-remote-p default-directory) "/bin/sh" shell-file-name)
    infile buffer display
@@ -2914,6 +2962,14 @@ Similar to `call-process-shell-command', but calls `process-file'."
 \f
 ;;;; Lisp macros to do various things temporarily.
 
+(defmacro track-mouse (&rest body)
+  "Evaluate BODY with mouse movement events enabled.
+Within a `track-mouse' form, mouse motion generates input events that
+ you can read with `read-event'.
+Normally, mouse motion is ignored."
+  (declare (debug t) (indent 0))
+  `(internal--track-mouse (lambda () ,@body)))
+
 (defmacro with-current-buffer (buffer-or-name &rest body)
   "Execute the forms in BODY with BUFFER-OR-NAME temporarily current.
 BUFFER-OR-NAME must be a buffer or the name of an existing buffer.
@@ -3078,6 +3134,11 @@ 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'.
 
+By default, the setup hook puts the buffer into Help mode before running BODY.
+If BODY does not change the major mode, the show hook makes the buffer
+read-only, and scans it for function and variable names to make them into
+clickable cross-references.
+
 See the related form `with-temp-buffer-window'."
   (declare (debug t))
   (let ((old-dir (make-symbol "old-dir"))
@@ -3173,12 +3234,7 @@ not really affect the buffer's content."
     `(let* ((,modified (buffer-modified-p))
             (buffer-undo-list t)
             (inhibit-read-only t)
-            (inhibit-modification-hooks t)
-            deactivate-mark
-            ;; Avoid setting and removing file locks and checking
-            ;; buffer's uptodate-ness w.r.t the underlying file.
-            buffer-file-name
-            buffer-file-truename)
+            (inhibit-modification-hooks t))
        (unwind-protect
            (progn
              ,@body)
@@ -3246,9 +3302,13 @@ even if this catches the signal."
 
 (defmacro with-demoted-errors (format &rest body)
   "Run BODY and demote any errors to simple messages.
+FORMAT is a string passed to `message' to format any error message.
+It should contain a single %-sequence; e.g., \"Error: %S\".
+
 If `debug-on-error' is non-nil, run BODY without catching its errors.
 This is to be used around code which is not expected to signal an error
 but which should be robust in the unexpected case that an error is signaled.
+
 For backward compatibility, if FORMAT is not a constant string, it
 is assumed to be part of BODY, in which case the message format
 used is \"Error: %S\"."
@@ -3292,6 +3352,19 @@ The value returned is the value of the last form in BODY."
                  ,@body)
         (with-current-buffer ,old-buffer
           (set-case-table ,old-case-table))))))
+
+(defmacro with-file-modes (modes &rest body)
+  "Execute BODY with default file permissions temporarily set to MODES.
+MODES is as for `set-default-file-modes'."
+  (declare (indent 1) (debug t))
+  (let ((umask (make-symbol "umask")))
+    `(let ((,umask (default-file-modes)))
+       (unwind-protect
+           (progn
+             (set-default-file-modes ,modes)
+             ,@body)
+         (set-default-file-modes ,umask)))))
+
 \f
 ;;; Matching and match data.
 
@@ -3643,12 +3716,14 @@ and replace a sub-expression, e.g.
       (setq matches (cons (substring string start l) matches)) ; leftover
       (apply #'concat (nreverse matches)))))
 \f
-(defun string-prefix-p (str1 str2 &optional ignore-case)
-  "Return non-nil if STR1 is a prefix of STR2.
+(defun string-prefix-p (prefix string &optional ignore-case)
+  "Return non-nil if PREFIX is a prefix of STRING.
 If IGNORE-CASE is non-nil, the comparison is done without paying attention
 to case differences."
-  (eq t (compare-strings str1 nil nil
-                         str2 0 (length str1) ignore-case)))
+  (let ((prefix-length (length prefix)))
+    (if (> prefix-length (length string)) nil
+      (eq t (compare-strings prefix 0 prefix-length string
+                            0 prefix-length ignore-case)))))
 
 (defun string-suffix-p (suffix string  &optional ignore-case)
   "Return non-nil if SUFFIX is a suffix of STRING.
@@ -3812,7 +3887,9 @@ This function is called directly from the C code."
       ;; 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)
+  (when (save-match-data
+          (and (string-match "/obsolete/\\([^/]*\\)\\'" abs-file)
+               (not (equal "loaddefs.el" (match-string 1 abs-file)))))
     ;; Maybe we should just use display-warning?  This seems yucky...
     (let* ((file (file-name-nondirectory abs-file))
           (msg (format "Package %s is obsolete!"
@@ -3832,7 +3909,8 @@ This function is called directly from the C code."
            (byte-compile-log-warning msg))
        (run-with-timer 0 nil
                        (lambda (msg)
-                         (message "%s" msg)) msg))))
+                         (message "%s" msg))
+                        msg))))
 
   ;; Finally, run any other hook.
   (run-hook-with-args 'after-load-functions abs-file))
@@ -4149,7 +4227,8 @@ 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).")
 
-(defconst internal--call-interactively (symbol-function 'call-interactively))
+(defconst internal--funcall-interactively
+  (symbol-function 'funcall-interactively))
 
 (defun called-interactively-p (&optional kind)
   "Return t if the containing function was called by `call-interactively'.
@@ -4223,10 +4302,13 @@ command is called from a keyboard macro?"
       (pcase (cons frame nextframe)
         ;; No subr calls `interactive-p', so we can rule that out.
         (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil)
-        ;; In case #<subr call-interactively> without going through the
-        ;; `call-interactively' symbol (bug#3984).
-        (`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t)
-        (`(,_ . (t call-interactively . ,_)) t)))))
+        ;; In case #<subr funcall-interactively> without going through the
+        ;; `funcall-interactively' symbol (bug#3984).
+        (`(,_ . (t ,(pred (lambda (f)
+                            (eq internal--funcall-interactively
+                                (indirect-function f))))
+                   . ,_))
+         t)))))
 
 (defun interactive-p ()
   "Return t if the containing function was run directly by user input.
@@ -4274,22 +4356,31 @@ use `called-interactively-p'."
 Normally, MAP is used only once, to look up the very next key.
 However, 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.
+function of no arguments: it is called from `pre-command-hook' and
+if it returns non-nil, then MAP stays active.
 
 Optional arg ON-EXIT, if non-nil, specifies a function that is
 called, with no arguments, after MAP is deactivated.
 
 This uses `overriding-terminal-local-map' which takes precedence over all other
 keymaps.  As usual, if no match for a key is found in MAP, the normal key
-lookup sequence then continues."
-  (let ((clearfun (make-symbol "clear-transient-map")))
+lookup sequence then continues.
+
+This returns an \"exit function\", which can be called with no argument
+to deactivate this transient map, regardless of KEEP-PRED."
+  (let* ((clearfun (make-symbol "clear-transient-map"))
+         (exitfun
+          (lambda ()
+            (internal-pop-keymap map 'overriding-terminal-local-map)
+            (remove-hook 'pre-command-hook clearfun)
+            (when on-exit (funcall on-exit)))))
     ;; Don't use letrec, because equal (in add/remove-hook) would get trapped
     ;; in a cycle.
     (fset clearfun
           (lambda ()
             (with-demoted-errors "set-transient-map PCH: %S"
               (unless (cond
+                       ((null keep-pred) nil)
                        ((not (eq map (cadr overriding-terminal-local-map)))
                         ;; There's presumably some other transient-map in
                         ;; effect.  Wait for that one to terminate before we
@@ -4302,16 +4393,14 @@ lookup sequence then continues."
                         ;; C-u and that 1 exits isearch whereas it doesn't
                         ;; exit C-u.
                         t)
-                       ((null keep-pred) nil)
                        ((eq t keep-pred)
                         (eq this-command
                             (lookup-key map (this-command-keys-vector))))
                        (t (funcall keep-pred)))
-                (internal-pop-keymap map 'overriding-terminal-local-map)
-                (remove-hook 'pre-command-hook clearfun)
-                (when on-exit (funcall on-exit))))))
+                (funcall exitfun)))))
     (add-hook 'pre-command-hook clearfun)
-    (internal-push-keymap map 'overriding-terminal-local-map)))
+    (internal-push-keymap map 'overriding-terminal-local-map)
+    exitfun))
 
 ;;;; Progress reporters.
 
@@ -4419,11 +4508,10 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter."
         (min-value    (aref parameters 1))
         (max-value    (aref parameters 2))
         (text         (aref parameters 3))
-        (current-time (float-time))
         (enough-time-passed
          ;; See if enough time has passed since the last update.
          (or (not update-time)
-             (when (>= current-time update-time)
+             (when (>= (float-time) update-time)
                ;; Calculate time for the next update
                (aset parameters 0 (+ update-time (aref parameters 5)))))))
     (cond ((and min-value max-value)
@@ -4723,6 +4811,21 @@ which is higher than \"1alpha\", which is higher than \"1snapshot\".
 Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
   (version-list-= (version-to-list v1) (version-to-list v2)))
 
+(defvar package--builtin-versions
+  ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions.
+  (purecopy `((emacs . ,(version-to-list emacs-version))))
+  "Alist giving the version of each versioned builtin package.
+I.e. each element of the list is of the form (NAME . VERSION) where
+NAME is the package name as a symbol, and VERSION is its version
+as a list.")
+
+(defun package--description-file (dir)
+  (concat (let ((subdir (file-name-nondirectory
+                         (directory-file-name dir))))
+            (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
+                (match-string 1 subdir) subdir))
+          "-pkg.el"))
+
 \f
 ;;; Misc.
 (defconst menu-bar-separator '("--")