;;; edebug.el --- a source-level debugger for Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 1988-1995, 1997, 1999-2013 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1988-1995, 1997, 1999-2014 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, tools, maint
;; This file is part of GNU Emacs.
;;; Code:
(require 'macroexp)
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(eval-when-compile (require 'pcase))
;;; Options
;;; Utilities
-;; Define edebug-gensym - from old cl.el
-(defvar edebug-gensym-index 0
- "Integer used by `edebug-gensym' to produce new names.")
-
-(defun edebug-gensym (&optional prefix)
- "Generate a fresh uninterned symbol.
-There is an optional argument, PREFIX. PREFIX is the string
-that begins the new name. Most people take just the default,
-except when debugging needs suggest otherwise."
- (if (null prefix)
- (setq prefix "G"))
- (let ((newsymbol nil)
- (newname ""))
- (while (not newsymbol)
- (setq newname (concat prefix (int-to-string edebug-gensym-index)))
- (setq edebug-gensym-index (+ edebug-gensym-index 1))
- (if (not (intern-soft newname))
- (setq newsymbol (make-symbol newname))))
- newsymbol))
-
(defun edebug-lambda-list-keywordp (object)
"Return t if OBJECT is a lambda list keyword.
A lambda list keyword is a symbol that starts with `&'."
"Return t if there are two windows."
(and (not (one-window-p))
(eq (selected-window)
- (next-window (next-window (selected-window))))))
-
-(defsubst edebug-lookup-function (object)
- (while (and (symbolp object) (fboundp object))
- (setq object (symbol-function object)))
- object)
-
-(defun edebug-macrop (object)
- "Return the macro named by OBJECT, or nil if it is not a macro."
- (setq object (edebug-lookup-function object))
- (if (and (listp object)
- (eq 'macro (car object))
- (functionp (cdr object)))
- object))
+ (next-window (next-window)))))
(defun edebug-sort-alist (alist function)
;; Return the ALIST sorted with comparison function FUNCTION.
((and (edebug-window-live-p window)
(eq (window-buffer window) buffer))
window)
- ((eq (window-buffer (selected-window)) buffer)
+ ((eq (window-buffer) buffer)
;; Selected window already displays BUFFER.
(selected-window))
((get-buffer-window buffer 0))
;; read is redefined to maybe instrument forms.
;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
-;; Save the original read function
-(defalias 'edebug-original-read
- (symbol-function (if (fboundp 'edebug-original-read)
- 'edebug-original-read 'read)))
-
-(defun edebug-read (&optional stream)
+(defun edebug--read (orig &optional stream)
"Read one Lisp expression as text from STREAM, return as Lisp object.
If STREAM is nil, use the value of `standard-input' (which see).
STREAM or the value of `standard-input' may be:
(or stream (setq stream standard-input))
(if (eq stream (current-buffer))
(edebug-read-and-maybe-wrap-form)
- (edebug-original-read stream)))
+ (funcall (or orig #'read) stream)))
-(or (fboundp 'edebug-original-eval-defun)
- (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))
+(defvar edebug-result) ; The result of the function call returned by body.
;; We should somehow arrange to be able to do this
;; without actually replacing the eval-defun command.
Setting option `edebug-all-defs' to a non-nil value reverses the meaning
of the prefix argument. Code is then instrumented when this function is
-invoked without a prefix argument
+invoked without a prefix argument.
If acting on a `defun' for FUNCTION, and the function was instrumented,
`Edebug: FUNCTION' is printed in the minibuffer. If not instrumented,
(put (nth 1 form) 'saved-face nil)))))
(setq edebug-result (eval (eval-sexp-add-defvars form) lexical-binding))
(if (not edebugging)
- (princ edebug-result)
+ (prog1
+ (prin1 edebug-result)
+ (let ((str (eval-expression-print-format edebug-result)))
+ (if str (princ str))))
edebug-result)))
(defun edebug-install-read-eval-functions ()
(interactive)
- ;; Don't install if already installed.
- (unless load-read-function
- (setq load-read-function 'edebug-read)
- (defalias 'eval-defun 'edebug-eval-defun)))
+ (add-function :around load-read-function #'edebug--read)
+ (advice-add 'eval-defun :override 'edebug-eval-defun))
(defun edebug-uninstall-read-eval-functions ()
(interactive)
- (setq load-read-function nil)
- (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun)))
-
+ (remove-function load-read-function #'edebug--read)
+ (advice-remove 'eval-defun 'edebug-eval-defun))
;;; Edebug internal data
(cond
;; read goes one too far if a (possibly quoted) string or symbol
;; is immediately followed by non-whitespace.
- ((eq class 'symbol) (edebug-original-read (current-buffer)))
- ((eq class 'string) (edebug-original-read (current-buffer)))
+ ((eq class 'symbol) (read (current-buffer)))
+ ((eq class 'string) (read (current-buffer)))
((eq class 'quote) (forward-char 1)
(list 'quote (edebug-read-sexp)))
((eq class 'backquote)
((eq class 'comma)
(list '\, (edebug-read-sexp)))
(t ; anything else, just read it.
- (edebug-original-read (current-buffer))))))
+ (read (current-buffer))))))
;;; Offsets for reader
(funcall
(or (cdr (assq (edebug-next-token-class) edebug-read-alist))
;; anything else, just read it.
- 'edebug-original-read)
+ #'read)
stream))))
-(defun edebug-read-symbol (stream)
- (edebug-original-read stream))
-
-(defun edebug-read-string (stream)
- (edebug-original-read stream))
+(defalias 'edebug-read-symbol #'read)
+(defalias 'edebug-read-string #'read)
(defun edebug-read-quote (stream)
;; Turn 'thing into (quote thing)
((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6
?7 ?8 ?9 ?0))
(backward-char 1)
- (edebug-original-read stream))
+ (read stream))
(t (edebug-syntax-error "Bad char after #"))))
(defun edebug-read-list (stream)
edebug-gate
edebug-best-error
edebug-error-point
- no-match
;; Do this once here instead of several times.
(max-lisp-eval-depth (+ 800 max-lisp-eval-depth))
(max-specpdl-size (+ 2000 max-specpdl-size)))
- (setq no-match
- (catch 'no-match
- (setq result (edebug-read-and-maybe-wrap-form1))
- nil))
- (if no-match
- (apply 'edebug-syntax-error no-match))
+ (let ((no-match
+ (catch 'no-match
+ (setq result (edebug-read-and-maybe-wrap-form1))
+ nil)))
+ (if no-match
+ (apply 'edebug-syntax-error no-match)))
result))
(if (and (eq 'lparen (edebug-next-token-class))
(eq 'symbol (progn (forward-char 1) (edebug-next-token-class))))
;; Find out if this is a defining form from first symbol
- (setq def-kind (edebug-original-read (current-buffer))
+ (setq def-kind (read (current-buffer))
spec (and (symbolp def-kind) (get-edebug-spec def-kind))
defining-form-p (and (listp spec)
(eq '&define (car spec)))
def-name (if (and defining-form-p
(eq 'name (car (cdr spec)))
(eq 'symbol (edebug-next-token-class)))
- (edebug-original-read (current-buffer))))))
+ (read (current-buffer))))))
;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms)
(cond
(defining-form-p
;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
;; Do this after parsing since that may find a name.
(setq edebug-def-name
- (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
+ (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon")))
`(edebug-enter
(quote ,edebug-def-name)
,(if edebug-inside-func
;; Set the name here if it was not set by edebug-make-enter-wrapper.
(setq edebug-def-name
- (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
+ (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon")))
;; Add this def as a dependent of containing def. Buggy.
'(if (and edebug-containing-def-name
; but leave it in for compatibility.
))
;; No edebug-form-spec provided.
- ((edebug-macrop head)
+ ((macrop head)
(if edebug-eval-macro-args
(edebug-forms cursor)
(edebug-sexps cursor)))
[&optional stringp]
[&optional ("interactive" interactive)]
def-body))
-;; FIXME? Isn't this missing the doc-string? Cf defun.
(def-edebug-spec defmacro
;; FIXME: Improve `declare' so we can Edebug gv-expander and
;; gv-setter declarations.
- (&define name lambda-list [&optional ("declare" &rest sexp)] def-body))
+ (&define name lambda-list [&optional stringp]
+ [&optional ("declare" &rest sexp)] def-body))
(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list.
(defvar edebug-coverage) ; the coverage results of each expression of function.
(defvar edebug-buffer) ; which buffer the function is in.
-(defvar edebug-result) ; the result of the function call returned by body
-(defvar edebug-outside-executing-macro)
-(defvar edebug-outside-defining-kbd-macro)
(defvar edebug-execution-mode 'step) ; Current edebug mode set by user.
(defvar edebug-next-execution-mode nil) ; Use once instead of initial mode.
(defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside
(defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside
-
-(defvar edebug-outside-pre-command-hook)
-(defvar edebug-outside-post-command-hook)
-
-(defvar cl-lexical-debug) ;; Defined in cl.el
-
;;; Handling signals
(defun edebug-signal (signal-name signal-data)
;; Binding these may not be the right thing to do.
;; We want to allow the global values to be changed.
(debug-on-error (or debug-on-error edebug-on-error))
- (debug-on-quit edebug-on-quit)
-
- ;; Lexical bindings must be uncompiled for this to work.
- (cl-lexical-debug t))
+ (debug-on-quit edebug-on-quit))
(unwind-protect
(let ((signal-hook-function 'edebug-signal))
(setq edebug-execution-mode (or edebug-next-execution-mode
(if edebug-global-break-condition
(condition-case nil
(setq edebug-global-break-result
- ;; FIXME: lexbind.
- (eval edebug-global-break-condition))
+ (edebug-eval edebug-global-break-condition))
(error nil))))
(edebug-break))
(and edebug-break-data
(or (not edebug-break-condition)
(setq edebug-break-result
- ;; FIXME: lexbind.
- (eval edebug-break-condition))))))
+ (edebug-eval edebug-break-condition))))))
(if (and edebug-break
(nth 2 edebug-break-data)) ; is it temporary?
;; Delete the breakpoint.
(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-o-a-p) ; outside overlay-arrow-position
-(defvar edebug-outside-o-a-s) ; outside overlay-arrow-string
-(defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area
(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.
;; Emacs 19 adds an arg to mark and mark-marker.
(defalias 'edebug-mark-marker 'mark-marker)
-(defvar edebug-outside-unread-command-events)
-
(defun edebug--display (value offset-index arg-mode)
(unless (marker-position edebug-def-mark)
;; The buffer holding the source has been killed.
(edebug-outside-buffer (current-buffer))
(edebug-outside-point (point))
(edebug-outside-mark (edebug-mark))
- (edebug-outside-unread-command-events unread-command-events)
edebug-outside-windows ; Window or screen configuration.
edebug-buffer-points
edebug-trace-window
edebug-trace-window-start
- (edebug-outside-o-a-p overlay-arrow-position)
- (edebug-outside-o-a-s overlay-arrow-string)
- (edebug-outside-c-i-e-a cursor-in-echo-area)
(edebug-outside-d-c-i-n-s-w
(default-value 'cursor-in-non-selected-windows)))
(unwind-protect
- (let ((overlay-arrow-position overlay-arrow-position)
- (overlay-arrow-string overlay-arrow-string)
- (cursor-in-echo-area nil)
+ (let ((cursor-in-echo-area nil)
(unread-command-events nil)
;; any others??
)
(setq-default cursor-in-non-selected-windows t)
(if (not (buffer-name edebug-buffer))
- (let ((debug-on-error nil))
- (error "Buffer defining %s not found" edebug-function)))
+ (user-error "Buffer defining %s not found" edebug-function))
(if (eq 'after arg-mode)
;; Compute result string now before windows are modified.
;; Check whether positions are up-to-date.
;; This assumes point is never before symbol.
(if (not (memq (following-char) '(?\( ?\# ?\` )))
- (let ((debug-on-error nil))
- (error "Source has changed - reevaluate definition of %s"
- edebug-function)
- )))
+ (user-error "Source has changed - reevaluate definition of %s"
+ edebug-function)
+ ))
(setcdr edebug-window-data
(edebug-adjust-window (cdr edebug-window-data)))
(edebug-stop)
;; (discard-input) ; is this unfriendly??
))
- ;; Now display arrow based on mode.
- (edebug-overlay-arrow)
-
- (cond
- ((eq 'error arg-mode)
- ;; Display error message
- (setq edebug-execution-mode 'step)
- (edebug-overlay-arrow)
- (beep)
- (if (eq 'quit (car value))
- (message "Quit")
- (edebug-report-error value)))
- (edebug-break
- (cond
- (edebug-global-break
- (message "Global Break: %s => %s"
- edebug-global-break-condition
- edebug-global-break-result))
- (edebug-break-condition
- (message "Break: %s => %s"
- edebug-break-condition
- edebug-break-result))
- ((not (eq edebug-execution-mode 'Continue-fast))
- (message "Break"))
- (t)))
- (t (message "")))
-
- (if (eq 'after arg-mode)
- (progn
- ;; Display result of previous evaluation.
- (if (and edebug-break
- (not (eq edebug-execution-mode 'Continue-fast)))
- (sit-for edebug-sit-for-seconds)) ; Show message.
- (edebug-previous-result)))
-
- (cond
- (edebug-break
- (cond
- ((eq edebug-execution-mode 'continue)
- (sit-for edebug-sit-for-seconds))
- ((eq edebug-execution-mode 'Continue-fast) (sit-for 0))
- (t (setq edebug-stop t))))
- ;; not edebug-break
- ((eq edebug-execution-mode 'trace)
- (sit-for edebug-sit-for-seconds)) ; Force update and pause.
- ((eq edebug-execution-mode 'Trace-fast)
- (sit-for 0))) ; Force update and continue.
+ ;; Make sure we bind those in the right buffer (bug#16410).
+ (let ((overlay-arrow-position overlay-arrow-position)
+ (overlay-arrow-string overlay-arrow-string))
+ ;; Now display arrow based on mode.
+ (edebug-overlay-arrow)
- (unwind-protect
- (if (or edebug-stop
- (memq edebug-execution-mode '(step next))
- (eq arg-mode 'error))
- (progn
- ;; (setq edebug-execution-mode 'step)
- ;; (edebug-overlay-arrow) ; This doesn't always show up.
- (edebug--recursive-edit arg-mode))) ; <----- Recursive edit
-
- ;; Reset the edebug-window-data to whatever it is now.
- (let ((window (if (eq (window-buffer) edebug-buffer)
- (selected-window)
- (get-buffer-window edebug-buffer))))
- ;; Remember window-start for edebug-buffer, if still displayed.
- (if window
- (progn
- (setcar edebug-window-data window)
- (setcdr edebug-window-data (window-start window)))))
-
- ;; Save trace window point before restoring outside windows.
- ;; Could generalize this for other buffers.
- (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))
- (if edebug-trace-window
- (setq edebug-trace-window-start
- (and edebug-trace-window
- (window-start edebug-trace-window))))
-
- ;; Restore windows before continuing.
- (if edebug-save-windows
- (progn
- (edebug-set-windows edebug-outside-windows)
-
- ;; Restore displayed buffer points.
- ;; Needed even if restoring windows because
- ;; window-points are not restored. (should they be??)
- (if edebug-save-displayed-buffer-points
- (edebug-set-buffer-points edebug-buffer-points))
-
- ;; Unrestore trace window's window-point.
- (if edebug-trace-window
- (set-window-start edebug-trace-window
- edebug-trace-window-start))
-
- ;; Unrestore edebug-buffer's window-start, if displayed.
- (let ((window (car edebug-window-data)))
- (if (and (edebug-window-live-p window)
- (eq (window-buffer) edebug-buffer))
- (progn
- (set-window-start window (cdr edebug-window-data)
- 'no-force)
- ;; Unrestore edebug-buffer's window-point.
- ;; Needed in addition to setting the buffer point
- ;; - otherwise quitting doesn't leave point as is.
- ;; But this causes point to not be restored at times.
- ;; Also, it may not be a visible window.
- ;; (set-window-point window edebug-point)
- )))
-
- ;; Unrestore edebug-buffer's point. Rerestored below.
- ;; (goto-char edebug-point) ;; in edebug-buffer
- )
- ;; Since we may be in a save-excursion, in case of quit,
- ;; reselect the outside window only.
- ;; Only needed if we are not recovering windows??
- (if (edebug-window-live-p edebug-outside-window)
- (select-window edebug-outside-window))
- ) ; if edebug-save-windows
-
- ;; Restore current buffer always, in case application needs it.
- (if (buffer-name edebug-outside-buffer)
- (set-buffer edebug-outside-buffer))
- ;; Restore point, and mark.
- ;; Needed even if restoring windows because
- ;; that doesn't restore point and mark in the current buffer.
- ;; But don't restore point if edebug-buffer is current buffer.
- (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
+ (cond
+ ((eq 'error arg-mode)
+ ;; Display error message
+ (setq edebug-execution-mode 'step)
+ (edebug-overlay-arrow)
+ (beep)
+ (if (eq 'quit (car value))
+ (message "Quit")
+ (edebug-report-error value)))
+ (edebug-break
+ (cond
+ (edebug-global-break
+ (message "Global Break: %s => %s"
+ edebug-global-break-condition
+ edebug-global-break-result))
+ (edebug-break-condition
+ (message "Break: %s => %s"
+ edebug-break-condition
+ edebug-break-result))
+ ((not (eq edebug-execution-mode 'Continue-fast))
+ (message "Break"))
+ (t)))
+
+ (t (message "")))
+
+ (if (eq 'after arg-mode)
+ (progn
+ ;; Display result of previous evaluation.
+ (if (and edebug-break
+ (not (eq edebug-execution-mode 'Continue-fast)))
+ (sit-for edebug-sit-for-seconds)) ; Show message.
+ (edebug-previous-result)))
+
+ (cond
+ (edebug-break
+ (cond
+ ((eq edebug-execution-mode 'continue)
+ (sit-for edebug-sit-for-seconds))
+ ((eq edebug-execution-mode 'Continue-fast) (sit-for 0))
+ (t (setq edebug-stop t))))
+ ;; not edebug-break
+ ((eq edebug-execution-mode 'trace)
+ (sit-for edebug-sit-for-seconds)) ; Force update and pause.
+ ((eq edebug-execution-mode 'Trace-fast)
+ (sit-for 0))) ; Force update and continue.
+
+ (unwind-protect
+ (if (or edebug-stop
+ (memq edebug-execution-mode '(step next))
+ (eq arg-mode 'error))
+ (progn
+ ;; (setq edebug-execution-mode 'step)
+ ;; (edebug-overlay-arrow) ; This doesn't always show up.
+ (edebug--recursive-edit arg-mode))) ; <--- Recursive edit
+
+ ;; Reset the edebug-window-data to whatever it is now.
+ (let ((window (if (eq (window-buffer) edebug-buffer)
+ (selected-window)
+ (get-buffer-window edebug-buffer))))
+ ;; Remember window-start for edebug-buffer, if still displayed.
+ (if window
+ (progn
+ (setcar edebug-window-data window)
+ (setcdr edebug-window-data (window-start window)))))
+
+ ;; Save trace window point before restoring outside windows.
+ ;; Could generalize this for other buffers.
+ (setq edebug-trace-window
+ (get-buffer-window edebug-trace-buffer))
+ (if edebug-trace-window
+ (setq edebug-trace-window-start
+ (and edebug-trace-window
+ (window-start edebug-trace-window))))
+
+ ;; Restore windows before continuing.
+ (if edebug-save-windows
+ (progn
+ (edebug-set-windows edebug-outside-windows)
+
+ ;; Restore displayed buffer points.
+ ;; Needed even if restoring windows because
+ ;; window-points are not restored. (should they be??)
+ (if edebug-save-displayed-buffer-points
+ (edebug-set-buffer-points edebug-buffer-points))
+
+ ;; Unrestore trace window's window-point.
+ (if edebug-trace-window
+ (set-window-start edebug-trace-window
+ edebug-trace-window-start))
+
+ ;; Unrestore edebug-buffer's window-start, if displayed.
+ (let ((window (car edebug-window-data)))
+ (if (and (edebug-window-live-p window)
+ (eq (window-buffer) edebug-buffer))
+ (progn
+ (set-window-start window (cdr edebug-window-data)
+ 'no-force)
+ ;; Unrestore edebug-buffer's window-point.
+ ;; Needed in addition to setting the buffer point
+ ;; - otherwise quitting doesn't leave point as is.
+ ;; But can this causes point to not be restored.
+ ;; Also, it may not be a visible window.
+ ;; (set-window-point window edebug-point)
+ )))
+
+ ;; Unrestore edebug-buffer's point. Rerestored below.
+ ;; (goto-char edebug-point) ;; in edebug-buffer
+ )
+ ;; Since we may be in a save-excursion, in case of quit,
+ ;; reselect the outside window only.
+ ;; Only needed if we are not recovering windows??
+ (if (edebug-window-live-p edebug-outside-window)
+ (select-window edebug-outside-window))
+ ) ; if edebug-save-windows
+
+ ;; Restore current buffer always, in case application needs it.
+ (if (buffer-name edebug-outside-buffer)
+ (set-buffer edebug-outside-buffer))
+ ;; Restore point, and mark.
+ ;; Needed even if restoring windows because
+ ;; that doesn't restore point and mark in the current buffer.
+ ;; But don't restore point if edebug-buffer is current buffer.
+ (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.
;; Restore edebug-buffer's outside point.
(if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
(with-timeout-unsuspend edebug-with-timeout-suspend)
;; Reset global variables to outside values in case they were changed.
- (setq
- unread-command-events edebug-outside-unread-command-events
- overlay-arrow-position edebug-outside-o-a-p
- overlay-arrow-string edebug-outside-o-a-s
- cursor-in-echo-area edebug-outside-c-i-e-a)
(setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
)))
(defvar edebug-inside-windows)
(defvar edebug-interactive-p)
-(defvar edebug-outside-map)
-(defvar edebug-outside-standard-output)
-(defvar edebug-outside-standard-input)
-(defvar edebug-outside-current-prefix-arg)
-(defvar edebug-outside-last-command)
-(defvar edebug-outside-this-command)
-
-;; Note: here we have defvars for variables that are
-;; built-in in certain versions.
-;; Each defvar makes a difference
-;; in versions where the variable is *not* built-in.
-
-;; Emacs 18 FIXME
-
-;; Emacs 19.
-(defvar edebug-outside-last-command-event)
-(defvar edebug-outside-last-input-event)
-(defvar edebug-outside-last-event-frame)
-(defvar edebug-outside-last-nonmenu-event)
-(defvar edebug-outside-track-mouse)
-
(defun edebug--recursive-edit (arg-mode)
;; Start up a recursive edit inside of edebug.
;; The current buffer is the edebug-buffer, which is put into edebug-mode.
;; The window configuration may be saved and restored
;; during a recursive-edit
edebug-inside-windows
-
- ;; Save the outside value of executing macro. (here??)
- (edebug-outside-executing-macro executing-kbd-macro)
- (edebug-outside-pre-command-hook
- (edebug-var-status 'pre-command-hook))
- (edebug-outside-post-command-hook
- (edebug-var-status 'post-command-hook))
-
- (edebug-outside-standard-output standard-output)
- (edebug-outside-standard-input standard-input)
- (edebug-outside-defining-kbd-macro defining-kbd-macro)
-
- (edebug-outside-last-command last-command)
- (edebug-outside-this-command this-command)
-
- (edebug-outside-current-prefix-arg current-prefix-arg)
-
- (edebug-outside-last-input-event last-input-event)
- (edebug-outside-last-command-event last-command-event)
- (edebug-outside-last-event-frame last-event-frame)
- (edebug-outside-last-nonmenu-event last-nonmenu-event)
- (edebug-outside-track-mouse track-mouse)
)
(unwind-protect
(overriding-local-map nil)
(overriding-terminal-local-map nil)
- ;; Bind again to outside values.
+ ;; Bind again to outside values.
(debug-on-error edebug-outside-debug-on-error)
(debug-on-quit edebug-outside-debug-on-quit)
;; gotta have a buffer to let its buffer local variables be set
(get-buffer-create " bogus edebug buffer"))
));; inner let
-
- ;; Reset global vars to outside values, in case they have been changed.
- (setq
- last-command-event edebug-outside-last-command-event
- last-command edebug-outside-last-command
- this-command edebug-outside-this-command
- current-prefix-arg edebug-outside-current-prefix-arg
- last-input-event edebug-outside-last-input-event
- last-event-frame edebug-outside-last-event-frame
- last-nonmenu-event edebug-outside-last-nonmenu-event
- track-mouse edebug-outside-track-mouse
-
- standard-output edebug-outside-standard-output
- standard-input edebug-outside-standard-input
- defining-kbd-macro edebug-outside-defining-kbd-macro)
-
- (setq executing-kbd-macro edebug-outside-executing-macro)
- (edebug-restore-status
- 'post-command-hook edebug-outside-post-command-hook)
- (edebug-restore-status
- 'pre-command-hook edebug-outside-pre-command-hook))))
+ )))
;;; Display related functions
(if (looking-at "\(")
(edebug--form-data-name
(edebug-get-form-data-entry (point)))
- (edebug-original-read (current-buffer))))))
+ (read (current-buffer))))))
(edebug-instrument-function func))))
(put function 'edebug-on-entry nil))
-(if (not (fboundp 'edebug-original-debug-on-entry))
- (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
-'(fset 'debug-on-entry 'edebug-debug-on-entry) ;; Should we do this?
+'(advice-add 'debug-on-entry :around 'edebug--debug-on-entry) ;; Should we do this?
;; Also need edebug-cancel-debug-on-entry
-'(defun edebug-debug-on-entry (function)
- "Request FUNCTION to invoke debugger each time it is called.
-If the user continues, FUNCTION's execution proceeds.
-Works by modifying the definition of FUNCTION,
-which must be written in Lisp, not predefined.
-Use `cancel-debug-on-entry' to cancel the effect of this command.
-Redefining FUNCTION also does that.
-
-This version is from Edebug. If the function is instrumented for
-Edebug, it calls `edebug-on-entry'."
- (interactive "aDebug on entry (to function): ")
+'(defun edebug--debug-on-entry (orig function)
+ "If the function is instrumented for Edebug, call `edebug-on-entry'."
(let ((func-data (get function 'edebug)))
(if (or (null func-data) (markerp func-data))
- (edebug-original-debug-on-entry function)
+ (funcall orig function)
(edebug-on-entry function))))
(defmacro edebug-outside-excursion (&rest body)
"Evaluate an expression list in the outside context.
Return the result of the last expression."
+ ;; Only restores the non-variables context since all the variables let-bound
+ ;; by Edebug will be properly reset to the appropriate context's value by
+ ;; backtrace-eval.
(declare (debug t))
`(save-excursion ; of current-buffer
(if edebug-save-windows
(edebug-set-windows edebug-outside-windows)))
(set-buffer edebug-buffer) ; why?
- ;; (use-local-map edebug-outside-map)
(set-match-data edebug-outside-match-data)
;; Restore outside context.
- (let (;; (edebug-inside-map (current-local-map)) ;; restore map??
- (last-command-event edebug-outside-last-command-event)
- (last-command edebug-outside-last-command)
- (this-command edebug-outside-this-command)
- (unread-command-events edebug-outside-unread-command-events)
- (current-prefix-arg edebug-outside-current-prefix-arg)
- (last-input-event edebug-outside-last-input-event)
- (last-event-frame edebug-outside-last-event-frame)
- (last-nonmenu-event edebug-outside-last-nonmenu-event)
- (track-mouse edebug-outside-track-mouse)
- (standard-output edebug-outside-standard-output)
- (standard-input edebug-outside-standard-input)
-
- (executing-kbd-macro edebug-outside-executing-macro)
- (defining-kbd-macro edebug-outside-defining-kbd-macro)
- ;; Get the values out of the saved statuses.
- (pre-command-hook (cdr edebug-outside-pre-command-hook))
- (post-command-hook (cdr edebug-outside-post-command-hook))
-
- ;; See edebug-display.
- (overlay-arrow-position edebug-outside-o-a-p)
- (overlay-arrow-string edebug-outside-o-a-s)
- (cursor-in-echo-area edebug-outside-c-i-e-a)
- )
- (setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
- (unwind-protect
- (with-current-buffer edebug-outside-buffer ; of edebug-buffer
- (goto-char edebug-outside-point)
- (if (marker-buffer (edebug-mark-marker))
- (set-marker (edebug-mark-marker) edebug-outside-mark))
- ,@body)
-
- ;; Back to edebug-buffer. Restore rest of inside context.
- ;; (use-local-map edebug-inside-map)
- (if edebug-save-windows
- ;; Restore inside windows.
- (edebug-set-windows edebug-inside-windows))
-
- ;; Save values that may have been changed.
- (setq
- edebug-outside-last-command-event last-command-event
- edebug-outside-last-command last-command
- edebug-outside-this-command this-command
- edebug-outside-unread-command-events unread-command-events
- edebug-outside-current-prefix-arg current-prefix-arg
- edebug-outside-last-input-event last-input-event
- edebug-outside-last-event-frame last-event-frame
- edebug-outside-last-nonmenu-event last-nonmenu-event
- edebug-outside-track-mouse track-mouse
- edebug-outside-standard-output standard-output
- edebug-outside-standard-input standard-input
-
- edebug-outside-executing-macro executing-kbd-macro
- edebug-outside-defining-kbd-macro defining-kbd-macro
-
- edebug-outside-o-a-p overlay-arrow-position
- edebug-outside-o-a-s overlay-arrow-string
- edebug-outside-c-i-e-a cursor-in-echo-area
- edebug-outside-d-c-i-n-s-w (default-value
- 'cursor-in-non-selected-windows)
- )
-
- ;; Restore the outside saved values; don't alter
- ;; the outside binding loci.
- (setcdr edebug-outside-pre-command-hook pre-command-hook)
- (setcdr edebug-outside-post-command-hook post-command-hook)
-
- (setq-default cursor-in-non-selected-windows t)
- )) ; let
- ))
-
-(defvar cl-debug-env) ; defined in cl; non-nil when lexical env used.
+ (setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
+ (unwind-protect
+ (with-current-buffer edebug-outside-buffer ; of edebug-buffer
+ (goto-char edebug-outside-point)
+ (if (marker-buffer (edebug-mark-marker))
+ (set-marker (edebug-mark-marker) edebug-outside-mark))
+ ,@body)
+
+ ;; Back to edebug-buffer. Restore rest of inside context.
+ ;; (use-local-map edebug-inside-map)
+ (if edebug-save-windows
+ ;; Restore inside windows.
+ (edebug-set-windows edebug-inside-windows))
+
+ ;; Save values that may have been changed.
+ (setq edebug-outside-d-c-i-n-s-w
+ (default-value 'cursor-in-non-selected-windows))
+
+ ;; Restore the outside saved values; don't alter
+ ;; the outside binding loci.
+ (setq-default cursor-in-non-selected-windows t))))
(defun edebug-eval (expr)
- ;; Are there cl lexical variables active?
- (eval (if (and (bound-and-true-p cl-debug-env)
- (fboundp 'cl-macroexpand-all))
- (cl-macroexpand-all expr cl-debug-env)
- expr)
- lexical-binding))
+ (backtrace-eval expr 0 'edebug-after))
(defun edebug-safe-eval (expr)
;; Evaluate EXPR safely.
(remove-hook 'kill-buffer-hook 'edebug-kill-buffer t))
(pcase-dolist (`(,var . ,val) '((buffer-read-only . t)))
(push
- (if (local-variable-p var) var (cons var (symbol-value var)))
+ (if (local-variable-p var) (cons var (symbol-value var)) var)
edebug--mode-saved-vars)
(set (make-local-variable var) val))
;; Append `edebug-kill-buffer' to the hook to avoid interfering with
- ;; other entries that are ungarded against deleted buffer.
+ ;; other entries that are unguarded against deleted buffer.
(add-hook 'kill-buffer-hook 'edebug-kill-buffer t t)))
(defun edebug-kill-buffer ()
(eq (nth 1 (nth 1 frame1)) '())
(eq (nth 1 frame2) 'edebug-enter))
;; `edebug-enter' calls itself on its first invocation.
- (if (eq (nth 1 (internal--called-interactively-p--get-frame i))
+ (if (eq (nth 1 (backtrace-frame i 'called-interactively-p))
'edebug-enter)
2 1)))
'edebug--called-interactively-skip)
(remove-hook 'cl-read-load-hooks 'edebug--require-cl-read)
(edebug-uninstall-read-eval-functions)
- ;; continue standard unloading
+ ;; Continue standard unloading.
nil)
(provide 'edebug)
-
;;; edebug.el ends here