Commit 56ea7291 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Add support for lexical variables to the debugger's `e' command.

* lisp/emacs-lisp/debug.el (debug): Don't let-bind the debugger-outer-*
vars, except for debugger-outer-match-data.
(debugger-frame-number): Move check for "on a function call" from
callers into it.  Add `skip-base' argument.
(debugger-frame, debugger-frame-clear): Simplify accordingly.
(debugger-env-macro): Only reset the state stored in non-variables,
i.e. current-buffer and match-data.
(debugger-eval-expression): Rewrite using backtrace-eval.
* lisp/subr.el (internal--called-interactively-p--get-frame): Remove.
(called-interactively-p):
* lisp/emacs-lisp/edebug.el (edebug--called-interactively-skip): Use the new
`base' arg of backtrace-frame instead.
* src/eval.c (set_specpdl_old_value): New function.
(unbind_to): Minor simplification.
(get_backtrace_frame): New function.
(Fbacktrace_frame): Use it.  Add `base' argument.
(backtrace_eval_unrewind, Fbacktrace_eval): New functions.
(syms_of_eval): Export backtrace-eval.
* src/xterm.c (x_focus_changed): Simplify.
parent f6b15024
......@@ -158,6 +158,10 @@ You can pick the name of the function and the variables with `C-x 4 a'.
* Changes in Specialized Modes and Packages in Emacs 24.4
** The debugger's `e' command evaluates the code in the context at point.
This includes using the lexical environment at point, which means that
`e' now lets you access lexical variables as well.
** `eshell' now supports visual subcommands and options
Eshell has been able to handle "visual" commands (interactive,
non-line oriented commands such as top that require display
......
2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
Add support for lexical variables to the debugger's `e' command.
* emacs-lisp/debug.el (debug): Don't let-bind the debugger-outer-*
vars, except for debugger-outer-match-data.
(debugger-frame-number): Move check for "on a function call" from
callers into it. Add `skip-base' argument.
(debugger-frame, debugger-frame-clear): Simplify accordingly.
(debugger-env-macro): Only reset the state stored in non-variables,
i.e. current-buffer and match-data.
(debugger-eval-expression): Rewrite using backtrace-eval.
* subr.el (internal--called-interactively-p--get-frame): Remove.
(called-interactively-p):
* emacs-lisp/edebug.el (edebug--called-interactively-skip): Use the new
`base' arg of backtrace-frame instead.
2013-07-26 Glenn Morris <rgm@gnu.org>
* align.el (align-regexp): Doc fix. (Bug#14857)
......
......@@ -102,22 +102,6 @@ The value used here is passed to `quit-restore-window'."
This is to optimize `debugger-make-xrefs'.")
(defvar debugger-outer-match-data)
(defvar debugger-outer-load-read-function)
(defvar debugger-outer-overriding-local-map)
(defvar debugger-outer-overriding-terminal-local-map)
(defvar debugger-outer-track-mouse)
(defvar debugger-outer-last-command)
(defvar debugger-outer-this-command)
(defvar debugger-outer-unread-command-events)
(defvar debugger-outer-unread-post-input-method-events)
(defvar debugger-outer-last-input-event)
(defvar debugger-outer-last-command-event)
(defvar debugger-outer-last-nonmenu-event)
(defvar debugger-outer-last-event-frame)
(defvar debugger-outer-standard-input)
(defvar debugger-outer-standard-output)
(defvar debugger-outer-inhibit-redisplay)
(defvar debugger-outer-cursor-in-echo-area)
(defvar debugger-will-be-back nil
"Non-nil if we expect to get back in the debugger soon.")
......@@ -174,24 +158,6 @@ first will be printed into the backtrace buffer."
;; Save the outer values of these vars for the `e' command
;; before we replace the values.
(debugger-outer-match-data (match-data))
(debugger-outer-load-read-function load-read-function)
(debugger-outer-overriding-local-map overriding-local-map)
(debugger-outer-overriding-terminal-local-map
overriding-terminal-local-map)
(debugger-outer-track-mouse track-mouse)
(debugger-outer-last-command last-command)
(debugger-outer-this-command this-command)
(debugger-outer-unread-command-events unread-command-events)
(debugger-outer-unread-post-input-method-events
unread-post-input-method-events)
(debugger-outer-last-input-event last-input-event)
(debugger-outer-last-command-event last-command-event)
(debugger-outer-last-nonmenu-event last-nonmenu-event)
(debugger-outer-last-event-frame last-event-frame)
(debugger-outer-standard-input standard-input)
(debugger-outer-standard-output standard-output)
(debugger-outer-inhibit-redisplay inhibit-redisplay)
(debugger-outer-cursor-in-echo-area cursor-in-echo-area)
(debugger-with-timeout-suspend (with-timeout-suspend)))
;; Set this instead of binding it, so that `q'
;; will not restore it.
......@@ -294,26 +260,6 @@ first will be printed into the backtrace buffer."
(funcall (nth 0 debugger-previous-state))))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
;; Put into effect the modified values of these variables
;; in case the user set them with the `e' command.
(setq load-read-function debugger-outer-load-read-function)
(setq overriding-local-map debugger-outer-overriding-local-map)
(setq overriding-terminal-local-map
debugger-outer-overriding-terminal-local-map)
(setq track-mouse debugger-outer-track-mouse)
(setq last-command debugger-outer-last-command)
(setq this-command debugger-outer-this-command)
(setq unread-command-events debugger-outer-unread-command-events)
(setq unread-post-input-method-events
debugger-outer-unread-post-input-method-events)
(setq last-input-event debugger-outer-last-input-event)
(setq last-command-event debugger-outer-last-command-event)
(setq last-nonmenu-event debugger-outer-last-nonmenu-event)
(setq last-event-frame debugger-outer-last-event-frame)
(setq standard-input debugger-outer-standard-input)
(setq standard-output debugger-outer-standard-output)
(setq inhibit-redisplay debugger-outer-inhibit-redisplay)
(setq cursor-in-echo-area debugger-outer-cursor-in-echo-area)
(setq debug-on-next-call debugger-step-after-exit)
debugger-value)))
......@@ -518,18 +464,21 @@ removes itself from that hook."
(setq debugger-jumping-flag nil)
(remove-hook 'post-command-hook 'debugger-reenable))
(defun debugger-frame-number ()
(defun debugger-frame-number (&optional skip-base)
"Return number of frames in backtrace before the one point points at."
(save-excursion
(beginning-of-line)
(if (looking-at " *;;;\\|[a-z]")
(error "This line is not a function call"))
(let ((opoint (point))
(count 0))
(while (not (eq (cadr (backtrace-frame count)) 'debug))
(setq count (1+ count)))
;; Skip debug--implement-debug-on-entry frame.
(when (eq 'debug--implement-debug-on-entry
(cadr (backtrace-frame (1+ count))))
(setq count (+ 2 count)))
(unless skip-base
(while (not (eq (cadr (backtrace-frame count)) 'debug))
(setq count (1+ count)))
;; Skip debug--implement-debug-on-entry frame.
(when (eq 'debug--implement-debug-on-entry
(cadr (backtrace-frame (1+ count))))
(setq count (+ 2 count))))
(goto-char (point-min))
(when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
(goto-char (match-end 0))
......@@ -551,12 +500,8 @@ removes itself from that hook."
"Request entry to debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(interactive)
(save-excursion
(beginning-of-line)
(if (looking-at " *;;;\\|[a-z]")
(error "This line is not a function call")))
(beginning-of-line)
(backtrace-debug (debugger-frame-number) t)
(beginning-of-line)
(if (= (following-char) ? )
(let ((inhibit-read-only t))
(delete-char 1)
......@@ -567,12 +512,8 @@ Applies to the frame whose line point is on in the backtrace."
"Do not enter debugger when this frame exits.
Applies to the frame whose line point is on in the backtrace."
(interactive)
(save-excursion
(beginning-of-line)
(if (looking-at " *;;;\\|[a-z]")
(error "This line is not a function call")))
(beginning-of-line)
(backtrace-debug (debugger-frame-number) nil)
(beginning-of-line)
(if (= (following-char) ?*)
(let ((inhibit-read-only t))
(delete-char 1)
......@@ -583,59 +524,33 @@ Applies to the frame whose line point is on in the backtrace."
"Run BODY in original environment."
(declare (indent 0))
`(save-excursion
(if (null (buffer-name debugger-old-buffer))
(if (null (buffer-live-p debugger-old-buffer))
;; old buffer deleted
(setq debugger-old-buffer (current-buffer)))
(set-buffer debugger-old-buffer)
(let ((load-read-function debugger-outer-load-read-function)
(overriding-terminal-local-map
debugger-outer-overriding-terminal-local-map)
(overriding-local-map debugger-outer-overriding-local-map)
(track-mouse debugger-outer-track-mouse)
(last-command debugger-outer-last-command)
(this-command debugger-outer-this-command)
(unread-command-events debugger-outer-unread-command-events)
(unread-post-input-method-events
debugger-outer-unread-post-input-method-events)
(last-input-event debugger-outer-last-input-event)
(last-command-event debugger-outer-last-command-event)
(last-nonmenu-event debugger-outer-last-nonmenu-event)
(last-event-frame debugger-outer-last-event-frame)
(standard-input debugger-outer-standard-input)
(standard-output debugger-outer-standard-output)
(inhibit-redisplay debugger-outer-inhibit-redisplay)
(cursor-in-echo-area debugger-outer-cursor-in-echo-area))
(set-match-data debugger-outer-match-data)
(prog1
(progn ,@body)
(setq debugger-outer-match-data (match-data))
(setq debugger-outer-load-read-function load-read-function)
(setq debugger-outer-overriding-terminal-local-map
overriding-terminal-local-map)
(setq debugger-outer-overriding-local-map overriding-local-map)
(setq debugger-outer-track-mouse track-mouse)
(setq debugger-outer-last-command last-command)
(setq debugger-outer-this-command this-command)
(setq debugger-outer-unread-command-events unread-command-events)
(setq debugger-outer-unread-post-input-method-events
unread-post-input-method-events)
(setq debugger-outer-last-input-event last-input-event)
(setq debugger-outer-last-command-event last-command-event)
(setq debugger-outer-last-nonmenu-event last-nonmenu-event)
(setq debugger-outer-last-event-frame last-event-frame)
(setq debugger-outer-standard-input standard-input)
(setq debugger-outer-standard-output standard-output)
(setq debugger-outer-inhibit-redisplay inhibit-redisplay)
(setq debugger-outer-cursor-in-echo-area cursor-in-echo-area)
))))
(set-match-data debugger-outer-match-data)
(prog1
(progn ,@body)
(setq debugger-outer-match-data (match-data)))))
(defun debugger-eval-expression (exp)
"Eval an expression, in an environment like that outside the debugger."
"Eval an expression, in an environment like that outside the debugger.
The environment used is the one when entering the activation frame at point."
(interactive
(list (read-from-minibuffer "Eval: "
nil read-expression-map t
'read-expression-history)))
(debugger-env-macro (eval-expression exp)))
(let ((nframe (condition-case nil (1+ (debugger-frame-number 'skip-base))
(error 0))) ;; If on first line.
(base (if (eq 'debug--implement-debug-on-entry
(cadr (backtrace-frame 1 'debug)))
'debug--implement-debug-on-entry 'debug)))
(debugger-env-macro
(let ((val (backtrace-eval exp nframe base)))
(prog1
(prin1 val t)
(let ((str (eval-expression-print-format val)))
(if str (princ str t))))))))
(defvar debugger-mode-map
(let ((map (make-keymap))
......
......@@ -4268,7 +4268,7 @@ With prefix argument, make it a temporary breakpoint."
(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)))
......
......@@ -4191,22 +4191,6 @@ I is the index of the frame after FRAME2. It should return nil
if those frames don't seem special and otherwise, it should return
the number of frames to skip (minus 1).")
(defmacro internal--called-interactively-p--get-frame (n)
;; `sym' will hold a global variable, which will be used kind of like C's
;; "static" variables.
(let ((sym (make-symbol "base-index")))
`(progn
(defvar ,sym)
(unless (boundp ',sym)
(let ((i 1))
(while (not (eq (indirect-function (nth 1 (backtrace-frame i)) t)
(indirect-function 'called-interactively-p)))
(setq i (1+ i)))
(setq ,sym i)))
;; (unless (eq (nth 1 (backtrace-frame ,sym)) 'called-interactively-p)
;; (error "called-interactively-p: %s is out-of-sync!" ,sym))
(backtrace-frame (+ ,sym ,n)))))
(defun called-interactively-p (&optional kind)
"Return t if the containing function was called by `call-interactively'.
If KIND is `interactive', then only return t if the call was made
......@@ -4241,7 +4225,7 @@ command is called from a keyboard macro?"
(get-next-frame
(lambda ()
(setq frame nextframe)
(setq nextframe (internal--called-interactively-p--get-frame i))
(setq nextframe (backtrace-frame i 'called-interactively-p))
;; (message "Frame %d = %S" i nextframe)
(setq i (1+ i)))))
(funcall get-next-frame) ;; Get the first frame.
......
2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
* eval.c (set_specpdl_old_value): New function.
(unbind_to): Minor simplification.
(get_backtrace_frame): New function.
(Fbacktrace_frame): Use it. Add `base' argument.
(backtrace_eval_unrewind, Fbacktrace_eval): New functions.
(syms_of_eval): Export backtrace-eval.
* xterm.c (x_focus_changed): Simplify.
2013-07-25 Paul Eggert <eggert@cs.ucla.edu>
* fileio.c (Finsert_file_contents): Avoid double-close (Bug#14936).
......
......@@ -138,6 +138,13 @@ specpdl_old_value (union specbinding *pdl)
return pdl->let.old_value;
}
static void
set_specpdl_old_value (union specbinding *pdl, Lisp_Object val)
{
eassert (pdl->kind >= SPECPDL_LET);
pdl->let.old_value = val;
}
static Lisp_Object
specpdl_where (union specbinding *pdl)
{
......@@ -3301,6 +3308,8 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
case SPECPDL_UNWIND_VOID:
specpdl_ptr->unwind_void.func ();
break;
case SPECPDL_BACKTRACE:
break;
case SPECPDL_LET:
/* If variable has a trivial value (no forwarding), we can
just set it. No need to check for constant symbols here,
......@@ -3315,27 +3324,20 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
Fset_default (specpdl_symbol (specpdl_ptr),
specpdl_old_value (specpdl_ptr));
break;
case SPECPDL_BACKTRACE:
case SPECPDL_LET_DEFAULT:
Fset_default (specpdl_symbol (specpdl_ptr),
specpdl_old_value (specpdl_ptr));
break;
case SPECPDL_LET_LOCAL:
case SPECPDL_LET_DEFAULT:
{ /* If the symbol is a list, it is really (SYMBOL WHERE
. CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
frame. If WHERE is a buffer or frame, this indicates we
bound a variable that had a buffer-local or frame-local
binding. WHERE nil means that the variable had the default
value when it was bound. CURRENT-BUFFER is the buffer that
was current when the variable was bound. */
{
Lisp_Object symbol = specpdl_symbol (specpdl_ptr);
Lisp_Object where = specpdl_where (specpdl_ptr);
Lisp_Object old_value = specpdl_old_value (specpdl_ptr);
eassert (BUFFERP (where));
if (specpdl_ptr->kind == SPECPDL_LET_DEFAULT)
Fset_default (symbol, old_value);
/* If this was a local binding, reset the value in the appropriate
buffer, but only if that buffer's binding still exists. */
else if (!NILP (Flocal_variable_p (symbol, where)))
if (!NILP (Flocal_variable_p (symbol, where)))
set_internal (symbol, old_value, where, 1);
}
break;
......@@ -3422,7 +3424,30 @@ Output stream used is value of `standard-output'. */)
return Qnil;
}
DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, NULL,
union specbinding *
get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
{
union specbinding *pdl = backtrace_top ();
register EMACS_INT i;
CHECK_NATNUM (nframes);
if (!NILP (base))
{ /* Skip up to `base'. */
base = Findirect_function (base, Qt);
while (backtrace_p (pdl)
&& !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
pdl = backtrace_next (pdl);
}
/* Find the frame requested. */
for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--)
pdl = backtrace_next (pdl);
return pdl;
}
DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 2, NULL,
doc: /* Return the function and arguments NFRAMES up from current execution point.
If that frame has not evaluated the arguments yet (or is a special form),
the value is (nil FUNCTION ARG-FORMS...).
......@@ -3431,17 +3456,12 @@ the value is (t FUNCTION ARG-VALUES...).
A &rest arg is represented as the tail of the list ARG-VALUES.
FUNCTION is whatever was supplied as car of evaluated list,
or a lambda expression for macro calls.
If NFRAMES is more than the number of frames, the value is nil. */)
(Lisp_Object nframes)
If NFRAMES is more than the number of frames, the value is nil.
If BASE is non-nil, it should be a function and NFRAMES counts from its
nearest activation frame. */)
(Lisp_Object nframes, Lisp_Object base)
{
union specbinding *pdl = backtrace_top ();
register EMACS_INT i;
CHECK_NATNUM (nframes);
/* Find the frame requested. */
for (i = 0; backtrace_p (pdl) && i < XFASTINT (nframes); i++)
pdl = backtrace_next (pdl);
union specbinding *pdl = get_backtrace_frame (nframes, base);
if (!backtrace_p (pdl))
return Qnil;
......@@ -3456,6 +3476,108 @@ If NFRAMES is more than the number of frames, the value is nil. */)
}
}
/* For backtrace-eval, we want to temporarily unwind the last few elements of
the specpdl stack, and then rewind them. We store the pre-unwind values
directly in the pre-existing specpdl elements (i.e. we swap the current
value and the old value stored in the specpdl), kind of like the inplace
pointer-reversal trick. As it turns out, the rewind does the same as the
unwind, except it starts from the other end of the spepdl stack, so we use
the same function for both unwind and rewind. */
void
backtrace_eval_unrewind (int distance)
{
union specbinding *tmp = specpdl_ptr;
int step = -1;
if (distance < 0)
{ /* It's a rewind rather than unwind. */
tmp += distance - 1;
step = 1;
distance = -distance;
}
for (; distance > 0; distance--)
{
tmp += step;
/* */
switch (tmp->kind)
{
/* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
unwind_protect, but the problem is that we don't know how to
rewind them afterwards. */
case SPECPDL_UNWIND:
case SPECPDL_UNWIND_PTR:
case SPECPDL_UNWIND_INT:
case SPECPDL_UNWIND_VOID:
case SPECPDL_BACKTRACE:
break;
case SPECPDL_LET:
/* If variable has a trivial value (no forwarding), we can
just set it. No need to check for constant symbols here,
since that was already done by specbind. */
if (XSYMBOL (specpdl_symbol (tmp))->redirect
== SYMBOL_PLAINVAL)
{
struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (tmp));
Lisp_Object old_value = specpdl_old_value (tmp);
set_specpdl_old_value (tmp, SYMBOL_VAL (sym));
SET_SYMBOL_VAL (sym, old_value);
break;
}
else
/* FALLTHROUGH!
NOTE: we only ever come here if make_local_foo was used for
the first time on this var within this let. */
;
case SPECPDL_LET_DEFAULT:
{
Lisp_Object sym = specpdl_symbol (tmp);
Lisp_Object old_value = specpdl_old_value (tmp);
set_specpdl_old_value (tmp, Fdefault_value (sym));
Fset_default (sym, old_value);
}
break;
case SPECPDL_LET_LOCAL:
{
Lisp_Object symbol = specpdl_symbol (tmp);
Lisp_Object where = specpdl_where (tmp);
Lisp_Object old_value = specpdl_old_value (tmp);
eassert (BUFFERP (where));
/* If this was a local binding, reset the value in the appropriate
buffer, but only if that buffer's binding still exists. */
if (!NILP (Flocal_variable_p (symbol, where)))
{
set_specpdl_old_value
(tmp, Fbuffer_local_value (symbol, where));
set_internal (symbol, old_value, where, 1);
}
}
break;
}
}
}
DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL,
doc: /* Evaluate EXP in the context of some activation frame.
NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
(Lisp_Object exp, Lisp_Object nframes, Lisp_Object base)
{
union specbinding *pdl = get_backtrace_frame (nframes, base);
ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t distance = specpdl_ptr - pdl;
eassert (distance >= 0);
if (!backtrace_p (pdl))
error ("Activation frame not found!");
backtrace_eval_unrewind (distance);
record_unwind_protect_int (backtrace_eval_unrewind, -distance);
/* Use eval_sub rather than Feval since the main motivation behind
backtrace-eval is to be able to get/set the value of lexical variables
from the debugger. */
return unbind_to (count, eval_sub (exp));
}
void
mark_specpdl (void)
......@@ -3701,6 +3823,7 @@ alist of active lexical bindings. */);
defsubr (&Sbacktrace_debug);
defsubr (&Sbacktrace);
defsubr (&Sbacktrace_frame);
defsubr (&Sbacktrace_eval);
defsubr (&Sspecial_variable_p);
defsubr (&Sfunctionp);
}
......@@ -3435,17 +3435,10 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra
/* Don't stop displaying the initial startup message
for a switch-frame event we don't need. */
/* When run as a daemon, Vterminal_frame is always NIL. */
if ((NILP (Vterminal_frame) || EQ (Fdaemonp(), Qt))
&& CONSP (Vframe_list)
&& !NILP (XCDR (Vframe_list)))
{
bufp->arg = Qt;
}
else
{
bufp->arg = Qnil;
}
bufp->arg = (((NILP (Vterminal_frame) || EQ (Fdaemonp (), Qt))
&& CONSP (Vframe_list)
&& !NILP (XCDR (Vframe_list)))
? Qt : Qnil);
bufp->kind = FOCUS_IN_EVENT;
XSETFRAME (bufp->frame_or_window, frame);
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment