mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-17 10:27:41 +00:00
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'.
This commit is contained in:
parent
85b4e88194
commit
06e452a572
3 changed files with 142 additions and 48 deletions
|
|
@ -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, non-@code{nil}
|
||||
to allow it.
|
||||
@end defopt
|
||||
|
||||
@defopt 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},
|
||||
@code{edebug-before} 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.
|
||||
@end defopt
|
||||
|
||||
@defopt 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
|
||||
@code{edebug-announce-definition} which prints a message each time a
|
||||
definition is instrumented. If you are instrumenting a lot of code
|
||||
and find the messages excessive, remove
|
||||
@code{edebug-announce-definition}.
|
||||
@end defopt
|
||||
|
||||
@defopt 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.
|
||||
@end defopt
|
||||
|
|
|
|||
9
etc/NEWS
9
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
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
(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)))
|
||||
;; 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)))
|
||||
))
|
||||
;; 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)))
|
||||
|
|
|
|||
Loading…
Reference in a new issue