Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

9 files changed, 53 insertions, 44 deletions

diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 247fb91379e..76c2e80fda8 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -657,33 +657,33 @@ The port (if any) is omitted.  IP can be a string, as well."
 OP can be one of: unpack', (pack VAL), or (length VAL) where VAL
 is the name of a variable that will hold the value we need to pack.")
 
-(cl-defmethod bindat--type (op (_ (eql byte)))
+(cl-defmethod bindat--type (op (_ (eql 'byte)))
   (bindat--pcase op
     ('unpack `(bindat--unpack-u8))
     (`(length . ,_) `(cl-incf bindat-idx 1))
     (`(pack . ,args) `(bindat--pack-u8 . ,args))))
 
-(cl-defmethod bindat--type (op (_ (eql uint))  n)
+(cl-defmethod bindat--type (op (_ (eql 'uint))  n)
   (if (eq n 8) (bindat--type op 'byte)
     (bindat--pcase op
       ('unpack `(bindat--unpack-uint ,n))
       (`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
       (`(pack . ,args) `(bindat--pack-uint ,n . ,args)))))
 
-(cl-defmethod bindat--type (op (_ (eql uintr)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uintr)) n)
   (if (eq n 8) (bindat--type op 'byte)
     (bindat--pcase op
       ('unpack `(bindat--unpack-uintr ,n))
       (`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
       (`(pack . ,args) `(bindat--pack-uintr ,n . ,args)))))
 
-(cl-defmethod bindat--type (op (_ (eql str))   len)
+(cl-defmethod bindat--type (op (_ (eql 'str))   len)
   (bindat--pcase op
     ('unpack `(bindat--unpack-str ,len))
     (`(length . ,_) `(cl-incf bindat-idx ,len))
     (`(pack . ,args) `(bindat--pack-str ,len . ,args))))
 
-(cl-defmethod bindat--type (op (_ (eql strz))  &optional len)
+(cl-defmethod bindat--type (op (_ (eql 'strz))  &optional len)
   (bindat--pcase op
     ('unpack `(bindat--unpack-strz ,len))
     (`(length ,val)
@@ -701,25 +701,25 @@ is the name of a variable that will hold the value we need to pack.")
             (bindat--pack-str ,len . ,args)
           (bindat--pack-strz . ,args))))))
 
-(cl-defmethod bindat--type (op (_ (eql bits))  len)
+(cl-defmethod bindat--type (op (_ (eql 'bits))  len)
   (bindat--pcase op
     ('unpack `(bindat--unpack-bits ,len))
     (`(length . ,_) `(cl-incf bindat-idx ,len))
     (`(pack . ,args) `(bindat--pack-bits ,len . ,args))))
 
-(cl-defmethod bindat--type (_op (_ (eql fill))  len)
+(cl-defmethod bindat--type (_op (_ (eql 'fill))  len)
   `(progn (cl-incf bindat-idx ,len) nil))
 
-(cl-defmethod bindat--type (_op (_ (eql align)) len)
+(cl-defmethod bindat--type (_op (_ (eql 'align)) len)
   `(progn (cl-callf bindat--align bindat-idx ,len) nil))
 
-(cl-defmethod bindat--type (op (_ (eql type)) exp)
+(cl-defmethod bindat--type (op (_ (eql 'type)) exp)
   (bindat--pcase op
     ('unpack        `(funcall (bindat--type-ue ,exp)))
     (`(length . ,args) `(funcall (bindat--type-le ,exp) . ,args))
     (`(pack . ,args)   `(funcall (bindat--type-pe ,exp) . ,args))))
 
-(cl-defmethod bindat--type (op (_ (eql vec)) count &rest type)
+(cl-defmethod bindat--type (op (_ (eql 'vec)) count &rest type)
   (unless type (setq type '(byte)))
   (let ((fun (macroexpand-all (bindat--fun type) macroexpand-all-environment)))
     (bindat--pcase op
@@ -743,10 +743,10 @@ is the name of a variable that will hold the value we need to pack.")
        `(dotimes (bindat--i ,count)
 	  (funcall ,fun (elt ,val bindat--i)))))))
 
-(cl-defmethod bindat--type (op (_ (eql unit)) val)
+(cl-defmethod bindat--type (op (_ (eql 'unit)) val)
   (pcase op ('unpack val) (_ nil)))
 
-(cl-defmethod bindat--type (op (_ (eql struct)) &rest args)
+(cl-defmethod bindat--type (op (_ (eql 'struct)) &rest args)
   (apply #'bindat--type op args))
 
 (cl-defmethod bindat--type (op (_ (eql :pack-var)) var &rest fields)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 96072ea1b55..6475f69eded 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -601,15 +601,9 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
                   (lexvar (assq var byte-optimize--lexvars))
                   (value (byte-optimize-form expr nil)))
              (when lexvar
-               ;; Set a new value or inhibit further substitution.
-               (setcdr (cdr lexvar)
-                       (and
-                        ;; Inhibit if bound outside conditional code.
-                        (not (assq var byte-optimize--vars-outside-condition))
-                        ;; The new value must be substitutable.
-                        (byte-optimize--substitutable-p value)
-                        (list value)))
-               (setcar (cdr lexvar) t))   ; Mark variable to be kept.
+               (setcar (cdr lexvar) t)    ; Mark variable to be kept.
+               (setcdr (cdr lexvar) nil)) ; Inhibit further substitution.
+
              (push var var-expr-list)
              (push value var-expr-list))
            (setq args (cddr args)))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 544704be387..db5a5a0c89a 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1158,7 +1158,17 @@ These match if the argument is a cons cell whose car is `eql' to VAL."
 (cl-defmethod cl-generic-generalizers ((specializer (head eql)))
   "Support for (eql VAL) specializers.
 These match if the argument is `eql' to VAL."
-  (puthash (cadr specializer) specializer cl--generic-eql-used)
+  (let ((form (cadr specializer)))
+    (puthash (if (or (not (symbolp form)) (macroexp-const-p form))
+                 (eval form t)
+               ;; FIXME: Compatibility with Emacs<28.  For now emitting
+               ;; a warning would be annoying for third party packages
+               ;; which can't use the new form without breaking compatibility
+               ;; with older Emacsen, but in the future we should emit
+               ;; a warning.
+               ;; (message "Quoting obsolete `eql' form: %S" specializer)
+               form)
+             specializer cl--generic-eql-used))
   (list cl--generic-eql-generalizer))
 
 (cl--generic-prefill-dispatchers 0 (eql nil))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 638d4b274cc..a04413b6f00 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -3936,7 +3936,9 @@ display a message."
                                (concat "emacs-async-comp-"
                                        (file-name-base source-file) "-")
                                nil ".el"))
-                   (expr-strings (mapcar #'prin1-to-string expr))
+                   (expr-strings (let ((print-length nil)
+                                       (print-level nil))
+                                   (mapcar #'prin1-to-string expr)))
                    (_ (progn
                         (with-temp-file temp-file
                           (mapc #'insert expr-strings))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 3a00fdb454d..8a2b3b4626a 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -497,8 +497,11 @@ on if the hook has explicitly disabled it.
          ,(concat (format "Toggle %s in all buffers.\n" pretty-name)
                   (internal--format-docstring-line
                    "With prefix ARG, enable %s if ARG is positive; otherwise, \
-disable it.  If called from Lisp, enable the mode if ARG is omitted or nil.\n\n"
+disable it.\n\n"
                    pretty-global-name)
+                  "If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.\n\n"
                   (internal--format-docstring-line
                    "%s is enabled in all buffers where `%s' would do it.\n\n"
                    pretty-name turn-on)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 2aec8197dc9..7def9ff96a7 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1731,7 +1731,7 @@ contains a circular object."
 
 (defsubst edebug-match-body (cursor) (edebug-forms cursor))
 
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&optional)) cursor specs)
   ;; Keep matching until one spec fails.
   (edebug-&optional-wrapper cursor specs #'edebug-&optional-wrapper))
 
@@ -1755,7 +1755,7 @@ contains a circular object."
   "Handle &foo spec operators.
 &foo spec operators operate on all the subsequent SPECS.")
 
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&rest)) cursor specs)
   ;; Repeatedly use specs until failure.
   (let (edebug-best-error
 	edebug-error-point)
@@ -1768,7 +1768,7 @@ contains a circular object."
        (edebug-&optional-wrapper c (or s specs) rh)))))
 
 
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&or)) cursor specs)
   ;; Keep matching until one spec succeeds, and return its results.
   ;; If none match, fail.
   ;; This needs to be optimized since most specs spend time here.
@@ -1792,7 +1792,7 @@ contains a circular object."
       (apply #'edebug-no-match cursor "Expected one of" original-specs))
     ))
 
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &interpose)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&interpose)) cursor specs)
   "Compute the specs for `&interpose SPEC FUN ARGS...'.
 Extracts the head of the data by matching it against SPEC,
 and then matches the rest by calling (FUN HEAD PF ARGS...)
@@ -1817,7 +1817,7 @@ a sequence of elements."
                     (append instrumented-head (edebug-match cursor newspecs)))
                  ,@args))))
 
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &not)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&not)) cursor specs)
   ;; If any specs match, then fail
   (if (null (catch 'no-match
 	      (let ((edebug-gate nil))
@@ -1829,7 +1829,7 @@ a sequence of elements."
   ;; This means nothing matched, so it is OK.
   nil) ;; So, return nothing
 
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&key)) cursor specs)
   ;; Following specs must look like (<name> <spec>) ...
   ;; where <name> is the name of a keyword, and spec is its spec.
   ;; This really doesn't save much over the expanded form and takes time.
@@ -1842,7 +1842,7 @@ a sequence of elements."
                            (car (cdr pair))))
 		 specs))))
 
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&error)) cursor specs)
   ;; Signal an error, using the following string in the spec as argument.
   (let ((error-string (car specs))
         (edebug-error-point (edebug-before-offset cursor)))
@@ -1942,7 +1942,7 @@ a sequence of elements."
 (defun edebug-match-function (_cursor)
   (error "Use function-form instead of function in edebug spec"))
 
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&define)) cursor specs)
   ;; Match a defining form.
   ;; Normally, &define is interpreted specially other places.
   ;; This should only be called inside of a spec list to match the remainder
@@ -1958,7 +1958,7 @@ a sequence of elements."
     ;; Stop backtracking here (Bug#41988).
     (setq edebug-gate t)))
 
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&name)) cursor specs)
   "Compute the name for `&name SPEC FUN` spec operator.
 
 The full syntax of that operator is:
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 5c76fb9eb95..c59342875db 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -407,15 +407,15 @@ See `map-into' for all supported values of TYPE."
   "Convert MAP into a map of TYPE.")
 
 ;; FIXME: I wish there was a way to avoid this η-redex!
-(cl-defmethod map-into (map (_type (eql list)))
+(cl-defmethod map-into (map (_type (eql 'list)))
   "Convert MAP into an alist."
   (map-pairs map))
 
-(cl-defmethod map-into (map (_type (eql alist)))
+(cl-defmethod map-into (map (_type (eql 'alist)))
   "Convert MAP into an alist."
   (map-pairs map))
 
-(cl-defmethod map-into (map (_type (eql plist)))
+(cl-defmethod map-into (map (_type (eql 'plist)))
   "Convert MAP into a plist."
   (let (plist)
     (map-do (lambda (k v) (setq plist `(,v ,k ,@plist))) map)
@@ -510,7 +510,7 @@ KEYWORD-ARGS are forwarded to `make-hash-table'."
             map)
     ht))
 
-(cl-defmethod map-into (map (_type (eql hash-table)))
+(cl-defmethod map-into (map (_type (eql 'hash-table)))
   "Convert MAP into a hash-table with keys compared with `equal'."
   (map--into-hash map (list :size (map-length map) :test #'equal)))
 
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index f1daa8d124a..dfd2148aa6b 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1366,11 +1366,9 @@ errors signaled by ERROR-FORM or by BODY).
                 (kill-buffer buffer)
                 (goto-char (point-min))))))
       (package--unless-error body
-        (let ((url (expand-file-name file url)))
-          (unless (file-name-absolute-p url)
-            (error "Location %s is not a url nor an absolute file name"
-                   url))
-          (insert-file-contents-literally url)))))
+        (unless (file-name-absolute-p url)
+          (error "Location %s is not a url nor an absolute file name" url))
+        (insert-file-contents-literally (expand-file-name file url)))))
 
 (define-error 'bad-signature "Failed to verify signature")
 
@@ -4171,7 +4169,9 @@ activations need to be changed, such as when `package-load-list' is modified."
                 ;; Prefer uncompiled files (and don't accept .so files).
                 (let ((load-suffixes '(".el" ".elc")))
                   (locate-library (package--autoloads-file-name pkg))))
-               (pfile (prin1-to-string file)))
+               (pfile (let ((print-length nil)
+                            (print-level nil))
+                        (prin1-to-string file))))
           (insert "(let ((load-true-file-name " pfile ")\
 (load-file-name " pfile "))\n")
           (insert-file-contents file)
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
index fb659753501..a529ed025d6 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -240,7 +240,7 @@ PREFIX is only used internally."
 (declare-function map-apply "map" (function map))
 
 (defun radix-tree-from-map (map)
-  ;; Aka (cl-defmethod map-into (map (type (eql radix-tree)))) ...)
+  ;; Aka (cl-defmethod map-into (map (type (eql 'radix-tree)))) ...)
   (require 'map)
   (let ((rt nil))
     (map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map)