diff options
Diffstat (limited to 'lisp/emacs-lisp/edebug.el')
| -rw-r--r-- | lisp/emacs-lisp/edebug.el | 177 |
1 files changed, 114 insertions, 63 deletions
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index df1f893288c..60133055623 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -112,6 +112,18 @@ and some not, use `def-edebug-spec' to specify an `edebug-form-spec'." :type 'boolean :group 'edebug) +(defcustom edebug-max-depth 150 + "Maximum recursion depth when instrumenting code. +This limit is intended to stop recursion if an Edebug specification +contains an infinite loop. When Edebug is instrumenting code +containing very large quoted lists, it may reach this limit and give +the error message \"Too deep - perhaps infinite loop in spec?\". +Make this limit larger to countermand that, but you may also need to +increase `max-lisp-eval-depth' and `max-specpdl-size'." + :type 'integer + :group 'edebug + :version "26.1") + (defcustom edebug-save-windows t "If non-nil, Edebug saves and restores the window configuration. That takes some time, so if your program does not care what happens to @@ -233,6 +245,12 @@ If the result is non-nil, then break. Errors are ignored." :type 'number :group 'edebug) +(defcustom edebug-sit-on-break t + "Whether or not to pause for `edebug-sit-for-seconds' on reaching a break." + :type 'boolean + :group 'edebug + :version "26.1") + ;;; Form spec utilities. (defun get-edebug-spec (symbol) @@ -380,31 +398,30 @@ Return the result of the last expression in BODY." (defun edebug-current-windows (which-windows) ;; Get either a full window configuration or some window information. (if (listp which-windows) - (mapcar (function (lambda (window) - (if (edebug-window-live-p window) - (list window - (window-buffer window) - (window-point window) - (window-start window) - (window-hscroll window))))) + (mapcar (lambda (window) + (if (edebug-window-live-p window) + (list window + (window-buffer window) + (window-point window) + (window-start window) + (window-hscroll window)))) which-windows) (current-window-configuration))) (defun edebug-set-windows (window-info) ;; Set either a full window configuration or some window information. (if (listp window-info) - (mapcar (function - (lambda (one-window-info) - (if one-window-info - (apply (function - (lambda (window buffer point start hscroll) - (if (edebug-window-live-p window) - (progn - (set-window-buffer window buffer) - (set-window-point window point) - (set-window-start window start) - (set-window-hscroll window hscroll))))) - one-window-info)))) + (mapcar (lambda (one-window-info) + (if one-window-info + (apply (function + (lambda (window buffer point start hscroll) + (if (edebug-window-live-p window) + (progn + (set-window-buffer window buffer) + (set-window-point window point) + (set-window-start window start) + (set-window-hscroll window hscroll))))) + one-window-info))) window-info) (set-window-configuration window-info))) @@ -640,7 +657,7 @@ Maybe clear the markers and delete the symbol's edebug property?" (progn ;; Instead of this, we could just find all contained forms. ;; (put (car entry) 'edebug nil) ; - ;; (mapcar 'edebug-clear-form-data-entry ; dangerous + ;; (mapcar #'edebug-clear-form-data-entry ; dangerous ;; (get (car entry) 'edebug-dependents)) ;; (set-marker (nth 1 entry) nil) ;; (set-marker (nth 2 entry) nil) @@ -737,6 +754,11 @@ Maybe clear the markers and delete the symbol's edebug property?" (defvar edebug-offsets-stack nil) (defvar edebug-current-offset nil) ; Top of the stack, for convenience. +;; The association list of objects read with the #n=object form. +;; Each member of the list has the form (n . object), and is used to +;; look up the object for the corresponding #n# construct. +(defvar edebug-read-objects nil) + ;; We must store whether we just read a list with a dotted form that ;; is itself a list. This structure will be condensed, so the offsets ;; must also be condensed. @@ -808,7 +830,7 @@ Maybe clear the markers and delete the symbol's edebug property?" (backquote . edebug-read-backquote) (comma . edebug-read-comma) (lbracket . edebug-read-vector) - (hash . edebug-read-function) + (hash . edebug-read-special) )) (defun edebug-read-storing-offsets (stream) @@ -854,19 +876,47 @@ Maybe clear the markers and delete the symbol's edebug property?" (edebug-storing-offsets opoint symbol) (edebug-read-storing-offsets stream))))) -(defun edebug-read-function (stream) - ;; Turn #'thing into (function thing) - (forward-char 1) - (cond ((eq ?\' (following-char)) - (forward-char 1) - (list - (edebug-storing-offsets (- (point) 2) 'function) - (edebug-read-storing-offsets stream))) - ((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6 - ?7 ?8 ?9 ?0)) - (backward-char 1) - (read stream)) - (t (edebug-syntax-error "Bad char after #")))) +(defun edebug-read-special (stream) + "Read from STREAM a Lisp object beginning with #. +Turn #'thing into (function thing) and handle the read syntax for +circular objects. Let `read' read everything else." + (catch 'return + (forward-char 1) + (let ((start (point))) + (cond + ((eq ?\' (following-char)) + (forward-char 1) + (throw 'return + (list + (edebug-storing-offsets (- (point) 2) 'function) + (edebug-read-storing-offsets stream)))) + ((and (>= (following-char) ?0) (<= (following-char) ?9)) + (while (and (>= (following-char) ?0) (<= (following-char) ?9)) + (forward-char 1)) + (let ((n (string-to-number (buffer-substring start (point))))) + (when (and read-circle + (<= n most-positive-fixnum)) + (cond + ((eq ?= (following-char)) + ;; Make a placeholder for #n# to use temporarily. + (let* ((placeholder (cons nil nil)) + (elem (cons n placeholder))) + (push elem edebug-read-objects) + ;; Read the object and then replace the placeholder + ;; with the object itself, wherever it occurs. + (forward-char 1) + (let ((obj (edebug-read-storing-offsets stream))) + (substitute-object-in-subtree obj placeholder) + (throw 'return (setf (cdr elem) obj))))) + ((eq ?# (following-char)) + ;; #n# returns a previously read object. + (let ((elem (assq n edebug-read-objects))) + (when (consp elem) + (forward-char 1) + (throw 'return (cdr elem)))))))))) + ;; Let read handle errors, radix notation, and anything else. + (goto-char (1- start)) + (read stream)))) (defun edebug-read-list (stream) (forward-char 1) ; skip \( @@ -894,7 +944,7 @@ Maybe clear the markers and delete the symbol's edebug property?" (let ((elements)) (while (not (eq 'rbracket (edebug-next-token-class))) (push (edebug-read-storing-offsets stream) elements)) - (apply 'vector (nreverse elements))) + (apply #'vector (nreverse elements))) (forward-char 1) ; skip \] )) @@ -937,7 +987,7 @@ Maybe clear the markers and delete the symbol's edebug property?" ;; Check if a dotted form is required. (if edebug-dotted-spec (edebug-no-match cursor "Dot expected.")) ;; Check if there is at least one more argument. - (if (edebug-empty-cursor cursor) (apply 'edebug-no-match cursor error)) + (if (edebug-empty-cursor cursor) (apply #'edebug-no-match cursor error)) ;; Return that top element. (edebug-top-element cursor)) @@ -1044,7 +1094,7 @@ Maybe clear the markers and delete the symbol's edebug property?" (setq result (edebug-read-and-maybe-wrap-form1)) nil))) (if no-match - (apply 'edebug-syntax-error no-match))) + (apply #'edebug-syntax-error no-match))) result)) @@ -1058,6 +1108,7 @@ Maybe clear the markers and delete the symbol's edebug property?" edebug-offsets edebug-offsets-stack edebug-current-offset ; reset to nil + edebug-read-objects ) (save-excursion (if (and (eq 'lparen (edebug-next-token-class)) @@ -1203,7 +1254,7 @@ expressions; a `progn' form will be returned enclosing these forms." (setq sexp new-sexp new-sexp (edebug-unwrap sexp))) (if (consp new-sexp) - (mapcar 'edebug-unwrap* new-sexp) + (mapcar #'edebug-unwrap* new-sexp) new-sexp))) @@ -1446,7 +1497,6 @@ expressions; a `progn' form will be returned enclosing these forms." (defvar edebug-after-dotted-spec nil) (defvar edebug-matching-depth 0) ;; initial value -(defconst edebug-max-depth 150) ;; maximum number of matching recursions. ;;; Failure to match @@ -1465,7 +1515,7 @@ expressions; a `progn' form will be returned enclosing these forms." (progn (if edebug-error-point (goto-char edebug-error-point)) - (apply 'edebug-syntax-error args)) + (apply #'edebug-syntax-error args)) (throw 'no-match args))) @@ -1661,7 +1711,7 @@ expressions; a `progn' form will be returned enclosing these forms." ;; Reset the cursor for the next match. (edebug-set-cursor cursor this-form this-offset)) ;; All failed. - (apply 'edebug-no-match cursor "Expected one of" original-specs)) + (apply #'edebug-no-match cursor "Expected one of" original-specs)) )) @@ -1687,9 +1737,9 @@ expressions; a `progn' form will be returned enclosing these forms." (edebug-match-&rest cursor (cons '&or - (mapcar (function (lambda (pair) - (vector (format ":%s" (car pair)) - (car (cdr pair))))) + (mapcar (lambda (pair) + (vector (format ":%s" (car pair)) + (car (cdr pair)))) specs)))) @@ -1734,7 +1784,7 @@ expressions; a `progn' form will be returned enclosing these forms." form (cdr (edebug-top-offset cursor))) (cdr specs)))) (edebug-move-cursor cursor) - (list (apply 'vector result))) + (list (apply #'vector result))) (edebug-no-match cursor "Expected" specs))) ((listp form) @@ -1761,7 +1811,7 @@ expressions; a `progn' form will be returned enclosing these forms." (edebug-match-specs cursor specs 'edebug-match-specs) (if (not (edebug-empty-cursor cursor)) (if edebug-best-error - (apply 'edebug-no-match cursor edebug-best-error) + (apply #'edebug-no-match cursor edebug-best-error) ;; A failed &rest or &optional spec may leave some args. (edebug-no-match cursor "Failed matching" specs) ))))) @@ -1927,6 +1977,7 @@ expressions; a `progn' form will be returned enclosing these forms." (def-edebug-spec defun (&define name lambda-list [&optional stringp] + [&optional ("declare" &rest sexp)] [&optional ("interactive" interactive)] def-body)) (def-edebug-spec defmacro @@ -2163,8 +2214,7 @@ The purpose of this function is so you can properly undo subsequent changes to the same binding, by passing the status cons cell to `edebug-restore-status'. The status cons cell has the form (LOCUS . VALUE), where LOCUS can be a buffer -\(for a buffer-local binding), a frame (for a frame-local binding), -or nil (if the default binding is current)." +\(for a buffer-local binding), or nil (if the default binding is current)." (cons (variable-binding-locus var) (symbol-value var))) @@ -2356,7 +2406,7 @@ MSG is printed after `::::} '." (defvar edebug-window-data) ; window and window-start for current function (defvar edebug-outside-windows) ; outside window configuration (defvar edebug-eval-buffer) ; for the evaluation list. -(defvar edebug-outside-d-c-i-n-s-w) ; outside default-cursor-in-non-selected-windows +(defvar edebug-outside-d-c-i-n-s-w) ; outside default cursor-in-non-selected-windows (defvar edebug-eval-list nil) ;; List of expressions to evaluate. @@ -2489,6 +2539,7 @@ MSG is printed after `::::} '." (progn ;; Display result of previous evaluation. (if (and edebug-break + edebug-sit-on-break (not (eq edebug-execution-mode 'Continue-fast))) (sit-for edebug-sit-for-seconds)) ; Show message. (edebug-previous-result))) @@ -3325,10 +3376,10 @@ Return the result of the last expression." (message "%s: %s" (or (get (car value) 'error-message) (format "peculiar error (%s)" (car value))) - (mapconcat (function (lambda (edebug-arg) - ;; continuing after an error may - ;; complain about edebug-arg. why?? - (prin1-to-string edebug-arg))) + (mapconcat (lambda (edebug-arg) + ;; continuing after an error may + ;; complain about edebug-arg. why?? + (prin1-to-string edebug-arg)) (cdr value) ", "))) (defvar print-readably) ; defined by lemacs @@ -3359,11 +3410,9 @@ Return the result of the last expression." ;;; Read, Eval and Print -(defalias 'edebug-prin1 'prin1) -(defalias 'edebug-print 'print) -(defalias 'edebug-prin1-to-string 'prin1-to-string) -(defalias 'edebug-format 'format-message) -(defalias 'edebug-message 'message) +(defalias 'edebug-prin1-to-string #'cl-prin1-to-string) +(defalias 'edebug-format #'format-message) +(defalias 'edebug-message #'message) (defun edebug-eval-expression (expr) "Evaluate an expression in the outside environment. @@ -3604,7 +3653,7 @@ Options: ;; Don't do any edebug things now. (let ((edebug-execution-mode 'Go-nonstop) (edebug-trace nil)) - (mapcar 'edebug-safe-eval edebug-eval-list))) + (mapcar #'edebug-safe-eval edebug-eval-list))) (defun edebug-eval-display-list (eval-result-list) ;; Assumes edebug-eval-buffer exists. @@ -3752,7 +3801,7 @@ Otherwise call `debug' normally." ;; Otherwise call debug normally. ;; Still need to remove extraneous edebug calls from stack. - (apply 'debug arg-mode args) + (apply #'debug arg-mode args) )) @@ -3790,7 +3839,9 @@ Otherwise call `debug' normally." (forward-line 1) (delete-region last-ok-point (point))) - ((looking-at "^ edebug") + ((looking-at (if debugger-stack-frame-as-list + "^ (edebug" + "^ edebug")) (forward-line 1) (delete-region last-ok-point (point)) ))) @@ -3816,7 +3867,7 @@ You must include newlines in FMT to break lines, but one newline is appended." (setq truncate-lines t) (setq buf-window (selected-window)) (goto-char (point-max)) - (insert (apply 'edebug-format fmt args) "\n") + (insert (apply #'edebug-format fmt args) "\n") ;; Make it visible. (vertical-motion (- 1 (window-height))) (set-window-start buf-window (point)) @@ -3831,7 +3882,7 @@ You must include newlines in FMT to break lines, but one newline is appended." (defun edebug-trace (fmt &rest args) "Convenience call to `edebug-trace-display' using `edebug-trace-buffer'." - (apply 'edebug-trace-display edebug-trace-buffer fmt args)) + (apply #'edebug-trace-display edebug-trace-buffer fmt args)) ;;; Frequency count and coverage |