* lisp/emacs-lisp/edebug.el: Miscellaneous cleanup.

Remove obsolete byte-compiler hack that tried to silence some warnings.
(edebug-submit-bug-report): Remove.
(edebug-get-buffer-window, edebug-sit-for, edebug-input-pending-p):
Remove aliases, use the un-prefixed name instead.
(edebug-pop-to-buffer): Consider other frames.
(edebug-original-read):: Make it more obvious that it's always defined.
(edebug--make-form-data-entry, edebug--form-data-name)
(edebug--form-data-begin, edebug--form-data-end): Rename from the
single-dashed name, and implement with cl-defstruct.
(edebug-set-form-data-entry): Use the standard accessors.
(edebug-make-top-form-data-entry): Use push.
(edebug-no-match): Drop useless `funcall'.
(mapcar, mapconcat, mapatoms, apply, funcall): Don't add debug specs
to functions.
(defsubst, dont-compile, eval-when-compile, eval-and-compile)
(delay-mode-hooks, with-temp-file, with-temp-message, ad-dolist)
(with-syntax-table, push, pop, 1value, noreturn, defadvice)
(easy-menu-define, with-custom-print): Remove redundant specs.
(edebug-outside-overriding-local-map)
(edebug-outside-overriding-terminal-local-map): Remove, unused.
(edebug--display): Bind unread-command-events directly to nil rather
than binding it to unread-command-events and later setting it to nil.
(edebug--display): Kill edebug-eval-buffer here...
(edebug--recursive-edit): ...rather than here.
Bind standard-output and standard-input.
(edebug-eval): Check cl-macroexpand-all is fboundp.
(edebug-temp-display-freq-count): Fix last change.

* lisp/emacs-lisp/easymenu.el (easy-menu-define): Add `debug' spec.
* lisp/subr.el (noreturn, 1value): Add `debug' spec.
* lisp/emacs-lisp/advice.el: Require cl-lib.
(ad-copy-tree): Remove, use copy-tree instead.
(ad-dolist): Remove use dolist or cl-dolist instead.
(ad-do-return): Remove, use cl-return instead.
(defadvice): Add `debug' spec.

1 files changed, 72 insertions, 111 deletions

diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index cac76d2bce..f0d277a3f6 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1,4 +1,4 @@
-;;; advice.el --- an overloading mechanism for Emacs Lisp functions
+;;; advice.el --- An overloading mechanism for Emacs Lisp functions
 
 ;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc.
 
@@ -1746,7 +1746,7 @@
 (provide 'advice-preload)
 ;; During a normal load this is a noop:
 (require 'advice-preload "advice.el")
-
+(eval-when-compile (require 'cl-lib))
 
 ;; @@ Variable definitions:
 ;; ========================
@@ -1812,54 +1812,6 @@ generates a copy of TREE."
          (funcall fUnCtIoN tReE))
         (t tReE)))
 
-;; this is just faster than `ad-substitute-tree':
-(defun ad-copy-tree (tree)
-  "Return a copy of the list structure of TREE."
-  (cond ((consp tree)
-	 (cons (ad-copy-tree (car tree))
-	       (ad-copy-tree (cdr tree))))
-	(t tree)))
-
-(defmacro ad-dolist (varform &rest body)
-  "A Common-Lisp-style dolist iterator with the following syntax:
-
-    (ad-dolist (VAR INIT-FORM [RESULT-FORM])
-       BODY-FORM...)
-
-which will iterate over the list yielded by INIT-FORM binding VAR to the
-current head at every iteration.  If RESULT-FORM is supplied its value will
-be returned at the end of the iteration, nil otherwise.  The iteration can be
-exited prematurely with `(ad-do-return [VALUE])'."
-  (let ((expansion
-         `(let ((ad-dO-vAr ,(car (cdr varform)))
-                ,(car varform))
-           (while ad-dO-vAr
-             (setq ,(car varform) (car ad-dO-vAr))
-             ,@body
-             ;;work around a backquote bug:
-             ;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong
-             ;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar)))
-             ,'(setq ad-dO-vAr (cdr ad-dO-vAr)))
-           ,(car (cdr (cdr varform))))))
-    ;;ok, this wastes some cons cells but only during compilation:
-    (if (catch 'contains-return
-	  (ad-substitute-tree
-	   (function (lambda (subtree)
-             (cond ((eq (car-safe subtree) 'ad-dolist))
-                   ((eq (car-safe subtree) 'ad-do-return)
-                    (throw 'contains-return t)))))
-	   'identity body)
-	  nil)
-	`(catch 'ad-dO-eXiT ,expansion)
-        expansion)))
-
-(defmacro ad-do-return (value)
-  `(throw 'ad-dO-eXiT ,value))
-
-(if (not (get 'ad-dolist 'lisp-indent-hook))
-    (put 'ad-dolist 'lisp-indent-hook 1))
-
-
 ;; @@ Save real definitions of subrs used by Advice:
 ;; =================================================
 ;; Advice depends on the real, unmodified functionality of various subrs,
@@ -1924,16 +1876,16 @@ exited prematurely with `(ad-do-return [VALUE])'."
      ad-advised-functions)))
 
 (defmacro ad-do-advised-functions (varform &rest body)
-  "`ad-dolist'-style iterator that maps over `ad-advised-functions'.
+  "`dolist'-style iterator that maps over `ad-advised-functions'.
 \(ad-do-advised-functions (VAR [RESULT-FORM])
    BODY-FORM...)
 On each iteration VAR will be bound to the name of an advised function
 \(a symbol)."
-  `(ad-dolist (,(car varform)
+  `(cl-dolist (,(car varform)
                ad-advised-functions
                ,(car (cdr varform)))
-    (setq ,(car varform) (intern (car ,(car varform))))
-    ,@body))
+     (setq ,(car varform) (intern (car ,(car varform))))
+     ,@body))
 
 (if (not (get 'ad-do-advised-functions 'lisp-indent-hook))
     (put 'ad-do-advised-functions 'lisp-indent-hook 1))
@@ -1948,7 +1900,7 @@ On each iteration VAR will be bound to the name of an advised function
   `(put ,function 'ad-advice-info ,advice-info))
 
 (defmacro ad-copy-advice-info (function)
-  `(ad-copy-tree (get ,function 'ad-advice-info)))
+  `(copy-tree (get ,function 'ad-advice-info)))
 
 (defmacro ad-is-advised (function)
   "Return non-nil if FUNCTION has any advice info associated with it.
@@ -2022,8 +1974,8 @@ either t or nil, and DEFINITION should be a list of the form
 
 (defun ad-has-enabled-advice (function class)
   "True if at least one of FUNCTION's advices in CLASS is enabled."
-  (ad-dolist (advice (ad-get-advice-info-field function class))
-    (if (ad-advice-enabled advice) (ad-do-return t))))
+  (cl-dolist (advice (ad-get-advice-info-field function class))
+    (if (ad-advice-enabled advice) (cl-return t))))
 
 (defun ad-has-redefining-advice (function)
   "True if FUNCTION's advice info defines at least 1 redefining advice.
@@ -2036,14 +1988,14 @@ Redefining advices affect the construction of an advised definition."
 (defun ad-has-any-advice (function)
   "True if the advice info of FUNCTION defines at least one advice."
   (and (ad-is-advised function)
-       (ad-dolist (class ad-advice-classes nil)
+       (cl-dolist (class ad-advice-classes nil)
 	 (if (ad-get-advice-info-field function class)
-	     (ad-do-return t)))))
+	     (cl-return t)))))
 
 (defun ad-get-enabled-advices (function class)
   "Return the list of enabled advices of FUNCTION in CLASS."
   (let (enabled-advices)
-    (ad-dolist (advice (ad-get-advice-info-field function class))
+    (dolist (advice (ad-get-advice-info-field function class))
       (if (ad-advice-enabled advice)
 	  (push advice enabled-advices)))
     (reverse enabled-advices)))
@@ -2151,7 +2103,7 @@ function at point for which PREDICATE returns non-nil)."
 	    (ad-do-advised-functions (function)
 	      (if (or (null predicate)
 		      (funcall predicate function))
-		  (ad-do-return function)))
+		  (cl-return function)))
 	    (error "ad-read-advised-function: %s"
 		   "There are no qualifying advised functions")))
   (let* ((ad-pReDiCaTe predicate)
@@ -2184,9 +2136,9 @@ be returned on empty input (defaults to the first non-empty advice
 class of FUNCTION)."
   (setq default
 	(or default
-	    (ad-dolist (class ad-advice-classes)
+	    (cl-dolist (class ad-advice-classes)
 	      (if (ad-get-advice-info-field function class)
-		  (ad-do-return class)))
+		  (cl-return class)))
 	    (error "ad-read-advice-class: `%s' has no advices" function)))
   (let ((class (completing-read
 		(format "%s (default %s): " (or prompt "Class") default)
@@ -2255,18 +2207,18 @@ NAME can be a symbol or a regular expression matching part of an advice name.
 If CLASS is `any' all valid advice classes will be checked."
   (if (ad-is-advised function)
       (let (found-advice)
-	(ad-dolist (advice-class ad-advice-classes)
+	(cl-dolist (advice-class ad-advice-classes)
 	  (if (or (eq class 'any) (eq advice-class class))
 	      (setq found-advice
-		    (ad-dolist (advice (ad-get-advice-info-field
+		    (cl-dolist (advice (ad-get-advice-info-field
 					function advice-class))
 		      (if (or (and (stringp name)
 				   (string-match
 				    name (symbol-name
 					  (ad-advice-name advice))))
 			      (eq name (ad-advice-name advice)))
-			  (ad-do-return advice)))))
-	  (if found-advice (ad-do-return found-advice))))))
+			  (cl-return advice)))))
+	  (if found-advice (cl-return found-advice))))))
 
 (defun ad-enable-advice-internal (function class name flag)
   "Set enable FLAG of FUNCTION's advices in CLASS matching NAME.
@@ -2277,10 +2229,10 @@ considered.  The number of changed advices will be returned (or nil if
 FUNCTION was not advised)."
   (if (ad-is-advised function)
       (let ((matched-advices 0))
-	(ad-dolist (advice-class ad-advice-classes)
+	(dolist (advice-class ad-advice-classes)
 	  (if (or (eq class 'any) (eq advice-class class))
-	      (ad-dolist (advice (ad-get-advice-info-field
-				  function advice-class))
+	      (dolist (advice (ad-get-advice-info-field
+                               function advice-class))
 		(cond ((or (and (stringp name)
 				(string-match
 				 name (symbol-name (ad-advice-name advice))))
@@ -2868,8 +2820,8 @@ in any of these classes."
     (if origdoc (setq paragraphs (list origdoc)))
     (unless (eq style 'plain)
       (push (concat "This " origtype " is advised.") paragraphs))
-    (ad-dolist (class ad-advice-classes)
-      (ad-dolist (advice (ad-get-enabled-advices function class))
+    (dolist (class ad-advice-classes)
+      (dolist (advice (ad-get-enabled-advices function class))
 	(setq advice-docstring
 	      (ad-make-single-advice-docstring advice class style))
 	(if advice-docstring
@@ -2891,24 +2843,24 @@ in any of these classes."
 
 (defun ad-advised-arglist (function)
   "Find first defined arglist in FUNCTION's redefining advices."
-  (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
+  (cl-dolist (advice (append (ad-get-enabled-advices function 'before)
 			     (ad-get-enabled-advices function 'around)
 			     (ad-get-enabled-advices function 'after)))
     (let ((arglist (ad-arglist (ad-advice-definition advice))))
       (if arglist
 	  ;; We found the first one, use it:
-	  (ad-do-return arglist)))))
+	  (cl-return arglist)))))
 
 (defun ad-advised-interactive-form (function)
   "Find first interactive form in FUNCTION's redefining advices."
-  (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
+  (cl-dolist (advice (append (ad-get-enabled-advices function 'before)
 			     (ad-get-enabled-advices function 'around)
 			     (ad-get-enabled-advices function 'after)))
     (let ((interactive-form
 	   (ad-interactive-form (ad-advice-definition advice))))
       (if interactive-form
 	  ;; We found the first one, use it:
-	  (ad-do-return interactive-form)))))
+	  (cl-return interactive-form)))))
 
 ;; @@@ Putting it all together:
 ;; ============================
@@ -2997,29 +2949,29 @@ and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
 should be modified.  The assembled function will be returned."
 
   (let (before-forms around-form around-form-protected after-forms definition)
-    (ad-dolist (advice befores)
-               (cond ((and (ad-advice-protected advice)
-                           before-forms)
-                      (setq before-forms
-                            `((unwind-protect
-                                   ,(ad-prognify before-forms)
-                                ,@(ad-body-forms
-                                   (ad-advice-definition advice))))))
-                     (t (setq before-forms
-                              (append before-forms
-                                      (ad-body-forms (ad-advice-definition advice)))))))
+    (dolist (advice befores)
+      (cond ((and (ad-advice-protected advice)
+                  before-forms)
+             (setq before-forms
+                   `((unwind-protect
+                         ,(ad-prognify before-forms)
+                       ,@(ad-body-forms
+                          (ad-advice-definition advice))))))
+            (t (setq before-forms
+                     (append before-forms
+                             (ad-body-forms (ad-advice-definition advice)))))))
 
     (setq around-form `(setq ad-return-value ,orig))
-    (ad-dolist (advice (reverse arounds))
-               ;; If any of the around advices is protected then we
-               ;; protect the complete around advice onion:
-               (if (ad-advice-protected advice)
-                   (setq around-form-protected t))
-               (setq around-form
-                     (ad-substitute-tree
-                      (function (lambda (form) (eq form 'ad-do-it)))
-                      (function (lambda (form) around-form))
-                      (ad-prognify (ad-body-forms (ad-advice-definition advice))))))
+    (dolist (advice (reverse arounds))
+      ;; If any of the around advices is protected then we
+      ;; protect the complete around advice onion:
+      (if (ad-advice-protected advice)
+          (setq around-form-protected t))
+      (setq around-form
+            (ad-substitute-tree
+             (function (lambda (form) (eq form 'ad-do-it)))
+             (function (lambda (form) around-form))
+             (ad-prognify (ad-body-forms (ad-advice-definition advice))))))
 
     (setq after-forms
 	  (if (and around-form-protected before-forms)
@@ -3027,17 +2979,17 @@ should be modified.  The assembled function will be returned."
                      ,(ad-prognify before-forms)
                   ,around-form))
               (append before-forms (list around-form))))
-    (ad-dolist (advice afters)
-               (cond ((and (ad-advice-protected advice)
-                           after-forms)
-                      (setq after-forms
-                            `((unwind-protect
-                                   ,(ad-prognify after-forms)
-                                ,@(ad-body-forms
-                                   (ad-advice-definition advice))))))
-                     (t (setq after-forms
-                              (append after-forms
-                                      (ad-body-forms (ad-advice-definition advice)))))))
+    (dolist (advice afters)
+      (cond ((and (ad-advice-protected advice)
+                  after-forms)
+             (setq after-forms
+                   `((unwind-protect
+                         ,(ad-prognify after-forms)
+                       ,@(ad-body-forms
+                          (ad-advice-definition advice))))))
+            (t (setq after-forms
+                     (append after-forms
+                             (ad-body-forms (ad-advice-definition advice)))))))
 
     (setq definition
 	  `(,@(if (memq type '(macro special-form)) '(macro))
@@ -3171,11 +3123,11 @@ advised definition from scratch."
 	(nth 2 cache-id)))))
 
 (defun ad-verify-cache-class-id (cache-class-id advices)
-  (ad-dolist (advice advices (null cache-class-id))
+  (cl-dolist (advice advices (null cache-class-id))
     (if (ad-advice-enabled advice)
 	(if (eq (car cache-class-id) (ad-advice-name advice))
 	    (setq cache-class-id (cdr cache-class-id))
-	  (ad-do-return nil)))))
+	  (cl-return nil)))))
 
 ;; There should be a way to monitor if and why a cache verification failed
 ;; in order to determine whether a certain preactivation could be used or
@@ -3670,7 +3622,16 @@ See Info node `(elisp)Advising Functions' for comprehensive documentation.
 usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
           [DOCSTRING] [INTERACTIVE-FORM]
           BODY...)"
-  (declare (doc-string 3))
+  (declare (doc-string 3)
+           (debug (&define name  ;; thing being advised.
+                           (name ;; class is [&or "before" "around" "after"
+                                 ;;               "activation" "deactivation"]
+                            name ;; name of advice
+                            &rest sexp ;; optional position and flags
+                            )
+                           [&optional stringp]
+                           [&optional ("interactive" interactive)]
+                           def-body)))
   (if (not (ad-name-p function))
       (error "defadvice: Invalid function name: %s" function))
   (let* ((class (car args))