Merge from trunk and resolve conflicts.

12 files changed, 419 insertions, 1411 deletions

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 9c52cc44eb4..0e96ba93f44 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2521,7 +2521,8 @@ If QUOTED is non-nil, print with quoting; otherwise, print without quoting."
   "Return an expression which will evaluate to a function value FUN.
 FUN should be either a `lambda' value or a `closure' value."
   (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil))
-                    `(closure ,env ,args . ,body)) fun)
+                    `(closure ,env ,args . ,body))
+                fun)
                (renv ()))
     ;; Turn the function's closed vars (if any) into local let bindings.
     (dolist (binding env)
@@ -2723,7 +2724,9 @@ for symbols generated by the byte compiler itself."
               ;; byte-string, constants-vector, stack depth
               (cdr compiled)
               ;; optionally, the doc string.
-              (cond (lexical-binding
+              (cond ((and lexical-binding arglist)
+                     ;; byte-compile-make-args-desc lost the args's names,
+                     ;; so preserve them in the docstring.
                      (list (help-add-fundoc-usage doc arglist)))
                     ((or doc int)
                      (list doc)))
@@ -4069,7 +4072,6 @@ binding slots have been popped."
 (byte-defop-compiler-1 save-restriction)
 ;; (byte-defop-compiler-1 save-window-excursion)      ;Obsolete: now a macro.
 ;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro.
-(byte-defop-compiler-1 track-mouse)
 
 (defvar byte-compile--use-old-handlers t
   "If nil, use new byte codes introduced in Emacs-24.4.")
@@ -4104,12 +4106,6 @@ binding slots have been popped."
   (byte-compile-form-do-effect (car (cdr form)))
   (byte-compile-out 'byte-unbind 1))
 
-(defun byte-compile-track-mouse (form)
-  (byte-compile-form
-   (pcase form
-     (`(,_ :fun-body ,f) `(eval (list 'track-mouse (list 'funcall ,f))))
-     (_ `(eval '(track-mouse ,@(byte-compile-top-level-body (cdr form))))))))
-
 (defun byte-compile-condition-case (form)
   (if byte-compile--use-old-handlers
       (byte-compile-condition-case--old form)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 40f1531e0f7..98eef11a658 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -462,10 +462,6 @@ places where they originally did not directly appear."
      `(,head ,(cconv-convert form env extend)
         :fun-body ,(cconv--convert-function () body env form)))
 
-    (`(track-mouse . ,body)
-     `(track-mouse
-        :fun-body ,(cconv--convert-function () body env form)))
-
     (`(setq . ,forms)                   ; setq special form
      (let ((prognlist ()))
        (while forms
@@ -701,11 +697,6 @@ and updates the data stored in ENV."
      (cconv-analyse-form form env)
      (cconv--analyse-function () body env form))
 
-    ;; FIXME: The lack of bytecode for track-mouse forces us to wrap the body.
-    ;; `track-mouse' really should be made into a macro.
-    (`(track-mouse . ,body)
-     (cconv--analyse-function () body env form))
-
     (`(defvar ,var) (push var byte-compile-bound-variables))
     (`(,(or `defconst `defvar) ,var ,value . ,_)
      (push var byte-compile-bound-variables)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 3761d04c2c2..a7970261608 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -383,6 +383,42 @@ With two arguments, return rounding and remainder of their quotient."
   "Return 1 if X is positive, -1 if negative, 0 if zero."
   (cond ((> x 0) 1) ((< x 0) -1) (t 0)))
 
+;;;###autoload
+(cl-defun cl-parse-integer (string &key start end radix junk-allowed)
+  "Parse integer from the substring of STRING from START to END.
+STRING may be surrounded by whitespace chars (chars with syntax ` ').
+Other non-digit chars are considered junk.
+RADIX is an integer between 2 and 36, the default is 10.  Signal
+an error if the substring between START and END cannot be parsed
+as an integer unless JUNK-ALLOWED is non-nil."
+  (cl-check-type string string)
+  (let* ((start (or start 0))
+	 (len	(length string))
+	 (end   (or end len))
+	 (radix (or radix 10)))
+    (or (<= start end len)
+	(error "Bad interval: [%d, %d)" start end))
+    (cl-flet ((skip-whitespace ()
+		(while (and (< start end)
+			    (= 32 (char-syntax (aref string start))))
+		  (setq start (1+ start)))))
+      (skip-whitespace)
+      (let ((sign (cl-case (and (< start end) (aref string start))
+		    (?+ (cl-incf start) +1)
+		    (?- (cl-incf start) -1)
+		    (t  +1)))
+	    digit sum)
+	(while (and (< start end)
+		    (setq digit (cl-digit-char-p (aref string start) radix)))
+	  (setq sum (+ (* (or sum 0) radix) digit)
+		start (1+ start)))
+	(skip-whitespace)
+	(cond ((and junk-allowed (null sum)) sum)
+	      (junk-allowed (* sign sum))
+	      ((or (/= start end) (null sum))
+	       (error "Not an integer string: `%s'" string))
+	      (t (* sign sum)))))))
+
 
 ;; Random numbers.
 
@@ -611,6 +647,13 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
 	(progn (setplist sym (cdr (cdr plist))) t)
       (cl--do-remf plist tag))))
 
+;;; Streams.
+
+;;;###autoload
+(defun cl-fresh-line (&optional stream)
+  "Output a newline unless already at the beginning of a line."
+  (terpri stream 'ensure))
+
 ;;; Some debugging aids.
 
 (defun cl-prettyprint (form)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index c4b9673aa2a..c7d21c76fc1 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -279,6 +279,25 @@ so that they are registered at compile-time as well as run-time."
   "Return t if INTEGER is even."
   (eq (logand integer 1) 0))
 
+(defconst cl-digit-char-table
+  (let* ((digits (make-vector 256 nil))
+         (populate (lambda (start end base)
+                     (mapc (lambda (i)
+                             (aset digits i (+ base (- i start))))
+                           (number-sequence start end)))))
+    (funcall populate ?0 ?9 0)
+    (funcall populate ?A ?Z 10)
+    (funcall populate ?a ?z 10)
+    digits))
+
+(defun cl-digit-char-p (char &optional radix)
+  "Test if CHAR is a digit in the specified RADIX (default 10).
+If true return the decimal value of digit CHAR in RADIX."
+  (or (<= 2 (or radix 10) 36)
+      (signal 'args-out-of-range (list 'radix radix '(2 36))))
+  (let ((n (aref cl-digit-char-table char)))
+    (and n (< n (or radix 10)) n)))
+
 (defvar cl--random-state
   (vector 'cl--random-state-tag -1 30 (cl--random-time)))
 
@@ -682,7 +701,6 @@ If ALIST is non-nil, the new pairs are prepended to it."
 (gv-define-setter window-width (store)
   `(progn (enlarge-window (- ,store (window-width)) t) ,store))
 (gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
-(gv-define-simple-setter x-get-selection x-own-selection t)
 
 ;; More complex setf-methods.
 
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index b5b6566cf66..9a17a75e48b 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -300,7 +300,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
          ,(format "Hook run after entering or leaving `%s'.
 No problems result if this variable is not bound.
 `add-hook' automatically binds it.  (This is true for all hook variables.)"
-                  mode))
+		  modefun))
 
        ;; Define the minor-mode keymap.
        ,(unless (symbolp keymap)	;nil is also a symbol.
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 0b8304af29f..7245989c4b0 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -1,4 +1,4 @@
-;;; eldoc.el --- show function arglist or variable docstring in echo area  -*- lexical-binding: t; -*-
+;;; eldoc.el --- Show function arglist or variable docstring in echo area  -*- lexical-binding:t; -*-
 
 ;; Copyright (C) 1996-2014 Free Software Foundation, Inc.
 
@@ -88,7 +88,7 @@ has no effect, unless the function handles it explicitly."
 		(function-item downcase)
                 function)
   :group 'eldoc)
-(make-obsolete-variable 'eldoc-argument-case nil "24.5")
+(make-obsolete-variable 'eldoc-argument-case nil "25.1")
 
 (defcustom eldoc-echo-area-use-multiline-p 'truncate-sym-name-if-fit
   "Allow long ElDoc messages to resize echo area display.
@@ -116,8 +116,8 @@ has no effect, unless the function handles it explicitly."
 (defface eldoc-highlight-function-argument
   '((t (:inherit bold)))
   "Face used for the argument at point in a function's argument list.
-Note that if `eldoc-documentation-function' is non-nil, this face
-has no effect, unless the function handles it explicitly."
+Note that this face has no effect unless the `eldoc-documentation-function'
+handles it explicitly."
   :group 'eldoc)
 
 ;;; No user options below here.
@@ -185,15 +185,34 @@ it displays the argument list of the function called in the
 expression point is on."
   :group 'eldoc :lighter eldoc-minor-mode-string
   (setq eldoc-last-message nil)
-  (if eldoc-mode
+  (cond
+   ((not eldoc-documentation-function)
+    (message "There is no ElDoc support in this buffer")
+    (setq eldoc-mode nil))
+   (eldoc-mode
+    (when eldoc-print-after-edit
+      (setq-local eldoc-message-commands (eldoc-edit-message-commands)))
+    (add-hook 'post-command-hook 'eldoc-schedule-timer nil t)
+    (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area nil t))
+   (t
+    (kill-local-variable 'eldoc-message-commands)
+    (remove-hook 'post-command-hook 'eldoc-schedule-timer t)
+    (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t))))
+
+;;;###autoload
+(define-minor-mode global-eldoc-mode
+  "Enable `eldoc-mode' in all buffers where it's applicable."
+  :group 'eldoc :global t
+  (setq eldoc-last-message nil)
+  (if global-eldoc-mode
       (progn
 	(when eldoc-print-after-edit
 	  (setq-local eldoc-message-commands (eldoc-edit-message-commands)))
-	(add-hook 'post-command-hook 'eldoc-schedule-timer nil t)
-	(add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area nil t))
+	(add-hook 'post-command-hook #'eldoc-schedule-timer)
+	(add-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area))
     (kill-local-variable 'eldoc-message-commands)
-    (remove-hook 'post-command-hook 'eldoc-schedule-timer t)
-    (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t)))
+    (remove-hook 'post-command-hook #'eldoc-schedule-timer)
+    (remove-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area)))
 
 ;;;###autoload
 (define-obsolete-function-alias 'turn-on-eldoc-mode 'eldoc-mode "24.4")
@@ -201,11 +220,14 @@ expression point is on."
 
 (defun eldoc-schedule-timer ()
   (or (and eldoc-timer
-           (memq eldoc-timer timer-idle-list))
+           (memq eldoc-timer timer-idle-list)) ;FIXME: Why?
       (setq eldoc-timer
             (run-with-idle-timer
 	     eldoc-idle-delay t
-	     (lambda () (and eldoc-mode (eldoc-print-current-symbol-info))))))
+	     (lambda ()
+               (when (or eldoc-mode
+                         (and global-eldoc-mode eldoc-documentation-function))
+                 (eldoc-print-current-symbol-info))))))
 
   ;; If user has changed the idle delay, update the timer.
   (cond ((not (= eldoc-idle-delay eldoc-current-idle-delay))
@@ -300,7 +322,7 @@ Otherwise work like `message'."
 
 
 ;;;###autoload
-(defvar eldoc-documentation-function #'eldoc-documentation-function-default
+(defvar eldoc-documentation-function nil
   "Function to call to return doc string.
 The function of no args should return a one-line string for displaying
 doc about a function etc. appropriate to the context around point.
@@ -313,8 +335,7 @@ the variables `eldoc-argument-case' and `eldoc-echo-area-use-multiline-p',
 and the face `eldoc-highlight-function-argument', if they are to have any
 effect.
 
-This variable is expected to be made buffer-local by modes (other than
-Emacs Lisp mode) that support ElDoc.")
+This variable is expected to be set buffer-locally by modes that support ElDoc.")
 
 (defun eldoc-print-current-symbol-info ()
   ;; This is run from post-command-hook or some idle timer thing,
@@ -327,239 +348,6 @@ Emacs Lisp mode) that support ElDoc.")
                nil))
 	 (eldoc-message (funcall eldoc-documentation-function)))))
 
-(defun eldoc-documentation-function-default ()
-  "Default value for `eldoc-documentation-function' (which see)."
-  (let ((current-symbol (eldoc-current-symbol))
-	(current-fnsym  (eldoc-fnsym-in-current-sexp)))
-    (cond ((null current-fnsym)
-	   nil)
-	  ((eq current-symbol (car current-fnsym))
-	   (or (apply #'eldoc-get-fnsym-args-string current-fnsym)
-	       (eldoc-get-var-docstring current-symbol)))
-	  (t
-	   (or (eldoc-get-var-docstring current-symbol)
-	       (apply #'eldoc-get-fnsym-args-string current-fnsym))))))
-
-(defun eldoc-get-fnsym-args-string (sym &optional index)
-  "Return a string containing the parameter list of the function SYM.
-If SYM is a subr and no arglist is obtainable from the docstring
-or elsewhere, return a 1-line docstring."
-  (let (args doc advertised)
-    (cond ((not (and sym (symbolp sym) (fboundp sym))))
-	  ((and (eq sym (aref eldoc-last-data 0))
-		(eq 'function (aref eldoc-last-data 2)))
-	   (setq doc (aref eldoc-last-data 1)))
-	  ((listp (setq advertised (gethash (indirect-function sym)
-					    advertised-signature-table t)))
-	   (setq args advertised))
-	  ((setq doc (help-split-fundoc (documentation sym t) sym))
-	   (setq args (car doc)))
-	  (t
-	   (setq args (help-function-arglist sym))))
-    (if args
-	;; Stringify, and store before highlighting, downcasing, etc.
-	;; FIXME should truncate before storing.
-	(eldoc-last-data-store sym (setq args (eldoc-function-argstring args))
-			       'function)
-      (setq args doc))		  ; use stored value
-    ;; Change case, highlight, truncate.
-    (if args
-	(eldoc-highlight-function-argument sym args index))))
-
-(defun eldoc-highlight-function-argument (sym args index)
-  "Highlight argument INDEX in ARGS list for function SYM.
-In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
-  (let ((start          nil)
-	(end            0)
-	(argument-face  'eldoc-highlight-function-argument))
-    ;; Find the current argument in the argument string.  We need to
-    ;; handle `&rest' and informal `...' properly.
-    ;;
-    ;; FIXME: What to do with optional arguments, like in
-    ;;        (defun NAME ARGLIST [DOCSTRING] BODY...) case?
-    ;;        The problem is there is no robust way to determine if
-    ;;        the current argument is indeed a docstring.
-
-    ;; When `&key' is used finding position based on `index'
-    ;; would be wrong, so find the arg at point and determine
-    ;; position in ARGS based on this current arg.
-    (when (string-match "&key" args)
-      (let* (case-fold-search
-             (cur-w (current-word))
-             (limit (save-excursion
-                      (when (re-search-backward (symbol-name sym) nil t)
-                        (match-end 0))))
-             (cur-a (if (string-match ":\\([^ ()]*\\)" cur-w)
-                        (substring cur-w 1)
-                      (save-excursion
-                        (when (re-search-backward ":\\([^ ()\n]*\\)" limit t)
-                            (match-string 1))))))
-        ;; If `cur-a' is nil probably cursor is on a positional arg
-        ;; before `&key', in this case, exit this block and determine
-        ;; position with `index'.
-        (when (and cur-a
-                   (string-match (concat "\\_<" (upcase cur-a) "\\_>") args))
-          (setq index nil ; Skip next block based on positional args.
-                start (match-beginning 0)
-                end   (match-end 0)))))
-    ;; Handle now positional arguments.
-    (while (and index (>= index 1))
-      (if (string-match "[^ ()]+" args end)
-	  (progn
-	    (setq start (match-beginning 0)
-		  end   (match-end 0))
-	    (let ((argument (match-string 0 args)))
-	      (cond ((string= argument "&rest")
-		     ;; All the rest arguments are the same.
-		     (setq index 1))
-		    ((string= argument "&optional")) ; Skip.
-                    ((string= argument "&allow-other-keys")) ; Skip.
-                    ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc...
-                    ;; like in `setq'.
-		    ((or (string-match-p "\\.\\.\\.$" argument)
-                         (and (string-match-p "\\.\\.\\.)?$" args)
-                              (> index 1) (cl-oddp index)))
-                     (setq index 0))
-		    (t
-		     (setq index (1- index))))))
-	(setq end           (length args)
-	      start         (1- end)
-	      argument-face 'font-lock-warning-face
-	      index         0)))
-    (let ((doc args))
-      (when start
-	(setq doc (copy-sequence args))
-	(add-text-properties start end (list 'face argument-face) doc))
-      (setq doc (eldoc-docstring-format-sym-doc
-		 sym doc (if (functionp sym) 'font-lock-function-name-face
-                           'font-lock-keyword-face)))
-      doc)))
-
-;; Return a string containing a brief (one-line) documentation string for
-;; the variable.
-(defun eldoc-get-var-docstring (sym)
-  (when sym
-    (cond ((and (eq sym (aref eldoc-last-data 0))
-		(eq 'variable (aref eldoc-last-data 2)))
-	   (aref eldoc-last-data 1))
-	  (t
-	   (let ((doc (documentation-property sym 'variable-documentation t)))
-	     (cond (doc
-		    (setq doc (eldoc-docstring-format-sym-doc
-			       sym (eldoc-docstring-first-line doc)
-			       'font-lock-variable-name-face))
-		    (eldoc-last-data-store sym doc 'variable)))
-	     doc)))))
-
-(defun eldoc-last-data-store (symbol doc type)
-  (aset eldoc-last-data 0 symbol)
-  (aset eldoc-last-data 1 doc)
-  (aset eldoc-last-data 2 type))
-
-;; Note that any leading `*' in the docstring (which indicates the variable
-;; is a user option) is removed.
-(defun eldoc-docstring-first-line (doc)
-  (and (stringp doc)
-       (substitute-command-keys
-        (save-match-data
-	  ;; Don't use "^" in the regexp below since it may match
-	  ;; anywhere in the doc-string.
-	  (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0)))
-            (cond ((string-match "\n" doc)
-                   (substring doc start (match-beginning 0)))
-                  ((zerop start) doc)
-                  (t (substring doc start))))))))
-
-;; If the entire line cannot fit in the echo area, the symbol name may be
-;; truncated or eliminated entirely from the output to make room for the
-;; description.
-(defun eldoc-docstring-format-sym-doc (sym doc face)
-  (save-match-data
-    (let* ((name (symbol-name sym))
-           (ea-multi eldoc-echo-area-use-multiline-p)
-           ;; Subtract 1 from window width since emacs will not write
-           ;; any chars to the last column, or in later versions, will
-           ;; cause a wraparound and resize of the echo area.
-           (ea-width (1- (window-width (minibuffer-window))))
-           (strip (- (+ (length name) (length ": ") (length doc)) ea-width)))
-      (cond ((or (<= strip 0)
-                 (eq ea-multi t)
-                 (and ea-multi (> (length doc) ea-width)))
-             (format "%s: %s" (propertize name 'face face) doc))
-            ((> (length doc) ea-width)
-             (substring (format "%s" doc) 0 ea-width))
-            ((>= strip (length name))
-             (format "%s" doc))
-            (t
-             ;; Show the end of the partial symbol name, rather
-             ;; than the beginning, since the former is more likely
-             ;; to be unique given package namespace conventions.
-             (setq name (substring name strip))
-             (format "%s: %s" (propertize name 'face face) doc))))))
-
-
-;; Return a list of current function name and argument index.
-(defun eldoc-fnsym-in-current-sexp ()
-  (save-excursion
-    (let ((argument-index (1- (eldoc-beginning-of-sexp))))
-      ;; If we are at the beginning of function name, this will be -1.
-      (when (< argument-index 0)
-	(setq argument-index 0))
-      ;; Don't do anything if current word is inside a string.
-      (if (= (or (char-after (1- (point))) 0) ?\")
-	  nil
-	(list (eldoc-current-symbol) argument-index)))))
-
-;; Move to the beginning of current sexp.  Return the number of nested
-;; sexp the point was over or after.
-(defun eldoc-beginning-of-sexp ()
-  (let ((parse-sexp-ignore-comments t)
-	(num-skipped-sexps 0))
-    (condition-case _
-	(progn
-	  ;; First account for the case the point is directly over a
-	  ;; beginning of a nested sexp.
-	  (condition-case _
-	      (let ((p (point)))
-		(forward-sexp -1)
-		(forward-sexp 1)
-		(when (< (point) p)
-		  (setq num-skipped-sexps 1)))
-	    (error))
-	  (while
-	      (let ((p (point)))
-		(forward-sexp -1)
-		(when (< (point) p)
-		  (setq num-skipped-sexps (1+ num-skipped-sexps))))))
-      (error))
-    num-skipped-sexps))
-
-;; returns nil unless current word is an interned symbol.
-(defun eldoc-current-symbol ()
-  (let ((c (char-after (point))))
-    (and c
-         (memq (char-syntax c) '(?w ?_))
-         (intern-soft (current-word)))))
-
-;; Do indirect function resolution if possible.
-(defun eldoc-symbol-function (fsym)
-  (let ((defn (symbol-function fsym)))
-    (and (symbolp defn)
-         (condition-case _
-             (setq defn (indirect-function fsym))
-           (error (setq defn nil))))
-    defn))
-
-(defun eldoc-function-argstring (arglist)
-  "Return ARGLIST as a string enclosed by ().
-ARGLIST is either a string, or a list of strings or symbols."
-  (let ((str (cond ((stringp arglist) arglist)
-                   ((not (listp arglist)) nil)
-                   (t (format "%S" (help-make-usage 'toto arglist))))))
-    (if (and str (string-match "\\`([^ ]+ ?" str))
-        (replace-match "(" t t str)
-      str)))
-
 
 ;; When point is in a sexp, the function args are not reprinted in the echo
 ;; area after every possible interactive command because some of them print
@@ -575,7 +363,7 @@ ARGLIST is either a string, or a list of strings or symbols."
 
 (defun eldoc-add-command-completions (&rest names)
   (dolist (name names)
-    (apply 'eldoc-add-command (all-completions name obarray 'commandp))))
+    (apply #'eldoc-add-command (all-completions name obarray 'commandp))))
 
 (defun eldoc-remove-command (&rest cmds)
   (dolist (name cmds)
@@ -585,7 +373,7 @@ ARGLIST is either a string, or a list of strings or symbols."
 
 (defun eldoc-remove-command-completions (&rest names)
   (dolist (name names)
-    (apply 'eldoc-remove-command
+    (apply #'eldoc-remove-command
            (all-completions name eldoc-message-commands))))
 
 
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 692b76e8a36..229ad275bf5 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -357,6 +357,34 @@ The return value is the last VAL in the list.
   (macroexp-let2 nil v val
     `(with-current-buffer ,buf (set (make-local-variable ,var) ,v))))
 
+(gv-define-expander alist-get
+  (lambda (do key alist &optional default remove)
+    (macroexp-let2 macroexp-copyable-p k key
+      (gv-letplace (getter setter) alist
+        (macroexp-let2 nil p `(assq ,k ,getter)
+          (funcall do (if (null default) `(cdr ,p)
+                        `(if ,p (cdr ,p) ,default))
+                   (lambda (v)
+                     (macroexp-let2 nil v v
+                       (let ((set-exp
+                              `(if ,p (setcdr ,p ,v)
+                                 ,(funcall setter
+                                           `(cons (setq ,p (cons ,k ,v))
+                                                  ,getter)))))
+                         (cond
+                          ((null remove) set-exp)
+                          ((or (eql v default)
+                               (and (eq (car-safe v) 'quote)
+                                    (eq (car-safe default) 'quote)
+                                    (eql (cadr v) (cadr default))))
+                           `(if ,p ,(funcall setter `(delq ,p ,getter))))
+                          (t
+                           `(cond
+                             ((not (eql ,default ,v)) ,set-exp)
+                             (,p ,(funcall setter
+                                           `(delq ,p ,getter)))))))))))))))
+
+
 ;;; Some occasionally handy extensions.
 
 ;; While several of the "places" below are not terribly useful for direct use,
@@ -479,22 +507,13 @@ REF must have been previously obtained with `gv-ref'."
 ;;  … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el")
 (gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v))
 
-;;; Vaguely related definitions that should be moved elsewhere.
-
-;; (defun alist-get (key alist)
-;;   "Get the value associated to KEY in ALIST."
-;;   (declare
-;;    (gv-expander
-;;     (lambda (do)
-;;       (macroexp-let2 macroexp-copyable-p k key
-;;         (gv-letplace (getter setter) alist
-;;           (macroexp-let2 nil p `(assoc ,k ,getter)
-;;             (funcall do `(cdr ,p)
-;;                      (lambda (v)
-;;                        `(if ,p (setcdr ,p ,v)
-;;                           ,(funcall setter
-;;                                     `(cons (cons ,k ,v) ,getter)))))))))))
-;;   (cdr (assoc key alist)))
+;; (defmacro gv-letref (vars place &rest body)
+;;   (declare (indent 2) (debug (sexp form &rest body)))
+;;   (require 'cl-lib) ;Can't require cl-lib at top-level for bootstrap reasons!
+;;   (gv-letplace (getter setter) place
+;;     `(cl-macrolet ((,(nth 0 vars) () ',getter)
+;;                    (,(nth 1 vars) (v) (funcall ',setter v)))
+;;        ,@body)))
 
 (provide 'gv)
 ;;; gv.el ends here
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 31df353321a..a13baf0ee22 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -33,17 +33,10 @@
 (defvar font-lock-keywords-case-fold-search)
 (defvar font-lock-string-face)
 
-(defvar lisp-mode-abbrev-table nil)
 (define-abbrev-table 'lisp-mode-abbrev-table ()
   "Abbrev table for Lisp mode.")
 
-(defvar emacs-lisp-mode-abbrev-table nil)
-(define-abbrev-table 'emacs-lisp-mode-abbrev-table ()
-  "Abbrev table for Emacs Lisp mode.
-It has `lisp-mode-abbrev-table' as its parent."
-  :parents (list lisp-mode-abbrev-table))
-
-(defvar emacs-lisp-mode-syntax-table
+(defvar lisp--mode-syntax-table
   (let ((table (make-syntax-table))
         (i 0))
     (while (< i ?0)
@@ -82,13 +75,11 @@ It has `lisp-mode-abbrev-table' as its parent."
     (modify-syntax-entry ?\\ "\\   " table)
     (modify-syntax-entry ?\( "()  " table)
     (modify-syntax-entry ?\) ")(  " table)
-    (modify-syntax-entry ?\[ "(]  " table)
-    (modify-syntax-entry ?\] ")[  " table)
     table)
-  "Syntax table used in `emacs-lisp-mode'.")
+  "Parent syntax table used in Lisp modes.")
 
 (defvar lisp-mode-syntax-table
-  (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
+  (let ((table (make-syntax-table lisp--mode-syntax-table)))
     (modify-syntax-entry ?\[ "_   " table)
     (modify-syntax-entry ?\] "_   " table)
     (modify-syntax-entry ?# "' 14" table)
@@ -102,26 +93,35 @@ It has `lisp-mode-abbrev-table' as its parent."
 	 (purecopy (concat "^\\s-*("
 			   (eval-when-compile
 			     (regexp-opt
-			      '("defun" "defun*" "defsubst" "defmacro"
+			      '("defun" "defmacro"
+                                ;; Elisp.
+                                "defun*" "defsubst"
 				"defadvice" "define-skeleton"
 				"define-compilation-mode" "define-minor-mode"
 				"define-global-minor-mode"
 				"define-globalized-minor-mode"
 				"define-derived-mode" "define-generic-mode"
+				"cl-defun" "cl-defsubst" "cl-defmacro"
+				"cl-define-compiler-macro"
+                                ;; CL.
 				"define-compiler-macro" "define-modify-macro"
 				"defsetf" "define-setf-expander"
 				"define-method-combination"
-				"defgeneric" "defmethod"
-				"cl-defun" "cl-defsubst" "cl-defmacro"
-				"cl-define-compiler-macro") t))
+                                ;; CLOS and EIEIO
+				"defgeneric" "defmethod")
+                              t))
 			   "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
 	 2)
    (list (purecopy "Variables")
 	 (purecopy (concat "^\\s-*("
 			   (eval-when-compile
 			     (regexp-opt
-			      '("defconst" "defconstant" "defcustom"
-				"defparameter" "define-symbol-macro") t))
+			      '(;; Elisp
+                                "defconst" "defcustom"
+                                ;; CL
+                                "defconstant"
+				"defparameter" "define-symbol-macro")
+                              t))
 			   "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
 	 2)
    ;; For `defvar', we ignore (defvar FOO) constructs.
@@ -133,10 +133,16 @@ It has `lisp-mode-abbrev-table' as its parent."
 	 (purecopy (concat "^\\s-*("
 			   (eval-when-compile
 			     (regexp-opt
-			      '("defgroup" "deftheme" "deftype" "defstruct"
-				"defclass" "define-condition" "define-widget"
-				"defface" "defpackage" "cl-deftype"
-				"cl-defstruct") t))
+			      '(;; Elisp
+                                "defgroup" "deftheme"
+                                "define-widget" "define-error"
+				"defface" "cl-deftype" "cl-defstruct"
+                                ;; CL
+                                "deftype" "defstruct"
+				"define-condition" "defpackage"
+                                ;; CLOS and EIEIO
+                                "defclass")
+                              t))
 			   "\\s-+'?\\(\\(\\sw\\|\\s_\\)+\\)"))
 	 2))
 
@@ -197,9 +203,9 @@ It has `lisp-mode-abbrev-table' as its parent."
               (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local"
                           "defface"))
               (el-tdefs '("defgroup" "deftheme"))
-              (el-kw '("while-no-input" "letrec" "pcase" "pcase-let"
-                       "pcase-let*" "save-restriction" "save-excursion"
-                       "save-selected-window"
+              (el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
+                       "pcase-let" "pcase-let*" "save-restriction"
+                       "save-excursion" "save-selected-window"
                        ;; "eval-after-load" "eval-next-after-load"
                        "save-window-excursion" "save-current-buffer"
                        "save-match-data" "combine-after-change-calls"
@@ -227,7 +233,7 @@ It has `lisp-mode-abbrev-table' as its parent."
                            "etypecase" "ccase" "ctypecase" "loop" "do" "do*"
                            "the" "locally" "proclaim" "declaim" "letf" "go"
                            ;; "lexical-let" "lexical-let*"
-                           "symbol-macrolet" "flet" "destructuring-bind"
+                           "symbol-macrolet" "flet" "flet*" "destructuring-bind"
                            "labels" "macrolet" "tagbody" "multiple-value-bind"
                            "block" "return" "return-from"))
               (cl-lib-errs '("assert" "check-type"))
@@ -558,166 +564,6 @@ font-lock keywords will not be case sensitive."
     map)
   "Keymap for commands shared by all sorts of Lisp modes.")
 
-(defvar emacs-lisp-mode-map
-  (let ((map (make-sparse-keymap "Emacs-Lisp"))
-	(menu-map (make-sparse-keymap "Emacs-Lisp"))
-	(lint-map (make-sparse-keymap))
-	(prof-map (make-sparse-keymap))
-	(tracing-map (make-sparse-keymap)))
-    (set-keymap-parent map lisp-mode-shared-map)
-    (define-key map "\e\t" 'completion-at-point)
-    (define-key map "\e\C-x" 'eval-defun)
-    (define-key map "\e\C-q" 'indent-pp-sexp)
-    (bindings--define-key map [menu-bar emacs-lisp]
-      (cons "Emacs-Lisp" menu-map))
-    (bindings--define-key menu-map [eldoc]
-      '(menu-item "Auto-Display Documentation Strings" eldoc-mode
-		  :button (:toggle . (bound-and-true-p eldoc-mode))
-		  :help "Display the documentation string for the item under cursor"))
-    (bindings--define-key menu-map [checkdoc]
-      '(menu-item "Check Documentation Strings" checkdoc
-		  :help "Check documentation strings for style requirements"))
-    (bindings--define-key menu-map [re-builder]
-      '(menu-item "Construct Regexp" re-builder
-		  :help "Construct a regexp interactively"))
-    (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map))
-    (bindings--define-key tracing-map [tr-a]
-      '(menu-item "Untrace All" untrace-all
-		  :help "Untrace all currently traced functions"))
-    (bindings--define-key tracing-map [tr-uf]
-      '(menu-item "Untrace Function..." untrace-function
-		  :help "Untrace function, and possibly activate all remaining advice"))
-    (bindings--define-key tracing-map [tr-sep] menu-bar-separator)
-    (bindings--define-key tracing-map [tr-q]
-      '(menu-item "Trace Function Quietly..." trace-function-background
-		  :help "Trace the function with trace output going quietly to a buffer"))
-    (bindings--define-key tracing-map [tr-f]
-      '(menu-item "Trace Function..." trace-function
-		  :help "Trace the function given as an argument"))
-    (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map))
-    (bindings--define-key prof-map [prof-restall]
-      '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
-		  :help "Restore the original definitions of all functions being profiled"))
-    (bindings--define-key prof-map [prof-restfunc]
-      '(menu-item "Remove Instrumentation for Function..." elp-restore-function
-		  :help "Restore an instrumented function to its original definition"))
-
-    (bindings--define-key prof-map [sep-rem] menu-bar-separator)
-    (bindings--define-key prof-map [prof-resall]
-      '(menu-item "Reset Counters for All Functions" elp-reset-all
-		  :help "Reset the profiling information for all functions being profiled"))
-    (bindings--define-key prof-map [prof-resfunc]
-      '(menu-item "Reset Counters for Function..." elp-reset-function
-		  :help "Reset the profiling information for a function"))
-    (bindings--define-key prof-map [prof-res]
-      '(menu-item "Show Profiling Results" elp-results
-		  :help "Display current profiling results"))
-    (bindings--define-key prof-map [prof-pack]
-      '(menu-item "Instrument Package..." elp-instrument-package
-		  :help "Instrument for profiling all function that start with a prefix"))
-    (bindings--define-key prof-map [prof-func]
-      '(menu-item "Instrument Function..." elp-instrument-function
-		  :help "Instrument a function for profiling"))
-    ;; Maybe this should be in a separate submenu from the ELP stuff?
-    (bindings--define-key prof-map [sep-natprof] menu-bar-separator)
-    (bindings--define-key prof-map [prof-natprof-stop]
-      '(menu-item "Stop Native Profiler" profiler-stop
-		  :help "Stop recording profiling information"
-		  :enable (and (featurep 'profiler)
-			       (profiler-running-p))))
-    (bindings--define-key prof-map [prof-natprof-report]
-      '(menu-item "Show Profiler Report" profiler-report
-		  :help "Show the current profiler report"
-		  :enable (and (featurep 'profiler)
-			       (profiler-running-p))))
-    (bindings--define-key prof-map [prof-natprof-start]
-      '(menu-item "Start Native Profiler..." profiler-start
-		  :help "Start recording profiling information"))
-
-    (bindings--define-key menu-map [lint] (cons "Linting" lint-map))
-    (bindings--define-key lint-map [lint-di]
-      '(menu-item "Lint Directory..." elint-directory
-		  :help "Lint a directory"))
-    (bindings--define-key lint-map [lint-f]
-      '(menu-item "Lint File..." elint-file
-		  :help "Lint a file"))
-    (bindings--define-key lint-map [lint-b]
-      '(menu-item "Lint Buffer" elint-current-buffer
-		  :help "Lint the current buffer"))
-    (bindings--define-key lint-map [lint-d]
-      '(menu-item "Lint Defun" elint-defun
-		  :help "Lint the function at point"))
-    (bindings--define-key menu-map [edebug-defun]
-      '(menu-item "Instrument Function for Debugging" edebug-defun
-		  :help "Evaluate the top level form point is in, stepping through with Edebug"
-		  :keys "C-u C-M-x"))
-    (bindings--define-key menu-map [separator-byte] menu-bar-separator)
-    (bindings--define-key menu-map [disas]
-      '(menu-item "Disassemble Byte Compiled Object..." disassemble
-		  :help "Print disassembled code for OBJECT in a buffer"))
-    (bindings--define-key menu-map [byte-recompile]
-      '(menu-item "Byte-recompile Directory..." byte-recompile-directory
-		  :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
-    (bindings--define-key menu-map [emacs-byte-compile-and-load]
-      '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load
-		  :help "Byte-compile the current file (if it has changed), then load compiled code"))
-    (bindings--define-key menu-map [byte-compile]
-      '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
-		  :help "Byte compile the file containing the current buffer"))
-    (bindings--define-key menu-map [separator-eval] menu-bar-separator)
-    (bindings--define-key menu-map [ielm]
-      '(menu-item "Interactive Expression Evaluation" ielm
-		  :help "Interactively evaluate Emacs Lisp expressions"))
-    (bindings--define-key menu-map [eval-buffer]
-      '(menu-item "Evaluate Buffer" eval-buffer
-		  :help "Execute the current buffer as Lisp code"))
-    (bindings--define-key menu-map [eval-region]
-      '(menu-item "Evaluate Region" eval-region
-		  :help "Execute the region as Lisp code"
-		  :enable mark-active))
-    (bindings--define-key menu-map [eval-sexp]
-      '(menu-item "Evaluate Last S-expression" eval-last-sexp
-		  :help "Evaluate sexp before point; print value in echo area"))
-    (bindings--define-key menu-map [separator-format] menu-bar-separator)
-    (bindings--define-key menu-map [comment-region]
-      '(menu-item "Comment Out Region" comment-region
-		  :help "Comment or uncomment each line in the region"
-		  :enable mark-active))
-    (bindings--define-key menu-map [indent-region]
-      '(menu-item "Indent Region" indent-region
-		  :help "Indent each nonblank line in the region"
-		  :enable mark-active))
-    (bindings--define-key menu-map [indent-line]
-      '(menu-item "Indent Line" lisp-indent-line))
-    map)
-  "Keymap for Emacs Lisp mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
-
-(defun emacs-lisp-byte-compile ()
-  "Byte compile the file containing the current buffer."
-  (interactive)
-  (if buffer-file-name
-      (byte-compile-file buffer-file-name)
-    (error "The buffer must be saved in a file first")))
-
-(defun emacs-lisp-byte-compile-and-load ()
-  "Byte-compile the current file (if it has changed), then load compiled code."
-  (interactive)
-  (or buffer-file-name
-      (error "The buffer must be saved in a file first"))
-  (require 'bytecomp)
-  ;; Recompile if file or buffer has changed since last compilation.
-  (if (and (buffer-modified-p)
-	   (y-or-n-p (format "Save buffer %s first? " (buffer-name))))
-      (save-buffer))
-  (byte-recompile-file buffer-file-name nil 0 t))
-
-(defcustom emacs-lisp-mode-hook nil
-  "Hook run when entering Emacs Lisp mode."
-  :options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
-  :type 'hook
-  :group 'lisp)
-
 (defcustom lisp-mode-hook nil
   "Hook run when entering Lisp mode."
   :options '(imenu-add-menubar-index)
@@ -733,72 +579,6 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
 (defconst lisp--prettify-symbols-alist
   '(("lambda"  . ?λ)))
 
-(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
-  "Major mode for editing Lisp code to run in Emacs.
-Commands:
-Delete converts tabs to spaces as it moves back.
-Blank lines separate paragraphs.  Semicolons start comments.
-
-\\{emacs-lisp-mode-map}"
-  :group 'lisp
-  (lisp-mode-variables nil nil 'elisp)
-  (setq imenu-case-fold-search nil)
-  (add-hook 'completion-at-point-functions
-            'lisp-completion-at-point nil 'local))
-
-;;; Emacs Lisp Byte-Code mode
-
-(eval-and-compile
-  (defconst emacs-list-byte-code-comment-re
-    (concat "\\(#\\)@\\([0-9]+\\) "
-            ;; Make sure it's a docstring and not a lazy-loaded byte-code.
-            "\\(?:[^(]\\|([^\"]\\)")))
-
-(defun emacs-lisp-byte-code-comment (end &optional _point)
-  "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
-  (let ((ppss (syntax-ppss)))
-    (when (and (nth 4 ppss)
-               (eq (char-after (nth 8 ppss)) ?#))
-      (let* ((n (save-excursion
-                  (goto-char (nth 8 ppss))
-                  (when (looking-at emacs-list-byte-code-comment-re)
-                    (string-to-number (match-string 2)))))
-             ;; `maxdiff' tries to make sure the loop below terminates.
-             (maxdiff n))
-        (when n
-          (let* ((bchar (match-end 2))
-                 (b (position-bytes bchar)))
-            (goto-char (+ b n))
-            (while (let ((diff (- (position-bytes (point)) b n)))
-                     (unless (zerop diff)
-                       (when (> diff maxdiff) (setq diff maxdiff))
-                       (forward-char (- diff))
-                       (setq maxdiff (if (> diff 0) diff
-                                       (max (1- maxdiff) 1)))
-                       t))))
-          (if (<= (point) end)
-              (put-text-property (1- (point)) (point)
-                                 'syntax-table
-                                 (string-to-syntax "> b"))
-            (goto-char end)))))))
-
-(defun emacs-lisp-byte-code-syntax-propertize (start end)
-  (emacs-lisp-byte-code-comment end (point))
-  (funcall
-   (syntax-propertize-rules
-    (emacs-list-byte-code-comment-re
-     (1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point))))))
-   start end))
-
-(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode))
-(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode
-  "Elisp-Byte-Code"
-  "Major mode for *.elc files."
-  ;; TODO: Add way to disassemble byte-code under point.
-  (setq-local open-paren-in-column-0-is-defun-start nil)
-  (setq-local syntax-propertize-function
-              #'emacs-lisp-byte-code-syntax-propertize))
-
 ;;; Generic Lisp mode.
 
 (defvar lisp-mode-map
@@ -852,415 +632,6 @@ or to switch back to an existing one."
   (interactive)
   (error "Process lisp does not exist"))
 
-(defvar lisp-interaction-mode-map
-  (let ((map (make-sparse-keymap))
-	(menu-map (make-sparse-keymap "Lisp-Interaction")))
-    (set-keymap-parent map lisp-mode-shared-map)
-    (define-key map "\e\C-x" 'eval-defun)
-    (define-key map "\e\C-q" 'indent-pp-sexp)
-    (define-key map "\e\t" 'completion-at-point)
-    (define-key map "\n" 'eval-print-last-sexp)
-    (bindings--define-key map [menu-bar lisp-interaction]
-      (cons "Lisp-Interaction" menu-map))
-    (bindings--define-key menu-map [eval-defun]
-      '(menu-item "Evaluate Defun" eval-defun
-		  :help "Evaluate the top-level form containing point, or after point"))
-    (bindings--define-key menu-map [eval-print-last-sexp]
-      '(menu-item "Evaluate and Print" eval-print-last-sexp
-		  :help "Evaluate sexp before point; print value into current buffer"))
-    (bindings--define-key menu-map [edebug-defun-lisp-interaction]
-      '(menu-item "Instrument Function for Debugging" edebug-defun
-		  :help "Evaluate the top level form point is in, stepping through with Edebug"
-		  :keys "C-u C-M-x"))
-    (bindings--define-key menu-map [indent-pp-sexp]
-      '(menu-item "Indent or Pretty-Print" indent-pp-sexp
-		  :help "Indent each line of the list starting just after point, or prettyprint it"))
-    (bindings--define-key menu-map [complete-symbol]
-      '(menu-item "Complete Lisp Symbol" completion-at-point
-		  :help "Perform completion on Lisp symbol preceding point"))
-    map)
-  "Keymap for Lisp Interaction mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
-
-(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
-  "Major mode for typing and evaluating Lisp forms.
-Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
-before point, and prints its value into the buffer, advancing point.
-Note that printing is controlled by `eval-expression-print-length'
-and `eval-expression-print-level'.
-
-Commands:
-Delete converts tabs to spaces as it moves back.
-Paragraphs are separated only by blank lines.
-Semicolons start comments.
-
-\\{lisp-interaction-mode-map}"
-  :abbrev-table nil)
-
-(defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal)
-  "Evaluate sexp before point; print value into current buffer.
-
-Normally, this function truncates long output according to the value
-of the variables `eval-expression-print-length' and
-`eval-expression-print-level'.  With a prefix argument of zero,
-however, there is no such truncation.  Such a prefix argument
-also causes integers to be printed in several additional formats
-\(octal, hexadecimal, and character).
-
-If `eval-expression-debug-on-error' is non-nil, which is the default,
-this command arranges for all errors to enter the debugger."
-  (interactive "P")
-  (let ((standard-output (current-buffer)))
-    (terpri)
-    (eval-last-sexp (or eval-last-sexp-arg-internal t))
-    (terpri)))
-
-
-(defun last-sexp-setup-props (beg end value alt1 alt2)
-  "Set up text properties for the output of `eval-last-sexp-1'.
-BEG and END are the start and end of the output in current-buffer.
-VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
-alternative printed representations that can be displayed."
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\C-m" 'last-sexp-toggle-display)
-    (define-key map [down-mouse-2] 'mouse-set-point)
-    (define-key map [mouse-2] 'last-sexp-toggle-display)
-    (add-text-properties
-     beg end
-     `(printed-value (,value ,alt1 ,alt2)
-		     mouse-face highlight
-		     keymap ,map
-		     help-echo "RET, mouse-2: toggle abbreviated display"
-		     rear-nonsticky (mouse-face keymap help-echo
-						printed-value)))))
-
-
-(defun last-sexp-toggle-display (&optional _arg)
-  "Toggle between abbreviated and unabbreviated printed representations."
-  (interactive "P")
-  (save-restriction
-    (widen)
-    (let ((value (get-text-property (point) 'printed-value)))
-      (when value
-	(let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
-							'printed-value)
-		       (point)))
-	      (end (or (next-single-char-property-change (point) 'printed-value) (point)))
-	      (standard-output (current-buffer))
-	      (point (point)))
-	  (delete-region beg end)
-	  (insert (nth 1 value))
-	  (or (= beg point)
-	      (setq point (1- (point))))
-	  (last-sexp-setup-props beg (point)
-				 (nth 0 value)
-				 (nth 2 value)
-				 (nth 1 value))
-	  (goto-char (min (point-max) point)))))))
-
-(defun prin1-char (char)
-  "Return a string representing CHAR as a character rather than as an integer.
-If CHAR is not a character, return nil."
-  (and (integerp char)
-       (eventp char)
-       (let ((c (event-basic-type char))
-	     (mods (event-modifiers char))
-	     string)
-	 ;; Prevent ?A from turning into ?\S-a.
-	 (if (and (memq 'shift mods)
-		  (zerop (logand char ?\S-\^@))
-		  (not (let ((case-fold-search nil))
-			 (char-equal c (upcase c)))))
-	     (setq c (upcase c) mods nil))
-	 ;; What string are we considering using?
-	 (condition-case nil
-	     (setq string
-		   (concat
-		    "?"
-		    (mapconcat
-		     (lambda (modif)
-		       (cond ((eq modif 'super) "\\s-")
-			     (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
-		     mods "")
-		    (cond
-		     ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
-		     ((eq c 127) "\\C-?")
-		     (t
-		      (string c)))))
-	   (error nil))
-	 ;; Verify the string reads a CHAR, not to some other character.
-	 ;; If it doesn't, return nil instead.
-	 (and string
-	      (= (car (read-from-string string)) char)
-	      string))))
-
-
-(defun preceding-sexp ()
-  "Return sexp before the point."
-  (let ((opoint (point))
-	ignore-quotes
-	expr)
-    (save-excursion
-      (with-syntax-table emacs-lisp-mode-syntax-table
-	;; If this sexp appears to be enclosed in `...'
-	;; then ignore the surrounding quotes.
-	(setq ignore-quotes
-	      (or (eq (following-char) ?\')
-		  (eq (preceding-char) ?\')))
-	(forward-sexp -1)
-	;; If we were after `?\e' (or similar case),
-	;; use the whole thing, not just the `e'.
-	(when (eq (preceding-char) ?\\)
-	  (forward-char -1)
-	  (when (eq (preceding-char) ??)
-	    (forward-char -1)))
-
-	;; Skip over hash table read syntax.
-	(and (> (point) (1+ (point-min)))
-	     (looking-back "#s" (- (point) 2))
-	     (forward-char -2))
-
-	;; Skip over `#N='s.
-	(when (eq (preceding-char) ?=)
-	  (let (labeled-p)
-	    (save-excursion
-	      (skip-chars-backward "0-9#=")
-	      (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
-	    (when labeled-p
-	      (forward-sexp -1))))
-
-	(save-restriction
-	  (if (and ignore-quotes (eq (following-char) ?`))
-              ;; vladimir@cs.ualberta.ca 30-Jul-1997: Skip ` in `variable' so
-              ;; that the value is returned, not the name.
-	      (forward-char))
-          (when (looking-at ",@?") (goto-char (match-end 0)))
-	  (narrow-to-region (point-min) opoint)
-	  (setq expr (read (current-buffer)))
-          ;; If it's an (interactive ...) form, it's more useful to show how an
-          ;; interactive call would use it.
-          ;; FIXME: Is it really the right place for this?
-          (when (eq (car-safe expr) 'interactive)
-	       (setq expr
-                  `(call-interactively
-                    (lambda (&rest args) ,expr args))))
-	  expr)))))
-
-
-(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
-  "Evaluate sexp before point; print value in the echo area.
-With argument, print output into current buffer.
-With a zero prefix arg, print output with no limit on the length
-and level of lists, and include additional formats for integers
-\(octal, hexadecimal, and character)."
-  (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
-    ;; Setup the lexical environment if lexical-binding is enabled.
-    (eval-last-sexp-print-value
-     (eval (eval-sexp-add-defvars (preceding-sexp)) lexical-binding)
-     eval-last-sexp-arg-internal)))
-
-
-(defun eval-last-sexp-print-value (value &optional eval-last-sexp-arg-internal)
-  (let ((unabbreviated (let ((print-length nil) (print-level nil))
-			 (prin1-to-string value)))
-	(print-length (and (not (zerop (prefix-numeric-value
-					eval-last-sexp-arg-internal)))
-			   eval-expression-print-length))
-	(print-level (and (not (zerop (prefix-numeric-value
-				       eval-last-sexp-arg-internal)))
-			  eval-expression-print-level))
-	(beg (point))
-	end)
-    (prog1
-	(prin1 value)
-      (let ((str (eval-expression-print-format value)))
-	(if str (princ str)))
-      (setq end (point))
-      (when (and (bufferp standard-output)
-		 (or (not (null print-length))
-		     (not (null print-level)))
-		 (not (string= unabbreviated
-			       (buffer-substring-no-properties beg end))))
-	(last-sexp-setup-props beg end value
-			       unabbreviated
-			       (buffer-substring-no-properties beg end))
-	))))
-
-
-(defvar eval-last-sexp-fake-value (make-symbol "t"))
-
-(defun eval-sexp-add-defvars (exp &optional pos)
-  "Prepend EXP with all the `defvar's that precede it in the buffer.
-POS specifies the starting position where EXP was found and defaults to point."
-  (setq exp (macroexpand-all exp))      ;Eager macro-expansion.
-  (if (not lexical-binding)
-      exp
-    (save-excursion
-      (unless pos (setq pos (point)))
-      (let ((vars ()))
-        (goto-char (point-min))
-        (while (re-search-forward
-                "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
-                pos t)
-          (let ((var (intern (match-string 1))))
-            (and (not (special-variable-p var))
-                 (save-excursion
-                   (zerop (car (syntax-ppss (match-beginning 0)))))
-              (push var vars))))
-        `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
-
-(defun eval-last-sexp (eval-last-sexp-arg-internal)
-  "Evaluate sexp before point; print value in the echo area.
-Interactively, with prefix argument, print output into current buffer.
-
-Normally, this function truncates long output according to the value
-of the variables `eval-expression-print-length' and
-`eval-expression-print-level'.  With a prefix argument of zero,
-however, there is no such truncation.  Such a prefix argument
-also causes integers to be printed in several additional formats
-\(octal, hexadecimal, and character).
-
-If `eval-expression-debug-on-error' is non-nil, which is the default,
-this command arranges for all errors to enter the debugger."
-  (interactive "P")
-  (if (null eval-expression-debug-on-error)
-      (eval-last-sexp-1 eval-last-sexp-arg-internal)
-    (let ((value
-	   (let ((debug-on-error eval-last-sexp-fake-value))
-	     (cons (eval-last-sexp-1 eval-last-sexp-arg-internal)
-		   debug-on-error))))
-      (unless (eq (cdr value) eval-last-sexp-fake-value)
-	(setq debug-on-error (cdr value)))
-      (car value))))
-
-(defun eval-defun-1 (form)
-  "Treat some expressions specially.
-Reset the `defvar' and `defcustom' variables to the initial value.
-\(For `defcustom', use the :set function if there is one.)
-Reinitialize the face according to the `defface' specification."
-  ;; The code in edebug-defun should be consistent with this, but not
-  ;; the same, since this gets a macroexpanded form.
-  (cond ((not (listp form))
-	 form)
-	((and (eq (car form) 'defvar)
-	      (cdr-safe (cdr-safe form))
-	      (boundp (cadr form)))
-	 ;; Force variable to be re-set.
-	 `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
-		 (setq-default ,(nth 1 form) ,(nth 2 form))))
-	;; `defcustom' is now macroexpanded to
-	;; `custom-declare-variable' with a quoted value arg.
-	((and (eq (car form) 'custom-declare-variable)
-	      (default-boundp (eval (nth 1 form) lexical-binding)))
-	 ;; Force variable to be bound, using :set function if specified.
-	 (let ((setfunc (memq :set form)))
-	   (when setfunc
-	     (setq setfunc (car-safe (cdr-safe setfunc)))
-	     (or (functionp setfunc) (setq setfunc nil)))
-	   (funcall (or setfunc 'set-default)
-		    (eval (nth 1 form) lexical-binding)
-		    ;; The second arg is an expression that evaluates to
-		    ;; an expression.  The second evaluation is the one
-		    ;; normally performed not by normal execution but by
-		    ;; custom-initialize-set (for example), which does not
-		    ;; use lexical-binding.
-		    (eval (eval (nth 2 form) lexical-binding))))
-	 form)
-	;; `defface' is macroexpanded to `custom-declare-face'.
-	((eq (car form) 'custom-declare-face)
-	 ;; Reset the face.
-	 (let ((face-symbol (eval (nth 1 form) lexical-binding)))
-	   (setq face-new-frame-defaults
-		 (assq-delete-all face-symbol face-new-frame-defaults))
-	   (put face-symbol 'face-defface-spec nil)
-	   (put face-symbol 'face-override-spec nil))
-	 form)
-	((eq (car form) 'progn)
-	 (cons 'progn (mapcar 'eval-defun-1 (cdr form))))
-	(t form)))
-
-(defun eval-defun-2 ()
-  "Evaluate defun that point is in or before.
-The value is displayed in the echo area.
-If the current defun is actually a call to `defvar',
-then reset the variable using the initial value expression
-even if the variable already has some other value.
-\(Normally `defvar' does not change the variable's value
-if it already has a value.\)
-
-Return the result of evaluation."
-  ;; FIXME: the print-length/level bindings should only be applied while
-  ;; printing, not while evaluating.
-  (let ((debug-on-error eval-expression-debug-on-error)
-	(print-length eval-expression-print-length)
-	(print-level eval-expression-print-level))
-    (save-excursion
-      ;; Arrange for eval-region to "read" the (possibly) altered form.
-      ;; eval-region handles recording which file defines a function or
-      ;; variable.
-      (let ((standard-output t)
-            beg end form)
-        ;; Read the form from the buffer, and record where it ends.
-        (save-excursion
-          (end-of-defun)
-          (beginning-of-defun)
-          (setq beg (point))
-          (setq form (read (current-buffer)))
-          (setq end (point)))
-        ;; Alter the form if necessary.
-        (let ((form (eval-sexp-add-defvars
-                     (eval-defun-1 (macroexpand form)))))
-          (eval-region beg end standard-output
-                       (lambda (_ignore)
-                         ;; Skipping to the end of the specified region
-                         ;; will make eval-region return.
-                         (goto-char end)
-                         form))))))
-  (let ((str (eval-expression-print-format (car values))))
-    (if str (princ str)))
-  ;; The result of evaluation has been put onto VALUES.  So return it.
-  (car values))
-
-(defun eval-defun (edebug-it)
-  "Evaluate the top-level form containing point, or after point.
-
-If the current defun is actually a call to `defvar' or `defcustom',
-evaluating it this way resets the variable using its initial value
-expression (using the defcustom's :set function if there is one), even
-if the variable already has some other value.  \(Normally `defvar' and
-`defcustom' do not alter the value if there already is one.)  In an
-analogous way, evaluating a `defface' overrides any customizations of
-the face, so that it becomes defined exactly as the `defface' expression
-says.
-
-If `eval-expression-debug-on-error' is non-nil, which is the default,
-this command arranges for all errors to enter the debugger.
-
-With a prefix argument, instrument the code for Edebug.
-
-If acting on a `defun' for FUNCTION, and the function was
-instrumented, `Edebug: FUNCTION' is printed in the echo area.  If not
-instrumented, just FUNCTION is printed.
-
-If not acting on a `defun', the result of evaluation is displayed in
-the echo area.  This display is controlled by the variables
-`eval-expression-print-length' and `eval-expression-print-level',
-which see."
-  (interactive "P")
-  (cond (edebug-it
-	 (require 'edebug)
-	 (eval-defun (not edebug-all-defs)))
-	(t
-	 (if (null eval-expression-debug-on-error)
-	     (eval-defun-2)
-	   (let ((old-value (make-symbol "t")) new-value value)
-	     (let ((debug-on-error old-value))
-	       (setq value (eval-defun-2))
-	       (setq new-value debug-on-error))
-	     (unless (eq old-value new-value)
-	       (setq debug-on-error new-value))
-	     value)))))
-
 ;; May still be used by some external Lisp-mode variant.
 (define-obsolete-function-alias 'lisp-comment-indent
     'comment-indent-default "22.1")
@@ -1583,19 +954,21 @@ Lisp function does not specify a special indentation."
 ;; like defun if the first form is placed on the next line, otherwise
 ;; it is indented like any other form (i.e. forms line up under first).
 
-(put 'autoload 'lisp-indent-function 'defun)
+(put 'autoload 'lisp-indent-function 'defun) ;Elisp
 (put 'progn 'lisp-indent-function 0)
 (put 'prog1 'lisp-indent-function 1)
 (put 'prog2 'lisp-indent-function 2)
-(put 'save-excursion 'lisp-indent-function 0)
-(put 'save-restriction 'lisp-indent-function 0)
-(put 'save-current-buffer 'lisp-indent-function 0)
+(put 'save-excursion 'lisp-indent-function 0)      ;Elisp
+(put 'save-restriction 'lisp-indent-function 0)    ;Elisp
+(put 'save-current-buffer 'lisp-indent-function 0) ;Elisp
 (put 'let 'lisp-indent-function 1)
 (put 'let* 'lisp-indent-function 1)
 (put 'while 'lisp-indent-function 1)
 (put 'if 'lisp-indent-function 2)
 (put 'catch 'lisp-indent-function 1)
 (put 'condition-case 'lisp-indent-function 2)
+(put 'handler-case 'lisp-indent-function 1) ;CL
+(put 'handler-bind 'lisp-indent-function 1) ;CL
 (put 'unwind-protect 'lisp-indent-function 1)
 (put 'with-output-to-temp-buffer 'lisp-indent-function 1)
 
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 30fee64635c..31682d036bf 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -758,247 +758,4 @@ considered."
         (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
                               (plist-get plist :predicate))))))
 
-(defun lisp--local-variables-1 (vars sexp)
-  "Return the vars locally bound around the witness, or nil if not found."
-  (let (res)
-    (while
-        (unless
-            (setq res
-                  (pcase sexp
-                    (`(,(or `let `let*) ,bindings)
-                     (let ((vars vars))
-                       (when (eq 'let* (car sexp))
-                         (dolist (binding (cdr (reverse bindings)))
-                           (push (or (car-safe binding) binding) vars)))
-                       (lisp--local-variables-1
-                        vars (car (cdr-safe (car (last bindings)))))))
-                    (`(,(or `let `let*) ,bindings . ,body)
-                     (let ((vars vars))
-                       (dolist (binding bindings)
-                         (push (or (car-safe binding) binding) vars))
-                       (lisp--local-variables-1 vars (car (last body)))))
-                    (`(lambda ,_) (setq sexp nil))
-                    (`(lambda ,args . ,body)
-                     (lisp--local-variables-1
-                      (append args vars) (car (last body))))
-                    (`(condition-case ,_ ,e) (lisp--local-variables-1 vars e))
-                    (`(condition-case ,v ,_ . ,catches)
-                     (lisp--local-variables-1
-                      (cons v vars) (cdr (car (last catches)))))
-                    (`(,_ . ,_)
-                     (lisp--local-variables-1 vars (car (last sexp))))
-                    (`lisp--witness--lisp (or vars '(nil)))
-                    (_ nil)))
-          (setq sexp (ignore-errors (butlast sexp)))))
-    res))
-
-(defun lisp--local-variables ()
-  "Return a list of locally let-bound variables at point."
-  (save-excursion
-    (skip-syntax-backward "w_")
-    (let* ((ppss (syntax-ppss))
-           (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point))
-                                                (or (nth 8 ppss) (point))))
-           (closer ()))
-      (dolist (p (nth 9 ppss))
-        (push (cdr (syntax-after p)) closer))
-      (setq closer (apply #'string closer))
-      (let* ((sexp (condition-case nil
-                       (car (read-from-string
-                             (concat txt "lisp--witness--lisp" closer)))
-                     (end-of-file nil)))
-             (macroexpand-advice (lambda (expander form &rest args)
-                                   (condition-case nil
-                                       (apply expander form args)
-                                     (error form))))
-             (sexp
-              (unwind-protect
-                  (progn
-                    (advice-add 'macroexpand :around macroexpand-advice)
-                    (macroexpand-all sexp))
-                (advice-remove 'macroexpand macroexpand-advice)))
-             (vars (lisp--local-variables-1 nil sexp)))
-        (delq nil
-              (mapcar (lambda (var)
-                        (and (symbolp var)
-                             (not (string-match (symbol-name var) "\\`[&_]"))
-                             ;; Eliminate uninterned vars.
-                             (intern-soft var)
-                             var))
-                      vars))))))
-
-(defvar lisp--local-variables-completion-table
-  ;; Use `defvar' rather than `defconst' since defconst would purecopy this
-  ;; value, which would doubly fail: it would fail because purecopy can't
-  ;; handle the recursive bytecode object, and it would fail because it would
-  ;; move `lastpos' and `lastvars' to pure space where they'd be immutable!
-  (let ((lastpos nil) (lastvars nil))
-    (letrec ((hookfun (lambda ()
-                        (setq lastpos nil)
-                        (remove-hook 'post-command-hook hookfun))))
-      (completion-table-dynamic
-       (lambda (_string)
-         (save-excursion
-           (skip-syntax-backward "_w")
-           (let ((newpos (cons (point) (current-buffer))))
-             (unless (equal lastpos newpos)
-               (add-hook 'post-command-hook hookfun)
-               (setq lastpos newpos)
-               (setq lastvars
-                     (mapcar #'symbol-name (lisp--local-variables))))))
-         lastvars)))))
-
-;; FIXME: Support for Company brings in features which straddle eldoc.
-;; We should consolidate this, so that major modes can provide all that
-;; data all at once:
-;; - a function to extract "the reference at point" (may be more complex
-;;     than a mere string, to distinguish various namespaces).
-;; - a function to jump to such a reference.
-;; - a function to show the signature/interface of such a reference.
-;; - a function to build a help-buffer about that reference.
-;; FIXME: Those functions should also be used by the normal completion code in
-;; the *Completions* buffer.
-
-(defun lisp--company-doc-buffer (str)
-  (let ((symbol (intern-soft str)))
-    ;; FIXME: we really don't want to "display-buffer and then undo it".
-    (save-window-excursion
-      ;; Make sure we don't display it in another frame, otherwise
-      ;; save-window-excursion won't be able to undo it.
-      (let ((display-buffer-overriding-action
-             '(nil . ((inhibit-switch-frame . t)))))
-        (ignore-errors
-          (cond
-           ((fboundp symbol) (describe-function symbol))
-           ((boundp symbol) (describe-variable symbol))
-           ((featurep symbol) (describe-package symbol))
-           ((facep symbol) (describe-face symbol))
-           (t (signal 'user-error nil)))
-          (help-buffer))))))
-
-(defun lisp--company-doc-string (str)
-  (let* ((symbol (intern-soft str))
-         (doc (if (fboundp symbol)
-                  (documentation symbol t)
-                (documentation-property symbol 'variable-documentation t))))
-    (and (stringp doc)
-         (string-match ".*$" doc)
-         (match-string 0 doc))))
-
-(declare-function find-library-name "find-func" (library))
-
-(defun lisp--company-location (str)
-  (let ((sym (intern-soft str)))
-    (cond
-     ((fboundp sym) (find-definition-noselect sym nil))
-     ((boundp sym) (find-definition-noselect sym 'defvar))
-     ((featurep sym)
-      (require 'find-func)
-      (cons (find-file-noselect (find-library-name
-                                 (symbol-name sym)))
-            0))
-     ((facep sym) (find-definition-noselect sym 'defface)))))
-
-(defun lisp-completion-at-point (&optional _predicate)
-  "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
-  (with-syntax-table emacs-lisp-mode-syntax-table
-    (let* ((pos (point))
-	   (beg (condition-case nil
-		    (save-excursion
-		      (backward-sexp 1)
-		      (skip-syntax-forward "'")
-		      (point))
-		  (scan-error pos)))
-	   (end
-	    (unless (or (eq beg (point-max))
-			(member (char-syntax (char-after beg))
-                                '(?\s ?\" ?\( ?\))))
-	      (condition-case nil
-		  (save-excursion
-		    (goto-char beg)
-		    (forward-sexp 1)
-		    (when (>= (point) pos)
-		      (point)))
-		(scan-error pos))))
-           (funpos (eq (char-before beg) ?\()) ;t if in function position.
-           (table-etc
-            (if (not funpos)
-                ;; FIXME: We could look at the first element of the list and
-                ;; use it to provide a more specific completion table in some
-                ;; cases.  E.g. filter out keywords that are not understood by
-                ;; the macro/function being called.
-                (list nil (completion-table-merge
-                           lisp--local-variables-completion-table
-                           (apply-partially #'completion-table-with-predicate
-                                            obarray
-                                            ;; Don't include all symbols
-                                            ;; (bug#16646).
-                                            (lambda (sym)
-                                              (or (boundp sym)
-                                                  (fboundp sym)
-                                                  (symbol-plist sym)))
-                                            'strict))
-                      :annotation-function
-                      (lambda (str) (if (fboundp (intern-soft str)) " <f>"))
-                      :company-doc-buffer #'lisp--company-doc-buffer
-                      :company-docsig #'lisp--company-doc-string
-                      :company-location #'lisp--company-location)
-              ;; Looks like a funcall position.  Let's double check.
-              (save-excursion
-                (goto-char (1- beg))
-                (let ((parent
-                       (condition-case nil
-                           (progn (up-list -1) (forward-char 1)
-                                  (let ((c (char-after)))
-                                    (if (eq c ?\() ?\(
-                                      (if (memq (char-syntax c) '(?w ?_))
-                                          (read (current-buffer))))))
-                         (error nil))))
-                  (pcase parent
-                    ;; FIXME: Rather than hardcode special cases here,
-                    ;; we should use something like a symbol-property.
-                    (`declare
-                     (list t (mapcar (lambda (x) (symbol-name (car x)))
-                                     (delete-dups
-                                      ;; FIXME: We should include some
-                                      ;; docstring with each entry.
-                                      (append
-                                       macro-declarations-alist
-                                       defun-declarations-alist)))))
-                    ((and (or `condition-case `condition-case-unless-debug)
-                          (guard (save-excursion
-                                   (ignore-errors
-                                     (forward-sexp 2)
-                                     (< (point) beg)))))
-                     (list t obarray
-                           :predicate (lambda (sym) (get sym 'error-conditions))))
-		    ((and ?\(
-			  (guard (save-excursion
-				   (goto-char (1- beg))
-				   (up-list -1)
-				   (forward-symbol -1)
-				   (looking-at "\\_<let\\*?\\_>"))))
-		     (list t obarray
-			   :predicate #'boundp
-			   :company-doc-buffer #'lisp--company-doc-buffer
-			   :company-docsig #'lisp--company-doc-string
-			   :company-location #'lisp--company-location))
-                    (_ (list nil obarray
-                             :predicate #'fboundp
-                             :company-doc-buffer #'lisp--company-doc-buffer
-                             :company-docsig #'lisp--company-doc-string
-                             :company-location #'lisp--company-location
-                             ))))))))
-      (when end
-        (let ((tail (if (null (car table-etc))
-                        (cdr table-etc)
-                      (cons
-                       (if (memq (char-syntax (or (char-after end) ?\s))
-                                 '(?\s ?>))
-                           (cadr table-etc)
-                         (apply-partially 'completion-table-with-terminator
-                                          " " (cadr table-etc)))
-                       (cddr table-etc)))))
-          `(,beg ,end ,@tail))))))
-
 ;;; lisp.el ends here
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 4d7ed8f121c..10944f81534 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -289,7 +289,11 @@ contrast, `package-user-dir' contains packages for personal use."
   :group 'package
   :version "24.1")
 
-(defcustom package-check-signature 'allow-unsigned
+(defvar epg-gpg-program)
+
+(defcustom package-check-signature
+  (if (progn (require 'epg-config) (executable-find epg-gpg-program))
+      'allow-unsigned)
   "Non-nil means to check package signatures when installing.
 The value `allow-unsigned' means to still install a package even if
 it is unsigned.
@@ -689,11 +693,9 @@ untar into a directory named DIR; otherwise, signal an error."
 	    (error "Package does not untar cleanly into directory %s/" dir)))))
   (tar-untar-buffer))
 
-(defun package-generate-description-file (pkg-desc pkg-dir)
+(defun package-generate-description-file (pkg-desc pkg-file)
   "Create the foo-pkg.el file for single-file packages."
-  (let* ((name (package-desc-name pkg-desc))
-         (pkg-file (expand-file-name (package--description-file pkg-dir)
-                                     pkg-dir)))
+  (let* ((name (package-desc-name pkg-desc)))
     (let ((print-level nil)
           (print-quoted t)
           (print-length nil))
@@ -714,25 +716,20 @@ untar into a directory named DIR; otherwise, signal an error."
                            (list (car elt)
                                  (package-version-join (cadr elt))))
                          requires))))
-          (let ((alist (package-desc-extras pkg-desc))
-                flat)
-            (while alist
-              (let* ((pair (pop alist))
-                     (key (car pair))
-                     (val (cdr pair)))
-                ;; Don't bother ‘quote’ing ‘key’; it is always a keyword.
-                (push key flat)
-                (push (if (and (not (consp val))
-                               (or (keywordp val)
-                                   (not (symbolp val))
-                                   (memq val '(nil t))))
-                          val
-                        `',val)
-                      flat)))
-            (nreverse flat))))
+          (package--alist-to-plist-args
+           (package-desc-extras pkg-desc))))
         "\n")
        nil pkg-file nil 'silent))))
 
+(defun package--alist-to-plist-args (alist)
+  (mapcar (lambda (x)
+            (if (and (not (consp x))
+                     (or (keywordp x)
+                         (not (symbolp x))
+                         (memq x '(nil t))))
+                x `',x))
+          (apply #'nconc
+                 (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))))
 (defun package-unpack (pkg-desc)
   "Install the contents of the current buffer as a package."
   (let* ((name (package-desc-name pkg-desc))
@@ -764,9 +761,10 @@ untar into a directory named DIR; otherwise, signal an error."
 (defun package--make-autoloads-and-stuff (pkg-desc pkg-dir)
   "Generate autoloads, description file, etc.. for PKG-DESC installed at PKG-DIR."
   (package-generate-autoloads (package-desc-name pkg-desc) pkg-dir)
-  (let ((desc-file (package--description-file pkg-dir)))
+  (let ((desc-file (expand-file-name (package--description-file pkg-dir)
+                                     pkg-dir)))
     (unless (file-exists-p desc-file)
-      (package-generate-description-file pkg-desc pkg-dir)))
+      (package-generate-description-file pkg-desc desc-file)))
   ;; FIXME: Create foo.info and dir file from foo.texi?
   )
 
@@ -1303,7 +1301,8 @@ similar to an entry in `package-alist'.  Save the cached copy to
   (setq file (expand-file-name file))
   (let ((context (epg-make-context 'OpenPGP))
 	(homedir (expand-file-name "gnupg" package-user-dir)))
-    (make-directory homedir t)
+    (with-file-modes 448
+      (make-directory homedir t))
     (epg-context-set-home-directory context homedir)
     (message "Importing %s..." (file-name-nondirectory file))
     (epg-import-keys-from-file context file)
@@ -1320,12 +1319,12 @@ makes them available for download."
     (make-directory package-user-dir t))
   (let ((default-keyring (expand-file-name "package-keyring.gpg"
 					   data-directory)))
-    (if (file-exists-p default-keyring)
-	(condition-case-unless-debug error
-	    (progn
-	      (epg-check-configuration (epg-configuration))
-	      (package-import-keyring default-keyring))
-	  (error (message "Cannot import default keyring: %S" (cdr error))))))
+    (when (and package-check-signature (file-exists-p default-keyring))
+      (condition-case-unless-debug error
+	  (progn
+	    (epg-check-configuration (epg-configuration))
+	    (package-import-keyring default-keyring))
+	(error (message "Cannot import default keyring: %S" (cdr error))))))
   (dolist (archive package-archives)
     (condition-case-unless-debug nil
 	(package--download-one-archive archive "archive-contents")
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 2cdb7b4987e..753cd3005e6 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -68,6 +68,8 @@
 
 (defconst pcase--dontcare-upats '(t _ pcase--dontcare))
 
+(defvar pcase--dontwarn-upats '(pcase--dontcare))
+
 (def-edebug-spec
   pcase-UPAT
   (&or symbolp
@@ -100,26 +102,31 @@ UPatterns can take the following forms:
   SYMBOL	matches anything and binds it to SYMBOL.
   (or UPAT...)	matches if any of the patterns matches.
   (and UPAT...)	matches if all the patterns match.
+  'VAL		matches if the object is `equal' to VAL
   `QPAT		matches if the QPattern QPAT matches.
-  (pred PRED)	matches if PRED applied to the object returns non-nil.
+  (pred FUN)	matches if FUN applied to the object returns non-nil.
   (guard BOOLEXP)	matches if BOOLEXP evaluates to non-nil.
   (let UPAT EXP)	matches if EXP matches UPAT.
+  (app FUN UPAT)	matches if FUN applied to the object matches UPAT.
 If a SYMBOL is used twice in the same pattern (i.e. the pattern is
 \"non-linear\"), then the second occurrence is turned into an `eq'uality test.
 
 QPatterns can take the following forms:
-  (QPAT1 . QPAT2)	matches if QPAT1 matches the car and QPAT2 the cdr.
-  ,UPAT			matches if the UPattern UPAT matches.
-  STRING		matches if the object is `equal' to STRING.
-  ATOM			matches if the object is `eq' to ATOM.
-QPatterns for vectors are not implemented yet.
-
-PRED can take the form
-  FUNCTION	     in which case it gets called with one argument.
-  (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument
+  (QPAT1 . QPAT2)       matches if QPAT1 matches the car and QPAT2 the cdr.
+  [QPAT1 QPAT2..QPATn]  matches a vector of length n and QPAT1..QPATn match
+                           its 0..(n-1)th elements, respectively.
+  ,UPAT                 matches if the UPattern UPAT matches.
+  STRING                matches if the object is `equal' to STRING.
+  ATOM                  matches if the object is `eq' to ATOM.
+
+FUN can take the form
+  SYMBOL or (lambda ARGS BODY)  in which case it's called with one argument.
+  (F ARG1 .. ARGn) in which case F gets called with an n+1'th argument
                         which is the value being matched.
-A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION).
-PRED patterns can refer to variables bound earlier in the pattern.
+So a FUN of the form SYMBOL is equivalent to one of the form (FUN).
+FUN can refer to variables bound earlier in the pattern.
+FUN is assumed to be pure, i.e. it can be dropped if its result is not used,
+and two identical calls can be merged into one.
 E.g. you can match pairs where the cdr is larger than the car with a pattern
 like `(,a . ,(pred (< a))) or, with more checks:
 `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))"
@@ -147,6 +154,16 @@ like `(,a . ,(pred (< a))) or, with more checks:
         ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
         expansion))))
 
+;;;###autoload
+(defmacro pcase-exhaustive (exp &rest cases)
+  "The exhaustive version of `pcase' (which see)."
+  (declare (indent 1) (debug pcase))
+  (let* ((x (make-symbol "x"))
+         (pcase--dontwarn-upats (cons x pcase--dontwarn-upats)))
+    (pcase--expand
+     ;; FIXME: Could we add the FILE:LINE data in the error message?
+     exp (append cases `((,x (error "No clause matching `%S'" ,x)))))))
+
 (defun pcase--let* (bindings body)
   (cond
    ((null bindings) (macroexp-progn body))
@@ -265,7 +282,7 @@ of the form (UPAT EXP)."
            (main
             (pcase--u
              (mapcar (lambda (case)
-                       `((match ,val . ,(car case))
+                       `(,(pcase--match val (pcase--macroexpand (car case)))
                          ,(lambda (vars)
                             (unless (memq case used-cases)
                               ;; Keep track of the cases that are used.
@@ -279,10 +296,50 @@ of the form (UPAT EXP)."
                              vars))))
                      cases))))
       (dolist (case cases)
-        (unless (or (memq case used-cases) (eq (car case) 'pcase--dontcare))
+        (unless (or (memq case used-cases)
+                    (memq (car case) pcase--dontwarn-upats))
           (message "Redundant pcase pattern: %S" (car case))))
       (macroexp-let* defs main))))
 
+(defun pcase--macroexpand (pat)
+  "Expands all macro-patterns in PAT."
+  (let ((head (car-safe pat)))
+    (cond
+     ((null head)
+      (if (pcase--self-quoting-p pat) `',pat pat))
+     ((memq head '(pred guard quote)) pat)
+     ((memq head '(or and)) `(,head ,@(mapcar #'pcase--macroexpand (cdr pat))))
+     ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat)))
+     ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
+     (t
+      (let* ((expander (get head 'pcase-macroexpander))
+             (npat (if expander (apply expander (cdr pat)))))
+        (if (null npat)
+            (error (if expander
+                       "Unexpandable %s pattern: %S"
+                     "Unknown %s pattern: %S")
+                   head pat)
+          (pcase--macroexpand npat)))))))
+
+;;;###autoload
+(defmacro pcase-defmacro (name args &rest body)
+  "Define a pcase UPattern macro."
+  (declare (indent 2) (debug (def-name sexp def-body)) (doc-string 3))
+  `(put ',name 'pcase-macroexpander
+        (lambda ,args ,@body)))
+
+(defun pcase--match (val upat)
+  "Build a MATCH structure, hoisting all `or's and `and's outside."
+  (cond
+   ;; Hoist or/and patterns into or/and matches.
+   ((memq (car-safe upat) '(or and))
+    `(,(car upat)
+      ,@(mapcar (lambda (upat)
+                  (pcase--match val upat))
+                (cdr upat))))
+   (t
+    `(match ,val . ,upat))))
+
 (defun pcase-codegen (code vars)
   ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding
   ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy
@@ -306,11 +363,6 @@ of the form (UPAT EXP)."
    ((eq then :pcase--dontcare) (debug) else) ;Can/should this ever happen?
    (t (macroexp-if test then else))))
 
-(defun pcase--upat (qpattern)
-  (cond
-   ((eq (car-safe qpattern) '\,) (cadr qpattern))
-   (t (list '\` qpattern))))
-
 ;; Note about MATCH:
 ;; When we have patterns like `(PAT1 . PAT2), after performing the `consp'
 ;; check, we want to turn all the similar patterns into ones of the form
@@ -383,21 +435,12 @@ MATCH is the pattern that needs to be matched, of the form:
 
 (defun pcase--split-match (sym splitter match)
   (cond
-    ((eq (car match) 'match)
+    ((eq (car-safe match) 'match)
      (if (not (eq sym (cadr match)))
          (cons match match)
-       (let ((pat (cddr match)))
-         (cond
-          ;; Hoist `or' and `and' patterns to `or' and `and' matches.
-          ((memq (car-safe pat) '(or and))
-           (pcase--split-match sym splitter
-                               (cons (car pat)
-                                     (mapcar (lambda (alt)
-                                               `(match ,sym . ,alt))
-                                             (cdr pat)))))
-          (t (let ((res (funcall splitter (cddr match))))
-               (cons (or (car res) match) (or (cdr res) match))))))))
-    ((memq (car match) '(or and))
+       (let ((res (funcall splitter (cddr match))))
+         (cons (or (car res) match) (or (cdr res) match)))))
+    ((memq (car-safe match) '(or and))
      (let ((then-alts '())
            (else-alts '())
            (neutral-elem (if (eq 'or (car match))
@@ -417,6 +460,7 @@ MATCH is the pattern that needs to be matched, of the form:
                    ((null else-alts) neutral-elem)
                    ((null (cdr else-alts)) (car else-alts))
                    (t (cons (car match) (nreverse else-alts)))))))
+    ((memq match '(:pcase--succeed :pcase--fail)) (cons match match))
     (t (error "Uknown MATCH %s" match))))
 
 (defun pcase--split-rest (sym splitter rest)
@@ -433,27 +477,13 @@ MATCH is the pattern that needs to be matched, of the form:
           (push (cons (cdr split) code&vars) else-rest))))
     (cons (nreverse then-rest) (nreverse else-rest))))
 
-(defun pcase--split-consp (syma symd pat)
-  (cond
-   ;; A QPattern for a cons, can only go the `then' side.
-   ((and (eq (car-safe pat) '\`) (consp (cadr pat)))
-    (let ((qpat (cadr pat)))
-      (cons `(and (match ,syma . ,(pcase--upat (car qpat)))
-                  (match ,symd . ,(pcase--upat (cdr qpat))))
-            :pcase--fail)))
-   ;; A QPattern but not for a cons, can only go to the `else' side.
-   ((eq (car-safe pat) '\`) '(:pcase--fail . nil))
-   ((and (eq (car-safe pat) 'pred)
-         (pcase--mutually-exclusive-p #'consp (cadr pat)))
-    '(:pcase--fail . nil))))
-
 (defun pcase--split-equal (elem pat)
   (cond
    ;; The same match will give the same result.
-   ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem))
+   ((and (eq (car-safe pat) 'quote) (equal (cadr pat) elem))
     '(:pcase--succeed . :pcase--fail))
    ;; A different match will fail if this one succeeds.
-   ((and (eq (car-safe pat) '\`)
+   ((and (eq (car-safe pat) 'quote)
          ;; (or (integerp (cadr pat)) (symbolp (cadr pat))
          ;;     (consp (cadr pat)))
          )
@@ -467,6 +497,7 @@ MATCH is the pattern that needs to be matched, of the form:
 	'(:pcase--fail . nil))))))
 
 (defun pcase--split-member (elems pat)
+  ;; FIXME: The new pred-based member code doesn't do these optimizations!
   ;; Based on pcase--split-equal.
   (cond
    ;; The same match (or a match of membership in a superset) will
@@ -474,10 +505,10 @@ MATCH is the pattern that needs to be matched, of the form:
    ;; (???
    ;;  '(:pcase--succeed . nil))
    ;; A match for one of the elements may succeed or fail.
-   ((and (eq (car-safe pat) '\`) (member (cadr pat) elems))
+   ((and (eq (car-safe pat) 'quote) (member (cadr pat) elems))
     nil)
    ;; A different match will fail if this one succeeds.
-   ((and (eq (car-safe pat) '\`)
+   ((and (eq (car-safe pat) 'quote)
          ;; (or (integerp (cadr pat)) (symbolp (cadr pat))
          ;;     (consp (cadr pat)))
          )
@@ -508,7 +539,7 @@ MATCH is the pattern that needs to be matched, of the form:
      ((and (eq 'pred (car upat))
            (let ((otherpred
                   (cond ((eq 'pred (car-safe pat)) (cadr pat))
-                        ((not (eq '\` (car-safe pat))) nil)
+                        ((not (eq 'quote (car-safe pat))) nil)
                         ((consp (cadr pat)) #'consp)
                         ((vectorp (cadr pat)) #'vectorp)
                         ((byte-code-function-p (cadr pat))
@@ -516,7 +547,7 @@ MATCH is the pattern that needs to be matched, of the form:
              (pcase--mutually-exclusive-p (cadr upat) otherpred)))
       '(:pcase--fail . nil))
      ((and (eq 'pred (car upat))
-           (eq '\` (car-safe pat))
+           (eq 'quote (car-safe pat))
            (symbolp (cadr upat))
            (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
            (get (cadr upat) 'side-effect-free)
@@ -538,10 +569,71 @@ MATCH is the pattern that needs to be matched, of the form:
 (defun pcase--self-quoting-p (upat)
   (or (keywordp upat) (numberp upat) (stringp upat)))
 
+(defun pcase--app-subst-match (match sym fun nsym)
+  (cond
+   ((eq (car-safe match) 'match)
+    (if (and (eq sym (cadr match))
+             (eq 'app (car-safe (cddr match)))
+             (equal fun (nth 1 (cddr match))))
+        (pcase--match nsym (nth 2 (cddr match)))
+      match))
+   ((memq (car-safe match) '(or and))
+    `(,(car match)
+      ,@(mapcar (lambda (match)
+                  (pcase--app-subst-match match sym fun nsym))
+                (cdr match))))
+   ((memq match '(:pcase--succeed :pcase--fail)) match)
+   (t (error "Uknown MATCH %s" match))))
+
+(defun pcase--app-subst-rest (rest sym fun nsym)
+  (mapcar (lambda (branch)
+            `(,(pcase--app-subst-match (car branch) sym fun nsym)
+              ,@(cdr branch)))
+          rest))
+
 (defsubst pcase--mark-used (sym)
   ;; Exceptionally, `sym' may be a constant expression rather than a symbol.
   (if (symbolp sym) (put sym 'pcase-used t)))
 
+(defmacro pcase--flip (fun arg1 arg2)
+  "Helper function, used internally to avoid (funcall (lambda ...) ...)."
+  (declare (debug (sexp body)))
+  `(,fun ,arg2 ,arg1))
+
+(defun pcase--funcall (fun arg vars)
+  "Build a function call to FUN with arg ARG."
+  (if (symbolp fun)
+      `(,fun ,arg)
+    (let* (;; `vs' is an upper bound on the vars we need.
+           (vs (pcase--fgrep (mapcar #'car vars) fun))
+           (env (mapcar (lambda (var)
+                          (list var (cdr (assq var vars))))
+                        vs))
+           (call (progn
+                   (when (memq arg vs)
+                     ;; `arg' is shadowed by `env'.
+                     (let ((newsym (make-symbol "x")))
+                       (push (list newsym arg) env)
+                       (setq arg newsym)))
+                   (if (functionp fun)
+                       `(funcall #',fun ,arg)
+                     `(,@fun ,arg)))))
+      (if (null vs)
+          call
+        ;; Let's not replace `vars' in `fun' since it's
+        ;; too difficult to do it right, instead just
+        ;; let-bind `vars' around `fun'.
+        `(let* ,env ,call)))))
+
+(defun pcase--eval (exp vars)
+  "Build an expression that will evaluate EXP."
+  (let* ((found (assq exp vars)))
+    (if found (cdr found)
+      (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
+             (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
+                          vs)))
+        (if env (macroexp-let* env exp) exp)))))
+
 ;; It's very tempting to use `pcase' below, tho obviously, it'd create
 ;; bootstrapping problems.
 (defun pcase--u1 (matches code vars rest)
@@ -563,22 +655,26 @@ Otherwise, it defers to REST which is a list of branches of the form
    ((eq 'or (caar matches))
     (let* ((alts (cdar matches))
            (var (if (eq (caar alts) 'match) (cadr (car alts))))
-           (simples '()) (others '()))
+           (simples '()) (others '()) (memq-ok t))
       (when var
         (dolist (alt alts)
           (if (and (eq (car alt) 'match) (eq var (cadr alt))
                    (let ((upat (cddr alt)))
-                     (and (eq (car-safe upat) '\`)
-                          (or (integerp (cadr upat)) (symbolp (cadr upat))
-                              (stringp (cadr upat))))))
-              (push (cddr alt) simples)
+                     (eq (car-safe upat) 'quote)))
+              (let ((val (cadr (cddr alt))))
+                (unless (or (integerp val) (symbolp val))
+                  (setq memq-ok nil))
+                (push (cadr (cddr alt)) simples))
             (push alt others))))
       (cond
        ((null alts) (error "Please avoid it") (pcase--u rest))
+       ;; Yes, we can use `memq' (or `member')!
        ((> (length simples) 1)
-        ;; De-hoist the `or' MATCH into an `or' pattern that will be
-        ;; turned into a `memq' below.
-        (pcase--u1 (cons `(match ,var or . ,(nreverse simples)) (cdr matches))
+        (pcase--u1 (cons `(match ,var
+                                 . (pred (pcase--flip
+                                          ,(if memq-ok #'memq #'member)
+                                          ',simples)))
+                         (cdr matches))
                    code vars
                    (if (null others) rest
                      (cons (cons
@@ -612,35 +708,11 @@ Otherwise, it defers to REST which is a list of branches of the form
                  sym (lambda (pat) (pcase--split-pred vars upat pat)) rest))
                (then-rest (car splitrest))
                (else-rest (cdr splitrest)))
-          (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat)))
-                         `(,(cadr upat) ,sym)
-                       (let* ((exp (cadr upat))
-                              ;; `vs' is an upper bound on the vars we need.
-                              (vs (pcase--fgrep (mapcar #'car vars) exp))
-                              (env (mapcar (lambda (var)
-                                             (list var (cdr (assq var vars))))
-                                           vs))
-                              (call (if (eq 'guard (car upat))
-                                        exp
-                                      (when (memq sym vs)
-                                        ;; `sym' is shadowed by `env'.
-                                        (let ((newsym (make-symbol "x")))
-                                          (push (list newsym sym) env)
-                                          (setq sym newsym)))
-                                      (if (functionp exp)
-                                          `(funcall #',exp ,sym)
-                                        `(,@exp ,sym)))))
-                         (if (null vs)
-                             call
-                           ;; Let's not replace `vars' in `exp' since it's
-                           ;; too difficult to do it right, instead just
-                           ;; let-bind `vars' around `exp'.
-                           `(let* ,env ,call))))
+          (pcase--if (if (eq (car upat) 'pred)
+                         (pcase--funcall (cadr upat) sym vars)
+                       (pcase--eval (cadr upat) vars))
                      (pcase--u1 matches code vars then-rest)
                      (pcase--u else-rest))))
-       ((pcase--self-quoting-p upat)
-        (pcase--mark-used sym)
-        (pcase--q1 sym upat matches code vars rest))
        ((symbolp upat)
         (pcase--mark-used sym)
         (if (not (assq upat vars))
@@ -655,57 +727,41 @@ Otherwise, it defers to REST which is a list of branches of the form
         ;;            (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest)
         (macroexp-let2
             macroexp-copyable-p sym
-            (let* ((exp (nth 2 upat))
-                   (found (assq exp vars)))
-              (if found (cdr found)
-                (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
-                       (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
-                                    vs)))
-                  (if env (macroexp-let* env exp) exp))))
-          (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
+            (pcase--eval (nth 2 upat) vars)
+          (pcase--u1 (cons (pcase--match sym (nth 1 upat)) matches)
                      code vars rest)))
-       ((eq (car-safe upat) '\`)
+       ((eq (car-safe upat) 'app)
+        ;; A upat of the form (app FUN UPAT)
         (pcase--mark-used sym)
-        (pcase--q1 sym (cadr upat) matches code vars rest))
-       ((eq (car-safe upat) 'or)
-        (let ((all (> (length (cdr upat)) 1))
-              (memq-fine t))
-          (when all
-            (dolist (alt (cdr upat))
-              (unless (if (pcase--self-quoting-p alt)
-                          (progn
-                            (unless (or (symbolp alt) (integerp alt))
-                              (setq memq-fine nil))
-                            t)
-                        (and (eq (car-safe alt) '\`)
-                             (or (symbolp (cadr alt)) (integerp (cadr alt))
-                                 (setq memq-fine nil)
-                                 (stringp (cadr alt)))))
-                (setq all nil))))
-          (if all
-              ;; Use memq for (or `a `b `c `d) rather than a big tree.
-              (let* ((elems (mapcar (lambda (x) (if (consp x) (cadr x) x))
-                                    (cdr upat)))
-                     (splitrest
-                      (pcase--split-rest
-                       sym (lambda (pat) (pcase--split-member elems pat)) rest))
-                     (then-rest (car splitrest))
-                     (else-rest (cdr splitrest)))
-                (pcase--mark-used sym)
-                (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems)
-                           (pcase--u1 matches code vars then-rest)
-                           (pcase--u else-rest)))
-            (pcase--u1 (cons `(match ,sym ,@(cadr upat)) matches) code vars
-                       (append (mapcar (lambda (upat)
-                                         `((and (match ,sym . ,upat) ,@matches)
-                                           ,code ,@vars))
-                                       (cddr upat))
-                               rest)))))
-       ((eq (car-safe upat) 'and)
-        (pcase--u1 (append (mapcar (lambda (upat) `(match ,sym ,@upat))
-                                   (cdr upat))
-                           matches)
-                   code vars rest))
+        (let* ((fun (nth 1 upat))
+               (nsym (make-symbol "x"))
+               (body
+                ;; We don't change `matches' to reuse the newly computed value,
+                ;; because we assume there shouldn't be such redundancy in there.
+                (pcase--u1 (cons (pcase--match nsym (nth 2 upat)) matches)
+                           code vars
+                           (pcase--app-subst-rest rest sym fun nsym))))
+          (if (not (get nsym 'pcase-used))
+              body
+            (macroexp-let*
+             `((,nsym ,(pcase--funcall fun sym vars)))
+             body))))
+       ((eq (car-safe upat) 'quote)
+        (pcase--mark-used sym)
+        (let* ((val (cadr upat))
+               (splitrest (pcase--split-rest
+                           sym (lambda (pat) (pcase--split-equal val pat)) rest))
+               (then-rest (car splitrest))
+               (else-rest (cdr splitrest)))
+          (pcase--if (cond
+                      ((null val) `(null ,sym))
+                      ((or (integerp val) (symbolp val))
+                       (if (pcase--self-quoting-p val)
+                           `(eq ,sym ,val)
+                         `(eq ,sym ',val)))
+                      (t `(equal ,sym ',val)))
+                     (pcase--u1 matches code vars then-rest)
+                     (pcase--u else-rest))))
        ((eq (car-safe upat) 'not)
         ;; FIXME: The implementation below is naive and results in
         ;; inefficient code.
@@ -727,57 +783,25 @@ Otherwise, it defers to REST which is a list of branches of the form
                      (pcase--u rest))
                    vars
                    (list `((and . ,matches) ,code . ,vars))))
-       (t (error "Unknown upattern `%s'" upat)))))
-   (t (error "Incorrect MATCH %s" (car matches)))))
+       (t (error "Unknown internal pattern `%S'" upat)))))
+   (t (error "Incorrect MATCH %S" (car matches)))))
 
-(defun pcase--q1 (sym qpat matches code vars rest)
-  "Return code that runs CODE if SYM matches QPAT and if MATCHES match.
-Otherwise, it defers to REST which is a list of branches of the form
-\(OTHER_MATCH OTHER-CODE . OTHER-VARS)."
+(pcase-defmacro \` (qpat)
   (cond
-   ((eq (car-safe qpat) '\,) (error "Can't use `,UPATTERN"))
-   ((floatp qpat) (error "Floating point patterns not supported"))
+   ((eq (car-safe qpat) '\,) (cadr qpat))
    ((vectorp qpat)
-    ;; FIXME.
-    (error "Vector QPatterns not implemented yet"))
+    `(and (pred vectorp)
+          (app length ,(length qpat))
+          ,@(let ((upats nil))
+              (dotimes (i (length qpat))
+                (push `(app (pcase--flip aref ,i) ,(list '\` (aref qpat i)))
+                      upats))
+              (nreverse upats))))
    ((consp qpat)
-    (let* ((syma (make-symbol "xcar"))
-           (symd (make-symbol "xcdr"))
-           (splitrest (pcase--split-rest
-                       sym
-                       (lambda (pat) (pcase--split-consp syma symd pat))
-                       rest))
-           (then-rest (car splitrest))
-           (else-rest (cdr splitrest))
-           (then-body (pcase--u1 `((match ,syma . ,(pcase--upat (car qpat)))
-                                   (match ,symd . ,(pcase--upat (cdr qpat)))
-                                   ,@matches)
-                                 code vars then-rest)))
-      (pcase--if
-       `(consp ,sym)
-       ;; We want to be careful to only add bindings that are used.
-       ;; The byte-compiler could do that for us, but it would have to pay
-       ;; attention to the `consp' test in order to figure out that car/cdr
-       ;; can't signal errors and our byte-compiler is not that clever.
-       ;; FIXME: Some of those let bindings occur too early (they are used in
-       ;; `then-body', but only within some sub-branch).
-       (macroexp-let*
-        `(,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
-          ,@(if (get symd 'pcase-used) `((,symd (cdr ,sym)))))
-        then-body)
-       (pcase--u else-rest))))
-   ((or (integerp qpat) (symbolp qpat) (stringp qpat))
-    (let* ((splitrest (pcase--split-rest
-                       sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
-           (then-rest (car splitrest))
-           (else-rest (cdr splitrest)))
-      (pcase--if (cond
-                  ((stringp qpat) `(equal ,sym ,qpat))
-                  ((null qpat) `(null ,sym))
-                  (t `(eq ,sym ',qpat)))
-                 (pcase--u1 matches code vars then-rest)
-                 (pcase--u else-rest))))
-   (t (error "Unknown QPattern %s" qpat))))
+    `(and (pred consp)
+          (app car ,(list '\` (car qpat)))
+          (app cdr ,(list '\` (cdr qpat)))))
+   ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat)))
 
 
 (provide 'pcase)
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 76473b39a77..759760c7d62 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -47,7 +47,7 @@ last.  FORMS are the expressions to be threaded."
     (_ (car forms))))
 
 (defmacro thread-first (&rest forms)
-  "Thread FORMS elements as the first argument of their succesor.
+  "Thread FORMS elements as the first argument of their successor.
 Example:
     (thread-first
       5
@@ -64,7 +64,7 @@ threading."
   `(internal--thread-argument t ,@forms))
 
 (defmacro thread-last (&rest forms)
-  "Thread FORMS elements as the last argument of their succesor.
+  "Thread FORMS elements as the last argument of their successor.
 Example:
     (thread-last
       5
@@ -118,7 +118,7 @@ threading."
   "Process BINDINGS and if all values are non-nil eval THEN, else ELSE.
 Argument BINDINGS is a list of tuples whose car is a symbol to be
 bound and (optionally) used in THEN, and its cadr is a sexp to be
-evaled to set symbol's value.  In the special case you only want
+evalled to set symbol's value.  In the special case you only want
 to bind a single value, BINDINGS can just be a plain tuple."
   (declare (indent 2) (debug ((&rest (symbolp form)) form body)))
   (when (and (<= (length bindings) 2)
@@ -134,7 +134,7 @@ to bind a single value, BINDINGS can just be a plain tuple."
   "Process BINDINGS and if all values are non-nil eval BODY.
 Argument BINDINGS is a list of tuples whose car is a symbol to be
 bound and (optionally) used in BODY, and its cadr is a sexp to be
-evaled to set symbol's value.  In the special case you only want
+evalled to set symbol's value.  In the special case you only want
 to bind a single value, BINDINGS can just be a plain tuple."
   (declare (indent 1) (debug if-let))
   (list 'if-let bindings (macroexp-progn body)))
@@ -159,7 +159,7 @@ to bind a single value, BINDINGS can just be a plain tuple."
   "Join all STRINGS using SEPARATOR."
   (mapconcat 'identity strings separator))
 
-(define-obsolete-function-alias 'string-reverse 'reverse "24.5")
+(define-obsolete-function-alias 'string-reverse 'reverse "25.1")
 
 (defsubst string-trim-left (string)
   "Remove leading whitespace from STRING."