; Merge from master.

41 files changed, 2039 insertions, 905 deletions

diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 8e43ae68072..86a42b208e7 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1814,8 +1814,7 @@ Redefining advices affect the construction of an advised definition."
   (if (symbolp function)
       (setq function (if (fboundp function)
                          (advice--strip-macro (symbol-function function)))))
-  (while (advice--p function) (setq function (advice--cdr function)))
-  function)
+  (advice--cd*r function))
 
 (defun ad-clear-advicefunname-definition (function)
   (let ((advicefunname (ad-get-advice-info-field function 'advicefunname)))
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index d0bf342b842..1e4b2c14a01 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -1108,6 +1108,9 @@ directory or directories specified."
          ;; Files with no autoload cookies or whose autoloads go to other
          ;; files because of file-local autoload-generated-file settings.
 	 (no-autoloads nil)
+         ;; Ensure that we don't do odd things when putting the doc
+         ;; strings into the autoloads file.
+         (left-margin 0)
          (autoload-modified-buffers nil)
 	 (output-time
 	  (and (file-exists-p output-file)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 0a79bf9b797..d3d8405d068 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -338,7 +338,7 @@ for speeding up processing.")
              (let ((exps-opt (byte-optimize-body exps t)))
                (if (macroexp-const-p exp-opt)
                    `(progn ,@exps-opt ,exp-opt)
-	         `(prog1 ,exp-opt ,@exps-opt)))
+	         `(,fn ,exp-opt ,@exps-opt)))
 	   exp-opt)))
 
       (`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
@@ -358,7 +358,7 @@ for speeding up processing.")
               (then-opt (and test-opt (byte-optimize-form then for-effect)))
               (else-opt (and (not (and test-opt const))
                              (byte-optimize-body else for-effect))))
-         `(if ,test-opt ,then-opt . ,else-opt)))
+         `(,fn ,test-opt ,then-opt . ,else-opt)))
 
       (`(,(or 'and 'or) . ,exps)
        ;; FIXME: We have to traverse the expressions in left-to-right
@@ -397,7 +397,7 @@ for speeding up processing.")
               ;; as mutated variables have been marked as non-substitutable.
               (condition (byte-optimize-form (car condition-body) nil))
               (body (byte-optimize-body (cdr condition-body) t)))
-         `(while ,condition . ,body)))
+         `(,fn ,condition . ,body)))
 
       (`(interactive . ,_)
        (byte-compile-warn-x form "misplaced interactive spec: `%s'" form)
@@ -409,7 +409,7 @@ for speeding up processing.")
        form)
 
       (`(condition-case ,var ,exp . ,clauses)
-       `(condition-case ,var          ;Not evaluated.
+       `(,fn ,var          ;Not evaluated.
             ,(byte-optimize-form exp for-effect)
           ,@(mapcar (lambda (clause)
                       (let ((byte-optimize--lexvars
@@ -432,14 +432,14 @@ for speeding up processing.")
        (let ((bodyform (byte-optimize-form exp for-effect)))
          (pcase exps
            (`(:fun-body ,f)
-            `(unwind-protect ,bodyform
+            `(,fn ,bodyform
                :fun-body ,(byte-optimize-form f nil)))
            (_
-            `(unwind-protect ,bodyform
+            `(,fn ,bodyform
                . ,(byte-optimize-body exps t))))))
 
       (`(catch ,tag . ,exps)
-       `(catch ,(byte-optimize-form tag nil)
+       `(,fn ,(byte-optimize-form tag nil)
           . ,(byte-optimize-body exps for-effect)))
 
       ;; Needed as long as we run byte-optimize-form after cconv.
@@ -495,7 +495,7 @@ for speeding up processing.")
                                   (cons (byte-optimize-form (car rest) nil)
                                         (cdr rest)))))
          (push name byte-optimize--dynamic-vars)
-         `(defvar ,name . ,optimized-rest)))
+         `(,fn ,name . ,optimized-rest)))
 
       (`(,(pred byte-code-function-p) . ,exps)
        (cons fn (mapcar #'byte-optimize-form exps)))
@@ -561,49 +561,50 @@ for speeding up processing.")
 
 (defun byte-optimize--rename-var (var new-var form)
   "Replace VAR with NEW-VAR in FORM."
-  (pcase form
-    ((pred symbolp) (if (eq form var) new-var form))
-    (`(setq . ,args)
-     (let ((new-args nil))
-       (while args
-         (push (byte-optimize--rename-var var new-var (car args)) new-args)
-         (push (byte-optimize--rename-var var new-var (cadr args)) new-args)
-         (setq args (cddr args)))
-       `(setq . ,(nreverse new-args))))
-    ;; In binding constructs like `let', `let*' and `condition-case' we
-    ;; rename everything for simplicity, even new bindings named VAR.
-    (`(,(and head (or 'let 'let*)) ,bindings . ,body)
-     `(,head
-       ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b))
-                bindings)
-       ,@(byte-optimize--rename-var-body var new-var body)))
-    (`(condition-case ,res-var ,protected-form . ,handlers)
-     `(condition-case ,(byte-optimize--rename-var var new-var res-var)
-          ,(byte-optimize--rename-var var new-var protected-form)
-        ,@(mapcar (lambda (h)
-                    (cons (car h)
-                          (byte-optimize--rename-var-body var new-var (cdr h))))
-                  handlers)))
-    (`(internal-make-closure ,vars ,env . ,rest)
-     `(internal-make-closure
-       ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest))
-    (`(defvar ,name . ,rest)
-     ;; NAME is not renamed here; we only care about lexical variables.
-     `(defvar ,name . ,(byte-optimize--rename-var-body var new-var rest)))
-
-    (`(cond . ,clauses)
-     `(cond ,@(mapcar (lambda (c)
-                        (byte-optimize--rename-var-body var new-var c))
-                      clauses)))
-
-    (`(function . ,_) form)
-    (`(quote . ,_) form)
-    (`(lambda . ,_) form)
-
-    ;; Function calls and special forms not handled above.
-    (`(,head . ,args)
-     `(,head . ,(byte-optimize--rename-var-body var new-var args)))
-    (_ form)))
+  (let ((fn (car-safe form)))
+    (pcase form
+      ((pred symbolp) (if (eq form var) new-var form))
+      (`(setq . ,args)
+       (let ((new-args nil))
+         (while args
+           (push (byte-optimize--rename-var var new-var (car args)) new-args)
+           (push (byte-optimize--rename-var var new-var (cadr args)) new-args)
+           (setq args (cddr args)))
+         `(,fn . ,(nreverse new-args))))
+      ;; In binding constructs like `let', `let*' and `condition-case' we
+      ;; rename everything for simplicity, even new bindings named VAR.
+      (`(,(and head (or 'let 'let*)) ,bindings . ,body)
+       `(,head
+         ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b))
+                  bindings)
+         ,@(byte-optimize--rename-var-body var new-var body)))
+      (`(condition-case ,res-var ,protected-form . ,handlers)
+       `(,fn ,(byte-optimize--rename-var var new-var res-var)
+             ,(byte-optimize--rename-var var new-var protected-form)
+             ,@(mapcar (lambda (h)
+                         (cons (car h)
+                               (byte-optimize--rename-var-body var new-var (cdr h))))
+                       handlers)))
+      (`(internal-make-closure ,vars ,env . ,rest)
+       `(,fn
+         ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest))
+      (`(defvar ,name . ,rest)
+       ;; NAME is not renamed here; we only care about lexical variables.
+       `(,fn ,name . ,(byte-optimize--rename-var-body var new-var rest)))
+
+      (`(cond . ,clauses)
+       `(,fn ,@(mapcar (lambda (c)
+                         (byte-optimize--rename-var-body var new-var c))
+                       clauses)))
+
+      (`(function . ,_) form)
+      (`(quote . ,_) form)
+      (`(lambda . ,_) form)
+
+      ;; Function calls and special forms not handled above.
+      (`(,head . ,args)
+       `(,head . ,(byte-optimize--rename-var-body var new-var args)))
+      (_ form))))
 
 (defun byte-optimize-let-form (head form for-effect)
   ;; Recursively enter the optimizer for the bindings and body
@@ -1049,6 +1050,14 @@ See Info node `(elisp) Integer Basics'."
         form          ; No improvement.
       (cons 'concat (nreverse newargs)))))
 
+(defun byte-optimize-string-greaterp (form)
+  ;; Rewrite in terms of `string-lessp' which has its own bytecode.
+  (pcase (cdr form)
+    (`(,a ,b) (let ((arg1 (make-symbol "arg1")))
+                `(let ((,arg1 ,a))
+                   (string-lessp ,b ,arg1))))
+    (_ form)))
+
 (put 'identity 'byte-optimizer #'byte-optimize-identity)
 (put 'memq 'byte-optimizer #'byte-optimize-memq)
 (put 'memql  'byte-optimizer #'byte-optimize-member)
@@ -1072,6 +1081,9 @@ See Info node `(elisp) Integer Basics'."
 (put 'string= 'byte-optimizer #'byte-optimize-binary-predicate)
 (put 'string-equal 'byte-optimizer #'byte-optimize-binary-predicate)
 
+(put 'string-greaterp 'byte-optimizer #'byte-optimize-string-greaterp)
+(put 'string> 'byte-optimizer #'byte-optimize-string-greaterp)
+
 (put 'concat 'byte-optimizer #'byte-optimize-concat)
 
 ;; I'm not convinced that this is necessary.  Doesn't the optimizer loop
@@ -1163,21 +1175,21 @@ See Info node `(elisp) Integer Basics'."
                 (proper-list-p clause))
            (if (null (cddr clause))
                ;; A trivial `progn'.
-               (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form)))
+               (byte-optimize-if `(,(car form) ,(cadr clause) ,@(nthcdr 2 form)))
              (nconc (butlast clause)
                     (list
                      (byte-optimize-if
-                      `(if ,(car (last clause)) ,@(nthcdr 2 form)))))))
+                      `(,(car form) ,(car (last clause)) ,@(nthcdr 2 form)))))))
           ((byte-compile-trueconstp clause)
 	   `(progn ,clause ,(nth 2 form)))
 	  ((byte-compile-nilconstp clause)
            `(progn ,clause ,@(nthcdr 3 form)))
 	  ((nth 2 form)
 	   (if (equal '(nil) (nthcdr 3 form))
-	       (list 'if clause (nth 2 form))
+	       (list (car form) clause (nth 2 form))
 	     form))
 	  ((or (nth 3 form) (nthcdr 4 form))
-	   (list 'if
+	   (list (car form)
 		 ;; Don't make a double negative;
 		 ;; instead, take away the one that is there.
 		 (if (and (consp clause) (memq (car clause) '(not null))
@@ -1256,7 +1268,7 @@ See Info node `(elisp) Integer Basics'."
                              (and (consp binding) (cadr binding)))
                            bindings)
                  ,const)
-       `(let* ,(butlast bindings)
+       `(,head ,(butlast bindings)
           ,@(and (consp (car (last bindings)))
                  (cdar (last bindings)))
           ,const)))
@@ -1271,7 +1283,7 @@ See Info node `(elisp) Integer Basics'."
          `(progn ,@(mapcar (lambda (binding)
                              (and (consp binding) (cadr binding)))
                            bindings))
-       `(let* ,(butlast bindings)
+       `(,head ,(butlast bindings)
           ,@(and (consp (car (last bindings)))
                  (cdar (last bindings))))))
 
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 384e8cba88f..0113051c8eb 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -32,8 +32,7 @@
 
 (defvar byte-run--ssp-seen nil
   "Which conses/vectors/records have been processed in strip-symbol-positions?
-The value is a hash table, the key being the old element and the value being
-the corresponding new element of the same type.
+The value is a hash table, the keys being the elements and the values being t.
 
 The purpose of this is to detect circular structures.")
 
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 9be44a8d5af..c0dffe544cf 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -471,7 +471,7 @@ Return the compile-time value of FORM."
   (let ((print-symbols-bare t))         ; Possibly redundant binding.
     (setf form (macroexp-macroexpand form byte-compile-macro-environment)))
   (if (eq (car-safe form) 'progn)
-      (cons 'progn
+      (cons (car form)
             (mapcar (lambda (subform)
                       (byte-compile-recurse-toplevel
                        subform non-toplevel-case))
@@ -500,8 +500,9 @@ Return the compile-time value of FORM."
                                         byte-compile-new-defuns))
                                    (setf result
                                          (byte-compile-eval
+                                          (byte-run-strip-symbol-positions
                                            (byte-compile-top-level
-                                            (byte-compile-preprocess form)))))))
+                                            (byte-compile-preprocess form))))))))
                               (list 'quote result))))
     (eval-and-compile . ,(lambda (&rest body)
                            (byte-compile-recurse-toplevel
@@ -512,9 +513,10 @@ Return the compile-time value of FORM."
                               ;; or byte-compile-file-form.
                               (let* ((print-symbols-bare t) ; Possibly redundant binding.
                                      (expanded
-                                      (macroexpand--all-toplevel
-                                       form
-                                       macroexpand-all-environment)))
+                                      (byte-run-strip-symbol-positions
+                                       (macroexpand--all-toplevel
+                                        form
+                                        macroexpand-all-environment))))
                                 (eval expanded lexical-binding)
                                 expanded)))))
     (with-suppressed-warnings
@@ -1007,13 +1009,22 @@ CONST2 may be evaluated multiple times."
 
     ;; Similarly, replace TAGs in all jump tables with the correct PC index.
     (dolist (hash-table byte-compile-jump-tables)
-      (maphash #'(lambda (value tag)
-                   (setq pc (cadr tag))
-                   ;; We don't need to split PC here, as it is stored as a lisp
-                   ;; object in the hash table (whereas other goto-* ops store
-                   ;; it within 2 bytes in the byte string).
-                   (puthash value pc hash-table))
-               hash-table))
+      (let (alist)
+        (maphash #'(lambda (value tag)
+                     (setq pc (cadr tag))
+                     ;; We don't need to split PC here, as it is stored as a
+                     ;; lisp object in the hash table (whereas other goto-*
+                     ;; ops store it within 2 bytes in the byte string).
+                     ;; De-position any symbols with position in `value'.
+                     ;; Since this may change the hash table key, we remove
+                     ;; the entry from the table and reinsert it outside the
+                     ;; scope of the `maphash'.
+                     (setq value (byte-run-strip-symbol-positions value))
+                     (push (cons value pc) alist)
+                     (remhash value hash-table))
+                 hash-table)
+        (dolist (elt alist)
+          (puthash (car elt) (cdr elt) hash-table))))
     (let ((bytecode (apply 'unibyte-string (nreverse bytes))))
       (when byte-native-compiling
         ;; Spill LAP for the native compiler here.
@@ -1162,27 +1173,27 @@ message buffer `default-directory'."
         (f2 (file-relative-name file dir)))
     (if (< (length f2) (length f1)) f2 f1)))
 
-(defun byte-compile--first-symbol (form)
-  "Return the \"first\" symbol found in form, or 0 if there is none.
+(defun byte-compile--first-symbol-with-pos (form)
+  "Return the \"first\" symbol with position found in form, or 0 if none.
 Here, \"first\" is by a depth first search."
   (let (sym)
     (cond
-     ((symbolp form) form)
+     ((symbol-with-pos-p form) form)
      ((consp form)
-      (or (and (symbolp (setq sym (byte-compile--first-symbol (car form))))
+      (or (and (symbol-with-pos-p (setq sym (byte-compile--first-symbol-with-pos (car form))))
                sym)
-          (and (symbolp (setq sym (byte-compile--first-symbol (cdr form))))
+          (and (symbolp (setq sym (byte-compile--first-symbol-with-pos (cdr form))))
                sym)
           0))
-     ((and (vectorp form)
+     ((and (or (vectorp form) (recordp form))
            (> (length form) 0))
       (let ((i 0)
             (len (length form))
             elt)
         (catch 'sym
           (while (< i len)
-            (when (symbolp
-                   (setq elt (byte-compile--first-symbol (aref form i))))
+            (when (symbol-with-pos-p
+                   (setq elt (byte-compile--first-symbol-with-pos (aref form i))))
               (throw 'sym elt))
             (setq i (1+ i)))
           0)))
@@ -1193,7 +1204,7 @@ Here, \"first\" is by a depth first search."
 Return nil if such is not found."
   (catch 'offset
     (dolist (form byte-compile-form-stack)
-      (let ((s (byte-compile--first-symbol form)))
+      (let ((s (byte-compile--first-symbol-with-pos form)))
         (if (symbol-with-pos-p s)
             (throw 'offset (symbol-with-pos-pos s)))))))
 
@@ -1428,7 +1439,7 @@ when printing the error message."
   (and (eq 'macro (car-safe f)) (setq f (cdr f)))
   ;; Advice wrappers have "catch all" args, so fetch the actual underlying
   ;; function to find the real arguments.
-  (while (advice--p f) (setq f (advice--cdr f)))
+  (setq f (advice--cd*r f))
   (if (eq (car-safe f) 'declared)
       (byte-compile-arglist-signature (nth 1 f))
     (condition-case nil
@@ -3073,7 +3084,7 @@ lambda-expression."
                        ;; which may include "calls" to
                        ;; internal-make-closure (Bug#29988).
                        lexical-binding)
-                   (setq int `(interactive ,newform)))))
+                   (setq int `(,(car int) ,newform)))))
             ((cdr int)                  ; Invalid (interactive . something).
 	     (byte-compile-warn-x int "malformed interactive spec: %s"
 				  int))))
@@ -3922,7 +3933,7 @@ discarding."
 		     docstring-exp))	;Otherwise, we don't need a closure.
       (cl-assert (byte-code-function-p fun))
       (byte-compile-form
-       (if (or (not docstring-exp) (stringp docstring-exp))
+       (if (macroexp-const-p docstring-exp)
            ;; Use symbols V0, V1 ... as placeholders for closure variables:
            ;; they should be short (to save space in the .elc file), yet
            ;; distinct when disassembled.
@@ -3938,7 +3949,7 @@ discarding."
                           (vconcat dummy-vars (aref fun 2))
                           (aref fun 3)
                           (if docstring-exp
-                              (cons docstring-exp (cdr opt-args))
+                              (cons (eval docstring-exp t) (cdr opt-args))
                             opt-args))))
              `(make-closure ,proto-fun ,@env))
          ;; Nontrivial doc string expression: create a bytecode object
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index c16619bc45d..4535f1aa6eb 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -201,7 +201,10 @@ Returns a form where all lambdas don't have any free variables."
          (i 0)
          (new-env ()))
     ;; Build the "formal and actual envs" for the closure-converted function.
-    (dolist (fv fvs)
+    ;; Hack for OClosure: `nreverse' here intends to put the captured vars
+    ;; in the closure such that the first one is the one that is bound
+    ;; most closely.
+    (dolist (fv (nreverse fvs))
       (let ((exp (or (cdr (assq fv env)) fv)))
         (pcase exp
           ;; If `fv' is a variable that's wrapped in a cons-cell,
@@ -240,7 +243,7 @@ Returns a form where all lambdas don't have any free variables."
   ;; this case better, we'd need to traverse the tree one more time to
   ;; collect this data, and I think that it's not worth it.
   (mapcar (lambda (mapping)
-            (if (not (eq (cadr mapping) 'apply-partially))
+            (if (not (eq (cadr mapping) #'apply-partially))
                 mapping
               (cl-assert (eq (car mapping) (nth 2 mapping)))
               `(,(car mapping)
@@ -449,6 +452,9 @@ places where they originally did not directly appear."
                  (let ((var-def (cconv--lifted-arg var env))
                        (closedsym (make-symbol (format "closed-%s" var))))
                    (setq new-env (cconv--remap-llv new-env var closedsym))
+                   ;; FIXME: `closedsym' doesn't need to be added to `extend'
+                   ;; but adding it makes it easier to write the assertion at
+                   ;; the beginning of this function.
                    (setq new-extend (cons closedsym (remq var new-extend)))
                    (push `(,closedsym ,var-def) binders-new)))
 
@@ -494,11 +500,11 @@ places where they originally did not directly appear."
                  args)))
 
     (`(cond . ,cond-forms)              ; cond special form
-     `(cond . ,(mapcar (lambda (branch)
-                         (mapcar (lambda (form)
-                                   (cconv-convert form env extend))
-                                 branch))
-                       cond-forms)))
+     `(,(car form) . ,(mapcar (lambda (branch)
+                                (mapcar (lambda (form)
+                                          (cconv-convert form env extend))
+                                        branch))
+                              cond-forms)))
 
     (`(function (lambda ,args . ,body) . ,_)
      (let ((docstring (if (eq :documentation (car-safe (car body)))
@@ -532,7 +538,7 @@ places where they originally did not directly appear."
             (msg (when (eq class :unused)
                    (cconv--warn-unused-msg var "variable")))
             (newprotform (cconv-convert protected-form env extend)))
-       `(condition-case ,var
+       `(,(car form) ,var
             ,(if msg
                  (macroexp--warn-wrap var msg newprotform 'lexical)
                newprotform)
@@ -548,9 +554,9 @@ places where they originally did not directly appear."
                        `((let ((,var (list ,var))) ,@body))))))
              handlers))))
 
-    (`(unwind-protect ,form . ,body)
-     `(unwind-protect ,(cconv-convert form env extend)
-        :fun-body ,(cconv--convert-function () body env form)))
+    (`(unwind-protect ,form1 . ,body)
+     `(,(car form) ,(cconv-convert form1 env extend)
+        :fun-body ,(cconv--convert-function () body env form1)))
 
     (`(setq . ,forms)                   ; setq special form
      (if (= (logand (length forms) 1) 1)
@@ -562,7 +568,7 @@ places where they originally did not directly appear."
                   (sym-new (or (cdr (assq sym env)) sym))
                   (value (cconv-convert (pop forms) env extend)))
              (push (pcase sym-new
-                     ((pred symbolp) `(setq ,sym-new ,value))
+                     ((pred symbolp) `(,(car form) ,sym-new ,value))
                      (`(car-safe ,iexp) `(setcar ,iexp ,value))
                      ;; This "should never happen", but for variables which are
                      ;; mutated+captured+unused, we may end up trying to `setq'
@@ -598,12 +604,20 @@ places where they originally did not directly appear."
                                  (cons fun args)))))))
 
     (`(interactive . ,forms)
-     `(interactive . ,(mapcar (lambda (form)
+     `(,(car form) . ,(mapcar (lambda (form)
                                 (cconv-convert form nil nil))
                               forms)))
 
     (`(declare . ,_) form)              ;The args don't contain code.
 
+    (`(oclosure--fix-type (ignore . ,vars) ,exp)
+     (dolist (var vars)
+       (let ((x (assq var env)))
+         (pcase (cdr x)
+           (`(car-safe . ,_) (error "Slot %S should not be mutated" var))
+           (_ (cl-assert (null (cdr x)))))))
+     (cconv-convert exp env extend))
+
     (`(,func . ,forms)
      ;; First element is function or whatever function-like forms are: or, and,
      ;; if, catch, progn, prog1, while, until
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index ed9b1b7d836..8e38df43c87 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -553,10 +553,14 @@ too large if positive or too small if negative)."
 			,new)))))
   (seq-subseq seq start end))
 
+;;; This isn't a defalias because autoloading defalises doesn't work
+;;; very well.
+
 ;;;###autoload
-(defalias 'cl-concatenate #'seq-concatenate
+(defun cl-concatenate (type &rest sequences)
   "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
-\n(fn TYPE SEQUENCE...)")
+\n(fn TYPE SEQUENCE...)"
+  (apply #'seq-concatenate type sequences))
 
 ;;; List functions.
 
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index b44dda6f9d4..200af057cd7 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -144,13 +144,20 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG
 (cl-defstruct (cl--generic-method
                (:constructor nil)
                (:constructor cl--generic-make-method
-                (specializers qualifiers uses-cnm function))
+                (specializers qualifiers call-con function))
                (:predicate nil))
   (specializers nil :read-only t :type list)
   (qualifiers   nil :read-only t :type (list-of atom))
-  ;; USES-CNM is a boolean indicating if FUNCTION expects an extra argument
-  ;; holding the next-method.
-  (uses-cnm     nil :read-only t :type boolean)
+  ;; CALL-CON indicates the calling convention expected by FUNCTION:
+  ;; - nil: FUNCTION is just a normal function with no extra arguments for
+  ;;   `call-next-method' or `next-method-p' (which it hence can't use).
+  ;; - `curried': FUNCTION is a curried function that first takes the
+  ;;   "next combined method" and return the resulting combined method.
+  ;;   It can distinguish `next-method-p' by checking if that next method
+  ;;   is `cl--generic-isnot-nnm-p'.
+  ;; - t: FUNCTION takes the `call-next-method' function as its first (extra)
+  ;;      argument.
+  (call-con     nil :read-only t :type symbol)
   (function     nil :read-only t :type function))
 
 (cl-defstruct (cl--generic
@@ -262,6 +269,16 @@ DEFAULT-BODY, if present, is used as the body of a default method.
          (declarations nil)
          (methods ())
          (options ())
+         (warnings
+          (let ((nonsymargs
+                 (delq nil (mapcar (lambda (arg) (unless (symbolp arg) arg))
+                                   args))))
+            (when nonsymargs
+              (list
+               (macroexp-warn-and-return
+                (format "Non-symbol arguments to cl-defgeneric: %s"
+                        (mapconcat #'prin1-to-string nonsymargs ""))
+                nil nil nil nonsymargs)))))
          next-head)
     (while (progn (setq next-head (car-safe (car options-and-methods)))
                   (or (keywordp next-head)
@@ -284,14 +301,17 @@ DEFAULT-BODY, if present, is used as the body of a default method.
       (setq name (gv-setter (cadr name))))
     `(prog1
          (progn
+           ,@warnings
            (defalias ',name
              (cl-generic-define ',name ',args ',(nreverse options))
              ,(if (consp doc)           ;An expression rather than a constant.
                   `(help-add-fundoc-usage ,doc ',args)
                 (help-add-fundoc-usage doc args)))
            :autoload-end
-           ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
-                     (nreverse methods)))
+           ,(when methods
+              `(with-suppressed-warnings ((obsolete ,name))
+                 ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
+                           (nreverse methods)))))
        ,@(mapcar (lambda (declaration)
                    (let ((f (cdr (assq (car declaration)
                                        defun-declarations-alist))))
@@ -381,14 +401,16 @@ the specializer used will be the one returned by BODY."
                                    . ,(lambda () spec-args))
                                  macroexpand-all-environment)))
       (require 'cl-lib)        ;Needed to expand `cl-flet' and `cl-function'.
-      (when (assq 'interactive (cadr fun))
+      (when (assq 'interactive body)
         (message "Interactive forms not supported in generic functions: %S"
-                 (assq 'interactive (cadr fun))))
+                 (assq 'interactive body)))
       ;; First macroexpand away the cl-function stuff (e.g. &key and
       ;; destructuring args, `declare' and whatnot).
       (pcase (macroexpand fun macroenv)
         (`#'(lambda ,args . ,body)
          (let* ((parsed-body (macroexp-parse-body body))
+                (nm (make-symbol "cl--nm"))
+                (arglist (make-symbol "cl--args"))
                 (cnm (make-symbol "cl--cnm"))
                 (nmp (make-symbol "cl--nmp"))
                 (nbody (macroexpand-all
@@ -401,15 +423,49 @@ the specializer used will be the one returned by BODY."
                 ;; is used.
                 ;; FIXME: Also, optimize the case where call-next-method is
                 ;; only called with explicit arguments.
-                (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
-           (cons (not (not uses-cnm))
-                 `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
-                      ,@(car parsed-body)
-                      ,(if (not (assq nmp uses-cnm))
-                           nbody
-                         `(let ((,nmp (lambda ()
-                                        (cl--generic-isnot-nnm-p ,cnm))))
-                            ,nbody))))))
+                (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody))
+                (λ-lift (mapcar #'car uses-cnm)))
+           (if (not uses-cnm)
+               (cons nil
+                     `#'(lambda (,@args)
+                          ,@(car parsed-body)
+                          ,nbody))
+             (cons 'curried
+                   `#'(lambda (,nm) ;Called when constructing the effective method.
+                        (let ((,nmp (if (cl--generic-isnot-nnm-p ,nm)
+                                        #'always #'ignore)))
+                          ;; This `(λ (&rest x) .. (apply (λ (args) ..) x))'
+                          ;; dance is needed because we need to get the original
+                          ;; args as a list when `cl-call-next-method' is
+                          ;; called with no arguments.  It's important to
+                          ;; capture it as a list since it needs to distinguish
+                          ;; the nil case from the absent case in optional
+                          ;; arguments and it needs to properly remember the
+                          ;; original value if `nbody' mutates some of its
+                          ;; formal args.
+                          ;; FIXME: This `(λ (&rest ,arglist)' could be skipped
+                          ;; when we know `cnm' is always called with args, and
+                          ;; it could be implemented more efficiently if `cnm'
+                          ;; is always called directly and there are no
+                          ;; `&optional' args.
+                          (lambda (&rest ,arglist)
+                            ,@(let* ((prebody (car parsed-body))
+                                     (ds (if (stringp (car prebody))
+                                             prebody
+                                           (setq prebody (cons nil prebody))))
+                                     (usage (help-split-fundoc (car ds) nil)))
+                                (unless usage
+                                  (setcar ds (help-add-fundoc-usage (car ds)
+                                                                    args)))
+                                prebody)
+                            (let ((,cnm (lambda (&rest args)
+                                          (apply ,nm (or args ,arglist)))))
+                              ;; This `apply+lambda' basically parses
+                              ;; `arglist' according to `args'.
+                              ;; A destructuring-bind would do the trick
+                              ;; as well when/if it's more efficient.
+                              (apply (lambda (,@λ-lift ,@args) ,nbody)
+                                     ,@λ-lift ,arglist)))))))))
         (f (error "Unexpected macroexpansion result: %S" f))))))
 
 (put 'cl-defmethod 'function-documentation
@@ -498,8 +554,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
                     cl--generic-edebug-make-name nil]
              lambda-doc                 ; documentation string
              def-body)))                ; part to be debugged
-  (let ((qualifiers nil)
-        (orig-name name))
+  (let ((qualifiers nil))
     (while (cl-generic--method-qualifier-p args)
       (push args qualifiers)
       (setq args (pop body)))
@@ -507,23 +562,18 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
       (require 'gv)
       (declare-function gv-setter "gv" (name))
       (setq name (gv-setter (cadr name))))
-    (pcase-let* ((`(,uses-cnm . ,fun) (cl--generic-lambda args body)))
+    (pcase-let* ((`(,call-con . ,fun) (cl--generic-lambda args body)))
       `(progn
-         ,(and (get name 'byte-obsolete-info)
-               (or (not (fboundp 'byte-compile-warning-enabled-p))
-                   (byte-compile-warning-enabled-p 'obsolete name))
-               (let* ((obsolete (get name 'byte-obsolete-info)))
-                 (macroexp-warn-and-return
-                  (macroexp--obsolete-warning name obsolete "generic function")
-                  nil nil nil orig-name)))
          ;; You could argue that `defmethod' modifies rather than defines the
          ;; function, so warnings like "not known to be defined" are fair game.
          ;; But in practice, it's common to use `cl-defmethod'
          ;; without a previous `cl-defgeneric'.
          ;; The ",'" is a no-op that pacifies check-declare.
          (,'declare-function ,name "")
-         (cl-generic-define-method ',name ',(nreverse qualifiers) ',args
-                                   ,uses-cnm ,fun)))))
+         ;; We use #' to quote `name' so as to trigger an
+         ;; obsolescence warning when applicable.
+         (cl-generic-define-method #',name ',(nreverse qualifiers) ',args
+                                   ',call-con ,fun)))))
 
 (defun cl--generic-member-method (specializers qualifiers methods)
   (while
@@ -541,7 +591,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
   `(,name ,qualifiers . ,specializers))
 
 ;;;###autoload
-(defun cl-generic-define-method (name qualifiers args uses-cnm function)
+(defun cl-generic-define-method (name qualifiers args call-con function)
   (pcase-let*
       ((generic (cl-generic-ensure-function name))
        (`(,spec-args . ,_) (cl--generic-split-args args))
@@ -550,7 +600,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
                                    spec-arg (cdr spec-arg)))
                              spec-args))
        (method (cl--generic-make-method
-                specializers qualifiers uses-cnm function))
+                specializers qualifiers call-con function))
        (mt (cl--generic-method-table generic))
        (me (cl--generic-member-method specializers qualifiers mt))
        (dispatches (cl--generic-dispatches generic))
@@ -603,6 +653,14 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
 
 (defvar cl--generic-dispatchers (make-hash-table :test #'equal))
 
+(defvar cl--generic-compiler
+  ;; Don't byte-compile the dispatchers if cl-generic itself is not
+  ;; compiled.  Otherwise the byte-compiler and all the code on
+  ;; which it depends needs to be usable before cl-generic is loaded,
+  ;; which imposes a significant burden on the bootstrap.
+  (if (consp (lambda (x) (+ x 1)))
+      (lambda (exp) (eval exp t)) #'byte-compile))
+
 (defun cl--generic-get-dispatcher (dispatch)
   (with-memoization
       ;; We need `copy-sequence` here because this `dispatch' object might be
@@ -647,7 +705,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
       ;; FIXME: For generic functions with a single method (or with 2 methods,
       ;; one of which always matches), using a tagcode + hash-table is
       ;; overkill: better just use a `cl-typep' test.
-      (byte-compile
+      (funcall
+       cl--generic-compiler
        `(lambda (generic dispatches-left methods)
           ;; FIXME: We should find a way to expand `with-memoize' once
           ;; and forall so we don't need `subr-x' when we get here.
@@ -718,29 +777,38 @@ for all those different tags in the method-cache.")
                   (list (cl--generic-name generic)))
         f))))
 
-(defun cl--generic-no-next-method-function (generic method)
-  (lambda (&rest args)
-    (apply #'cl-no-next-method generic method args)))
+(oclosure-define (cl--generic-nnm)
+  "Special type for `call-next-method's that just call `no-next-method'.")
 
 (defun cl-generic-call-method (generic method &optional fun)
   "Return a function that calls METHOD.
 FUN is the function that should be called when METHOD calls
 `call-next-method'."
-  (if (not (cl--generic-method-uses-cnm method))
-      (cl--generic-method-function method)
-    (let ((met-fun (cl--generic-method-function method))
-          (next (or fun (cl--generic-no-next-method-function
-                         generic method))))
-      (lambda (&rest args)
-        (apply met-fun
-               ;; FIXME: This sucks: passing just `next' would
-               ;; be a lot more efficient than the lambda+apply
-               ;; quasi-η, but we need this to implement the
-               ;; "if call-next-method is called with no
-               ;; arguments, then use the previous arguments".
-               (lambda (&rest cnm-args)
-                 (apply next (or cnm-args args)))
-               args)))))
+  (let ((met-fun (cl--generic-method-function method)))
+    (pcase (cl--generic-method-call-con method)
+      ('nil met-fun)
+      ('curried
+       (funcall met-fun (or fun
+                            (oclosure-lambda (cl--generic-nnm) (&rest args)
+                              (apply #'cl-no-next-method generic method
+                                     args)))))
+      ;; FIXME: backward compatibility with old convention for `.elc' files
+      ;; compiled before the `curried' convention.
+      (_
+       (lambda (&rest args)
+         (apply met-fun
+                (if fun
+                    ;; FIXME: This sucks: passing just `next' would
+                    ;; be a lot more efficient than the lambda+apply
+                    ;; quasi-η, but we need this to implement the
+                    ;; "if call-next-method is called with no
+                    ;; arguments, then use the previous arguments".
+                    (lambda (&rest cnm-args)
+                      (apply fun (or cnm-args args)))
+                  (oclosure-lambda (cl--generic-nnm) (&rest cnm-args)
+                    (apply #'cl-no-next-method generic method
+                           (or cnm-args args))))
+                args))))))
 
 ;; Standard CLOS name.
 (defalias 'cl-method-qualifiers #'cl--generic-method-qualifiers)
@@ -875,11 +943,20 @@ those methods.")
     (setq arg-or-context `(&context . ,arg-or-context)))
   (unless (fboundp 'cl--generic-get-dispatcher)
     (require 'cl-generic))
-  (let ((fun (cl--generic-get-dispatcher
-              `(,arg-or-context
-                ,@(apply #'append
-                         (mapcar #'cl-generic-generalizers specializers))
-                ,cl--generic-t-generalizer))))
+  (let ((fun
+         ;; Let-bind cl--generic-dispatchers so we *re*compute the function
+         ;; from scratch, since the one in the cache may be non-compiled!
+         (let ((cl--generic-dispatchers (make-hash-table))
+               ;; When compiling `cl-generic' during bootstrap, make sure
+               ;; we prefill with compiled dispatchers even though the loaded
+               ;; `cl-generic' is still interpreted.
+               (cl--generic-compiler
+                (if (featurep 'bytecomp) #'byte-compile cl--generic-compiler)))
+           (cl--generic-get-dispatcher
+            `(,arg-or-context
+              ,@(apply #'append
+                       (mapcar #'cl-generic-generalizers specializers))
+              ,cl--generic-t-generalizer)))))
     ;; Recompute dispatch at run-time, since the generalizers may be slightly
     ;; different (e.g. byte-compiled rather than interpreted).
     ;; FIXME: There is a risk that the run-time generalizer is not equivalent
@@ -897,36 +974,9 @@ those methods.")
   "Standard support for :after, :before, :around, and `:extra NAME' qualifiers."
   (cl--generic-standard-method-combination generic methods))
 
-(defconst cl--generic-nnm-sample (cl--generic-no-next-method-function t t))
-(defconst cl--generic-cnm-sample
-  (funcall (cl--generic-build-combined-method
-            nil (list (cl--generic-make-method () () t #'identity)))))
-
 (defun cl--generic-isnot-nnm-p (cnm)
   "Return non-nil if CNM is the function that calls `cl-no-next-method'."
-  ;; ¡Big Gross Ugly Hack!
-  ;; `next-method-p' just sucks, we should let it die.  But EIEIO did support
-  ;; it, and some packages use it, so we need to support it.
-  (catch 'found
-    (cl-assert (function-equal cnm cl--generic-cnm-sample))
-    (if (byte-code-function-p cnm)
-        (let ((cnm-constants (aref cnm 2))
-              (sample-constants (aref cl--generic-cnm-sample 2)))
-          (dotimes (i (length sample-constants))
-            (when (function-equal (aref sample-constants i)
-                                  cl--generic-nnm-sample)
-              (throw 'found
-                     (not (function-equal (aref cnm-constants i)
-                                          cl--generic-nnm-sample))))))
-      (cl-assert (eq 'closure (car-safe cl--generic-cnm-sample)))
-      (let ((cnm-env (cadr cnm)))
-        (dolist (vb (cadr cl--generic-cnm-sample))
-          (when (function-equal (cdr vb) cl--generic-nnm-sample)
-            (throw 'found
-                   (not (function-equal (cdar cnm-env)
-                                        cl--generic-nnm-sample))))
-          (setq cnm-env (cdr cnm-env)))))
-    (error "Haven't found no-next-method-sample in cnm-sample")))
+  (not (eq (oclosure-type cnm) 'cl--generic-nnm)))
 
 ;;; Define some pre-defined generic functions, used internally.
 
@@ -1002,9 +1052,12 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
 (defun cl--generic-method-info (method)
   (let* ((specializers (cl--generic-method-specializers method))
          (qualifiers   (cl--generic-method-qualifiers method))
-         (uses-cnm     (cl--generic-method-uses-cnm method))
+         (call-con     (cl--generic-method-call-con method))
          (function     (cl--generic-method-function method))
-         (args (help-function-arglist function 'names))
+         (args (help-function-arglist (if (not (eq call-con 'curried))
+                                          function
+                                        (funcall function #'ignore))
+                                      'names))
          (docstring (documentation function))
          (qual-string
           (if (null qualifiers) ""
@@ -1015,7 +1068,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
                       (let ((split (help-split-fundoc docstring nil)))
                         (if split (cdr split) docstring))))
          (combined-args ()))
-    (if uses-cnm (setq args (cdr args)))
+    (if (eq t call-con) (setq args (cdr args)))
     (dolist (specializer specializers)
       (let ((arg (if (eq '&rest (car args))
                      (intern (format "arg%d" (length combined-args)))
@@ -1025,6 +1078,19 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
     (setq combined-args (append (nreverse combined-args) args))
     (list qual-string combined-args doconly)))
 
+(defun cl--generic-upcase-formal-args (args)
+  (mapcar (lambda (arg)
+            (cond
+             ((symbolp arg)
+              (let ((name (symbol-name arg)))
+                (if (eq ?& (aref name 0)) arg
+                  (intern (upcase name)))))
+             ((consp arg)
+              (cons (intern (upcase (symbol-name (car arg))))
+                    (cdr arg)))
+             (t arg)))
+          args))
+
 (add-hook 'help-fns-describe-function-functions #'cl--generic-describe)
 (defun cl--generic-describe (function)
   ;; Supposedly this is called from help-fns, so help-fns should be loaded at
@@ -1041,9 +1107,20 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
         (insert (propertize "Implementations:\n\n" 'face 'bold))
         ;; Loop over fanciful generics
         (dolist (method (cl--generic-method-table generic))
-          (let* ((info (cl--generic-method-info method)))
+          (pcase-let*
+              ((`(,qualifiers ,args ,doc) (cl--generic-method-info method)))
             ;; FIXME: Add hyperlinks for the types as well.
-            (insert (format "%s%S" (nth 0 info) (nth 1 info)))
+            (let ((print-quoted nil)
+                  (quals (if (length> qualifiers 0)
+                             (concat (substring qualifiers
+                                                0 (string-match " *\\'"
+                                                                qualifiers))
+                                     "\n")
+                           "")))
+              (insert (format "%s%S"
+                              quals
+                              (cons function
+                                    (cl--generic-upcase-formal-args args)))))
             (let* ((met-name (cl--generic-load-hist-format
                               function
                               (cl--generic-method-qualifiers method)
@@ -1055,7 +1132,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
                                          'help-function-def met-name file
                                          'cl-defmethod)
                 (insert (substitute-command-keys "'.\n"))))
-            (insert "\n" (or (nth 2 info) "Undocumented") "\n\n")))))))
+            (insert "\n" (or doc "Undocumented") "\n\n")))))))
 
 (defun cl--generic-specializers-apply-to-type-p (specializers type)
   "Return non-nil if a method with SPECIALIZERS applies to TYPE."
@@ -1071,7 +1148,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'."
                  (let ((sclass (cl--find-class specializer))
                        (tclass (cl--find-class type)))
                    (when (and sclass tclass)
-                     (member specializer (cl--generic-class-parents tclass))))))
+                     (member specializer (cl--class-allparents tclass))))))
            (setq applies t)))
     applies))
 
@@ -1200,22 +1277,11 @@ These match if the argument is `eql' to VAL."
   ;; Use exactly the same code as for `typeof'.
   `(if ,name (type-of ,name) 'null))
 
-(defun cl--generic-class-parents (class)
-  (let ((parents ())
-        (classes (list class)))
-    ;; BFS precedence.  FIXME: Use a topological sort.
-    (while (let ((class (pop classes)))
-             (cl-pushnew (cl--class-name class) parents)
-             (setq classes
-                   (append classes
-                           (cl--class-parents class)))))
-    (nreverse parents)))
-
 (defun cl--generic-struct-specializers (tag &rest _)
   (and (symbolp tag)
        (let ((class (get tag 'cl--class)))
          (when (cl-typep class 'cl-structure-class)
-           (cl--generic-class-parents class)))))
+           (cl--class-allparents class)))))
 
 (cl-generic-define-generalizer cl--generic-struct-generalizer
   50 #'cl--generic-struct-tag
@@ -1298,6 +1364,42 @@ Used internally for the (major-mode MODE) context specializers."
                     (progn (cl-assert (null modes)) mode)
                   `(derived-mode ,mode . ,modes))))
 
+;;; Dispatch on OClosure type
+
+;; It would make sense to put this into `oclosure.el' except that when
+;; `oclosure.el' is loaded `cl-defmethod' is not available yet.
+
+(defun cl--generic-oclosure-tag (name &rest _)
+  `(oclosure-type ,name))
+
+(defun cl-generic--oclosure-specializers (tag &rest _)
+  (and (symbolp tag)
+       (let ((class (cl--find-class tag)))
+         (when (cl-typep class 'oclosure--class)
+           (oclosure--class-allparents class)))))
+
+(cl-generic-define-generalizer cl-generic--oclosure-generalizer
+  ;; Give slightly higher priority than the struct specializer, so that
+  ;; for a generic function with methods dispatching structs and on OClosures,
+  ;; we first try `oclosure-type' before `type-of' since `type-of' will return
+  ;; non-nil for an OClosure as well.
+  51 #'cl--generic-oclosure-tag
+  #'cl-generic--oclosure-specializers)
+
+(cl-defmethod cl-generic-generalizers :extra "oclosure-struct" (type)
+  "Support for dispatch on types defined by `oclosure-define'."
+  (or
+   (when (symbolp type)
+     ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than
+     ;; the "cl-struct-*" variants which aren't inlined, so that dispatch can
+     ;; take place without requiring cl-lib.
+     (let ((class (cl--find-class type)))
+       (and (cl-typep class 'oclosure--class)
+            (list cl-generic--oclosure-generalizer))))
+   (cl-call-next-method)))
+
+(cl--generic-prefill-dispatchers 0 oclosure)
+
 ;;; Support for unloading.
 
 (cl-defmethod loadhist-unload-element ((x (head cl-defmethod)))
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 4e60a3c63d0..3f40ab07605 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -114,7 +114,10 @@ a future Emacs interpreter will be able to use it.")
 (defmacro cl-incf (place &optional x)
   "Increment PLACE by X (1 by default).
 PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the incremented value of PLACE."
+The return value is the incremented value of PLACE.
+
+If X is specified, it should be an expression that should
+evaluate to a number."
   (declare (debug (place &optional form)))
   (if (symbolp place)
       (list 'setq place (if x (list '+ place x) (list '1+ place)))
@@ -123,7 +126,10 @@ The return value is the incremented value of PLACE."
 (defmacro cl-decf (place &optional x)
   "Decrement PLACE by X (1 by default).
 PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the decremented value of PLACE."
+The return value is the decremented value of PLACE.
+
+If X is specified, it should be an expression that should
+evaluate to a number."
   (declare (debug cl-incf))
   (if (symbolp place)
       (list 'setq place (if x (list '- place x) (list '1- place)))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 4b231d81496..a9d422929f1 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2430,6 +2430,57 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
       (unless advised
         (advice-remove 'macroexpand #'cl--sm-macroexpand)))))
 
+;;;###autoload
+(defmacro cl-with-gensyms (names &rest body)
+  "Bind each of NAMES to an uninterned symbol and evaluate BODY."
+  (declare (debug (sexp body)) (indent 1))
+  `(let ,(cl-loop for name in names collect
+                  `(,name (gensym (symbol-name ',name))))
+     ,@body))
+
+;;;###autoload
+(defmacro cl-once-only (names &rest body)
+  "Generate code to evaluate each of NAMES just once in BODY.
+
+This macro helps with writing other macros.  Each of names is
+either (NAME FORM) or NAME, which latter means (NAME NAME).
+During macroexpansion, each NAME is bound to an uninterned
+symbol.  The expansion evaluates each FORM and binds it to the
+corresponding uninterned symbol.
+
+For example, consider this macro:
+
+    (defmacro my-cons (x)
+      (cl-once-only (x)
+        \\=`(cons ,x ,x)))
+
+The call (my-cons (pop y)) will expand to something like this:
+
+    (let ((g1 (pop y)))
+      (cons g1 g1))
+
+The use of `cl-once-only' ensures that the pop is performed only
+once, as intended.
+
+See also `macroexp-let2'."
+  (declare (debug (sexp body)) (indent 1))
+  (setq names (mapcar #'ensure-list names))
+  (let ((our-gensyms (cl-loop for _ in names collect (gensym))))
+    ;; During macroexpansion, obtain a gensym for each NAME.
+    `(let ,(cl-loop for sym in our-gensyms collect `(,sym (gensym)))
+       ;; Evaluate each FORM and bind to the corresponding gensym.
+       ;;
+       ;; We require this explicit call to `list' rather than using
+       ;; (,,@(cl-loop ...)) due to a limitation of Elisp's backquote.
+       `(let ,(list
+               ,@(cl-loop for name in names for gensym in our-gensyms
+                          for to-eval = (or (cadr name) (car name))
+                          collect ``(,,gensym ,,to-eval)))
+          ;; During macroexpansion, bind each NAME to its gensym.
+          ,(let ,(cl-loop for name in names for gensym in our-gensyms
+                          collect `(,(car name) ,gensym))
+             ,@body)))))
+
 ;;; Multiple values.
 
 ;;;###autoload
@@ -2509,7 +2560,7 @@ values.  For compatibility, (cl-values A B C) is a synonym for (list A B C).
       (push x defun-declarations-alist)))
 
 (defun cl--optimize (f _args &rest qualities)
-  "Serve 'cl-optimize' in function declarations.
+  "Serve `cl-optimize' in function declarations.
 Example:
 (defun foo (x)
   (declare (cl-optimize (speed 3) (safety 0)))
@@ -2901,18 +2952,10 @@ To see the documentation for a defined struct type, use
            (debug
             (&define                    ;Makes top-level form not be wrapped.
              [&or symbolp
-                  (gate
+                  (gate ;; FIXME: Why?
                    symbolp &rest
-                   [&or symbolp
-                        (&or [":conc-name" symbolp]
-                             [":constructor" symbolp &optional cl-lambda-list]
-                             [":copier" symbolp]
-                             [":predicate" symbolp]
-                             [":include" symbolp &rest sexp] ;; Not finished.
-                             [":print-function" sexp]
-                             [":type" symbolp]
-                             [":named"]
-                             [":initial-offset" natnump])])]
+                   [&or (":constructor" &define name &optional cl-lambda-list)
+                        sexp])]
              [&optional stringp]
              ;; All the above is for the following def-form.
              &rest &or symbolp (symbolp &optional def-form &rest sexp))))
@@ -3287,8 +3330,9 @@ the form NAME which is a shorthand for (NAME NAME)."
             (funcall orig pred1
                      (cl--defstruct-predicate t2))))
      (funcall orig pred1 pred2))))
-(advice-add 'pcase--mutually-exclusive-p
-            :around #'cl--pcase-mutually-exclusive-p)
+(when (fboundp 'advice-add)           ;Not available during bootstrap.
+  (advice-add 'pcase--mutually-exclusive-p
+              :around #'cl--pcase-mutually-exclusive-p))
 
 
 (defun cl-struct-sequence-type (struct-type)
@@ -3359,9 +3403,11 @@ Of course, we really can't know that for sure, so it's just a heuristic."
                  (boolean	. booleanp)
                  (bool-vector	. bool-vector-p)
                  (buffer	. bufferp)
+                 (byte-code-function . byte-code-function-p)
                  (character	. natnump)
                  (char-table	. char-table-p)
                  (command	. commandp)
+                 (compiled-function . byte-code-function-p)
                  (hash-table	. hash-table-p)
                  (cons		. consp)
                  (fixnum	. fixnump)
@@ -3375,6 +3421,7 @@ Of course, we really can't know that for sure, so it's just a heuristic."
                  (null		. null)
                  (real		. numberp)
                  (sequence	. sequencep)
+                 (subr		. subrp)
                  (string	. stringp)
                  (symbol	. symbolp)
                  (vector	. vectorp)
@@ -3632,7 +3679,7 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc."
 
 (define-inline cl-struct-slot-value (struct-type slot-name inst)
   "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE.
-STRUCT and SLOT-NAME are symbols.  INST is a structure instance."
+STRUCT-TYPE and SLOT-NAME are symbols.  INST is a structure instance."
   (declare (side-effect-free t))
   (inline-letevals (struct-type slot-name inst)
     (inline-quote
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index b4be54bbd63..46f5ab35ff7 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -53,13 +53,23 @@
 (defconst cl--typeof-types
   ;; Hand made from the source code of `type-of'.
   '((integer number number-or-marker atom)
-    (symbol atom) (string array sequence atom)
+    (symbol-with-pos symbol atom) (symbol atom) (string array sequence atom)
     (cons list sequence)
     ;; Markers aren't `numberp', yet they are accepted wherever integers are
     ;; accepted, pretty much.
     (marker number-or-marker atom)
     (overlay atom) (float number atom) (window-configuration atom)
-    (process atom) (window atom) (subr atom) (compiled-function function atom)
+    (process atom) (window atom)
+    ;; FIXME: We'd want to put `function' here, but that's only true
+    ;; for those `subr's which aren't special forms!
+    (subr atom)
+    ;; FIXME: We should probably reverse the order between
+    ;; `compiled-function' and `byte-code-function' since arguably
+    ;; `subr' and also "compiled functions" but not "byte code functions",
+    ;; but it would require changing the value returned by `type-of' for
+    ;; byte code objects, which risks breaking existing code, which doesn't
+    ;; seem worth the trouble.
+    (compiled-function byte-code-function function atom)
     (module-function function atom)
     (buffer atom) (char-table array sequence atom)
     (bool-vector array sequence atom)
@@ -307,6 +317,17 @@ supertypes from the most specific to least specific.")
 (cl-assert (cl--class-p (cl--find-class 'cl-structure-class)))
 (cl-assert (cl--class-p (cl--find-class 'cl-structure-object)))
 
+(defun cl--class-allparents (class)
+  (let ((parents ())
+        (classes (list class)))
+    ;; BFS precedence.  FIXME: Use a topological sort.
+    (while (let ((class (pop classes)))
+             (cl-pushnew (cl--class-name class) parents)
+             (setq classes
+                   (append classes
+                           (cl--class-parents class)))))
+    (nreverse parents)))
+
 ;; Make sure functions defined with cl-defsubst can be inlined even in
 ;; packages which do not require CL.  We don't put an autoload cookie
 ;; directly on that function, since those cookies only go to cl-loaddefs.
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 2aade140e25..30d7e6525a4 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -221,26 +221,11 @@ into a button whose action shows the function's disassembly.")
                             'byte-code-function object)))))
   (princ ")" stream))
 
-;; This belongs in nadvice.el, of course, but some load-ordering issues make it
-;; complicated: cl-generic uses macros from cl-macs and cl-macs uses advice-add
-;; from nadvice, so nadvice needs to be loaded before cl-generic and hence
-;; can't use cl-defmethod.
-(cl-defmethod cl-print-object :extra "nadvice"
-              ((object compiled-function) stream)
-  (if (not (advice--p object))
-      (cl-call-next-method)
-    (princ "#f(advice-wrapper " stream)
-    (when (fboundp 'advice--where)
-      (princ (advice--where object) stream)
-      (princ " " stream))
-    (cl-print-object (advice--cdr object) stream)
-    (princ " " stream)
-    (cl-print-object (advice--car object) stream)
-    (let ((props (advice--props object)))
-      (when props
-        (princ " " stream)
-        (cl-print-object props stream)))
-    (princ ")" stream)))
+;; This belongs in oclosure.el, of course, but some load-ordering issues make it
+;; complicated.
+(cl-defmethod cl-print-object ((object accessor) stream)
+  ;; FIXME: η-reduce!
+  (oclosure--accessor-cl-print object stream))
 
 (cl-defmethod cl-print-object ((object cl-structure-object) stream)
   (if (and cl-print--depth (natnump print-level)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 122638077ce..237de52884b 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -238,7 +238,7 @@ native compilation runs.")
 
 (defvar comp-curr-allocation-class 'd-default
   "Current allocation class.
-Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'.  See `comp-ctxt'.")
+Can be one of: `d-default', `d-impure' or `d-ephemeral'.  See `comp-ctxt'.")
 
 (defconst comp-passes '(comp-spill-lap
                         comp-limplify
@@ -898,6 +898,8 @@ non local exit (ends with an `unreachable' insn)."))
        :documentation "Doc string.")
   (int-spec nil :type list
             :documentation "Interactive form.")
+  (command-modes nil :type list
+                 :documentation "Command modes.")
   (lap () :type list
        :documentation "LAP assembly representation.")
   (ssa-status nil :type symbol
@@ -1021,7 +1023,7 @@ To be used by all entry points."
 
 (defun comp-alloc-class-to-container (alloc-class)
   "Given ALLOC-CLASS, return the data container for the current context.
-Assume allocation class 'd-default as default."
+Assume allocation class `d-default' as default."
   (cl-struct-slot-value 'comp-ctxt (or alloc-class 'd-default) comp-ctxt))
 
 (defsubst comp-add-const-to-relocs (obj)
@@ -1243,6 +1245,7 @@ clashes."
                                  :c-name c-name
                                  :doc (documentation f t)
                                  :int-spec (interactive-form f)
+                                 :command-modes (command-modes f)
                                  :speed (comp-spill-speed function-name)
                                  :pure (comp-spill-decl-spec function-name
                                                              'pure))))
@@ -1282,10 +1285,12 @@ clashes."
                    (make-comp-func-l :c-name c-name
                                      :doc (documentation form t)
                                      :int-spec (interactive-form form)
+                                     :command-modes (command-modes form)
                                      :speed (comp-ctxt-speed comp-ctxt))
                  (make-comp-func-d :c-name c-name
                                    :doc (documentation form t)
                                    :int-spec (interactive-form form)
+                                   :command-modes (command-modes form)
                                    :speed (comp-ctxt-speed comp-ctxt)))))
     (let ((lap (byte-to-native-lambda-lap
                 (gethash (aref byte-code 1)
@@ -1327,6 +1332,7 @@ clashes."
             (comp-func-byte-func func) byte-func
             (comp-func-doc func) (documentation byte-func t)
             (comp-func-int-spec func) (interactive-form byte-func)
+            (comp-func-command-modes func) (command-modes byte-func)
             (comp-func-c-name func) c-name
             (comp-func-lap func) lap
             (comp-func-frame-size func) (comp-byte-frame-size byte-func)
@@ -2079,7 +2085,8 @@ and the annotation emission."
                                 (i (hash-table-count h)))
                            (puthash i (comp-func-doc f) h)
                            i)
-                         (comp-func-int-spec f)))
+                         (comp-func-int-spec f)
+                         (comp-func-command-modes f)))
                        ;; This is the compilation unit it-self passed as
                        ;; parameter.
                        (make-comp-mvar :slot 0))))))
@@ -2122,7 +2129,8 @@ These are stored in the reloc data array."
                          (i (hash-table-count h)))
                     (puthash i (comp-func-doc func) h)
                     i)
-                  (comp-func-int-spec func)))
+                  (comp-func-int-spec func)
+                  (comp-func-command-modes func)))
                 ;; This is the compilation unit it-self passed as
                 ;; parameter.
                 (make-comp-mvar :slot 0)))))
@@ -2625,8 +2633,8 @@ TARGET-BB-SYM is the symbol name of the target block."
             do (comp-emit-call-cstr target insn-cell cstr)))))))
 
 (defun comp-add-cstrs (_)
-  "Rewrite conditional branches adding appropriate 'assume' insns.
-This is introducing and placing 'assume' insns in use by fwprop
+  "Rewrite conditional branches adding appropriate `assume' insns.
+This is introducing and placing `assume' insns in use by fwprop
 to propagate conditional branch test information on target basic
 blocks."
   (maphash (lambda (_ f)
@@ -3474,7 +3482,7 @@ Return the list of m-var ids nuked."
 
 (defun comp-remove-type-hints-func ()
   "Remove type hints from the current function.
-These are substituted with a normal 'set' op."
+These are substituted with a normal `set' op."
   (cl-loop
    for b being each hash-value of (comp-func-blocks comp-func)
    do (comp-loop-insn-in-block b
@@ -4209,7 +4217,7 @@ Generate .elc files in addition to the .eln files.
 Force the produced .eln to be outputted in the eln system
 directory (the last entry in `native-comp-eln-load-path') unless
 `native-compile-target-directory' is non-nil.  If the environment
-variable 'NATIVE_DISABLED' is set, only byte compile."
+variable \"NATIVE_DISABLED\" is set, only byte compile."
   (comp-ensure-native-compiler)
   (if (equal (getenv "NATIVE_DISABLED") "1")
       (batch-byte-compile)
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index f3e1981732c..8a5c3d3730c 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -254,6 +254,23 @@ with empty strings removed."
                     'crm--choose-completion-string nil 'local)
           (setq-local minibuffer-completion-table #'crm--collection-fn)
           (setq-local minibuffer-completion-predicate predicate)
+          (setq-local completion-list-insert-choice-function
+                      (lambda (start end choice)
+                        (if (and (stringp start) (stringp end))
+                            (let* ((beg (save-excursion
+                                          (goto-char (minibuffer-prompt-end))
+                                          (or (search-forward start nil t)
+                                              (search-forward-regexp crm-separator nil t)
+                                              (minibuffer-prompt-end))))
+                                   (end (save-excursion
+                                          (goto-char (point-max))
+                                          (or (search-backward end nil t)
+                                              (progn
+                                                (goto-char beg)
+                                                (search-forward-regexp crm-separator nil t))
+                                              (point-max)))))
+                              (completion--replace beg end choice))
+                          (completion--replace start end choice))))
           ;; see completing_read in src/minibuf.c
           (setq-local minibuffer-completion-confirm
                       (unless (eq require-match t) require-match))
diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el
index 85ed5f2176c..4f1f4b81557 100644
--- a/lisp/emacs-lisp/debug-early.el
+++ b/lisp/emacs-lisp/debug-early.el
@@ -35,30 +35,34 @@
 
 (defalias 'debug-early-backtrace
   #'(lambda ()
-  "Print a trace of Lisp function calls currently active.
+      "Print a trace of Lisp function calls currently active.
 The output stream used is the value of `standard-output'.
 
 This is a simplified version of the standard `backtrace'
 function, intended for use in debugging the early parts
 of the build process."
-  (princ "\n")
-  (mapbacktrace
-   #'(lambda (evald func args _flags)
-       (let ((args args))
-	 (if evald
-	     (progn
-	       (princ "  ")
-	       (prin1 func)
-	       (princ "("))
-	   (progn
-	     (princ "  (")
-	     (setq args (cons func args))))
-	 (if args
-	     (while (progn
-	              (prin1 (car args))
-	              (setq args (cdr args)))
-	       (princ " ")))
-	 (princ ")\n"))))))
+      (princ "\n")
+      (let ((print-escape-newlines t)
+            (print-escape-control-characters t)
+            (print-escape-nonascii t)
+            (prin1 (if (fboundp 'cl-prin1) #'cl-prin1 #'prin1)))
+        (mapbacktrace
+         #'(lambda (evald func args _flags)
+             (let ((args args))
+	       (if evald
+	           (progn
+	             (princ "  ")
+	             (funcall prin1 func)
+	             (princ "("))
+	         (progn
+	           (princ "  (")
+	           (setq args (cons func args))))
+	       (if args
+	           (while (progn
+	                    (funcall prin1 (car args))
+	                    (setq args (cdr args)))
+	             (princ " ")))
+	       (princ ")\n")))))))
 
 (defalias 'debug-early
   #'(lambda (&rest args)
@@ -76,7 +80,7 @@ superseded by `debug' after enough Lisp has been loaded to
 support the latter, except in batch mode which always uses
 `debug-early'.
 
-(In versions of Emacs prior to Emacs 29, no backtrace was
+\(In versions of Emacs prior to Emacs 29, no backtrace was
 available before `debug' was usable.)"
   (princ "\nError: ")
   (prin1 (car (car (cdr args))))	; The error symbol.
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 46b0306d64f..6c172d6c31d 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -90,6 +90,11 @@ The value used here is passed to `quit-restore-window'."
   :group 'debugger
   :version "24.3")
 
+(defcustom debug-allow-recursive-debug nil
+  "If non-nil, erroring in debug and edebug won't recursively debug."
+  :type 'boolean
+  :version "29.1")
+
 (defvar debugger-step-after-exit nil
   "Non-nil means \"single-step\" after the debugger exits.")
 
@@ -534,11 +539,23 @@ The environment used is the one when entering the activation frame at point."
                       (error 0)))) ;; If on first line.
 	(base (debugger--backtrace-base)))
     (debugger-env-macro
-      (let ((val (backtrace-eval exp nframe base)))
-        (prog1
-            (debugger--print val t)
-          (let ((str (eval-expression-print-format val)))
-            (if str (princ str t))))))))
+      (let* ((errored nil)
+             (val (if debug-allow-recursive-debug
+                      (backtrace-eval exp nframe base)
+                    (condition-case err
+                        (backtrace-eval exp nframe base)
+                      (error (setq errored
+                                   (format "%s: %s"
+                                           (get (car err) 'error-message)
+			                   (car (cdr err)))))))))
+        (if errored
+            (progn
+              (message "Error: %s" errored)
+              nil)
+          (prog1
+              (debugger--print val t)
+            (let ((str (eval-expression-print-format val)))
+              (if str (princ str t)))))))))
 
 (define-obsolete-function-alias 'debugger-toggle-locals
   'backtrace-toggle-locals "28.1")
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 688c76e0c54..54cac116168 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -82,11 +82,9 @@ replacing its case-insensitive matches with the literal string in LIGHTER."
       (replace-regexp-in-string (regexp-quote lighter) lighter name t t))))
 
 (defconst easy-mmode--arg-docstring
-  "
-
-This is a minor mode.  If called interactively, toggle the `%s'
-mode.  If the prefix argument is positive, enable the mode, and
-if it is zero or negative, disable the mode.
+  "This is a %sminor mode.  If called interactively, toggle the
+`%s' mode.  If the prefix argument is positive, enable the mode,
+and if it is zero or negative, disable the mode.
 
 If called from Lisp, toggle the mode if ARG is `toggle'.
 Enable the mode if ARG is nil, omitted, or is a positive number.
@@ -99,28 +97,50 @@ The mode's hook is called both when the mode is enabled and when
 it is disabled.")
 
 (defun easy-mmode--mode-docstring (doc mode-pretty-name keymap-sym
-                                       getter)
-  (let ((doc (or doc (format "Toggle %s on or off.
-
-\\{%s}" mode-pretty-name keymap-sym))))
-    (if (string-match-p "\\bARG\\b" doc)
-        doc
-      (let* ((fill-prefix nil)
-             (docs-fc (bound-and-true-p emacs-lisp-docstring-fill-column))
-             (fill-column (if (integerp docs-fc) docs-fc 65))
-             (argdoc (format easy-mmode--arg-docstring mode-pretty-name
-                             ;; Avoid having quotes turn into pretty quotes.
-                             (string-replace "'" "\\\\='"
-                                             (format "%S" getter))))
-             (filled (if (fboundp 'fill-region)
-                         (with-temp-buffer
-                           (insert argdoc)
-                           (fill-region (point-min) (point-max) 'left t)
-                           (buffer-string))
-                       argdoc)))
-        (replace-regexp-in-string "\\(\n\n\\|\\'\\)\\(.\\|\n\\)*\\'"
-                                  (concat filled "\\1")
-                                  doc nil nil 1)))))
+                                       getter global)
+  ;; If we have a doc string, and it's already complete (which we
+  ;; guess at with the simple heuristic below), then just return that
+  ;; as is.
+  (if (and doc (string-match-p "\\bARG\\b" doc))
+      doc
+    ;; Compose a new doc string.
+    (with-temp-buffer
+      (let ((lines (if doc
+                       (string-lines doc)
+                     (list (format "Toggle %s on or off." mode-pretty-name)))))
+        ;; Insert the first line from the doc string.
+        (insert (pop lines))
+        ;; Ensure that we have (only) one blank line after the first
+        ;; line.
+        (ensure-empty-lines)
+        (while (and lines
+                    (equal (car lines) ""))
+          (pop lines))
+        ;; Insert the doc string.
+        (dolist (line lines)
+          (insert line "\n"))
+        (ensure-empty-lines)
+        ;; Insert the boilerplate.
+        (let* ((fill-prefix nil)
+               (docs-fc (bound-and-true-p emacs-lisp-docstring-fill-column))
+               (fill-column (if (integerp docs-fc) docs-fc 65))
+               (argdoc (format
+                        easy-mmode--arg-docstring
+                        (if global "global " "")
+                        mode-pretty-name
+                        ;; Avoid having quotes turn into pretty quotes.
+                        (string-replace "'" "\\='" (format "%S" getter)))))
+          (let ((start (point)))
+            (insert argdoc)
+            (when (fboundp 'fill-region)
+              (fill-region start (point) 'left t))))
+        ;; Finally, insert the keymap.
+        (when (and (boundp keymap-sym)
+                   (or (not doc)
+                       (not (string-search "\\{" doc))))
+          (ensure-empty-lines)
+          (insert (format "\\{%s}" keymap-sym)))
+        (buffer-string)))))
 
 ;;;###autoload
 (defalias 'easy-mmode-define-minor-mode #'define-minor-mode)
@@ -317,7 +337,7 @@ or call the function `%s'."))))
          warnwrap
          `(defun ,modefun (&optional arg ,@extra-args)
             ,(easy-mmode--mode-docstring doc pretty-name keymap-sym
-                                         getter)
+                                         getter globalp)
             ,(when interactive
 	       ;; Use `toggle' rather than (if ,mode 0 1) so that using
 	       ;; repeat-command still does the toggling correctly.
@@ -805,7 +825,6 @@ Interactively, COUNT is the prefix numeric argument, and defaults to 1."
            ,@body))
        (put ',prev-sym 'definition-name ',base))))
 
-
 (provide 'easy-mmode)
 
 ;;; easy-mmode.el ends here
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 722283b88ff..d8b0a13c305 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -57,6 +57,7 @@
 (require 'cl-lib)
 (require 'seq)
 (eval-when-compile (require 'pcase))
+(require 'debug)
 
 ;;; Options
 
@@ -3711,12 +3712,25 @@ Return the result of the last expression."
 If interactive, prompt for the expression.
 Print result in minibuffer."
   (interactive (list (read--expression "Eval: ")))
-  (princ
-   (edebug-outside-excursion
-    (let ((result (edebug-eval expr)))
-      (values--store-value result)
-      (concat (edebug-safe-prin1-to-string result)
-              (eval-expression-print-format result))))))
+  (let* ((errored nil)
+         (result
+          (edebug-outside-excursion
+           (let ((result (if debug-allow-recursive-debug
+                             (edebug-eval expr)
+                           (condition-case err
+                               (edebug-eval expr)
+                             (error
+                              (setq errored
+                                    (format "%s: %s"
+			                    (get (car err) 'error-message)
+			                    (car (cdr err)))))))))
+             (unless errored
+               (values--store-value result)
+               (concat (edebug-safe-prin1-to-string result)
+                       (eval-expression-print-format result)))))))
+    (if errored
+        (message "Error: %s" errored)
+      (princ result))))
 
 (defun edebug-eval-last-sexp (&optional no-truncate)
   "Evaluate sexp before point in the outside environment.
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 19aa20fa086..d687289b22f 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -92,7 +92,7 @@ Currently under control of this var:
                (:copier nil))
   children
   initarg-tuples                  ;; initarg tuples list
-  (class-slots nil :type eieio--slot)
+  (class-slots nil :type (vector-of eieio--slot))
   class-allocation-values         ;; class allocated value vector
   default-object-cache ;; what a newly created object would look like.
                        ; This will speed up instantiation time as
@@ -130,10 +130,7 @@ Currently under control of this var:
     class))
 
 (defsubst eieio--object-class (obj)
-  (let ((tag (eieio--object-class-tag obj)))
-    (if eieio-backward-compatibility
-        (eieio--class-object tag)
-      tag)))
+  (eieio--class-object (eieio--object-class-tag obj)))
 
 (defun class-p (x)
   "Return non-nil if X is a valid class vector.
@@ -265,6 +262,10 @@ use '%s or turn off `eieio-backward-compatibility' instead" cname)
 (defvar eieio--known-slot-names nil)
 (defvar eieio--known-class-slot-names nil)
 
+(defun eieio--known-slot-name-p (name)
+  (or (memq name eieio--known-slot-names)
+      (get name 'slot-name)))
+
 (defun eieio-defclass-internal (cname superclasses slots options)
   "Define CNAME as a new subclass of SUPERCLASSES.
 SLOTS are the slots residing in that class definition, and OPTIONS
@@ -710,9 +711,9 @@ an error."
       (cond
        ((not (eieio--perform-slot-validation st value))
 	(signal 'invalid-slot-type
-                (list (eieio--class-name class) slot st value)))
+                (list (cl--class-name class) slot st value)))
        ((alist-get :read-only (cl--slot-descriptor-props sd))
-        (signal 'eieio-read-only (list (eieio--class-name class) slot)))))))
+        (signal 'eieio-read-only (list (cl--class-name class) slot)))))))
 
 (defun eieio--validate-class-slot-value (class slot-idx value slot)
   "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
@@ -725,7 +726,7 @@ an error."
                                               slot-idx))))
       (if (not (eieio--perform-slot-validation st value))
 	  (signal 'invalid-slot-type
-                  (list (eieio--class-name class) slot st value))))))
+                  (list (cl--class-name class) slot st value))))))
 
 (defun eieio-barf-if-slot-unbound (value instance slotname fn)
   "Throw a signal if VALUE is a representation of an UNBOUND slot.
@@ -746,31 +747,35 @@ Argument FN is the function calling this verifier."
               (ignore obj)
               (pcase slot
                 ((and (or `',name (and name (pred keywordp)))
-                      (guard (not (memq name eieio--known-slot-names))))
+                      (guard (not (eieio--known-slot-name-p name))))
                  (macroexp-warn-and-return
                   (format-message "Unknown slot `%S'" name)
                   exp nil 'compile-only name))
                 (_ exp))))
+           ;; FIXME: Make it a gv-expander such that the hash-table lookup is
+           ;; only performed once when used in `push' and friends?
            (gv-setter eieio-oset))
   (cl-check-type slot symbol)
-  (cl-check-type obj (or eieio-object class cl-structure-object))
-  (let* ((class (cond ((symbolp obj)
-                       (error "eieio-oref called on a class: %s" obj)
-                       (eieio--full-class-object obj))
-                      (t (eieio--object-class obj))))
-	 (c (eieio--slot-name-index class slot)))
-    (if (not c)
-	;; It might be missing because it is a :class allocated slot.
-	;; Let's check that info out.
-	(if (setq c (eieio--class-slot-name-index class slot))
-	    ;; Oref that slot.
-	    (aref (eieio--class-class-allocation-values class) c)
-	  ;; The slot-missing method is a cool way of allowing an object author
-	  ;; to intercept missing slot definitions.  Since it is also the LAST
-	  ;; thing called in this fn, its return value would be retrieved.
-	  (slot-missing obj slot 'oref))
-      (cl-check-type obj (or eieio-object cl-structure-object))
-      (eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref))))
+  (cond
+   ((cl-typep obj '(or eieio-object cl-structure-object))
+    (let* ((class (eieio--object-class obj))
+           (c (eieio--slot-name-index class slot)))
+      (if (not c)
+	  ;; It might be missing because it is a :class allocated slot.
+	  ;; Let's check that info out.
+	  (if (setq c (eieio--class-slot-name-index class slot))
+	      ;; Oref that slot.
+	      (aref (eieio--class-class-allocation-values class) c)
+	    ;; The slot-missing method is a cool way of allowing an object author
+	    ;; to intercept missing slot definitions.  Since it is also the LAST
+	    ;; thing called in this fn, its return value would be retrieved.
+	    (slot-missing obj slot 'oref))
+	(eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref))))
+   ((cl-typep obj 'oclosure) (oclosure--slot-value obj slot))
+   (t
+    (signal 'wrong-type-argument
+            (list '(or eieio-object cl-structure-object oclosure) obj)))))
+
 
 
 (defun eieio-oref-default (class slot)
@@ -782,7 +787,7 @@ Fills in CLASS's SLOT with its default value."
               (ignore class)
               (pcase slot
                 ((and (or `',name (and name (pred keywordp)))
-                      (guard (not (memq name eieio--known-slot-names))))
+                      (guard (not (eieio--known-slot-name-p name))))
                  (macroexp-warn-and-return
                   (format-message "Unknown slot `%S'" name)
                   exp nil 'compile-only name))
@@ -817,24 +822,29 @@ Fills in CLASS's SLOT with its default value."
 (defun eieio-oset (obj slot value)
   "Do the work for the macro `oset'.
 Fills in OBJ's SLOT with VALUE."
-  (cl-check-type obj (or eieio-object cl-structure-object))
   (cl-check-type slot symbol)
-  (let* ((class (eieio--object-class obj))
-         (c (eieio--slot-name-index class slot)))
-    (if (not c)
-	;; It might be missing because it is a :class allocated slot.
-	;; Let's check that info out.
-	(if (setq c
-		  (eieio--class-slot-name-index class slot))
-	    ;; Oset that slot.
-	    (progn
-	      (eieio--validate-class-slot-value class c value slot)
-	      (aset (eieio--class-class-allocation-values class)
-		    c value))
-	  ;; See oref for comment on `slot-missing'
-	  (slot-missing obj slot 'oset value))
-      (eieio--validate-slot-value class c value slot)
-      (aset obj c value))))
+  (cond
+   ((cl-typep obj '(or eieio-object cl-structure-object))
+    (let* ((class (eieio--object-class obj))
+           (c (eieio--slot-name-index class slot)))
+      (if (not c)
+	  ;; It might be missing because it is a :class allocated slot.
+	  ;; Let's check that info out.
+	  (if (setq c
+		    (eieio--class-slot-name-index class slot))
+	      ;; Oset that slot.
+	      (progn
+	        (eieio--validate-class-slot-value class c value slot)
+	        (aset (eieio--class-class-allocation-values class)
+		      c value))
+	    ;; See oref for comment on `slot-missing'
+	    (slot-missing obj slot 'oset value))
+	(eieio--validate-slot-value class c value slot)
+	(aset obj c value))))
+   ((cl-typep obj 'oclosure) (oclosure--set-slot-value obj slot value))
+   (t
+    (signal 'wrong-type-argument
+            (list '(or eieio-object cl-structure-object oclosure) obj)))))
 
 (defun eieio-oset-default (class slot value)
   "Do the work for the macro `oset-default'.
@@ -844,7 +854,7 @@ Fills in the default value in CLASS' in SLOT with VALUE."
               (ignore class value)
               (pcase slot
                 ((and (or `',name (and name (pred keywordp)))
-                      (guard (not (memq name eieio--known-slot-names))))
+                      (guard (not (eieio--known-slot-name-p name))))
                  (macroexp-warn-and-return
                   (format-message "Unknown slot `%S'" name)
                   exp nil 'compile-only name))
@@ -867,7 +877,7 @@ Fills in the default value in CLASS' in SLOT with VALUE."
               (eieio--validate-class-slot-value class c value slot)
               (aset (eieio--class-class-allocation-values class) c
                     value))
-          (signal 'invalid-slot-name (list (eieio--class-name class) slot)))
+          (signal 'invalid-slot-name (list (cl--class-name class) slot)))
       ;; `oset-default' on an instance-allocated slot is allowed by EIEIO but
       ;; not by CLOS and is mildly inconsistent with the :initform thingy, so
       ;; it'd be nice to get rid of it.
@@ -896,7 +906,7 @@ The slot is a symbol which is installed in CLASS by the `defclass' call.
 If SLOT is the value created with :initarg instead,
 reverse-lookup that name, and recurse with the associated slot value."
   ;; Removed checks to outside this call
-  (let* ((fsi (gethash slot (eieio--class-index-table class))))
+  (let* ((fsi (gethash slot (cl--class-index-table class))))
     (if (integerp fsi)
         fsi
       (let ((fn (eieio--initarg-to-attribute class slot)))
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 73713a3dec9..74ffeb166d4 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -5,7 +5,7 @@
 ;; Author: Noah Friedman <friedman@splode.com>
 ;; Keywords: extensions
 ;; Created: 1995-10-06
-;; Version: 1.11.0
+;; Version: 1.11.1
 ;; Package-Requires: ((emacs "26.3"))
 
 ;; This is a GNU ELPA :core package.  Avoid functionality that is not
@@ -102,7 +102,7 @@ put in the echo area.  If a positive integer, the number is used
 directly, while a float specifies the number of lines as a
 proportion of the echo area frame's height.
 
-If value is the symbol `truncate-sym-name-if-fit' t, the part of
+If value is the symbol `truncate-sym-name-if-fit', the part of
 the doc string that represents a symbol's name may be truncated
 if it will enable the rest of the doc string to fit on a single
 line, without resizing the echo area.
@@ -525,7 +525,8 @@ Helper for `eldoc-display-in-echo-area'."
                         (goto-char (point-min))
                         (skip-chars-forward " \t\n")
                         (point))
-                 (goto-char (line-end-position available))
+                 (forward-visible-line (1- available))
+                 (end-of-visible-line)
                  (skip-chars-backward " \t\n")))
         (truncated (save-excursion
                      (skip-chars-forward " \t\n")
@@ -535,7 +536,8 @@ Helper for `eldoc-display-in-echo-area'."
           ((and truncated
                 (> available 1)
                 eldoc-echo-area-display-truncation-message)
-           (goto-char (line-end-position 0))
+           (forward-visible-line -1)
+           (end-of-visible-line)
            (concat (buffer-substring start (point))
                    (format
                     "\n(Documentation truncated. Use `%s' to see rest)"
@@ -610,7 +612,8 @@ Honor `eldoc-echo-area-use-multiline-p' and
                (let ((string
                       (with-current-buffer (eldoc--format-doc-buffer docs)
                         (buffer-substring (goto-char (point-min))
-                                          (line-end-position 1)))))
+                                          (progn (end-of-visible-line)
+                                                 (point))))))
                  (if (> (length string) width)  ; truncation to happen
                      (unless (eldoc--echo-area-prefer-doc-buffer-p t)
                        (truncate-string-to-width string width))
diff --git a/lisp/emacs-lisp/faceup.el b/lisp/emacs-lisp/faceup.el
index 77689f434c2..b44132dcead 100644
--- a/lisp/emacs-lisp/faceup.el
+++ b/lisp/emacs-lisp/faceup.el
@@ -1006,7 +1006,7 @@ which could be defined as:
     (defun my-test-explain (args...)
       (let ((faceup-test-explain t))
         (the-test args...)))
-    (put 'my-test 'ert-explainer 'my-test-explain)
+    (put \\='my-test \\='ert-explainer \\='my-test-explain)
 
 Alternative, you can use the macro `faceup-defexplainer' as follows:
 
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 571087c963d..96eaf1ab642 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -61,6 +61,7 @@
    "^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\
 ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
 foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
+cl-\\(?:defun\\|defmethod\\|defgeneric\\)\\|\
 menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)"
    find-function-space-re
    "\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)")
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 7df40e36f8f..e7c3a4b64f5 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -1436,29 +1436,49 @@ and initial semicolons."
                                   (derived-mode-p 'emacs-lisp-mode))
                              emacs-lisp-docstring-fill-column
                            fill-column)))
-        (save-restriction
+        (let ((ppss (syntax-ppss))
+              (start (point)))
           (save-excursion
-          (let ((ppss (syntax-ppss))
-                (start (point)))
-            ;; If we're in a string, then narrow (roughly) to that
-            ;; string before filling.  This avoids filling Lisp
-            ;; statements that follow the string.
-            (when (ppss-string-terminator ppss)
-              (goto-char (ppss-comment-or-string-start ppss))
-              (beginning-of-line)
-              ;; The string may be unterminated -- in that case, don't
-              ;; narrow.
-              (when (ignore-errors
-                      (progn
-                        (forward-sexp 1)
-                        t))
-                (narrow-to-region (ppss-comment-or-string-start ppss)
-                                  (point))))
-            ;; Move back to where we were.
+            (save-restriction
+              ;; If we're not inside a string, then do very basic
+              ;; filling.  This avoids corrupting embedded strings in
+              ;; code.
+              (if (not (ppss-comment-or-string-start ppss))
+                  (lisp--fill-line-simple)
+                ;; If we're in a string, then narrow (roughly) to that
+                ;; string before filling.  This avoids filling Lisp
+                ;; statements that follow the string.
+                (when (ppss-string-terminator ppss)
+                  (goto-char (ppss-comment-or-string-start ppss))
+                  ;; The string may be unterminated -- in that case, don't
+                  ;; narrow.
+                  (when (ignore-errors
+                          (progn
+                            (forward-sexp 1)
+                            t))
+                    (narrow-to-region (ppss-comment-or-string-start ppss)
+                                      (point))))
+                ;; Move back to where we were.
+                (goto-char start)
+	        (fill-paragraph justify)))))))
+  ;; Never return nil.
+  t)
+
+(defun lisp--fill-line-simple ()
+  (narrow-to-region (line-beginning-position) (line-end-position))
+  (goto-char (point-min))
+  (while (and (not (eobp))
+              (re-search-forward "\\_>" nil t))
+    (when (> (current-column) fill-column)
+      (let ((start (point)))
+        (backward-sexp)
+        (if (looking-back "[[(]" (point-min))
             (goto-char start)
-	    (fill-paragraph justify)))))
-      ;; Never return nil.
-      t))
+          (skip-chars-backward " \t")
+          (insert "\n")
+          (forward-sexp))))
+    (unless (eobp)
+      (forward-char 1))))
 
 (defun indent-code-rigidly (start end arg &optional nochange-regexp)
   "Indent all lines of code, starting in the region, sideways by ARG columns.
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 4aeca9c6b00..ffca0dcf4f5 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -171,6 +171,8 @@ This command assumes point is not in a string or comment.
 If INTERACTIVE is non-nil, as it is interactively,
 report errors as appropriate for this kind of usage."
   (interactive "^p\nd")
+  (when (ppss-comment-or-string-start (syntax-ppss))
+    (user-error "This command doesn't work in strings or comments"))
   (if interactive
       (condition-case _
           (down-list arg nil)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index e91b302af10..51c6e8e0ca2 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -330,108 +330,109 @@ Assumes the caller has bound `macroexpand-all-environment'."
         (setq form (macroexp-macroexpand form macroexpand-all-environment))
         ;; FIXME: It'd be nice to use `byte-optimize--pcase' here, but when
         ;; I tried it, it broke the bootstrap :-(
-        (pcase form
-          (`(cond . ,clauses)
-           (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
-          (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
-           (macroexp--cons
-            'condition-case
-            (macroexp--cons err
-                            (macroexp--cons (macroexp--expand-all body)
-                                            (macroexp--all-clauses handlers 1)
-                                            (cddr form))
-                            (cdr form))
-            form))
-          (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_)
-           (push name macroexp--dynvars)
-           (macroexp--all-forms form 2))
-          (`(function ,(and f `(lambda . ,_)))
-           (let ((macroexp--dynvars macroexp--dynvars))
-             (macroexp--cons 'function
-                             (macroexp--cons (macroexp--all-forms f 2)
-                                             nil
-                                             (cdr form))
-                             form)))
-          (`(,(or 'function 'quote) . ,_) form)
-          (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
-                                               pcase--dontcare))
-           (let ((macroexp--dynvars macroexp--dynvars))
+        (let ((fn (car-safe form)))
+          (pcase form
+            (`(cond . ,clauses)
+             (macroexp--cons fn (macroexp--all-clauses clauses) form))
+            (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
              (macroexp--cons
-              fun
-              (macroexp--cons
-               (macroexp--all-clauses bindings 1)
-               (if (null body)
-                   (macroexp-unprogn
-                    (macroexp-warn-and-return
-                     (format "Empty %s body" fun)
-                     nil nil 'compile-only fun))
-                 (macroexp--all-forms body))
-               (cdr form))
-              form)))
-          (`(,(and fun `(lambda . ,_)) . ,args)
-           ;; Embedded lambda in function position.
-           ;; If the byte-optimizer is loaded, try to unfold this,
-           ;; i.e. rewrite it to (let (<args>) <body>).  We'd do it in the optimizer
-           ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
-           ;; creation of a closure, thus resulting in much better code.
-           (let ((newform (macroexp--unfold-lambda form)))
-	     (if (eq newform form)
-	         ;; Unfolding failed for some reason, avoid infinite recursion.
-	         (macroexp--cons (macroexp--all-forms fun 2)
-                                 (macroexp--all-forms args)
-                                 form)
-	       (macroexp--expand-all newform))))
-          (`(funcall ,exp . ,args)
-           (let ((eexp (macroexp--expand-all exp))
-                 (eargs (macroexp--all-forms args)))
-             ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
-             ;; has a compiler-macro, or to unfold it.
-             (pcase eexp
-               ((and `#',f
-                     (guard (not (or (special-form-p f) (macrop f))))) ;; bug#46636
-                (macroexp--expand-all `(,f . ,eargs)))
-               (_ `(funcall ,eexp . ,eargs)))))
-          (`(funcall . ,_) form)            ;bug#53227
-          (`(,func . ,_)
-           (let ((handler (function-get func 'compiler-macro))
-                 (funargs (function-get func 'funarg-positions)))
-             ;; Check functions quoted with ' rather than with #'
-             (dolist (funarg funargs)
-               (let ((arg (nth funarg form)))
-                 (when (and (eq 'quote (car-safe arg))
-                            (eq 'lambda (car-safe (cadr arg))))
-                   (setcar (nthcdr funarg form)
-                           (macroexp-warn-and-return
-                            (format "%S quoted with ' rather than with #'"
-                                    (let ((f (cadr arg)))
-                                      (if (symbolp f) f `(lambda ,(nth 1 f) ...))))
-                            arg nil nil (cadr arg))))))
-             ;; Macro expand compiler macros.  This cannot be delayed to
-             ;; byte-optimize-form because the output of the compiler-macro can
-             ;; use macros.
-             (if (null handler)
-                 ;; No compiler macro.  We just expand each argument (for
-                 ;; setq/setq-default this works alright because the variable names
-                 ;; are symbols).
-                 (macroexp--all-forms form 1)
-               ;; If the handler is not loaded yet, try (auto)loading the
-               ;; function itself, which may in turn load the handler.
-               (unless (functionp handler)
-                 (with-demoted-errors "macroexp--expand-all: %S"
-                   (autoload-do-load (indirect-function func) func)))
-               (let ((newform (macroexp--compiler-macro handler form)))
-                 (if (eq form newform)
-                     ;; The compiler macro did not find anything to do.
-                     (if (equal form (setq newform (macroexp--all-forms form 1)))
-                         form
-                       ;; Maybe after processing the args, some new opportunities
-                       ;; appeared, so let's try the compiler macro again.
-                       (setq form (macroexp--compiler-macro handler newform))
-                       (if (eq newform form)
-                           newform
-                         (macroexp--expand-all newform)))
-                   (macroexp--expand-all newform))))))
-          (_ form)))
+              fn
+              (macroexp--cons err
+                              (macroexp--cons (macroexp--expand-all body)
+                                              (macroexp--all-clauses handlers 1)
+                                              (cddr form))
+                              (cdr form))
+              form))
+            (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_)
+             (push name macroexp--dynvars)
+             (macroexp--all-forms form 2))
+            (`(function ,(and f `(lambda . ,_)))
+             (let ((macroexp--dynvars macroexp--dynvars))
+               (macroexp--cons fn
+                               (macroexp--cons (macroexp--all-forms f 2)
+                                               nil
+                                               (cdr form))
+                               form)))
+            (`(,(or 'function 'quote) . ,_) form)
+            (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
+                                                 pcase--dontcare))
+             (let ((macroexp--dynvars macroexp--dynvars))
+               (macroexp--cons
+                fun
+                (macroexp--cons
+                 (macroexp--all-clauses bindings 1)
+                 (if (null body)
+                     (macroexp-unprogn
+                      (macroexp-warn-and-return
+                       (format "Empty %s body" fun)
+                       nil nil 'compile-only fun))
+                   (macroexp--all-forms body))
+                 (cdr form))
+                form)))
+            (`(,(and fun `(lambda . ,_)) . ,args)
+             ;; Embedded lambda in function position.
+             ;; If the byte-optimizer is loaded, try to unfold this,
+             ;; i.e. rewrite it to (let (<args>) <body>).  We'd do it in the optimizer
+             ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
+             ;; creation of a closure, thus resulting in much better code.
+             (let ((newform (macroexp--unfold-lambda form)))
+	       (if (eq newform form)
+	           ;; Unfolding failed for some reason, avoid infinite recursion.
+	           (macroexp--cons (macroexp--all-forms fun 2)
+                                   (macroexp--all-forms args)
+                                   form)
+	         (macroexp--expand-all newform))))
+            (`(funcall ,exp . ,args)
+             (let ((eexp (macroexp--expand-all exp))
+                   (eargs (macroexp--all-forms args)))
+               ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
+               ;; has a compiler-macro, or to unfold it.
+               (pcase eexp
+                 ((and `#',f
+                       (guard (not (or (special-form-p f) (macrop f))))) ;; bug#46636
+                  (macroexp--expand-all `(,f . ,eargs)))
+                 (_ `(funcall ,eexp . ,eargs)))))
+            (`(funcall . ,_) form)      ;bug#53227
+            (`(,func . ,_)
+             (let ((handler (function-get func 'compiler-macro))
+                   (funargs (function-get func 'funarg-positions)))
+               ;; Check functions quoted with ' rather than with #'
+               (dolist (funarg funargs)
+                 (let ((arg (nth funarg form)))
+                   (when (and (eq 'quote (car-safe arg))
+                              (eq 'lambda (car-safe (cadr arg))))
+                     (setcar (nthcdr funarg form)
+                             (macroexp-warn-and-return
+                              (format "%S quoted with ' rather than with #'"
+                                      (let ((f (cadr arg)))
+                                        (if (symbolp f) f `(lambda ,(nth 1 f) ...))))
+                              arg nil nil (cadr arg))))))
+               ;; Macro expand compiler macros.  This cannot be delayed to
+               ;; byte-optimize-form because the output of the compiler-macro can
+               ;; use macros.
+               (if (null handler)
+                   ;; No compiler macro.  We just expand each argument (for
+                   ;; setq/setq-default this works alright because the variable names
+                   ;; are symbols).
+                   (macroexp--all-forms form 1)
+                 ;; If the handler is not loaded yet, try (auto)loading the
+                 ;; function itself, which may in turn load the handler.
+                 (unless (functionp handler)
+                   (with-demoted-errors "macroexp--expand-all: %S"
+                     (autoload-do-load (indirect-function func) func)))
+                 (let ((newform (macroexp--compiler-macro handler form)))
+                   (if (eq form newform)
+                       ;; The compiler macro did not find anything to do.
+                       (if (equal form (setq newform (macroexp--all-forms form 1)))
+                           form
+                         ;; Maybe after processing the args, some new opportunities
+                         ;; appeared, so let's try the compiler macro again.
+                         (setq form (macroexp--compiler-macro handler newform))
+                         (if (eq newform form)
+                             newform
+                           (macroexp--expand-all newform)))
+                     (macroexp--expand-all newform))))))
+            (_ form))))
     (pop byte-compile-form-stack)))
 
 ;; Record which arguments expect functions, so we can warn when those
@@ -567,12 +568,20 @@ cases where EXP is a constant."
 (defmacro macroexp-let2* (test bindings &rest body)
   "Multiple binding version of `macroexp-let2'.
 
-BINDINGS is a list of elements of the form (SYM EXP).  Each EXP
-can refer to symbols specified earlier in the binding list."
+BINDINGS is a list of elements of the form (SYM EXP) or just SYM,
+which then stands for (SYM SYM).
+Each EXP can refer to symbols specified earlier in the binding list.
+
+TEST has to be a symbol, and if it is nil it can be omitted."
   (declare (indent 2) (debug (sexp (&rest (sexp form)) body)))
+  (when (consp test) ;; `test' was omitted.
+    (push bindings body)
+    (setq bindings test)
+    (setq test nil))
   (pcase-exhaustive bindings
     ('nil (macroexp-progn body))
-    (`((,var ,exp) . ,tl)
+    (`(,(or `(,var ,exp) (and (pred symbolp) var (let exp var)))
+       . ,tl)
      `(macroexp-let2 ,test ,var ,exp
         (macroexp-let2* ,test ,tl ,@body)))))
 
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index b3e7fca4781..c47025f8846 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -278,11 +278,17 @@ Type \\`SPC' or \\`y' to %s the current %s;
 
 ;; For backward compatibility check if short y/n answers are preferred.
 (defcustom read-answer-short 'auto
-  "If non-nil, `read-answer' accepts single-character answers.
+  "If non-nil, the `read-answer' function accepts single-character answers.
 If t, accept short (single key-press) answers to the question.
 If nil, require long answers.  If `auto', accept short answers if
 `use-short-answers' is non-nil, or the function cell of `yes-or-no-p'
-is set to `y-or-n-p'."
+is set to `y-or-n-p'.
+
+Note that this variable does not affect calls to the more
+commonly-used `yes-or-no-p' function; it only affects calls to
+the `read-answer' function.  To control whether `yes-or-no-p'
+requires a long or a short answer, see the `use-short-answers'
+variable."
   :type '(choice (const :tag "Accept short answers" t)
                  (const :tag "Require long answer" nil)
                  (const :tag "Guess preference" auto))
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index dea5b34991a..8c67d7c7a25 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -175,7 +175,17 @@ MAP can be an alist, plist, hash-table, or array."
 
 (cl-defgeneric map-delete (map key)
   "Delete KEY in-place from MAP and return MAP.
-Keys not present in MAP are ignored.")
+Keys not present in MAP are ignored.
+
+Note that if MAP is a list (either alist or plist), and you're
+deleting the final element in the list, the list isn't actually
+destructively modified (but the return value will reflect the
+deletion).  So if you're using this method on a list, you have to
+say
+
+  (setq map (map-delete map key))
+
+for this to work reliably.")
 
 (cl-defmethod map-delete ((map list) key)
   ;; FIXME: Signal map-not-inplace i.s.o returning a different list?
@@ -540,7 +550,7 @@ TYPE is a list whose car is `hash-table' and cdr a list of
 keyword-args forwarded to `make-hash-table'.
 
 Example:
-    (map-into '((1 . 3)) '(hash-table :test eql))"
+    (map-into \\='((1 . 3)) \\='(hash-table :test eql))"
   (map--into-hash map (cdr type)))
 
 (defun map--make-pcase-bindings (args)
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 77e140dda19..00c9e5438b8 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -42,55 +42,61 @@
 ;; as this one), so we have to do it by hand!
 (push (purecopy '(nadvice 1 0)) package--builtin-versions)
 
+(oclosure-define (advice
+                  (:predicate advice--p)
+                  (:copier advice--cons (cdr))
+                  (:copier advice--copy (car cdr how props)))
+  car cdr how props)
+
+(eval-when-compile
+  (defmacro advice--make-how-alist (&rest args)
+    `(list
+      ,@(mapcar
+         (lambda (arg)
+           (pcase-let ((`(,how . ,body) arg))
+             `(list ,how
+                    (oclosure-lambda (advice (how ,how)) (&rest r)
+                      ,@body)
+                    ,(replace-regexp-in-string
+                      "\\<car\\>" "FUNCTION"
+                      (replace-regexp-in-string
+                       "\\<cdr\\>" "OLDFUN"
+                       (format "%S" `(lambda (&rest r) ,@body))
+                       t t)
+                      t t))))
+         args))))
+
 ;;;; Lightweight advice/hook
-(defvar advice--where-alist
-  '((:around "\300\301\302\003#\207" 5)
-    (:before "\300\301\002\"\210\300\302\002\"\207" 4)
-    (:after "\300\302\002\"\300\301\003\"\210\207" 5)
-    (:override "\300\301\002\"\207" 4)
-    (:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4)
-    (:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4)
-    (:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4)
-    (:before-while "\300\301\002\"\205\013\000\300\302\002\"\207" 4)
-    (:filter-args "\300\302\301\003!\"\207" 5)
-    (:filter-return "\301\300\302\003\"!\207" 5))
+(defvar advice--how-alist
+  (advice--make-how-alist
+   (:around (apply car cdr r))
+   (:before (apply car r) (apply cdr r))
+   (:after (prog1 (apply cdr r) (apply car r)))
+   (:override (apply car r))
+   (:after-until (or (apply cdr r) (apply car r)))
+   (:after-while (and (apply cdr r) (apply car r)))
+   (:before-until (or (apply car r) (apply cdr r)))
+   (:before-while (and (apply car r) (apply cdr r)))
+   (:filter-args (apply cdr (funcall car r)))
+   (:filter-return (funcall car (apply cdr r))))
   "List of descriptions of how to add a function.
-Each element has the form (WHERE BYTECODE STACK) where:
-  WHERE is a keyword indicating where the function is added.
-  BYTECODE is the corresponding byte-code that will be used.
-  STACK is the amount of stack space needed by the byte-code.")
-
-(defvar advice--bytecodes (mapcar #'cadr advice--where-alist))
-
-(defun advice--p (object)
-  (and (byte-code-function-p object)
-       (eq 128 (aref object 0))
-       (memq (length object) '(5 6))
-       (memq (aref object 1) advice--bytecodes)
-       (eq #'apply (aref (aref object 2) 0))))
-
-(defsubst advice--car   (f) (aref (aref f 2) 1))
-(defsubst advice--cdr   (f) (aref (aref f 2) 2))
-(defsubst advice--props (f) (aref (aref f 2) 3))
+Each element has the form (HOW OCL DOC) where HOW is a keyword,
+OCL is a \"prototype\" function of type `advice', and
+DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
 
 (defun advice--cd*r (f)
   (while (advice--p f)
     (setq f (advice--cdr f)))
   f)
 
-(defun advice--where (f)
-  (let ((bytecode (aref f 1))
-        (where nil))
-    (dolist (elem advice--where-alist)
-      (if (eq bytecode (cadr elem)) (setq where (car elem))))
-    where))
+(define-obsolete-function-alias 'advice--where #'advice--how "29.1")
 
 (defun advice--make-single-doc (flist function macrop)
-  (let ((where (advice--where flist)))
+  (let ((how (advice--how flist)))
     (concat
      (format "This %s has %s advice: "
              (if macrop "macro" "function")
-             where)
+             how)
      (let ((fun (advice--car flist)))
        (if (symbolp fun) (format-message "`%S'." fun)
          (let* ((name (cdr (assq 'name (advice--props flist))))
@@ -180,33 +186,41 @@ Each element has the form (WHERE BYTECODE STACK) where:
         `(funcall ',fspec ',(cadr ifm))
       (cadr (or iff ifm)))))
 
-(defun advice--make-1 (byte-code stack-depth function main props)
-  "Build a function value that adds FUNCTION to MAIN."
-  (let ((adv-sig (gethash main advertised-signature-table))
-        (advice
-         (apply #'make-byte-code 128 byte-code
-                (vector #'apply function main props) stack-depth nil
-                (and (or (commandp function) (commandp main))
-                     (list (advice--make-interactive-form
-                            function main))))))
-    (when adv-sig (puthash advice adv-sig advertised-signature-table))
-    advice))
-
-(defun advice--make (where function main props)
-  "Build a function value that adds FUNCTION to MAIN at WHERE.
-WHERE is a symbol to select an entry in `advice--where-alist'."
+
+(cl-defmethod oclosure-interactive-form ((ad advice) &optional _)
+  (let ((car (advice--car ad))
+        (cdr (advice--cdr ad)))
+    (when (or (commandp car) (commandp cdr))
+      `(interactive ,(advice--make-interactive-form car cdr)))))
+
+(cl-defmethod cl-print-object ((object advice) stream)
+  (cl-assert (advice--p object))
+  (princ "#f(advice " stream)
+  (cl-print-object (advice--car object) stream)
+  (princ " " stream)
+  (princ (advice--how object) stream)
+  (princ " " stream)
+  (cl-print-object (advice--cdr object) stream)
+  (let ((props (advice--props object)))
+    (when props
+      (princ " " stream)
+      (cl-print-object props stream)))
+  (princ ")" stream))
+
+(defun advice--make (how function main props)
+  "Build a function value that adds FUNCTION to MAIN at HOW.
+HOW is a symbol to select an entry in `advice--how-alist'."
   (let ((fd (or (cdr (assq 'depth props)) 0))
         (md (if (advice--p main)
                 (or (cdr (assq 'depth (advice--props main))) 0))))
     (if (and md (> fd md))
         ;; `function' should go deeper.
-        (let ((rest (advice--make where function (advice--cdr main) props)))
-          (advice--make-1 (aref main 1) (aref main 3)
-                          (advice--car main) rest (advice--props main)))
-      (let ((desc (assq where advice--where-alist)))
-        (unless desc (error "Unknown add-function location `%S'" where))
-        (advice--make-1 (nth 1 desc) (nth 2 desc)
-                        function main props)))))
+        (let ((rest (advice--make how function (advice--cdr main) props)))
+          (advice--cons main rest))
+      (let ((proto (assq how advice--how-alist)))
+        (unless proto (error "Unknown add-function location `%S'" how))
+        (advice--copy (cadr proto)
+                      function main how props)))))
 
 (defun advice--member-p (function use-name definition)
   (let ((found nil))
@@ -232,8 +246,7 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
         (if val (car val)
           (let ((nrest (advice--tweak rest tweaker)))
             (if (eq rest nrest) flist
-              (advice--make-1 (aref flist 1) (aref flist 3)
-                              first nrest props))))))))
+              (advice--cons flist nrest))))))))
 
 ;;;###autoload
 (defun advice--remove-function (flist function)
@@ -273,10 +286,33 @@ different, but `function-equal' will hopefully ignore those differences.")
           ((symbolp place)              `(default-value ',place))
           (t place))))
 
+(defun nadvice--make-docstring (sym)
+  (let* ((main (documentation (symbol-function sym) 'raw))
+         (ud (help-split-fundoc main 'pcase))
+         (doc (or (cdr ud) main))
+         (col1width (apply #'max (mapcar (lambda (x)
+                                           (string-width (symbol-name (car x))))
+                                         advice--how-alist)))
+         (table (mapconcat (lambda (x)
+                             (format (format " %%-%ds %%s" col1width)
+                                     (car x) (nth 2 x)))
+                           advice--how-alist "\n"))
+         (table (if global-prettify-symbols-mode
+                    (replace-regexp-in-string "(lambda\\>" "(λ" table t t)
+                  table))
+         (combined-doc
+          (if (not (string-match "<<>>" doc))
+              doc
+            (replace-match table t t doc))))
+    (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))
+
+(put 'add-function 'function-documentation
+     '(nadvice--make-docstring 'add-function))
+
 ;;;###autoload
-(defmacro add-function (where place function &optional props)
+(defmacro add-function (how place function &optional props)
   ;; TODO:
-  ;; - maybe let `where' specify some kind of predicate and use it
+  ;; - maybe let `how' specify some kind of predicate and use it
   ;;   to implement things like mode-local or eieio-defmethod.
   ;;   Of course, that only makes sense if the predicates of all advices can
   ;;   be combined and made more efficient.
@@ -285,20 +321,11 @@ different, but `function-equal' will hopefully ignore those differences.")
   ;; :before-until is like add-hook on run-hook-with-args-until-success.
   ;; Same with :after-* but for (add-hook ... 'append).
   "Add a piece of advice on the function stored at PLACE.
-FUNCTION describes the code to add.  WHERE describes where to add it.
-WHERE can be explained by showing the resulting new function, as the
+FUNCTION describes the code to add.  HOW describes how to add it.
+HOW can be explained by showing the resulting new function, as the
 result of combining FUNCTION and the previous value of PLACE, which we
 call OLDFUN here:
-`:before'	(lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r))
-`:after'	(lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r)))
-`:around'	(lambda (&rest r) (apply FUNCTION OLDFUN r))
-`:override'	(lambda (&rest r) (apply FUNCTION r))
-`:before-while'	(lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r)))
-`:before-until'	(lambda (&rest r) (or  (apply FUNCTION r) (apply OLDFUN r)))
-`:after-while'	(lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r)))
-`:after-until'	(lambda (&rest r) (or  (apply OLDFUN r) (apply FUNCTION r)))
-`:filter-args'	(lambda (&rest r) (apply OLDFUN (funcall FUNCTION r)))
-`:filter-return'(lambda (&rest r) (funcall FUNCTION (apply OLDFUN r)))
+<<>>
 If FUNCTION was already added, do nothing.
 PROPS is an alist of additional properties, among which the following have
 a special meaning:
@@ -326,13 +353,13 @@ is also interactive.  There are 3 cases:
    ;;(indent 2)
    (debug (form [&or symbolp ("local" form) ("var" sexp) gv-place]
            form &optional form)))
-  `(advice--add-function ,where (gv-ref ,(advice--normalize-place place))
+  `(advice--add-function ,how (gv-ref ,(advice--normalize-place place))
                          ,function ,props))
 
 (declare-function comp-subr-trampoline-install "comp")
 
 ;;;###autoload
-(defun advice--add-function (where ref function props)
+(defun advice--add-function (how ref function props)
   (when (and (featurep 'native-compile)
              (subr-primitive-p (gv-deref ref)))
     (let ((subr-name (intern (subr-name (gv-deref ref)))))
@@ -357,7 +384,7 @@ is also interactive.  There are 3 cases:
             (advice--remove-function (gv-deref ref)
                                      (or name (advice--car a)))))
     (setf (gv-deref ref)
-          (advice--make where function (gv-deref ref) props))))
+          (advice--make how function (gv-deref ref) props))))
 
 ;;;###autoload
 (defmacro remove-function (place function)
@@ -455,11 +482,16 @@ of the piece of advice."
         (put symbol 'advice--pending (advice--subst-main oldadv nil)))
       (funcall fsetfun symbol newdef))))
 
+(put 'advice-add 'function-documentation
+     '(nadvice--make-docstring 'advice-add))
+
 ;;;###autoload
-(defun advice-add (symbol where function &optional props)
+(defun advice-add (symbol how function &optional props)
   "Like `add-function' but for the function named SYMBOL.
 Contrary to `add-function', this will properly handle the cases where SYMBOL
-is defined as a macro, alias, command, ..."
+is defined as a macro, alias, command, ...
+HOW can be one of:
+<<>>"
   ;; TODO:
   ;; - record the advice location, to display in describe-function.
   ;; - change all defadvice in lisp/**/*.el.
@@ -467,21 +499,21 @@ is defined as a macro, alias, command, ..."
   (let* ((f (symbol-function symbol))
 	 (nf (advice--normalize symbol f)))
     (unless (eq f nf) (fset symbol nf))
-    (add-function where (cond
-                         ((eq (car-safe nf) 'macro) (cdr nf))
-                         ;; Reasons to delay installation of the advice:
-                         ;; - If the function is not yet defined, installing
-                         ;;   the advice would affect `fboundp'ness.
-                         ;; - the symbol-function slot of an autoloaded
-                         ;;   function is not itself a function value.
-                         ;; - `autoload' does nothing if the function is
-                         ;;   not an autoload or undefined.
-                         ((or (not nf) (autoloadp nf))
-                          (get symbol 'advice--pending))
-                         (t (symbol-function symbol)))
+    (add-function how (cond
+                       ((eq (car-safe nf) 'macro) (cdr nf))
+                       ;; Reasons to delay installation of the advice:
+                       ;; - If the function is not yet defined, installing
+                       ;;   the advice would affect `fboundp'ness.
+                       ;; - the symbol-function slot of an autoloaded
+                       ;;   function is not itself a function value.
+                       ;; - `autoload' does nothing if the function is
+                       ;;   not an autoload or undefined.
+                       ((or (not nf) (autoloadp nf))
+                        (get symbol 'advice--pending))
+                       (t (symbol-function symbol)))
                   function props)
-    ;; FIXME: We could use a defmethod on `function-docstring' instead,
-    ;; except when (or (not nf) (autoloadp nf))!
+    ;; FIXME: We could use a defmethod on `function-documentation' instead,
+    ;; except when (autoloadp nf)!
     (put symbol 'function-documentation `(advice--make-docstring ',symbol))
     (add-function :around (get symbol 'defalias-fset-function)
                   #'advice--defalias-fset))
@@ -517,12 +549,12 @@ See `advice-add' and `add-function' for explanation on the
 arguments.  Note if NAME is nil the advice is anonymous;
 otherwise it is named `SYMBOL@NAME'.
 
-\(fn SYMBOL (WHERE LAMBDA-LIST &optional NAME DEPTH) &rest BODY)"
+\(fn SYMBOL (HOW LAMBDA-LIST &optional NAME DEPTH) &rest BODY)"
   (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body)))
   (or (listp args) (signal 'wrong-type-argument (list 'listp args)))
   (or (<= 2 (length args) 4)
       (signal 'wrong-number-of-arguments (list 2 4 (length args))))
-  (let* ((where         (nth 0 args))
+  (let* ((how           (nth 0 args))
          (lambda-list   (nth 1 args))
          (name          (nth 2 args))
          (depth         (nth 3 args))
@@ -532,7 +564,7 @@ otherwise it is named `SYMBOL@NAME'.
                         (intern (format "%s@%s" symbol name)))
                        (t (error "Unrecognized name spec `%S'" name)))))
     `(prog1 ,@(and (symbolp advice) `((defun ,advice ,lambda-list ,@body)))
-       (advice-add ',symbol ,where #',advice ,@(and props `(',props))))))
+       (advice-add ',symbol ,how #',advice ,@(and props `(',props))))))
 
 (defun advice-mapc (fun symbol)
   "Apply FUN to every advice function in SYMBOL.
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
new file mode 100644
index 00000000000..cb8c59b05a2
--- /dev/null
+++ b/lisp/emacs-lisp/oclosure.el
@@ -0,0 +1,562 @@
+;;; oclosure.el --- Open Closures       -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022  Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; An OClosure is an object that combines the properties of records
+;; with those of a function.  More specifically it is a function extended
+;; with a notion of type (e.g. for defmethod dispatch) as well as the
+;; ability to have some fields that are accessible from the outside.
+
+;; See "Open closures", ELS'2022 (https://zenodo.org/record/6228797).
+
+;; Here are some cases of "callable objects" where OClosures have found use:
+;; - nadvice.el (the original motivation)
+;; - kmacros (for cl-print and for `kmacro-extract-lambda')
+;; - cl-generic: turn `cl--generic-isnot-nnm-p' into a mere type test
+;;   (by putting the no-next-methods into their own class).
+;; - Slot accessor functions, where the type-dispatch can be used to
+;;   dynamically compute the docstring, and also to pretty print them.
+;; - `save-some-buffers-function'
+;; Here are other cases of "callable objects" where OClosures could be used:
+;; - Use the type to distinguish macros from functions.
+;; - Use a `name' and `depth' property from the function passed to
+;;   `add-function' (or `add-hook') instead of passing it via "props".
+;; - iterators (generator.el), thunks (thunk.el), streams (stream.el).
+;; - PEG rules: they're currently just functions, but they should carry
+;;   their original (macro-expanded) definition (and should be printed
+;;   differently from functions)!
+;; - auto-generate docstrings for cl-defstruct slot accessors instead of
+;;   storing them in the accessor itself?
+;; - SRFI-17's `setter'.
+;; - coercion wrappers, as in "Threesomes, with and without blame"
+;;   https://dl.acm.org/doi/10.1145/1706299.1706342, or
+;;   "On the Runtime Complexity of Type-Directed Unboxing"
+;;   http://sv.c.titech.ac.jp/minamide/papers.html
+;; - An efficient `negate' operation such that
+;;   (negate (negate f)) returns just `f' and (negate #'<) returns #'>=.
+;; - Autoloads (tho currently our bytecode functions (and hence OClosures)
+;;   are too fat for that).
+
+;; Related constructs:
+;; - `funcallable-standard-object' (FSO) in Common-Lisp.  These are different
+;;   from OClosures in that they involve an additional indirection to get
+;;   to the actual code, and that they offer the possibility of
+;;   changing (via mutation) the code associated with
+;;   an FSO.  Also the FSO's function can't directly access the FSO's
+;;   other fields, contrary to the case with OClosures where those are directly
+;;   available as local variables.
+;; - Function objects in Javascript.
+;; - Function objects in Python.
+;; - Callable/Applicable classes in OO languages, i.e. classes with
+;;   a single method called `apply' or `call'.  The most obvious
+;;   difference with OClosures (beside the fact that Callable can be
+;;   extended with additional methods) is that all instances of
+;;   a given Callable class have to use the same method, whereas every
+;;   OClosure object comes with its own code, so two OClosure objects of the
+;;   same type can have different code.  Of course, you can get the
+;;   same result by turning every `oclosure-lambda' into its own class
+;;   declaration creating an ad-hoc subclass of the specified type.
+;;   In this sense, OClosures are just a generalization of `lambda' which brings
+;;   some of the extra feature of Callable objects.
+;; - Apply hooks and "entities" in MIT Scheme
+;;   https://www.gnu.org/software/mit-scheme/documentation/stable/mit-scheme-ref/Application-Hooks.html
+;;   Apply hooks are basically the same as Common-Lisp's FSOs, and "entities"
+;;   are a variant of it where the inner function gets the FSO itself as
+;;   additional argument (a kind of "self" arg), thus making it easier
+;;   for the code to get data from the object's extra info, tho still
+;;   not as easy as with OClosures.
+;; - "entities" in Lisp Machine Lisp (LML)
+;;   https://hanshuebner.github.io/lmman/fd-clo.xml
+;;   These are arguably identical to OClosures, modulo the fact that LML doesn't
+;;   have lexically-scoped closures and uses a form of closures based on
+;;   capturing (and reinstating) dynamically scoped bindings instead.
+
+;; Naming: OClosures were originally named FunCallableRecords (FCR), but
+;; that name suggested these were fundamentally records that happened
+;; to be called, whereas OClosures are really just closures that happen
+;; to enjoy some characteristics of records.
+;; The "O" comes from "Open" because OClosures aren't completely opaque
+;; (for that same reason, an alternative name suggested at the time was
+;; "disclosures").
+;; The "O" can also be understood to mean "Object" since you have notions
+;; of inheritance, and the ability to associate methods with particular
+;; OClosure types, just as is the case for OO classes.
+
+;;; Code:
+
+;; TODO:
+;; - `oclosure-(cl-)defun', `oclosure-(cl-)defsubst', `oclosure-define-inline'?
+;; - Use accessor in cl-defstruct.
+;; - Add pcase patterns for OClosures.
+;; - anonymous OClosure types.
+;; - copiers for mixins
+;; - class-allocated slots?
+;; - code-allocated slots?
+;;   The `where' slot of `advice' would like to be code-allocated, and the
+;;   interactive-spec of commands is currently code-allocated but would like
+;;   to be instance-allocated.  Their scoping rules are a bit odd, so maybe
+;;   it's best to avoid them.
+
+(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))   ;For `named-let'.
+
+(defun oclosure--index-table (slotdescs)
+  (let ((i -1)
+        (it (make-hash-table :test #'eq)))
+    (dolist (desc slotdescs)
+      (let* ((slot (cl--slot-descriptor-name desc)))
+        (cl-incf i)
+        (when (gethash slot it)
+          (error "Duplicate slot name: %S" slot))
+        (setf (gethash slot it) i)))
+    it))
+
+(cl-defstruct (oclosure--class
+               (:constructor nil)
+               (:constructor oclosure--class-make
+                ( name docstring slots parents allparents
+                  &aux (index-table (oclosure--index-table slots))))
+               (:include cl--class)
+               (:copier nil))
+  "Metaclass for OClosure classes."
+  (allparents nil :read-only t :type (list-of symbol)))
+
+(setf (cl--find-class 'oclosure)
+      (oclosure--class-make 'oclosure
+                            "The root parent of all OClosure classes"
+                            nil nil '(oclosure)))
+(defun oclosure--p (oclosure)
+  (not (not (oclosure-type oclosure))))
+
+(cl-deftype oclosure () '(satisfies oclosure--p))
+
+(defun oclosure--slot-mutable-p (slotdesc)
+  (not (alist-get :read-only (cl--slot-descriptor-props slotdesc))))
+
+(defun oclosure--defstruct-make-copiers (copiers slotdescs name)
+  (require 'cl-macs)            ;`cl--arglist-args' is not autoloaded.
+  (let* ((mutables '())
+         (slots (mapcar
+                 (lambda (desc)
+	           (let ((name (cl--slot-descriptor-name desc)))
+	             (when (oclosure--slot-mutable-p desc)
+	               (push name mutables))
+	             name))
+	         slotdescs)))
+    (mapcar
+     (lambda (copier)
+       (pcase-let*
+           ((cname (pop copier))
+            (args (or (pop copier) `(&key ,@slots)))
+            (inline (and (eq :inline (car copier)) (pop copier)))
+            (doc (or (pop copier)
+                     (format "Copier for objects of type `%s'." name)))
+            (obj (make-symbol "obj"))
+            (absent (make-symbol "absent"))
+            (anames (cl--arglist-args args))
+            (mnames
+             (let ((res '())
+                   (tmp args))
+               (while (and tmp
+                           (not (memq (car tmp)
+                                      cl--lambda-list-keywords)))
+                 (push (pop tmp) res))
+               res))
+            (index -1)
+            (mutlist '())
+            (argvals
+             (mapcar
+	      (lambda (slot)
+	        (setq index (1+ index))
+	        (let* ((mutable (memq slot mutables))
+	               (get `(oclosure--get ,obj ,index ,(not (not mutable)))))
+	          (push mutable mutlist)
+		  (cond
+		   ((not (memq slot anames)) get)
+		   ((memq slot mnames) slot)
+		   (t
+		    `(if (eq ',absent ,slot)
+		         ,get
+		       ,slot)))))
+	      slots)))
+	 `(,(if inline 'cl-defsubst 'cl-defun) ,cname
+               (&cl-defs (',absent) ,obj ,@args)
+            ,doc
+            (declare (side-effect-free t))
+            (oclosure--copy ,obj ',(if (remq nil mutlist) (nreverse mutlist))
+                       ,@argvals))))
+     copiers)))
+
+
+(defmacro oclosure-define (name &optional docstring &rest slots)
+  "Define a new OClosure type.
+NAME should be a symbol which is the name of the new type.
+It can also be of the form (NAME . PROPS) in which case PROPS
+is a list of additional properties among the following:
+  (:predicate PRED): asks to create a predicate function named PRED.
+  (:parent TYPE): make TYPE (another OClosure type) be a parent of NAME.
+  (:copier COPIER ARGS): asks to create a \"copier\" (i.e. functional update
+    function) named COPIER.  It will take an object of type NAME as first
+    argument followed by ARGS.  ARGS lists the names of the slots that will
+    be updated with the value of the corresponding argument.
+SLOTS is a list if slot descriptions.  Each slot can be a single symbol
+which is the name of the slot, or it can be of the form (SLOT-NAME . SPROPS)
+where SLOT-NAME is then the name of the slot and SPROPS is a property
+list of slot properties.  The currently known properties are the following:
+  `:mutable': A non-nil value mean the slot can be mutated.
+  `:type': Specifies the type of the values expected to appear in the slot."
+  (declare (doc-string 2) (indent 1))
+  (unless (stringp docstring)
+    (push docstring slots)
+    (setq docstring nil))
+  (let* ((options (when (consp name)
+                    (prog1 (copy-sequence (cdr name))
+                      (setq name (car name)))))
+         (get-opt (lambda (opt &optional all)
+                    (let ((val (assq opt options))
+                          tmp)
+                      (when val (setq options (delq val options)))
+                      (if (not all)
+                          (cdr val)
+                        (when val
+                          (setq val (list (cdr val)))
+                          (while (setq tmp (assq opt options))
+                            (push (cdr tmp) val)
+                            (setq options (delq tmp options)))
+                          (nreverse val))))))
+         (predicate (car (funcall get-opt :predicate)))
+         (parent-names (or (funcall get-opt :parent)
+                           (funcall get-opt :include)))
+         (copiers (funcall get-opt :copier 'all)))
+    `(progn
+       ,(when options (macroexp-warn-and-return name
+                       (format "Ignored options: %S" options)
+                       nil))
+       (eval-and-compile
+         (oclosure--define ',name ,docstring ',parent-names ',slots
+                           ,@(when predicate `(:predicate ',predicate))))
+       (oclosure--define-functions ,name ,copiers))))
+
+(defun oclosure--build-class (name docstring parent-names slots)
+  (cl-assert (null (cdr parent-names)))
+  (let* ((parent-class (let ((name (or (car parent-names) 'oclosure)))
+                         (or (cl--find-class name)
+                             (error "Unknown class: %S" name))))
+         (slotdescs
+          (append
+           (oclosure--class-slots parent-class)
+           (mapcar (lambda (field)
+                     (if (not (consp field))
+                         (cl--make-slot-descriptor field nil nil
+                                                   '((:read-only . t)))
+                       (let ((name (pop field))
+                             (type nil)
+                             (read-only t)
+                             (props '()))
+                         (while field
+                           (pcase (pop field)
+                             (:mutable (setq read-only (not (car field))))
+                             (:type (setq type (car field)))
+                             (p (message "Unknown property: %S" p)
+                                (push (cons p (car field)) props)))
+                           (setq field (cdr field)))
+                         (cl--make-slot-descriptor name nil type
+                                                   `((:read-only . ,read-only)
+                                                     ,@props)))))
+                   slots))))
+    (oclosure--class-make name docstring slotdescs
+                          (if (cdr parent-names)
+                              (oclosure--class-parents parent-class)
+                            (list parent-class))
+                          (cons name (oclosure--class-allparents
+                                      parent-class)))))
+
+(defmacro oclosure--define-functions (name copiers)
+  (let* ((class (cl--find-class name))
+         (slotdescs (oclosure--class-slots class)))
+    `(progn
+     ,@(let ((i -1))
+           (mapcar (lambda (desc)
+                     (let* ((slot (cl--slot-descriptor-name desc))
+                            (mutable (oclosure--slot-mutable-p desc))
+                            ;; Always use a double hyphen: if users wants to
+                            ;; make it public, they can do so with an alias.
+                            (aname (intern (format "%S--%S" name slot))))
+                       (cl-incf i)
+                       (if (not mutable)
+                           `(defalias ',aname
+                              ;; We use `oclosure--copy' instead of
+                              ;; `oclosure--accessor-copy' here to circumvent
+                              ;; bootstrapping problems.
+                              (oclosure--copy
+                               oclosure--accessor-prototype
+                               nil ',name ',slot ,i))
+                         (require 'gv)  ;For `gv-setter'.
+                         `(progn
+                            (defalias ',aname
+                              (oclosure--accessor-copy
+                               oclosure--mut-getter-prototype
+                               ',name ',slot ,i))
+                            (defalias ',(gv-setter aname)
+                              (oclosure--accessor-copy
+                               oclosure--mut-setter-prototype
+                               ',name ',slot ,i))))))
+                   slotdescs))
+       ,@(oclosure--defstruct-make-copiers
+          copiers slotdescs name))))
+
+;;;###autoload
+(defun oclosure--define (name docstring parent-names slots
+                              &rest props)
+  (let* ((class (oclosure--build-class name docstring parent-names slots))
+         (pred (lambda (oclosure)
+                 (let ((type (oclosure-type oclosure)))
+                   (when type
+                     (memq name (oclosure--class-allparents
+                                 (cl--find-class type)))))))
+         (predname (or (plist-get props :predicate)
+                       (intern (format "%s--internal-p" name)))))
+    (setf (cl--find-class name) class)
+    (dolist (slot (oclosure--class-slots class))
+      (put (cl--slot-descriptor-name slot) 'slot-name t))
+    (defalias predname pred)
+    (put name 'cl-deftype-satisfies predname)))
+
+(defmacro oclosure--lambda (type bindings mutables args &rest body)
+  "Low level construction of an OClosure object.
+TYPE should be a form returning an OClosure type (a symbol)
+BINDINGS should list all the slots expected by this type, in the proper order.
+MUTABLE is a list of symbols indicating which of the BINDINGS
+should be mutable.
+No checking is performed,"
+  (declare (indent 3) (debug (sexp (&rest (sexp form)) sexp def-body)))
+  ;; FIXME: Fundamentally `oclosure-lambda' should be a special form.
+  ;; We define it here as a macro which expands to something that
+  ;; looks like "normal code" in order to avoid backward compatibility
+  ;; issues with third party macros that do "code walks" and would
+  ;; likely mishandle such a new special form (e.g. `generator.el').
+  ;; But don't be fooled: this macro is tightly bound to `cconv.el'.
+  (pcase-let*
+      ((`(,prebody . ,body) (macroexp-parse-body body))
+       (rovars (mapcar #'car bindings)))
+    (dolist (mutable mutables)
+      (setq rovars (delq mutable rovars)))
+    `(let ,(mapcar (lambda (bind)
+                     (if (cdr bind) bind
+                       ;; Bind to something that doesn't look
+                       ;; like a value to avoid the "Variable
+                       ;; ‘foo’ left uninitialized" warning.
+                       `(,(car bind) (progn nil))))
+                   (reverse bindings))
+       ;; FIXME: Make sure the slotbinds whose value is duplicable aren't
+       ;; just value/variable-propagated by the optimizer (tho I think our
+       ;; optimizer is too naive to be a problem currently).
+       (oclosure--fix-type
+        ;; This `oclosure--fix-type' + `ignore' call is used by the compiler (in
+        ;; `cconv.el') to detect and signal an error in case of
+        ;; store-conversion (i.e. if a variable/slot is mutated).
+        (ignore ,@rovars)
+        (lambda ,args
+          (:documentation ,type)
+          ,@prebody
+          ;; Add dummy code which accesses the field's vars to make sure
+          ;; they're captured in the closure.
+          (if t nil ,@rovars ,@(mapcar (lambda (m) `(setq ,m ,m)) mutables))
+          ,@body)))))
+
+(defmacro oclosure-lambda (type-and-slots args &rest body)
+  "Define anonymous OClosure function.
+TYPE-AND-SLOTS should be of the form (TYPE . SLOTS)
+where TYPE is an OClosure type name (defined by `oclosure-define')
+and SLOTS is a let-style list of bindings for the various slots of TYPE.
+ARGS and BODY are the same as for `lambda'."
+  (declare (indent 2) (debug ((sexp &rest (sexp form)) sexp def-body)))
+  ;; FIXME: Should `oclosure-define' distinguish "optional" from
+  ;; "mandatory" slots, and/or provide default values for slots missing
+  ;; from `fields'?
+  (pcase-let*
+      ((`(,type . ,fields) type-and-slots)
+       (class (or (cl--find-class type)
+                  (error "Unknown class: %S" type)))
+       (slots (oclosure--class-slots class))
+       (mutables '())
+       (slotbinds (mapcar (lambda (slot)
+                            (let ((name (cl--slot-descriptor-name slot)))
+                              (when (oclosure--slot-mutable-p slot)
+                                (push name mutables))
+                              (list name)))
+                          slots))
+       (tempbinds (mapcar
+                   (lambda (field)
+                     (let* ((name (car field))
+                            (bind (assq name slotbinds)))
+                       (cond
+                        ;; FIXME: Should we also warn about missing slots?
+                        ((not bind)
+                         (error "Unknown slot: %S" name))
+                        ((cdr bind)
+                         (error "Duplicate slot: %S" name))
+                        (t
+                         (let ((temp (gensym "temp")))
+                           (setcdr bind (list temp))
+                           (cons temp (cdr field)))))))
+                   fields)))
+    ;; FIXME: Optimize temps away when they're provided in the right order?
+    `(let ,tempbinds
+       (oclosure--lambda ',type ,slotbinds ,mutables ,args ,@body))))
+
+(defun oclosure--fix-type (_ignore oclosure)
+  "Helper function to implement `oclosure-lambda' via a macro.
+This has 2 uses:
+- For interpreted code, this converts the representation of type information
+  by moving it from the docstring to the environment.
+- For compiled code, this is used as a marker which cconv uses to check that
+  immutable fields are indeed not mutated."
+  (if (byte-code-function-p oclosure)
+      ;; Actually, this should never happen since the `cconv.el' should have
+      ;; optimized away the call to this function.
+      oclosure
+    ;; For byte-coded functions, we store the type as a symbol in the docstring
+    ;; slot.  For interpreted functions, there's no specific docstring slot
+    ;; so `Ffunction' turns the symbol into a string.
+    ;; We thus have convert it back into a symbol (via `intern') and then
+    ;; stuff it into the environment part of the closure with a special
+    ;; marker so we can distinguish this entry from actual variables.
+    (cl-assert (eq 'closure (car-safe oclosure)))
+    (let ((typename (nth 3 oclosure))) ;; The "docstring".
+      (cl-assert (stringp typename))
+      (push (cons :type (intern typename))
+            (cadr oclosure))
+      oclosure)))
+
+(defun oclosure--copy (oclosure mutlist &rest args)
+  (if (byte-code-function-p oclosure)
+      (apply #'make-closure oclosure
+             (if (null mutlist)
+                 args
+               (mapcar (lambda (arg) (if (pop mutlist) (list arg) arg)) args)))
+    (cl-assert (eq 'closure (car-safe oclosure))
+               nil "oclosure not closure: %S" oclosure)
+    (cl-assert (eq :type (caar (cadr oclosure))))
+    (let ((env (cadr oclosure)))
+      `(closure
+           (,(car env)
+            ,@(named-let loop ((env (cdr env)) (args args))
+                (when args
+                  (cons (cons (caar env) (car args))
+                        (loop (cdr env) (cdr args)))))
+            ,@(nthcdr (1+ (length args)) env))
+           ,@(nthcdr 2 oclosure)))))
+
+(defun oclosure--get (oclosure index mutable)
+  (if (byte-code-function-p oclosure)
+      (let* ((csts (aref oclosure 2))
+             (v (aref csts index)))
+        (if mutable (car v) v))
+    (cl-assert (eq 'closure (car-safe oclosure)))
+    (cl-assert (eq :type (caar (cadr oclosure))))
+    (cdr (nth (1+ index) (cadr oclosure)))))
+
+(defun oclosure--set (v oclosure index)
+  (if (byte-code-function-p oclosure)
+      (let* ((csts (aref oclosure 2))
+             (cell (aref csts index)))
+        (setcar cell v))
+    (cl-assert (eq 'closure (car-safe oclosure)))
+    (cl-assert (eq :type (caar (cadr oclosure))))
+    (setcdr (nth (1+ index) (cadr oclosure)) v)))
+
+(defun oclosure-type (oclosure)
+  "Return the type of OCLOSURE, or nil if the arg is not a OClosure."
+  (if (byte-code-function-p oclosure)
+      (let ((type (and (> (length oclosure) 4) (aref oclosure 4))))
+        (if (symbolp type) type))
+    (and (eq 'closure (car-safe oclosure))
+         (let* ((env (car-safe (cdr oclosure)))
+                (first-var (car-safe env)))
+           (and (eq :type (car-safe first-var))
+                (cdr first-var))))))
+
+(defconst oclosure--accessor-prototype
+  ;; Use `oclosure--lambda' to circumvent a bootstrapping problem:
+  ;; `oclosure-accessor' is not yet defined at this point but
+  ;; `oclosure--accessor-prototype' is needed when defining `oclosure-accessor'.
+  (oclosure--lambda 'oclosure-accessor ((type) (slot) (index)) nil
+    (oclosure) (oclosure--get oclosure index nil)))
+
+(oclosure-define accessor
+  "OClosure function to access a specific slot of an object."
+  type slot)
+
+(defun oclosure--accessor-cl-print (object stream)
+  (princ "#f(accessor " stream)
+  (prin1 (accessor--type object) stream)
+  (princ "." stream)
+  (prin1 (accessor--slot object) stream)
+  (princ ")" stream))
+
+(defun oclosure--accessor-docstring (f)
+  ;; This would like to be a (cl-defmethod function-documentation ...)
+  ;; but for circularity reason the defmethod is in `simple.el'.
+  (format "Access slot \"%S\" of OBJ of type `%S'.\n\n(fn OBJ)"
+          (accessor--slot f) (accessor--type f)))
+
+(oclosure-define (oclosure-accessor
+                  (:parent accessor)
+                  (:copier oclosure--accessor-copy (type slot index)))
+  "OClosure function to access a specific slot of an OClosure function."
+  index)
+
+(defun oclosure--slot-index (oclosure slotname)
+  (gethash slotname
+           (oclosure--class-index-table
+            (cl--find-class (oclosure-type oclosure)))))
+
+(defun oclosure--slot-value (oclosure slotname)
+  (let ((class (cl--find-class (oclosure-type oclosure)))
+        (index (oclosure--slot-index oclosure slotname)))
+    (oclosure--get oclosure index
+                   (oclosure--slot-mutable-p
+                    (nth index (oclosure--class-slots class))))))
+
+(defun oclosure--set-slot-value (oclosure slotname value)
+  (let ((class (cl--find-class (oclosure-type oclosure)))
+        (index (oclosure--slot-index oclosure slotname)))
+    (unless (oclosure--slot-mutable-p
+             (nth index (oclosure--class-slots class)))
+      (signal 'setting-constant (list oclosure slotname)))
+    (oclosure--set value oclosure index)))
+
+(defconst oclosure--mut-getter-prototype
+  (oclosure-lambda (oclosure-accessor (type) (slot) (index)) (oclosure)
+    (oclosure--get oclosure index t)))
+(defconst oclosure--mut-setter-prototype
+  ;; FIXME: The generated docstring is wrong.
+  (oclosure-lambda (oclosure-accessor (type) (slot) (index)) (val oclosure)
+    (oclosure--set val oclosure index)))
+
+;; Ideally, this should be in `files.el', but that file is loaded
+;; before `oclosure.el'.
+(oclosure-define (save-some-buffers-function
+                  (:predicate save-some-buffers-function--p)))
+
+
+(provide 'oclosure)
+;;; oclosure.el ends here
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 6aa82e576d9..58c1349e1c2 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -566,9 +566,9 @@ This is the name of the package with its version appended."
   "Return file-name extension of package-desc object PKG-DESC.
 Depending on the `package-desc-kind' of PKG-DESC, this is one of:
 
-   'single - \".el\"
-   'tar    - \".tar\"
-   'dir    - \"\"
+   \\='single - \".el\"
+   \\='tar    - \".tar\"
+   \\='dir    - \"\"
 
 Signal an error if the kind is none of the above."
   (pcase (package-desc-kind pkg-desc)
@@ -1854,8 +1854,12 @@ SEEN is used internally to detect infinite recursion."
               (error "Need package `%s-%s', but only %s is available"
                      next-pkg (package-version-join next-version)
                      found-something))
-             (t (error "Package `%s-%s' is unavailable"
-                       next-pkg (package-version-join next-version)))))
+             (t
+              (if (eq next-pkg 'emacs)
+                  (error "This package requires Emacs version %s"
+                         (package-version-join next-version))
+                (error "Package `%s-%s' is unavailable"
+                       next-pkg (package-version-join next-version))))))
           (setq packages
                 (package-compute-transaction (cons found packages)
                                              (package-desc-reqs found)
@@ -2132,6 +2136,31 @@ to install it but still mark it as selected."
           (message  "Package `%s' installed." name))
       (message "`%s' is already installed" name))))
 
+;;;###autoload
+(defun package-update (name)
+  "Update package NAME if a newer version exists."
+  (interactive
+   (progn
+     ;; Initialize the package system to get the list of package
+     ;; symbols for completion.
+     (package--archives-initialize)
+     (list (completing-read
+            "Update package: "
+            (mapcar
+             #'car
+             (seq-filter
+              (lambda (elt)
+                (let ((available
+                       (assq (car elt) package-archive-contents)))
+                  (and available
+                       (version-list-<
+                        (package-desc-priority-version (cadr elt))
+                        (package-desc-priority-version (cadr available))))))
+              package-alist))
+            nil t))))
+  (package-delete (cadr (assq (intern name) package-alist)) 'force)
+  (package-install (intern name) 'dont-select))
+
 (defun package-strip-rcs-id (str)
   "Strip RCS version ID from the version string STR.
 If the result looks like a dotted numeric version, return it.
@@ -3461,7 +3490,7 @@ corresponding to the newer version."
       ;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
       (let ((pkg-desc (car entry))
             (status (aref (cadr entry) 2)))
-        (cond ((member status '("installed" "dependency" "unsigned"))
+        (cond ((member status '("installed" "dependency" "unsigned" "external"))
                (push pkg-desc installed))
               ((member status '("available" "new"))
                (setq available (package--append-to-alist pkg-desc available))))))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 0330a2a0aba..07443dabfef 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -328,7 +328,7 @@ PATTERNS are normal `pcase' patterns, and VALUES are expression.
 
 Evaluation happens sequentially as in `setq' (not in parallel).
 
-An example: (pcase-setq `((,a) [(,b)]) '((1) [(2)]))
+An example: (pcase-setq \\=`((,a) [(,b)]) \\='((1) [(2)]))
 
 VAL is presumed to match PAT.  Failure to match may signal an error or go
 undetected, binding variables to arbitrary values, such as nil.
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index e782cdb1dab..ad693fa5a61 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -177,6 +177,10 @@ Also add the value to the front of the list in the variable `values'."
     (let ((pt (point)))
       (save-excursion
         (forward-sexp -1)
+        ;; Make `pp-eval-last-sexp' work the same way `eval-last-sexp'
+        ;; does.
+        (when (looking-at ",@?")
+          (goto-char (match-end 0)))
         (read
          ;; If first line is commented, ignore all leading comments:
          (if (save-excursion (beginning-of-line) (looking-at-p "[ \t]*;"))
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index e635c7f200c..195035e6be9 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -112,9 +112,15 @@
                 (goto-char start)
                 (dolist (line (split-string text "\n"))
                   (end-of-line)
-                  (if (bolp)
-                      (insert line "\n")
-                    (insert line))
+                  (if (not (bolp))
+		      (insert line)
+		    (insert (make-string
+                             (max (- (* (mod (1- times) columns)
+                                        (+ fill-column 4))
+                                     (current-column))
+                                  0)
+			     ?\s))
+                    (insert line "\n"))
                   (forward-line 1))))))))
     buf))
 
@@ -163,8 +169,9 @@ Usage example:
                       \\='((?a \"always\")
                         (?s \"session only\")
                         (?n \"no\")))"
-  (let* ((choices (if show-help choices (append choices '((?? "?")))))
-         (altered-names (mapcar #'rmc--add-key-description choices))
+  (let* ((prompt-choices
+          (if show-help choices (append choices '((?? "?")))))
+         (altered-names (mapcar #'rmc--add-key-description prompt-choices))
          (full-prompt
           (format
            "%s (%s): "
@@ -175,7 +182,7 @@ Usage example:
       (save-excursion
         (if show-help
             (setq buf (rmc--show-help prompt help-string show-help
-                                   choices altered-names)))
+                                      choices altered-names)))
 	(while (not tchar)
 	  (message "%s%s"
                    (if wrong-char
@@ -194,7 +201,7 @@ Usage example:
                             (lambda (elem)
                               (cons (capitalize (cadr elem))
                                     (car elem)))
-                            choices)))
+                            prompt-choices)))
                   (condition-case nil
                       (let ((cursor-in-echo-area t))
                         (read-event))
@@ -232,7 +239,7 @@ Usage example:
             (when wrong-char
               (ding))
             (setq buf (rmc--show-help prompt help-string show-help
-                                   choices altered-names))))))
+                                      choices altered-names))))))
     (when (buffer-live-p buf)
       (kill-buffer buf))
     (assq tchar choices)))
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 5ea9fae2e9b..133d3c9e118 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -403,23 +403,23 @@ found or not."
         (setq count (+ 1 count))))
     count))
 
-(with-suppressed-warnings ((obsolete seq-contains))
-  (cl-defgeneric seq-contains (sequence elt &optional testfn)
-    "Return the first element in SEQUENCE that is equal to ELT.
+(cl-defgeneric seq-contains (sequence elt &optional testfn)
+  "Return the first element in SEQUENCE that is equal to ELT.
 Equality is defined by TESTFN if non-nil or by `equal' if nil."
-    (declare (obsolete seq-contains-p "27.1"))
-    (seq-some (lambda (e)
-                (when (funcall (or testfn #'equal) elt e)
-                  e))
-              sequence)))
+  (declare (obsolete seq-contains-p "27.1"))
+  (seq-some (lambda (e)
+              (when (funcall (or testfn #'equal) elt e)
+                e))
+            sequence))
 
 (cl-defgeneric seq-contains-p (sequence elt &optional testfn)
   "Return non-nil if SEQUENCE contains an element equal to ELT.
 Equality is defined by TESTFN if non-nil or by `equal' if nil."
     (catch 'seq--break
       (seq-doseq (e sequence)
-        (when (funcall (or testfn #'equal) e elt)
-          (throw 'seq--break t)))
+        (let ((r (funcall (or testfn #'equal) e elt)))
+          (when r
+            (throw 'seq--break r))))
       nil))
 
 (cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn)
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index 8cd371321ae..2343a9b589f 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -177,12 +177,11 @@ See the documentation for `list-load-path-shadows' for further information."
      . (1 font-lock-warning-face)))
   "Keywords to highlight in `load-path-shadows-mode'.")
 
-(define-derived-mode load-path-shadows-mode fundamental-mode "LP-Shadows"
+(define-derived-mode load-path-shadows-mode special-mode "LP-Shadows"
   "Major mode for `load-path' shadows buffer."
   (setq-local font-lock-defaults
               '((load-path-shadows-font-lock-keywords)))
-  (setq buffer-undo-list t
-	buffer-read-only t))
+  (setq buffer-undo-list t))
 
 ;; TODO use text-properties instead, a la dired.
 (define-button-type 'load-path-shadows-find-file
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 658edd67527..340fe766c1e 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -47,30 +47,67 @@
   "Add GROUP to the list of defined documentation groups.
 FUNCTIONS is a list of elements on the form:
 
-  (fun
+  (FUNC
    :no-manual BOOL
    :args ARGS
-   :eval EXAMPLE-FORM
+   :eval EVAL
    :no-eval EXAMPLE-FORM
-   :no-eval* EXAMPLE-FORM
    :no-value EXAMPLE-FORM
+   :no-eval* EXAMPLE-FORM
    :result RESULT-FORM
-   :result-string RESULT-FORM
+   :result-string RESULT-STRING
    :eg-result RESULT-FORM
-   :eg-result-string RESULT-FORM)
+   :eg-result-string RESULT-STRING)
 
-BOOL should be non-nil if the function isn't documented in the
+FUNC is the function being documented.
+
+NO-MANUAL should be non-nil if FUNC isn't documented in the
 manual.
 
-ARGS is optional; the function's signature is displayed if ARGS
-is not present.
+ARGS is optional list of function FUNC's arguments.  FUNC's
+signature is displayed automatically if ARGS is not present.
+Specifying ARGS might be useful where you don't want to document
+some of the uncommon arguments a function might have.
+
+While the `:no-manual' and `:args' property can be used for
+any (FUNC ..) form, all of the other properties shown above
+cannot be used simultaneously in such a form.
 
-If EVAL isn't a string, it will be printed with `prin1', and then
-evaluated to give a result, which is also printed.  If it's a
-string, it'll be inserted as is, then the string will be `read',
-and then evaluated.
+Here are some common forms with examples of properties that go
+together:
 
-There can be any number of :example/:result elements."
+1. Document a form or string, and its evaluated return value.
+   (FUNC
+    :eval EVAL)
+
+If EVAL is a string, it will be inserted as is, and then that
+string will be `read' and evaluated.
+
+2. Document a form or string, but manually document its evalation
+   result.  The provided form will not be evaluated.
+
+  (FUNC
+   :no-eval EXAMPLE-FORM
+   :result RESULT-FORM   ;Use `:result-string' if value is in string form
+   )
+
+Using `:no-value' is the same as using `:no-eval'.
+
+Use `:no-eval*' instead of `:no-eval' where the successful
+execution of the documented form depends on some conditions.
+
+3. Document a form or string EXAMPLE-FORM.  Also manually
+   document an example result.  This result could be unrelated to
+   the documented form.
+
+  (FUNC
+   :no-eval EXAMPLE-FORM
+   :eg-result RESULT-FORM ;Use `:eg-result-string' if value is in string form
+   )
+
+A FUNC form can have any number of `:no-eval' (or `:no-value'),
+`:no-eval*', `:result', `:result-string', `:eg-result' and
+`:eg-result-string' properties."
   (declare (indent defun))
   `(progn
      (setq shortdoc--groups (delq (assq ',group shortdoc--groups)
@@ -1261,16 +1298,20 @@ There can be any number of :example/:result elements."
    :eval (keymap-lookup (current-global-map) "C-x x g")))
 
 ;;;###autoload
-(defun shortdoc-display-group (group &optional function)
+(defun shortdoc-display-group (group &optional function same-window)
   "Pop to a buffer with short documentation summary for functions in GROUP.
-If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)."
+If FUNCTION is non-nil, place point on the entry for FUNCTION (if any).
+If SAME-WINDOW, don't pop to a new window."
   (interactive (list (completing-read "Show summary for functions in: "
                                       (mapcar #'car shortdoc--groups))))
   (when (stringp group)
     (setq group (intern group)))
   (unless (assq group shortdoc--groups)
     (error "No such documentation group %s" group))
-  (pop-to-buffer (format "*Shortdoc %s*" group))
+  (funcall (if same-window
+               #'pop-to-buffer-same-window
+             #'pop-to-buffer)
+           (format "*Shortdoc %s*" group))
   (let ((inhibit-read-only t)
         (prev nil))
     (erase-buffer)
@@ -1408,11 +1449,14 @@ function's documentation in the Info manual")))
 If GROUP doesn't exist, it will be created.
 If SECTION doesn't exist, it will be added.
 
+ELEM is a Lisp form.  See `define-short-documentation-group' for
+details.
+
 Example:
 
   (shortdoc-add-function
-    'file \"Predicates\"
-    '(file-locked-p :no-eval (file-locked-p \"/tmp\")))"
+    \\='file \"Predicates\"
+    \\='(file-locked-p :no-eval (file-locked-p \"/tmp\")))"
   (let ((glist (assq group shortdoc--groups)))
     (unless glist
       (setq glist (list group))
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 2bab1319132..61d52026b38 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -1846,7 +1846,9 @@ to which that point should be aligned, if we were to reindent it.")
                            (move-to-column fc)
                            (syntax-ppss))))
         (while
-            (and (with-demoted-errors "SMIE Error: %S"
+            ;; We silence the error completely since errors are "normal" in
+            ;; some cases and an error message would be annoying (bug#19342).
+            (and (ignore-error scan-error
                    (save-excursion
                      (let ((end (point))
                            (bsf nil)    ;Best-so-far.
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 7ad4e9ba2ab..9cd793d05c5 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -81,116 +81,6 @@ Note how the single `-' got converted into a list before
 threading."
   (declare (indent 0) (debug thread-first))
   `(internal--thread-argument nil ,@forms))
-
-(defsubst internal--listify (elt)
-  "Wrap ELT in a list if it is not one.
-If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol."
-  (cond
-   ((symbolp elt) (list elt elt))
-   ((null (cdr elt))
-    (list (make-symbol "s") (car elt)))
-   (t elt)))
-
-(defsubst internal--check-binding (binding)
-  "Check BINDING is properly formed."
-  (when (> (length binding) 2)
-    (signal
-     'error
-     (cons "`let' bindings can have only one value-form" binding)))
-  binding)
-
-(defsubst internal--build-binding-value-form (binding prev-var)
-  "Build the conditional value form for BINDING using PREV-VAR."
-  (let ((var (car binding)))
-    `(,var (and ,prev-var ,(cadr binding)))))
-
-(defun internal--build-binding (binding prev-var)
-  "Check and build a single BINDING with PREV-VAR."
-  (thread-first
-    binding
-    internal--listify
-    internal--check-binding
-    (internal--build-binding-value-form prev-var)))
-
-(defun internal--build-bindings (bindings)
-  "Check and build conditional value forms for BINDINGS."
-  (let ((prev-var t))
-    (mapcar (lambda (binding)
-              (let ((binding (internal--build-binding binding prev-var)))
-                (setq prev-var (car binding))
-                binding))
-            bindings)))
-
-(defmacro if-let* (varlist then &rest else)
-  "Bind variables according to VARLIST and evaluate THEN or ELSE.
-This is like `if-let' but doesn't handle a VARLIST of the form
-\(SYMBOL SOMETHING) specially."
-  (declare (indent 2)
-           (debug ((&rest [&or symbolp (symbolp form) (form)])
-                   body)))
-  (if varlist
-      `(let* ,(setq varlist (internal--build-bindings varlist))
-         (if ,(caar (last varlist))
-             ,then
-           ,@else))
-    `(let* () ,then)))
-
-(defmacro when-let* (varlist &rest body)
-  "Bind variables according to VARLIST and conditionally evaluate BODY.
-This is like `when-let' but doesn't handle a VARLIST of the form
-\(SYMBOL SOMETHING) specially."
-  (declare (indent 1) (debug if-let*))
-  (list 'if-let* varlist (macroexp-progn body)))
-
-(defmacro and-let* (varlist &rest body)
-  "Bind variables according to VARLIST and conditionally evaluate BODY.
-Like `when-let*', except if BODY is empty and all the bindings
-are non-nil, then the result is non-nil."
-  (declare (indent 1) (debug if-let*))
-  (let (res)
-    (if varlist
-        `(let* ,(setq varlist (internal--build-bindings varlist))
-           (when ,(setq res (caar (last varlist)))
-             ,@(or body `(,res))))
-      `(let* () ,@(or body '(t))))))
-
-;;;###autoload
-(defmacro if-let (spec then &rest else)
-  "Bind variables according to SPEC and evaluate THEN or ELSE.
-Evaluate each binding in turn, as in `let*', stopping if a
-binding value is nil.  If all are non-nil return the value of
-THEN, otherwise the last form in ELSE.
-
-Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
-SYMBOL to the value of VALUEFORM.  An element can additionally be
-of the form (VALUEFORM), which is evaluated and checked for nil;
-i.e. SYMBOL can be omitted if only the test result is of
-interest.  It can also be of the form SYMBOL, then the binding of
-SYMBOL is checked for nil.
-
-As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING)
-like \((SYMBOL SOMETHING)).  This exists for backward compatibility
-with an old syntax that accepted only one binding."
-  (declare (indent 2)
-           (debug ([&or (symbolp form)  ; must be first, Bug#48489
-                        (&rest [&or symbolp (symbolp form) (form)])]
-                   body)))
-  (when (and (<= (length spec) 2)
-             (not (listp (car spec))))
-    ;; Adjust the single binding case
-    (setq spec (list spec)))
-  (list 'if-let* spec then (macroexp-progn else)))
-
-;;;###autoload
-(defmacro when-let (spec &rest body)
-  "Bind variables according to SPEC and conditionally evaluate BODY.
-Evaluate each binding in turn, stopping if a binding value is nil.
-If all are non-nil, return the value of the last form in BODY.
-
-The variable list SPEC is the same as in `if-let'."
-  (declare (indent 1) (debug if-let))
-  (list 'if-let spec (macroexp-progn body)))
-
 (defsubst hash-table-empty-p (hash-table)
   "Check whether HASH-TABLE is empty (has 0 elements)."
   (zerop (hash-table-count hash-table)))
@@ -320,12 +210,6 @@ than this function."
      (end (substring string (- (length string) length)))
      (t (substring string 0 length)))))
 
-;;;###autoload
-(defun string-lines (string &optional omit-nulls)
-  "Split STRING into a list of lines.
-If OMIT-NULLS, empty lines will be removed from the results."
-  (split-string string "\n" omit-nulls))
-
 (defun string-pad (string length &optional padding start)
   "Pad STRING to LENGTH using PADDING.
 If PADDING is nil, the space character is used.  If not nil, it
@@ -414,32 +298,6 @@ and return the value found in PLACE instead."
                ,(funcall setter val)
                ,val)))))
 
-;;;###autoload
-(defun ensure-empty-lines (&optional lines)
-  "Ensure that there are LINES number of empty lines before point.
-If LINES is nil or omitted, ensure that there is a single empty
-line before point.
-
-If called interactively, LINES is given by the prefix argument.
-
-If there are more than LINES empty lines before point, the number
-of empty lines is reduced to LINES.
-
-If point is not at the beginning of a line, a newline character
-is inserted before adjusting the number of empty lines."
-  (interactive "p")
-  (unless (bolp)
-    (insert "\n"))
-  (let ((lines (or lines 1))
-        (start (save-excursion
-                 (if (re-search-backward "[^\n]" nil t)
-                     (+ (point) 2)
-                   (point-min)))))
-    (cond
-     ((> (- (point) start) lines)
-      (delete-region (point) (- (point) (- (point) start lines))))
-     ((< (- (point) start) lines)
-      (insert (make-string (- lines (- (point) start)) ?\n))))))
 
 ;;;###autoload
 (defun string-pixel-width (string)
@@ -558,6 +416,43 @@ this defaults to the current buffer."
         (error "No process selected"))
       process)))
 
+(defmacro with-buffer-unmodified-if-unchanged (&rest body)
+  "Like `progn', but change buffer-modified status only if buffer text changes.
+If the buffer was unmodified before execution of BODY, and
+buffer text after execution of BODY is identical to what it was
+before, ensure that buffer is still marked unmodified afterwards.
+For example, the following won't change the buffer's modification
+status:
+
+  (with-buffer-unmodified-if-unchanged
+    (insert \"a\")
+    (delete-char -1))
+
+Note that only changes in the raw byte sequence of the buffer text,
+as stored in the internal representation, are monitored for the
+purpose of detecting the lack of changes in buffer text.  Any other
+changes that are normally perceived as \"buffer modifications\", such
+as changes in text properties, `buffer-file-coding-system', buffer
+multibyteness, etc. -- will not be noticed, and the buffer will still
+be marked unmodified, effectively ignoring those changes."
+  (declare (debug t) (indent 0))
+  (let ((hash (gensym))
+        (buffer (gensym)))
+    `(let ((,hash (and (not (buffer-modified-p))
+                       (buffer-hash)))
+           (,buffer (current-buffer)))
+       (prog1
+           (progn
+             ,@body)
+         ;; If we didn't change anything in the buffer (and the buffer
+         ;; was previously unmodified), then flip the modification status
+         ;; back to "unchanged".
+         (when (and ,hash (buffer-live-p ,buffer))
+           (with-current-buffer ,buffer
+             (when (and (buffer-modified-p)
+                        (equal ,hash (buffer-hash)))
+               (restore-buffer-modified-p nil))))))))
+
 (provide 'subr-x)
 
 ;;; subr-x.el ends here
diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el
index 9f86a28eb64..d11980f4f45 100644
--- a/lisp/emacs-lisp/text-property-search.el
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -47,7 +47,7 @@ match if is not `equal' to VALUE.  Furthermore, a nil PREDICATE
 means that the match region is ended if the value changes.  For
 instance, this means that if you loop with
 
-  (while (setq prop (text-property-search-forward 'face))
+  (while (setq prop (text-property-search-forward \\='face))
     ...)
 
 you will get all distinct regions with non-nil `face' values in
@@ -166,7 +166,6 @@ and if a matching region is found, place point at the start of the region."
     (let ((origin (point))
           (ended nil)
           pos)
-      (forward-char -1)
       ;; Find the previous candidate.
       (while (not ended)
         (setq pos (previous-single-property-change (point) property))
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index c93a50cabfe..aef18d0ba27 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -62,7 +62,7 @@
                   ((numberp repeat)
                    (propertize
                     (format "%12s" (format-seconds
-                                    "%dd %hh %mm %z%,1ss" repeat))
+                                    "%x%dd %hh %mm %z%,1ss" repeat))
                     'help-echo "Repeat interval"))
                   ((null repeat)
                    (propertize "           -" 'help-echo "Runs once"))
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index d8577c19762..61265c97c28 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -28,6 +28,12 @@
 (require 'text-property-search)
 (require 'mule-util)
 
+(defface vtable
+  '((t :inherit variable-pitch))
+  "Face used (by default) for vtables."
+  :version "29.1"
+  :group 'faces)
+
 (cl-defstruct vtable-column
   "A vtable column."
   name
@@ -55,10 +61,16 @@
    (actions :initarg :actions :accessor vtable-actions)
    (keymap :initarg :keymap :accessor vtable-keymap)
    (separator-width :initarg :separator-width :accessor vtable-separator-width)
+   (divider :initarg :divider :accessor vtable-divider :initform nil)
    (sort-by :initarg :sort-by :accessor vtable-sort-by)
    (ellipsis :initarg :ellipsis :accessor vtable-ellipsis)
-   (-cache :initform (make-hash-table :test #'equal)))
-  "A object to hold the data for a table.")
+   (column-colors :initarg :column-colors :accessor vtable-column-colors)
+   (row-colors :initarg :row-colors :accessor vtable-row-colors)
+   (-cached-colors :initform nil)
+   (-cache :initform (make-hash-table :test #'equal))
+   (-cached-keymap :initform nil)
+   (-has-column-spec :initform nil))
+  "An object to hold the data for a table.")
 
 (defvar-keymap vtable-map
   "S" #'vtable-sort-by-current-column
@@ -78,53 +90,84 @@
                             formatter
                             displayer
                             (use-header-line t)
-                            (face 'variable-pitch)
+                            (face 'vtable)
                             actions keymap
                             (separator-width 1)
+                            divider
+                            divider-width
                             sort-by
                             (ellipsis t)
-                            (insert t))
+                            (insert t)
+                            row-colors
+                            column-colors)
   "Create and insert a vtable at point.
 The vtable object is returned.  If INSERT is nil, the table won't
-be inserted."
+be inserted.
+
+See info node `(vtable)Top' for vtable documentation."
   (when objects-function
     (setq objects (funcall objects-function)))
-  ;; Auto-generate the columns.
-  (unless columns
-    (unless objects
-      (error "Can't auto-generate columns; no objects"))
-    (setf columns (make-list (length (car objects)) "")))
-  (setq columns (mapcar (lambda (column)
-                          (cond
-                           ;; We just have the name (as a string).
-                           ((stringp column)
-                            (make-vtable-column :name column))
-                           ;; A plist of keywords/values.
-                           ((listp column)
-                            (apply #'make-vtable-column column))
-                           ;; A full `vtable-column' object.
-                           (t
-                            column)))
-                        columns))
   ;; We'll be altering the list, so create a copy.
   (setq objects (copy-sequence objects))
   (let ((table
-         (make-instance 'vtable
-                        :columns columns
-                        :objects objects
-                        :objects-function objects-function
-                        :getter getter
-                        :formatter formatter
-                        :displayer displayer
-                        :use-header-line use-header-line
-                        :face face
-                        :actions actions
-                        :keymap keymap
-                        :separator-width separator-width
-                        :sort-by sort-by
-                        :ellipsis ellipsis)))
+         (make-instance
+          'vtable
+          :objects objects
+          :objects-function objects-function
+          :getter getter
+          :formatter formatter
+          :displayer displayer
+          :use-header-line use-header-line
+          :face face
+          :actions actions
+          :keymap keymap
+          :separator-width separator-width
+          :sort-by sort-by
+          :row-colors row-colors
+          :column-colors column-colors
+          :ellipsis ellipsis)))
+    ;; Store whether the user has specified columns or not.
+    (setf (slot-value table '-has-column-spec) (not (not columns)))
+    ;; Auto-generate the columns.
+    (unless columns
+      (unless objects
+        (error "Can't auto-generate columns; no objects"))
+      (setq columns (make-list (length (car objects)) "")))
+    (setf (vtable-columns table)
+          (mapcar (lambda (column)
+                    (cond
+                     ;; We just have the name (as a string).
+                     ((stringp column)
+                      (make-vtable-column :name column))
+                     ;; A plist of keywords/values.
+                     ((listp column)
+                      (apply #'make-vtable-column column))
+                     ;; A full `vtable-column' object.
+                     (t
+                      column)))
+                  columns))
     ;; Compute missing column data.
     (setf (vtable-columns table) (vtable--compute-columns table))
+    ;; Compute the colors.
+    (when (or row-colors column-colors)
+      (setf (slot-value table '-cached-colors)
+            (vtable--compute-colors row-colors column-colors)))
+    ;; Compute the divider.
+    (when (or divider divider-width)
+      (setf (vtable-divider table)
+            (propertize
+             (or (copy-sequence divider)
+                 (propertize
+                  " " 'display
+                  (list 'space :width
+                        (list (vtable--compute-width table divider-width)))))
+             'mouse-face 'highlight
+             'keymap
+             (define-keymap
+               "<drag-mouse-1>" #'vtable--drag-resize-column
+               "<down-mouse-1>" #'ignore))))
+    ;; Compute the keymap.
+    (setf (slot-value table '-cached-keymap) (vtable--make-keymap table))
     (unless sort-by
       (seq-do-indexed (lambda (column index)
                         (when (vtable-column-primary column)
@@ -135,6 +178,52 @@ be inserted."
       (vtable-insert table))
     table))
 
+(defun vtable--compute-colors (row-colors column-colors)
+  (cond
+   ((null column-colors)
+    (mapcar #'vtable--make-color-face row-colors))
+   ((null row-colors)
+    (mapcar #'vtable--make-color-face column-colors))
+   (t
+    (cl-loop for row in row-colors
+             collect (cl-loop for column in column-colors
+                              collect (vtable--face-blend
+                                       (vtable--make-color-face row)
+                                       (vtable--make-color-face column)))))))
+
+(defun vtable--make-color-face (object)
+  (if (stringp object)
+      (list :background object)
+    object))
+
+(defun vtable--face-blend (face1 face2)
+  (let ((foreground (vtable--face-color face1 face2 #'face-foreground
+                                        :foreground))
+        (background (vtable--face-color face1 face2 #'face-background
+                                        :background)))
+    `(,@(and foreground (list :foreground foreground))
+      ,@(and background (list :background background)))))
+
+(defun vtable--face-color (face1 face2 accessor slot)
+  (let ((col1 (if (facep face1)
+                  (funcall accessor face1)
+                (plist-get face1 slot)))
+        (col2 (if (facep face2)
+                  (funcall accessor face2)
+                (plist-get face2 slot))))
+    (if (and col1 col2)
+        (vtable--color-blend col1 col2)
+      (or col1 col2))))
+
+;;; FIXME: This is probably not the right way to blend two colors, is
+;;; it?
+(defun vtable--color-blend (color1 color2)
+  (cl-destructuring-bind (r g b)
+      (mapcar (lambda (n) (* (/ n 2) 255.0))
+              (cl-mapcar #'+ (color-name-to-rgb color1)
+                         (color-name-to-rgb color2)))
+    (format "#%02X%02X%02X" r g b)))
+
 ;;; Interface utility functions.
 
 (defun vtable-current-table ()
@@ -210,7 +299,8 @@ If it can't be found, return nil and don't move point."
         (error "Can't find the old object"))
       (setcar (cdr objects) object))
     ;; Then update the cache...
-    (let ((line (assq old-object (car (vtable--cache table)))))
+    (let* ((line-number (seq-position old-object (car (vtable--cache table))))
+           (line (elt (car (vtable--cache table)) line-number)))
       (unless line
         (error "Can't find cached object"))
       (setcar line object)
@@ -221,7 +311,8 @@ If it can't be found, return nil and don't move point."
         (let ((keymap (get-text-property (point) 'keymap))
               (start (point)))
           (delete-line)
-          (vtable--insert-line table line (nth 1 (vtable--cache table))
+          (vtable--insert-line table line line-number
+                               (nth 1 (vtable--cache table))
                                (vtable--spacer table))
           (add-text-properties start (point) (list 'keymap keymap
                                                    'vtable table))))
@@ -276,7 +367,10 @@ This also updates the displayed table."
           (unless (vtable-goto-object after-object)
             (vtable-end-of-table))))
       (let ((start (point)))
-        (vtable--insert-line table line (nth 1 cache) (vtable--spacer table))
+        ;; FIXME: We have to adjust colors in lines below this if we
+        ;; have :row-colors.
+        (vtable--insert-line table line 0
+                             (nth 1 cache) (vtable--spacer table))
         (add-text-properties start (point) (list 'keymap keymap
                                                  'vtable table)))
       ;; We may have inserted a non-numerical value into a previously
@@ -333,6 +427,16 @@ This also updates the displayed table."
 (defun vtable--spacer (table)
   (vtable--compute-width table (vtable-separator-width table)))
 
+(defun vtable--recompute-cache (table)
+  (let* ((data (vtable--compute-cache table))
+         (widths (vtable--compute-widths table data)))
+    (setf (gethash (vtable--cache-key) (slot-value table '-cache))
+          (list data widths))))
+
+(defun vtable--ensure-cache (table)
+  (or (vtable--cache table)
+      (vtable--recompute-cache table)))
+
 (defun vtable-insert (table)
   (let* ((spacer (vtable--spacer table))
          (start (point))
@@ -341,43 +445,48 @@ This also updates the displayed table."
                                    'face (vtable-face table))
                      ""))
          (ellipsis-width (string-pixel-width ellipsis))
-         data widths)
-    ;; We maintain a cache per screen/window width, so that we render
-    ;; correctly if Emacs is open on two different screens (or the
-    ;; user resizes the frame).
-    (if-let ((cache (vtable--cache table)))
-        (setq data (nth 0 cache)
-              widths (nth 1 cache))
-      (setq data (vtable--compute-cache table)
-            widths (vtable--compute-widths table data))
-      (setf (gethash (vtable--cache-key) (slot-value table '-cache))
-            (list data widths)))
-    (if (vtable-use-header-line table)
-        (vtable--set-header-line table widths spacer)
-      ;; Insert the header line directly into the buffer, and put a
-      ;; keymap to be able to sort the columns there (by clicking on
-      ;; them).
-      (vtable--insert-header-line table widths spacer)
-      (add-text-properties start (point)
-                           (list 'keymap vtable-header-line-map
-                                 'rear-nonsticky t
-                                 'vtable table))
-      (setq start (point)))
+         ;; We maintain a cache per screen/window width, so that we render
+         ;; correctly if Emacs is open on two different screens (or the
+         ;; user resizes the frame).
+         (widths (nth 1 (vtable--ensure-cache table))))
+    ;; Don't insert any header or header line if the user hasn't
+    ;; specified the columns.
+    (when (slot-value table '-has-column-spec)
+      (if (vtable-use-header-line table)
+          (vtable--set-header-line table widths spacer)
+        ;; Insert the header line directly into the buffer, and put a
+        ;; keymap to be able to sort the columns there (by clicking on
+        ;; them).
+        (vtable--insert-header-line table widths spacer)
+        (add-text-properties start (point)
+                             (list 'keymap vtable-header-line-map
+                                   'rear-nonsticky t
+                                   'vtable table))
+        (setq start (point))))
     (vtable--sort table)
     ;; Insert the data.
-    (dolist (line (car (vtable--cache table)))
-      (vtable--insert-line table line widths spacer
-                           ellipsis ellipsis-width))
+    (let ((line-number 0))
+      (dolist (line (car (vtable--cache table)))
+        (vtable--insert-line table line line-number widths spacer
+                             ellipsis ellipsis-width)
+        (setq line-number (1+ line-number))))
     (add-text-properties start (point)
-                         (list 'keymap (vtable--make-keymap table)
-                               'rear-nonsticky t
+                         (list 'rear-nonsticky t
                                'vtable table))
     (goto-char start)))
 
-(defun vtable--insert-line (table line widths spacer
+(defun vtable--insert-line (table line line-number widths spacer
                                   &optional ellipsis ellipsis-width)
   (let ((start (point))
-        (columns (vtable-columns table)))
+        (columns (vtable-columns table))
+        (column-colors
+         (and (vtable-column-colors table)
+              (if (vtable-row-colors table)
+                  (elt (slot-value table '-cached-colors)
+                       (mod line-number (length (vtable-row-colors table))))
+                (slot-value table '-cached-colors))))
+        (divider (vtable-divider table))
+        (keymap (slot-value table '-cached-keymap)))
     (seq-do-indexed
      (lambda (elem index)
        (let ((value (nth 0 elem))
@@ -418,30 +527,47 @@ This also updates the displayed table."
                         value (- (elt widths index) ellipsis-width))
                        ellipsis)
                     value))))
-               (start (point)))
+               (start (point))
+               ;; Don't insert the separator after the final column.
+               (last (= index (- (length line) 2))))
            (if (eq (vtable-column-align column) 'left)
-               (insert displayed
-                       (propertize
-                        " " 'display
-                        (list 'space
-                              :width (list
-                                      (+ (- (elt widths index)
-                                            (string-pixel-width displayed))
-                                         spacer)))))
+               (progn
+                 (insert displayed)
+                 (insert (propertize
+                          " " 'display
+                          (list 'space
+                                :width (list
+                                        (+ (- (elt widths index)
+                                              (string-pixel-width displayed))
+                                           (if last 0 spacer)))))))
              ;; Align to the right.
              (insert (propertize " " 'display
                                  (list 'space
                                        :width (list (- (elt widths index)
                                                        (string-pixel-width
                                                         displayed)))))
-                     displayed
-                     (propertize " " 'display
-                                 (list 'space
-                                       :width (list spacer)))))
-           (put-text-property start (point) 'vtable-column index))))
+                     displayed)
+             (unless last
+               (insert (propertize " " 'display
+                                   (list 'space
+                                         :width (list spacer))))))
+           (put-text-property start (point) 'vtable-column index)
+           (put-text-property start (point) 'keymap keymap)
+           (when column-colors
+             (add-face-text-property
+              start (point)
+              (elt column-colors (mod index (length column-colors)))))
+           (when divider
+             (insert divider)
+             (setq start (point))))))
      (cdr line))
     (insert "\n")
-    (put-text-property start (point) 'vtable-object (car line))))
+    (put-text-property start (point) 'vtable-object (car line))
+    (unless column-colors
+      (when-let ((row-colors (slot-value table '-cached-colors)))
+        (add-face-text-property
+         start (point)
+         (elt row-colors (mod line-number (length row-colors))))))))
 
 (defun vtable--cache-key ()
   (cons (frame-terminal) (window-width)))
@@ -456,22 +582,26 @@ This also updates the displayed table."
   (pcase-dolist (`(,index . ,direction) (vtable-sort-by table))
     (let ((cache (vtable--cache table))
           (numerical (vtable-column--numerical
-                      (elt (vtable-columns table) index))))
+                      (elt (vtable-columns table) index)))
+          (numcomp (if (eq direction 'descend)
+                       #'> #'<))
+          (stringcomp (if (eq direction 'descend)
+                          #'string> #'string<)))
       (setcar cache
               (sort (car cache)
                     (lambda (e1 e2)
                       (let ((c1 (elt e1 (1+ index)))
                             (c2 (elt e2 (1+ index))))
                         (if numerical
-                            (< (car c1) (car c2))
-                          (string< (if (stringp (car c1))
-                                       (car c1)
-                                     (format "%s" (car c1)))
-                                   (if (stringp (car c2))
-                                       (car c2)
-                                     (format "%s" (car c2)))))))))
-      (when (eq direction 'descend)
-        (setcar cache (nreverse (car cache)))))))
+                            (funcall numcomp (car c1) (car c2))
+                          (funcall
+                           stringcomp
+                           (if (stringp (car c1))
+                               (car c1)
+                             (format "%s" (car c1)))
+                           (if (stringp (car c2))
+                               (car c2)
+                             (format "%s" (car c2))))))))))))
 
 (defun vtable--indicator (table index)
   (let ((order (car (last (vtable-sort-by table)))))
@@ -489,35 +619,112 @@ This also updates the displayed table."
 
 (defun vtable--insert-header-line (table widths spacer)
   ;; Insert the header directly into the buffer.
-  (let* ((start (point)))
+  (let ((start (point))
+        (divider (vtable-divider table))
+        (cmap (define-keymap
+                "<header-line> <drag-mouse-1>" #'vtable--drag-resize-column
+                "<header-line> <down-mouse-1>" #'ignore))
+        (dmap (define-keymap
+                "<header-line> <drag-mouse-1>"
+                (lambda (e)
+                  (interactive "e")
+                  (vtable--drag-resize-column e t))
+                "<header-line> <down-mouse-1>" #'ignore)))
     (seq-do-indexed
      (lambda (column index)
        (let* ((name (propertize
                      (vtable-column-name column)
-                     'face (list 'header-line (vtable-face table))))
+                     'face (list 'header-line (vtable-face table))
+                     'mouse-face 'header-line-highlight
+                     'keymap cmap))
               (start (point))
               (indicator (vtable--indicator table index))
               (indicator-width (string-pixel-width indicator))
+              (last (= index (1- (length (vtable-columns table)))))
               displayed)
-         (insert
-          (setq displayed
-                (concat
-                 (if (> (string-pixel-width name)
-                        (- (elt widths index) indicator-width))
-                     (vtable--limit-string
-                      name (- (elt widths index) indicator-width))
-                   name)
-                 indicator))
-          (propertize " " 'display
-                      (list 'space :width
-                            (list (+ (- (elt widths index)
-                                        (string-pixel-width displayed))
-                                     spacer)))))
+         (setq displayed
+               (if (> (string-pixel-width name)
+                      (- (elt widths index) indicator-width))
+                   (vtable--limit-string
+                    name (- (elt widths index) indicator-width))
+                 name))
+         (let ((fill-width
+                (+ (- (elt widths index)
+                      (string-pixel-width displayed)
+                      indicator-width
+                      (vtable-separator-width table)
+                      ;; We want the indicator to not be quite flush
+                      ;; right.
+                      (/ (vtable--char-width table) 2.0))
+                   (if last 0 spacer))))
+           (if (or (not last)
+                   (zerop indicator-width)
+                   (< (seq-reduce #'+ widths 0) (window-width nil t)))
+               ;; Normal case.
+               (insert
+                displayed
+                (propertize " " 'display
+                            (list 'space :width (list fill-width)))
+                indicator)
+             ;; This is the final column, and we have a sorting
+             ;; indicator, and the table is too wide for the window.
+             (let* ((pre-indicator (string-pixel-width
+                                    (buffer-substring (point-min) (point))))
+                    (pre-fill
+                     (- (window-width nil t)
+                        pre-indicator
+                        (string-pixel-width displayed))))
+               (insert
+                displayed
+                (propertize " " 'display
+                            (list 'space :width (list pre-fill)))
+                indicator
+                (propertize " " 'display
+                            (list 'space :width
+                                  (list (- fill-width pre-fill))))))))
+         (when (and divider (not last))
+           (insert (propertize divider 'keymap dmap)))
+         (insert (propertize
+                  " " 'display
+                  (list 'space :width (list
+                                       (/ (vtable--char-width table) 2.0)))))
          (put-text-property start (point) 'vtable-column index)))
      (vtable-columns table))
     (insert "\n")
     (add-face-text-property start (point) 'header-line)))
 
+(defun vtable--drag-resize-column (e &optional next)
+  "Resize the column by dragging.
+If NEXT, do the next column."
+  (interactive "e")
+  (let* ((pos-start (event-start e))
+	 (obj (posn-object pos-start)))
+    (with-current-buffer (window-buffer (posn-window pos-start))
+      (let ((column
+             ;; In the header line we have a text property on the
+             ;; divider.
+             (or (get-text-property (if obj (cdr obj)
+                                      (posn-point pos-start))
+			            'vtable-column
+			            (car obj))
+                 ;; For reasons of efficiency, we don't have that in
+                 ;; the buffer itself, so find the column.
+                 (save-excursion
+                   (goto-char (posn-point pos-start))
+                   (1+
+                    (get-text-property
+                     (prop-match-beginning
+                      (text-property-search-backward 'vtable-column))
+                     'vtable-column)))))
+            (start-x (car (posn-x-y pos-start)))
+            (end-x (car (posn-x-y (event-end e)))))
+        (when (or (> column 0) next)
+          (vtable--alter-column-width (vtable-current-table)
+                                      (if next
+                                          column
+                                        (1- column))
+                                      (- end-x start-x)))))))
+
 (defun vtable--recompute-numerical (table line)
   "Recompute numericalness of columns if necessary."
   (let ((columns (vtable-columns table))
@@ -661,7 +868,7 @@ This also updates the displayed table."
       (vtable-goto-column column))))
 
 (defun vtable--widths (table)
-  (nth 1 (vtable--cache table)))
+  (nth 1 (vtable--ensure-cache table)))
 
 ;;; Commands.
 
@@ -673,25 +880,36 @@ This also updates the displayed table."
   "Minor mode for buffers with vtables with headers."
   :keymap vtable-header-mode-map)
 
-(defun vtable-narrow-current-column ()
-  "Narrow the current column."
-  (interactive)
+(defun vtable-narrow-current-column (&optional n)
+  "Narrow the current column by N characters.
+If N isn't given, N defaults to 1.
+
+Interactively, N is the prefix argument."
+  (interactive "p")
   (let* ((table (vtable-current-table))
-         (column (vtable-current-column))
-         (widths (vtable--widths table)))
+         (column (vtable-current-column)))
+    (unless column
+      (user-error "No column under point"))
+    (vtable--alter-column-width table column
+                                (- (* (vtable--char-width table) (or n 1))))))
+
+(defun vtable--alter-column-width (table column delta)
+  (let ((widths (vtable--widths table)))
     (setf (aref widths column)
           (max (* (vtable--char-width table) 2)
-               (- (aref widths column) (vtable--char-width table))))
+               (+ (aref widths column) delta)))
+    ;; Store the width so it'll be respected on a revert.
+    (setf (vtable-column-width (elt (vtable-columns table) column))
+          (format "%dpx" (aref widths column)))
     (vtable-revert)))
 
-(defun vtable-widen-current-column ()
-  "Widen the current column."
-  (interactive)
-  (let* ((table (vtable-current-table))
-         (column (vtable-current-column))
-         (widths (nth 1 (vtable--cache table))))
-    (cl-incf (aref widths column) (vtable--char-width table))
-    (vtable-revert)))
+(defun vtable-widen-current-column (&optional n)
+  "Widen the current column by N characters.
+If N isn't given, N defaults to 1.
+
+Interactively, N is the prefix argument."
+  (interactive "p")
+  (vtable-narrow-current-column (- n)))
 
 (defun vtable-previous-column ()
   "Go to the previous column."