[Emacs-diffs] master 06e452a 1/3: Allow Edebug's instrumentation to be used for other purposes

[Gemini Lasswell]

branch: master
commit 06e452a57287c797cb96a6d4b45220358daab379
Author: Gemini Lasswell <address@hidden>
Commit: Gemini Lasswell <address@hidden>

    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'.
---
 doc/lispref/edebug.texi   |  35 +++++++++++
 etc/NEWS                  |   9 +++
 lisp/emacs-lisp/edebug.el | 154 ++++++++++++++++++++++++++++++----------------
 3 files changed, 146 insertions(+), 52 deletions(-)

diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index cebf0a3..94d6148 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -1690,3 +1690,38 @@ Whether or not to pause for 
@code{edebug-sit-for-seconds} on reaching
 a breakpoint.  Set to @code{nil} to prevent the pause, address@hidden
 to allow it.
 @end defopt
+
address@hidden edebug-behavior-alist
+By default, this alist contains one entry with the key @code{edebug}
+and a list of three functions, which are the default implementations
+of the functions inserted in instrumented code: @code{edebug-enter},
address@hidden and @code{edebug-after}.  To change Edebug's
+behavior globally, modify the default entry.
+
+Edebug's behavior may also be changed on a per-definition basis by
+adding an entry to this alist, with a key of your choice and three
+functions.  Then set the @code{edebug-behavior} symbol property of an
+instrumented definition to the key of the new entry, and Edebug will
+call the new functions in place of its own for that definition.
address@hidden defopt
+
address@hidden edebug-new-definition-functions
+An abnormal hook run by Edebug after it wraps the body of a definition
+or closure.  After Edebug has initialized its own data, each function
+is called with one argument, the symbol associated with the
+definition, which may be the actual symbol defined or one generated by
+Edebug. This hook may be used to set the @code{edebug-behavior}
+symbol property of each definition instrumented by Edebug.
+
+By default @code{edebug-new-definition-functions} contains
address@hidden which prints a message each time a
+definition is instrumented.  If you are instrumenting a lot of code
+and find the messages excessive, remove
address@hidden
address@hidden defopt
+
address@hidden edebug-after-instrumentation-functions
+An abnormal hook run by Edebug after it instruments a form.
+Each function is called with one argument, a form which has
+just been instrumented by Edebug.
address@hidden defopt
diff --git a/etc/NEWS b/etc/NEWS
index 75a98d1..adc1085 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -56,6 +56,15 @@ replaced by a double typographic quote.
 
 * Changes in Specialized Modes and Packages in Emacs 27.1
 
+** Edebug
+
++++
+*** The runtime behavior of Edebug's instrumentation can be changed
+using the new variable 'edebug-behavior-alist' and the new abnormal
+hooks 'edebug-after-instrumentation-functions' and
+'edebug-new-definition-functions'. Edebug's behavior can be changed
+globally or for individual definitions.
+
 ** Enhanced xterm support
 
 *** New variable 'xterm-set-window-title' controls whether Emacs
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index dbc56e2..a070ff2 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)))