* lisp/emacs-lisp/edebug.el (edebug--handle-&-spec-op <&name>): New method

(edebug--concat-name): New function.
(edebug-match-name, edebug-match-cl-generic-method-qualifier)
(edebug-match-cl-generic-method-args): Delete functions.

* doc/lispref/edebug.texi (Specification List): Document it.

* lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Use `&name`.
(cl-generic--method-qualifier-p): New predicate.
(cl-defmethod): Use it and `&name`.
* lisp/emacs-lisp/cl-macs.el (cl-defun, cl-iter-defun, cl-flet):
* lisp/emacs-lisp/eieio-compat.el (defmethod):
* lisp/emacs-lisp/gv.el (gv-define-setter):
* lisp/emacs-lisp/ert.el (ert-deftest): Use `&name`.
* lisp/erc/erc-backend.el (define-erc-response-handler): Use `declare`
and `&name`.

1 files changed, 55 insertions, 37 deletions

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index cbf2d171a96..867161e0280 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1748,16 +1748,12 @@ contains a circular object."
 (dolist (pair '((form . edebug-match-form)
 		(sexp . edebug-match-sexp)
 		(body . edebug-match-body)
-		(name . edebug-match-name)
 		(arg . edebug-match-arg)
 		(def-body . edebug-match-def-body)
 		(def-form . edebug-match-def-form)
 		;; Less frequently used:
 		;; (function . edebug-match-function)
 		(lambda-expr . edebug-match-lambda-expr)
-                (cl-generic-method-qualifier
-                 . edebug-match-cl-generic-method-qualifier)
-                (cl-generic-method-args . edebug-match-cl-generic-method-args)
                 (cl-macrolet-expr . edebug-match-cl-macrolet-expr)
                 (cl-macrolet-name . edebug-match-cl-macrolet-name)
                 (cl-macrolet-body . edebug-match-cl-macrolet-body)
@@ -2056,19 +2052,61 @@ and then matches the rest against the output of (FUN ARGS... HEAD)."
       )))
 
 
-(defun edebug-match-name (cursor)
-  ;; Set the edebug-def-name bound in edebug-defining-form.
-  (let ((name (edebug-top-element-required cursor "Expected name")))
-    ;; Maybe strings and numbers could be used.
-    (if (not (symbolp name))
-	(edebug-no-match cursor "Symbol expected for name of definition"))
-    (setq edebug-def-name
-	  (if edebug-def-name
-	      ;; Construct a new name by appending to previous name.
-	      (intern (format "%s@%s" edebug-def-name name))
-	    name))
-    (edebug-move-cursor cursor)
-    (list name)))
+(cl-defmethod edebug--handle-&-spec-op ((_ (eql &name)) cursor specs)
+  "Compute the name for `&name SPEC FUN` spec operator.
+
+The full syntax of that operator is:
+    &name [PRESTRING] SPEC [POSTSTRING] FUN ARGS...
+
+Extracts the head of the data by matching it against SPEC,
+and then get the new name to use by calling
+  (FUN ARGS... OLDNAME [PRESTRING] HEAD [POSTSTRING])
+FUN should return either a string or a symbol.
+FUN can be missing in which case it defaults to concatenating
+the new name to the end of the old with an \"@\" char between the two.
+PRESTRING and POSTSTRING are optional strings that get prepended
+or appended to the actual name."
+  (pcase-let*
+      ((`(,spec ,fun . ,args) specs)
+       (prestrings (when (stringp spec)
+                     (prog1 (list spec) (setq spec fun fun (pop args)))))
+       (poststrings (when (stringp fun)
+                      (prog1 (list fun) (setq fun (pop args)))))
+       (exps (edebug-cursor-expressions cursor))
+       (instrumented (edebug-match-one-spec cursor spec))
+       (consumed (- (length exps)
+                    (length (edebug-cursor-expressions cursor))))
+       (newname (apply (or fun #'edebug--concat-name)
+                       `(,@args ,edebug-def-name
+                                ,@prestrings
+                                ,@(seq-subseq exps 0 consumed)
+                                ,@poststrings))))
+    (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps)))
+    (setq edebug-def-name (if (stringp newname) (intern newname) newname))
+    instrumented))
+
+(defun edebug--concat-name (oldname &rest newnames)
+  (let ((newname (if (null (cdr newnames))
+                     (car newnames)
+                   ;; Put spaces between each name, but not for the
+                   ;; leading and trailing strings, if any.
+                   (let (beg mid end)
+                     (dolist (name newnames)
+                       (if (stringp name)
+                           (push name (if mid end beg))
+                         (when end (setq mid (nconc end mid) end nil))
+                         (push name mid)))
+                     (apply #'concat `(,@(nreverse beg)
+                                       ,(mapconcat (lambda (x) (format "%s" x))
+                                                   (nreverse mid) " ")
+                                       ,@(nreverse end)))))))
+    (if (null oldname)
+        (if (or (stringp newname) (symbolp newname))
+            newname
+          (format "%s" newname))
+      (format "%s@%s" edebug-def-name newname))))
+
+(def-edebug-elem-spec 'name '(&name symbolp))
 
 (cl-defgeneric edebug--handle-:-spec-op (op cursor spec)
   "Handle :foo spec operators.
@@ -2094,26 +2132,6 @@ SPEC is the symbol name prefix for `gensym'."
 	    suffix)))
   nil)
 
-(defun edebug-match-cl-generic-method-qualifier (cursor)
-  "Match a QUALIFIER for `cl-defmethod' at CURSOR."
-  (let ((args (edebug-top-element-required cursor "Expected qualifier")))
-    ;; Like in CLOS spec, we support any non-list values.
-    (unless (atom args) (edebug-no-match cursor "Atom expected"))
-    ;; Append the arguments to `edebug-def-name' (Bug#42671).
-    (setq edebug-def-name (intern (format "%s %s" edebug-def-name args)))
-    (edebug-move-cursor cursor)
-    (list args)))
-
-(defun edebug-match-cl-generic-method-args (cursor)
-  (let ((args (edebug-top-element-required cursor "Expected arguments")))
-    (if (not (consp args))
-        (edebug-no-match cursor "List expected"))
-    ;; Append the arguments to edebug-def-name.
-    (setq edebug-def-name
-          (intern (format "%s %s" edebug-def-name args)))
-    (edebug-move-cursor cursor)
-    (list args)))
-
 (defvar edebug--cl-macrolet-defs nil
   "List of symbols found within the bindings of enclosing `cl-macrolet' forms.")
 (defvar edebug--current-cl-macrolet-defs nil