emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] trunk r113550: Add support for lexical variables to the de


From: Stefan Monnier
Subject: [Emacs-diffs] trunk r113550: Add support for lexical variables to the debugger's `e' command.
Date: Fri, 26 Jul 2013 07:39:28 +0000
User-agent: Bazaar (2.6b2)

------------------------------------------------------------
revno: 113550
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Fri 2013-07-26 03:38:18 -0400
message:
  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.
modified:
  etc/NEWS                       news-20100311060928-aoit31wvzf25yr1z-1
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/debug.el       debug.el-20091113204419-o5vbwnq5f7feedwu-398
  lisp/emacs-lisp/edebug.el      edebug.el-20091113204419-o5vbwnq5f7feedwu-483
  lisp/subr.el                   subr.el-20091113204419-o5vbwnq5f7feedwu-151
  src/ChangeLog                  changelog-20091113204419-o5vbwnq5f7feedwu-1438
  src/eval.c                     eval.c-20091113204419-o5vbwnq5f7feedwu-237
  src/xterm.c                    xterm.c-20091113204419-o5vbwnq5f7feedwu-244
=== modified file 'etc/NEWS'
--- a/etc/NEWS  2013-07-24 22:39:41 +0000
+++ b/etc/NEWS  2013-07-26 07:38:18 +0000
@@ -158,6 +158,10 @@
 
 * 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

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-07-26 02:45:15 +0000
+++ b/lisp/ChangeLog    2013-07-26 07:38:18 +0000
@@ -1,3 +1,19 @@
+2013-07-26  Stefan Monnier  <address@hidden>
+
+       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  <address@hidden>
 
        * align.el (align-regexp): Doc fix.  (Bug#14857)

=== modified file 'lisp/emacs-lisp/debug.el'
--- a/lisp/emacs-lisp/debug.el  2013-01-02 16:13:04 +0000
+++ b/lisp/emacs-lisp/debug.el  2013-07-26 07:38:18 +0000
@@ -102,22 +102,6 @@
 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 @@
          ;; 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 @@
                  (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 @@
   (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 @@
   "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 @@
   "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 @@
   "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))

=== modified file 'lisp/emacs-lisp/edebug.el'
--- a/lisp/emacs-lisp/edebug.el 2013-07-11 17:16:19 +0000
+++ b/lisp/emacs-lisp/edebug.el 2013-07-26 07:38:18 +0000
@@ -4268,7 +4268,7 @@
              (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)))
 

=== modified file 'lisp/subr.el'
--- a/lisp/subr.el      2013-07-22 17:24:31 +0000
+++ b/lisp/subr.el      2013-07-26 07:38:18 +0000
@@ -4191,22 +4191,6 @@
 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 @@
            (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.

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2013-07-25 07:29:36 +0000
+++ b/src/ChangeLog     2013-07-26 07:38:18 +0000
@@ -1,3 +1,13 @@
+2013-07-26  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * fileio.c (Finsert_file_contents): Avoid double-close (Bug#14936).

=== modified file 'src/eval.c'
--- a/src/eval.c        2013-07-24 06:21:07 +0000
+++ b/src/eval.c        2013-07-26 07:38:18 +0000
@@ -138,6 +138,13 @@
   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 @@
        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 @@
            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 @@
   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 @@
 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 @@
     }
 }
 
+/* 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 @@
   defsubr (&Sbacktrace_debug);
   defsubr (&Sbacktrace);
   defsubr (&Sbacktrace_frame);
+  defsubr (&Sbacktrace_eval);
   defsubr (&Sspecial_variable_p);
   defsubr (&Sfunctionp);
 }

=== modified file 'src/xterm.c'
--- a/src/xterm.c       2013-07-16 11:41:06 +0000
+++ b/src/xterm.c       2013-07-26 07:38:18 +0000
@@ -3435,17 +3435,10 @@
           /* 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);
         }


reply via email to

[Prev in Thread] Current Thread [Next in Thread]