diff options
Diffstat (limited to 'lisp/emacs-lisp/edebug.el')
| -rw-r--r-- | lisp/emacs-lisp/edebug.el | 130 |
1 files changed, 94 insertions, 36 deletions
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index a0bc6562bc9..78461185d3a 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -741,6 +741,21 @@ Maybe clear the markers and delete the symbol's edebug property?" ;;; Offsets for reader +(defun edebug-get-edebug-or-ghost (name) + "Get NAME's value of property `edebug' or property `ghost-edebug'. + +The idea is that should function NAME be recompiled whilst +debugging is in progress, property `edebug' will get set to a +marker. The needed data will then come from property +`ghost-edebug'." + (let ((e (get name 'edebug))) + (if (consp e) + e + (let ((g (get name 'ghost-edebug))) + (if (consp g) + g + e))))) + ;; Define a structure to represent offset positions of expressions. ;; Each offset structure looks like: (before . after) for constituents, ;; or for structures that have elements: (before <subexpressions> . after) @@ -1168,6 +1183,12 @@ purpose by adding an entry to this alist, and setting ;; 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. + + ;; Preserve the `edebug' property in case there's + ;; debugging still under way. + (let ((ghost (get def-name 'edebug))) + (if (consp ghost) + (put def-name 'ghost-edebug ghost))) (put def-name 'edebug (point-marker)) ;; Also nil out dependent defs. '(mapcar (function @@ -1411,6 +1432,8 @@ contains a circular object." (cons window (window-start window))))) ;; Store the edebug data in symbol's property list. + ;; We actually want to remove this property entirely, but can't. + (put edebug-def-name 'ghost-edebug nil) (put edebug-def-name 'edebug ;; A struct or vector would be better here!! (list edebug-form-begin-marker @@ -1423,8 +1446,8 @@ contains a circular object." ))) (defun edebug--restore-breakpoints (name) - (let ((data (get name 'edebug))) - (when (listp data) + (let ((data (edebug-get-edebug-or-ghost name))) + (when (consp data) (let ((offsets (nth 2 data)) (breakpoints (nth 1 data)) (start (nth 0 data)) @@ -1714,6 +1737,7 @@ contains a circular object." (cl-macrolet-body . edebug-match-cl-macrolet-body) (¬ . edebug-match-¬) (&key . edebug-match-&key) + (&error . edebug-match-&error) (place . edebug-match-place) (gate . edebug-match-gate) ;; (nil . edebug-match-nil) not this one - special case it. @@ -1832,9 +1856,6 @@ contains a circular object." ;; This means nothing matched, so it is OK. nil) ;; So, return nothing - -(def-edebug-spec &key edebug-match-&key) - (defun edebug-match-&key (cursor specs) ;; Following specs must look like (<name> <spec>) ... ;; where <name> is the name of a keyword, and spec is its spec. @@ -1847,6 +1868,15 @@ contains a circular object." (car (cdr pair)))) specs)))) +(defun edebug-match-&error (cursor specs) + ;; Signal an error, using the following string in the spec as argument. + (let ((error-string (car specs)) + (edebug-error-point (edebug-before-offset cursor))) + (goto-char edebug-error-point) + (error "%s" + (if (stringp error-string) + error-string + "String expected after &error in edebug-spec")))) (defun edebug-match-gate (_cursor) ;; Simply set the gate to prevent backtracking at this level. @@ -2105,10 +2135,10 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." (def-edebug-spec edebug-spec (&or + edebug-spec-list (vector &rest edebug-spec) ; matches a vector ("vector" &rest edebug-spec) ; matches a vector spec ("quote" symbolp) - edebug-spec-list stringp [edebug-lambda-list-keywordp &rest edebug-spec] [keywordp gate edebug-spec] @@ -2216,6 +2246,8 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." (def-edebug-spec nested-backquote-form (&or + ("`" &error "Triply nested backquotes (without commas \"between\" them) \ +are too difficult to instrument") ;; Allow instrumentation of any , or ,@ contained within the (\, ...) or ;; (\,@ ...) matched on the next line. ([&or "," ",@"] backquote-form) @@ -2755,6 +2787,7 @@ See `edebug-behavior-alist' for implementations.") (edebug-stop)) (edebug-overlay-arrow) + (edebug--overlay-breakpoints edebug-function) (unwind-protect (if (or edebug-stop @@ -2832,7 +2865,6 @@ See `edebug-behavior-alist' for implementations.") (if (not (eq edebug-buffer edebug-outside-buffer)) (goto-char edebug-outside-point)) (if (marker-buffer (edebug-mark-marker)) - ;; Does zmacs-regions need to be nil while doing set-marker? (set-marker (edebug-mark-marker) edebug-outside-mark)) )) ; unwind-protect ;; None of the following is done if quit or signal occurs. @@ -2844,6 +2876,7 @@ See `edebug-behavior-alist' for implementations.") (goto-char edebug-buffer-outside-point)) ;; ... nothing more. ) + (edebug--overlay-breakpoints-remove (point-min) (point-max)) ;; Could be an option to keep eval display up. (if edebug-eval-buffer (kill-buffer edebug-eval-buffer)) (with-timeout-unsuspend edebug-with-timeout-suspend) @@ -3118,7 +3151,7 @@ before returning. The default is one second." ;; Return (function . index) of the nearest edebug stop point. (let* ((edebug-def-name (edebug-form-data-symbol)) (edebug-data - (let ((data (get edebug-def-name 'edebug))) + (let ((data (edebug-get-edebug-or-ghost edebug-def-name))) (if (or (null data) (markerp data)) (error "%s is not instrumented for Edebug" edebug-def-name)) data)) ; we could do it automatically, if data is a marker. @@ -3155,7 +3188,7 @@ before returning. The default is one second." (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) - (edebug-data (get edebug-def-name 'edebug)) + (edebug-data (edebug-get-edebug-or-ghost edebug-def-name)) ;; pull out parts of edebug-data (edebug-def-mark (car edebug-data)) @@ -3196,7 +3229,7 @@ the breakpoint." (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) - (edebug-data (get edebug-def-name 'edebug)) + (edebug-data (edebug-get-edebug-or-ghost edebug-def-name)) ;; pull out parts of edebug-data (edebug-def-mark (car edebug-data)) @@ -3228,7 +3261,45 @@ the breakpoint." (setcar (cdr edebug-data) edebug-breakpoints) (goto-char position) - )))) + (edebug--overlay-breakpoints edebug-def-name))))) + +(define-fringe-bitmap 'edebug-breakpoint + "\x3c\x7e\xff\xff\xff\xff\x7e\x3c") + +(defun edebug--overlay-breakpoints (function) + (let* ((data (edebug-get-edebug-or-ghost function)) + (start (nth 0 data)) + (breakpoints (nth 1 data)) + (offsets (nth 2 data))) + ;; First remove all old breakpoint overlays. + (edebug--overlay-breakpoints-remove + start (+ start (aref offsets (1- (length offsets))))) + ;; Then make overlays for the breakpoints (but only when we are in + ;; edebug mode). + (when edebug-active + (dolist (breakpoint breakpoints) + (let* ((pos (+ start (aref offsets (car breakpoint)))) + (overlay (make-overlay pos (1+ pos))) + (face (if (nth 4 breakpoint) + (progn + (overlay-put overlay + 'help-echo "Disabled breakpoint") + (overlay-put overlay + 'face 'edebug-disabled-breakpoint)) + (overlay-put overlay 'help-echo "Breakpoint") + (overlay-put overlay 'face 'edebug-enabled-breakpoint)))) + (overlay-put overlay 'edebug t) + (let ((fringe (make-overlay pos pos))) + (overlay-put fringe 'edebug t) + (overlay-put fringe 'before-string + (propertize + "x" 'display + `(left-fringe edebug-breakpoint ,face))))))))) + +(defun edebug--overlay-breakpoints-remove (start end) + (dolist (overlay (overlays-in start end)) + (when (overlay-get overlay 'edebug) + (delete-overlay overlay)))) (defun edebug-set-breakpoint (arg) "Set the breakpoint of nearest sexp. @@ -3236,9 +3307,9 @@ With prefix argument, make it a temporary breakpoint." (interactive "P") ;; If the form hasn't been instrumented yet, do it now. (when (and (not edebug-active) - (let ((data (get (edebug--form-data-name - (edebug-get-form-data-entry (point))) - 'edebug))) + (let ((data (edebug-get-edebug-or-ghost + (edebug--form-data-name + (edebug-get-form-data-entry (point)))))) (or (null data) (markerp data)))) (edebug-defun)) (edebug-modify-breakpoint t nil arg)) @@ -3252,7 +3323,7 @@ With prefix argument, make it a temporary breakpoint." "Unset all the breakpoints in the current form." (interactive) (let* ((name (edebug-form-data-symbol)) - (breakpoints (nth 1 (get name 'edebug)))) + (breakpoints (nth 1 (edebug-get-edebug-or-ghost name)))) (unless breakpoints (user-error "There are no breakpoints in %s" name)) (save-excursion @@ -3268,12 +3339,13 @@ With prefix argument, make it a temporary breakpoint." (user-error "No stop point near point")) (let* ((name (car stop-point)) (index (cdr stop-point)) - (data (get name 'edebug)) + (data (edebug-get-edebug-or-ghost name)) (breakpoint (assq index (nth 1 data)))) (unless breakpoint (user-error "No breakpoint near point")) (setf (nth 4 breakpoint) - (not (nth 4 breakpoint)))))) + (not (nth 4 breakpoint))) + (edebug--overlay-breakpoints name)))) (defun edebug-set-global-break-condition (expression) "Set `edebug-global-break-condition' to EXPRESSION." @@ -3448,7 +3520,7 @@ instrument cannot be found, signal an error." (goto-char func-marker) (edebug-eval-top-level-form) (list func))) - ((consp func-marker) + ((and (consp func-marker) (consp (symbol-function func))) (message "%s is already instrumented." func) (list func)) (t @@ -3667,7 +3739,6 @@ Return the result of the last expression." (prin1-to-string edebug-arg)) (cdr value) ", "))) -(defvar print-readably) ; defined by lemacs ;; Alternatively, we could change the definition of ;; edebug-safe-prin1-to-string to only use these if defined. @@ -3675,8 +3746,7 @@ Return the result of the last expression." (let ((print-escape-newlines t) (print-length (or edebug-print-length print-length)) (print-level (or edebug-print-level print-level)) - (print-circle (or edebug-print-circle print-circle)) - (print-readably nil)) ; lemacs uses this. + (print-circle (or edebug-print-circle print-circle))) (edebug-prin1-to-string value))) (defun edebug-compute-previous-result (previous-value) @@ -4223,7 +4293,7 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME." (let* ((index (backtrace-get-index)) (frame (nth index backtrace-frames))) (when (edebug--frame-def-name frame) - (let* ((data (get (edebug--frame-def-name frame) 'edebug)) + (let* ((data (edebug-get-edebug-or-ghost (edebug--frame-def-name frame))) (marker (nth 0 data)) (offsets (nth 2 data))) (pop-to-buffer (marker-buffer marker)) @@ -4307,7 +4377,7 @@ reinstrument it." (let* ((function (edebug-form-data-symbol)) (counts (get function 'edebug-freq-count)) (coverages (get function 'edebug-coverage)) - (data (get function 'edebug)) + (data (edebug-get-edebug-or-ghost function)) (def-mark (car data)) ; mark at def start (edebug-points (nth 2 data)) (i (1- (length edebug-points))) @@ -4465,7 +4535,7 @@ With prefix argument, make it a temporary breakpoint." (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) - (edebug-data (get edebug-def-name 'edebug)) + (edebug-data (edebug-get-edebug-or-ghost edebug-def-name)) (edebug-breakpoints (car (cdr edebug-data))) (edebug-break-data (assq index edebug-breakpoints)) (edebug-break-condition (car (cdr edebug-break-data))) @@ -4479,17 +4549,6 @@ With prefix argument, make it a temporary breakpoint." (edebug-modify-breakpoint t condition arg)) (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus) - -;;; Autoloading of Edebug accessories - -;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu -(defun edebug--require-cl-read () - (require 'edebug-cl-read)) - -(if (featurep 'cl-read) - (add-hook 'edebug-setup-hook #'edebug--require-cl-read) - ;; The following causes edebug-cl-read to be loaded when you load cl-read.el. - (add-hook 'cl-read-load-hooks #'edebug--require-cl-read)) ;;; Finalize Loading @@ -4525,7 +4584,6 @@ With prefix argument, make it a temporary breakpoint." (run-with-idle-timer 0 nil #'(lambda () (unload-feature 'edebug))))) (remove-hook 'called-interactively-p-functions #'edebug--called-interactively-skip) - (remove-hook 'cl-read-load-hooks #'edebug--require-cl-read) (edebug-uninstall-read-eval-functions) ;; Continue standard unloading. nil) |