Allow Edebug's instrumentation to be used for other purposes

* lisp/emacs-lisp/edebug.el:
(edebug-after-instrumentation-functions)
(edebug-new-definition-functions): New hook variables.
(edebug-behavior-alist): New variable.
(edebug-read-and-maybe-wrap-form): Run a hook after a form is
wrapped.
(edebug-make-form-wrapper): Run a hook after a definition is
wrapped. Remove message for each definition.
(edebug-announce-definition): New function.
(edebug-enter): Rewritten to change behavior of Edebug based
on symbol property `edebug-behavior' and `edebug-behavior-alist'.
(edebug-default-enter): New function which does what `edebug-enter'
used to do.
(edebug-run-slow, edebug-run-fast): Modify edebug-behavior-alist.
(edebug-before, edebug-after): Function definitions are now set by
`edebug-enter'.

1 files changed, 102 insertions, 52 deletions

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index dbc56e272fd..a070ff25d17 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1065,6 +1065,31 @@ circular objects.  Let `read' read everything else."
 (defvar edebug-error-point nil)
 (defvar edebug-best-error nil)
 
+;; Hooks which may be used to extend Edebug's functionality.  See
+;; Testcover for an example.
+(defvar edebug-after-instrumentation-functions nil
+  "Abnormal hook run on code after instrumentation for debugging.
+Each function is called with one argument, a form which has just
+been instrumented for Edebugging.")
+
+(defvar edebug-new-definition-functions '(edebug-announce-definition)
+  "Abnormal hook run after Edebug wraps a new definition.
+After Edebug has initialized its own data, each hook function is
+called with one argument, the symbol associated with the
+definition, which may be the actual symbol defined or one
+generated by Edebug.")
+
+(defvar edebug-behavior-alist
+  '((edebug edebug-default-enter edebug-slow-before edebug-slow-after))
+  "Alist describing the runtime behavior of Edebug's instrumented code.
+Each definition instrumented by Edebug will have a
+`edebug-behavior' property which is a key to this alist.  When
+the instrumented code is running, Edebug will look here for the
+implementations of `edebug-enter', `edebug-before', and
+`edebug-after'.  Edebug's instrumentation may be used for a new
+purpose by adding an entry to this alist and a hook to
+`edebug-new-definition-functions' which sets `edebug-behavior'
+for the definition.")
 
 (defun edebug-read-and-maybe-wrap-form ()
   ;; Read a form and wrap it with edebug calls, if the conditions are right.
@@ -1124,47 +1149,48 @@ circular objects.  Let `read' read everything else."
                                   (eq 'symbol (edebug-next-token-class)))
                              (read (current-buffer))))))
 ;;;(message "all defs: %s   all forms: %s"  edebug-all-defs edebug-all-forms)
-    (cond
-     (defining-form-p
-       (if (or edebug-all-defs edebug-all-forms)
-           ;; If it is a defining form and we are edebugging defs,
-           ;; then let edebug-list-form start it.
-           (let ((cursor (edebug-new-cursor
-                          (list (edebug-read-storing-offsets (current-buffer)))
-                          (list edebug-offsets))))
-             (car
-              (edebug-make-form-wrapper
-               cursor
-               (edebug-before-offset cursor)
-               (1- (edebug-after-offset cursor))
-               (list (cons (symbol-name def-kind) (cdr spec))))))
-
-         ;; Not edebugging this form, so reset the symbol's edebug
-         ;; property to be just a marker at the definition's source code.
-         ;; This only works for defs with simple names.
-         (put def-name 'edebug (point-marker))
-         ;; Also nil out dependent defs.
-         '(mapcar (function
-                   (lambda (def)
-                     (put def-name 'edebug nil)))
-                  (get def-name 'edebug-dependents))
-         (edebug-read-sexp)))
-
-     ;; If all forms are being edebugged, explicitly wrap it.
-     (edebug-all-forms
-      (let ((cursor (edebug-new-cursor
-                     (list (edebug-read-storing-offsets (current-buffer)))
-                     (list edebug-offsets))))
-        (edebug-make-form-wrapper
-         cursor
-         (edebug-before-offset cursor)
-         (edebug-after-offset cursor)
-         nil)))
-
-     ;; Not a defining form, and not edebugging.
-     (t (edebug-read-sexp)))
-    ))
-
+    (let ((result
+           (cond
+            (defining-form-p
+              (if (or edebug-all-defs edebug-all-forms)
+                  ;; If it is a defining form and we are edebugging defs,
+                  ;; then let edebug-list-form start it.
+                  (let ((cursor (edebug-new-cursor
+                                 (list (edebug-read-storing-offsets (current-buffer)))
+                                 (list edebug-offsets))))
+                    (car
+                     (edebug-make-form-wrapper
+                      cursor
+                      (edebug-before-offset cursor)
+                      (1- (edebug-after-offset cursor))
+                      (list (cons (symbol-name def-kind) (cdr spec))))))
+
+                ;; Not edebugging this form, so reset the symbol's edebug
+                ;; property to be just a marker at the definition's source code.
+                ;; This only works for defs with simple names.
+                (put def-name 'edebug (point-marker))
+                ;; Also nil out dependent defs.
+                '(mapcar (function
+                          (lambda (def)
+                            (put def-name 'edebug nil)))
+                         (get def-name 'edebug-dependents))
+                (edebug-read-sexp)))
+
+            ;; If all forms are being edebugged, explicitly wrap it.
+            (edebug-all-forms
+             (let ((cursor (edebug-new-cursor
+                            (list (edebug-read-storing-offsets (current-buffer)))
+                            (list edebug-offsets))))
+               (edebug-make-form-wrapper
+                cursor
+                (edebug-before-offset cursor)
+                (edebug-after-offset cursor)
+                nil)))
+
+            ;; Not a defining form, and not edebugging.
+            (t (edebug-read-sexp)))))
+      (run-hook-with-args 'edebug-after-instrumentation-functions result)
+      result)))
 
 (defvar edebug-def-args) ; args of defining form.
 (defvar edebug-def-interactive) ; is it an emacs interactive function?
@@ -1332,7 +1358,6 @@ expressions; a `progn' form will be returned enclosing these forms."
 
       ;;    (message "defining: %s" edebug-def-name) (sit-for 2)
       (edebug-make-top-form-data-entry form-data-entry)
-      (message "Edebug: %s" edebug-def-name)
       ;;(debug edebug-def-name)
 
       ;; Destructively reverse edebug-offset-list and make vector from it.
@@ -1358,9 +1383,15 @@ expressions; a `progn' form will be returned enclosing these forms."
                  edebug-offset-list
                  edebug-top-window-data
                  ))
+      (put edebug-def-name 'edebug-behavior 'edebug)
+      (run-hook-with-args 'edebug-new-definition-functions edebug-def-name)
       result
       )))
 
+(defun edebug-announce-definition (def-name)
+  "Announce Edebug's processing of DEF-NAME."
+  (message "Edebug: %s" def-name))
+
 
 (defun edebug-clear-frequency-count (name)
   ;; Create initial frequency count vector.
@@ -2167,7 +2198,21 @@ error is signaled again."
 
 ;;; Entering Edebug
 
-(defun edebug-enter (function args body)
+(defun edebug-enter (func args body)
+  "Enter Edebug for a function.
+FUNC should be the symbol with the Edebug information, ARGS is
+the list of arguments and BODY is the code.
+
+Look up the `edebug-behavior' for FUNC in `edebug-behavior-alist'
+and run its entry function, and set up `edebug-before' and
+`edebug-after'."
+  (cl-letf* ((behavior (get func 'edebug-behavior))
+             (functions (cdr (assoc behavior edebug-behavior-alist)))
+             ((symbol-function #'edebug-before) (nth 1 functions))
+             ((symbol-function #'edebug-after) (nth 2 functions)))
+    (funcall (nth 0 functions) func args body)))
+
+(defun edebug-default-enter (function args body)
   ;; Entering FUNC.  The arguments are ARGS, and the body is BODY.
   ;; Setup edebug variables and evaluate BODY.  This function is called
   ;; when a function evaluated with edebug-eval-top-level-form is entered.
@@ -2198,7 +2243,7 @@ error is signaled again."
                                                 edebug-initial-mode
                                                 edebug-execution-mode)
                       edebug-next-execution-mode nil)
-                (edebug-enter function args body))))
+                (edebug-default-enter function args body))))
 
       (let* ((edebug-data (get function 'edebug))
              (edebug-def-mark (car edebug-data)) ; mark at def start
@@ -2317,22 +2362,27 @@ MSG is printed after `::::} '."
         value
       (edebug-debugger after-index 'after value)
       )))
-
 (defun edebug-fast-after (_before-index _after-index value)
   ;; Do nothing but return the value.
   value)
 
 (defun edebug-run-slow ()
-  (defalias 'edebug-before 'edebug-slow-before)
-  (defalias 'edebug-after 'edebug-slow-after))
+  "Set up Edebug's normal behavior."
+  (setf (cdr (assq 'edebug edebug-behavior-alist))
+        '(edebug-default-enter edebug-slow-before edebug-slow-after)))
 
 ;; This is not used, yet.
 (defun edebug-run-fast ()
-  (defalias 'edebug-before 'edebug-fast-before)
-  (defalias 'edebug-after 'edebug-fast-after))
-
-(edebug-run-slow)
-
+  "Disable Edebug without de-instrumenting code."
+  (setf (cdr (assq 'edebug edebug-behavior-alist))
+        '(edebug-default-enter edebug-fast-before edebug-fast-after)))
+
+(defalias 'edebug-before nil
+  "Function called by Edebug before a form is evaluated.
+See `edebug-behavior-alist' for implementations.")
+(defalias 'edebug-after nil
+  "Function called by Edebug after a form is evaluated.
+See `edebug-behavior-alist' for implementations.")
 
 (defun edebug--update-coverage (after-index value)
   (let ((old-result (aref edebug-coverage after-index)))