From 861c841eb242c474c66421ce4d9964940033ff31 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Pit--Claudel?= <address@hidden>
Date: Mon, 5 Dec 2016 00:52:14 -0500
Subject: [PATCH] New function mapbacktrace

---
 src/eval.c | 50 +++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 49 insertions(+), 1 deletion(-)

diff --git a/src/eval.c b/src/eval.c
index 724f001..dcda51c 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -3420,6 +3420,53 @@ The debugger is entered when that frame exits, if the flag is non-nil.  */)
   return flag;
 }
 
+DEFUN ("mapbacktrace", Fmapbacktrace, Smapbacktrace, 1, 2, 0,
+       doc: /* Call FUNCTION for each frame in backtrace.
+FUNCTION is called with 4 arguments EVALD FUNC ARGS FLAGS.  If a frame
+has not evaluated its arguments yet or is a special form, EVALD is nil
+and ARGS is a list of forms.  If a frame has evaluated its arguments
+and called its function already, EVALD is t and ARGS is a list of
+values.  FLAGS is a plist of properties of the current frame:
+currently, the only supported property is :debug-on-exit.
+If NSKIP is non-nil, the top NSKIP frames are skipped.
+`mapbacktrace' always returns nil.  */)
+     (Lisp_Object function, Lisp_Object nskip)
+{
+  union specbinding *pdl = backtrace_top ();
+
+  if (!NILP (nskip))
+    {
+      CHECK_NUMBER(nskip);
+      EMACS_INT to_skip = XINT(nskip);
+      while (to_skip > 0 && backtrace_p (pdl)) {
+        to_skip--;
+        pdl = backtrace_next (pdl);
+      }
+    }
+
+  while (backtrace_p (pdl))
+    {
+      Lisp_Object flags = Qnil;
+      if (backtrace_debug_on_exit (pdl))
+        {
+          flags = Fcons (QCdebug_on_exit, Fcons (Qt, Qnil));
+        }
+
+      if (backtrace_nargs (pdl) == UNEVALLED)
+        {
+          call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags);
+        }
+      else
+        {
+          Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
+          call4 (function, Qt, backtrace_function (pdl), tem, flags);
+        }
+      pdl = backtrace_next (pdl);
+    }
+
+  return Qnil;
+}
+
 DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
        doc: /* Print a trace of Lisp function calls currently active.
 Output stream used is value of `standard-output'.  */)
@@ -3973,7 +4020,8 @@ alist of active lexical bindings.  */);
   defsubr (&Srun_hook_wrapped);
   defsubr (&Sfetch_bytecode);
   defsubr (&Sbacktrace_debug);
-  defsubr (&Sbacktrace);
+  DEFSYM (QCdebug_on_exit, ":debug-on-exit");
+  defsubr (&Smapbacktrace);
   defsubr (&Sbacktrace_frame);
   defsubr (&Sbacktrace_eval);
   defsubr (&Sbacktrace__locals);
-- 
2.7.4