bug#6454: 24.0.50; kill-buffer switches current-buffer

[Helmut Eller]

* martin rudalics [2010-06-20 12:42+0200] writes:

>> I'm wondering a bit though: kill-buffer protects the current buffer
>> while calling kill-buffer-hook.  Wouldn't it be prudent to do that for
>> the entire function?
>
> You mean for the case where the buffer we want to kill is not the
> current buffer?

Both cases.  Even in the case where the to-be-killed buffer is not
current, kill-buffer may decide not to actually kill it and instead
return nil; this case should also not switch the buffer.

>> Actually, I think there is a small bug there: if kill-buffer-hook is a
>> list of functions, the first function could potentially switch buffer
>> and the second function would be called in the wrong buffer.
>
> I suppose you're right.  Could you propose a patch for this and the
> above issue?

Below are two patches.  The first essentially adds a save-excursion
around the whole function.

The second patch adds a function run_hook_in_buffer. It iterates over
the functions in the hook and for each function explicitly sets the
buffer before calling it.  I had to introduce a new macro
DO_HOOK_FUNCTIONS which is a big hammer for this, but I couldn't find a
better way.

Helmut

=== modified file 'src/buffer.c'
--- src/buffer.c        2010-06-05 00:41:32 +0000
+++ src/buffer.c        2010-06-20 17:24:02 +0000
@@ -1413,6 +1413,9 @@
   register struct Lisp_Marker *m;
   struct gcpro gcpro1;
 
+  int count = SPECPDL_INDEX ();
+  record_unwind_protect (save_excursion_restore, save_excursion_save ());
+
   if (NILP (buffer_or_name))
     buffer = Fcurrent_buffer ();
   else
@@ -1424,7 +1427,7 @@
 
   /* Avoid trouble for buffer already dead.  */
   if (NILP (b->name))
-    return Qnil;
+    return unbind_to (count, Qnil);
 
   /* Query if the buffer is still modified.  */
   if (INTERACTIVE && !NILP (b->filename)
@@ -1435,15 +1438,13 @@
                                     b->name, make_number (0)));
       UNGCPRO;
       if (NILP (tem))
-       return Qnil;
+       return unbind_to (count, Qnil);
     }
 
   /* Run hooks with the buffer to be killed the current buffer.  */
   {
-    int count = SPECPDL_INDEX ();
     Lisp_Object arglist[1];
 
-    record_unwind_protect (save_excursion_restore, save_excursion_save ());
     set_buffer_internal (b);
 
     /* First run the query functions; if any query is answered no,
@@ -1455,7 +1456,6 @@
 
     /* Then run the hooks.  */
     Frun_hooks (1, &Qkill_buffer_hook);
-    unbind_to (count, Qnil);
   }
 
   /* We have no more questions to ask.  Verify that it is valid
@@ -1464,10 +1464,10 @@
 
   /* Don't kill the minibuffer now current.  */
   if (EQ (buffer, XWINDOW (minibuf_window)->buffer))
-    return Qnil;
+    return unbind_to (count, Qnil);
 
   if (NILP (b->name))
-    return Qnil;
+    return unbind_to (count, Qnil);
 
   /* When we kill a base buffer, kill all its indirect buffers.
      We do it at this stage so nothing terrible happens if they
@@ -1499,7 +1499,7 @@
       tem = Fother_buffer (buffer, Qnil, Qnil);
       Fset_buffer (tem);
       if (b == current_buffer)
-       return Qnil;
+       return unbind_to (count, Qnil);
     }
 
   /* Notice if the buffer to kill is the sole visible buffer
@@ -1509,7 +1509,7 @@
     {
       tem = Fother_buffer (buffer, Qnil, Qnil);
       if (EQ (buffer, tem))
-       return Qnil;
+       return unbind_to (count, Qnil);
     }
 
   /* Now there is no question: we can kill the buffer.  */
@@ -1527,7 +1527,7 @@
      have called kill-buffer.  */
 
   if (NILP (b->name))
-    return Qnil;
+    return unbind_to (count, Qnil);
 
   clear_charpos_cache (b);
 
@@ -1609,7 +1609,7 @@
   UNBLOCK_INPUT;
   b->undo_list = Qnil;
 
-  return Qt;
+  return unbind_to (count, Qt);
 }
 
 /* Move the assoc for buffer BUF to the front of buffer-alist.  Since

=== modified file 'src/buffer.c'
--- src/buffer.c        2010-06-20 17:24:02 +0000
+++ src/buffer.c        2010-06-20 17:35:19 +0000
@@ -1382,6 +1382,34 @@
   return Qnil;
 }
 
+/* Run the hook HOOK in buffer BUFFER.
+   Make sure that each function is called in BUFFER.
+   Return the value returned by the last function. */
+static Lisp_Object
+run_hook_in_buffer (Lisp_Object hook, Lisp_Object buffer)
+{
+  Lisp_Object ret = Qnil;
+  struct gcpro gcpro1;
+  register struct buffer *b = XBUFFER (buffer);
+  int count = SPECPDL_INDEX ();
+  GCPRO1 (ret);
+
+  record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
+  set_buffer_internal (b);
+  {
+    DO_HOOK_FUNCTIONS (state, hook, fun) 
+      {
+       eassert (b->name);
+       /* set again, because calling a function may switch buffer */
+       set_buffer_internal (b);
+       ret = call0 (fun);
+      }
+    UNGCPRO;
+  }
+  UNGCPRO;
+  return unbind_to (count, ret);
+}
+
 /*
   DEFVAR_LISP ("kill-buffer-hook", no_cell, "\
 Hook to be run (by `run-hooks', which see) when a buffer is killed.\n\
@@ -1455,7 +1483,7 @@
       return unbind_to (count, Qnil);
 
     /* Then run the hooks.  */
-    Frun_hooks (1, &Qkill_buffer_hook);
+    run_hook_in_buffer (Qkill_buffer_hook, buffer);
   }
 
   /* We have no more questions to ask.  Verify that it is valid

=== modified file 'src/eval.c'
--- src/eval.c  2010-05-14 17:53:42 +0000
+++ src/eval.c  2010-06-20 17:35:19 +0000
@@ -2673,13 +2673,62 @@
   return run_hook_with_args (nargs, args, until_failure);
 }
 
+/* Move to the next iteration state and return the current function.
+   Return Qunbound as end indicator. */
+Lisp_Object
+hook_iterator_next (struct hook_iterator_state* state)
+{
+  Lisp_Object val = state->val;
+  Lisp_Object globals = state->globals;
+
+  if (NILP (globals))
+    {
+      if (EQ (val, Qunbound) || NILP (val))
+       return Qunbound;  /* loop end marker */
+      if (!CONSP (val) || EQ (XCAR (val), Qlambda))
+       {
+         state->val = Qnil;
+         return val;
+       }
+      if (EQ (XCAR (val), Qt))
+       {
+         /* t indicates this hook has a local binding;
+            it means to run the global binding too.  */
+         state->val = XCDR (val);
+         state->globals = Fdefault_value (state->sym);
+         return hook_iterator_next (state);
+       }
+      else
+       {
+         state->val = XCDR (val);
+         return XCAR (val);
+       }
+    }
+
+  else if (!CONSP (globals) || EQ (XCAR (globals), Qlambda))
+    {
+      state->globals = Qnil;
+      return globals;
+    }
+  else
+    {
+      state->globals = XCDR (globals);
+      /* In a global value, t should not occur.  If it does, we
+        must ignore it to avoid an endless loop.  */
+      if (XCAR (globals) == Qt)
+       return hook_iterator_next (state);
+      else
+       return XCAR (globals);
+    }
+}
+
 /* ARGS[0] should be a hook symbol.
    Call each of the functions in the hook value, passing each of them
    as arguments all the rest of ARGS (all NARGS - 1 elements).
    COND specifies a condition to test after each call
    to decide whether to stop.
    The caller (or its caller, etc) must gcpro all of ARGS,
-   except that it isn't necessary to gcpro ARGS[0].  */
+   except that it isn't necessary to gcpro ARGS[0]. */
 
 static Lisp_Object
 run_hook_with_args (nargs, args, cond)
@@ -2687,74 +2736,32 @@
      Lisp_Object *args;
      enum run_hooks_condition cond;
 {
-  Lisp_Object sym, val, ret;
-  struct gcpro gcpro1, gcpro2, gcpro3;
+  Lisp_Object ret;
+  struct gcpro gcpro1;
 
   /* If we are dying or still initializing,
      don't do anything--it would probably crash if we tried.  */
   if (NILP (Vrun_hooks))
     return Qnil;
 
-  sym = args[0];
-  val = find_symbol_value (sym);
   ret = (cond == until_failure ? Qt : Qnil);
-
-  if (EQ (val, Qunbound) || NILP (val))
-    return ret;
-  else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
-    {
-      args[0] = val;
-      return Ffuncall (nargs, args);
-    }
-  else
-    {
-      Lisp_Object globals = Qnil;
-      GCPRO3 (sym, val, globals);
-
-      for (;
-          CONSP (val) && ((cond == to_completion)
-                          || (cond == until_success ? NILP (ret)
-                              : !NILP (ret)));
-          val = XCDR (val))
-       {
-         if (EQ (XCAR (val), Qt))
-           {
-             /* t indicates this hook has a local binding;
-                it means to run the global binding too.  */
-             globals = Fdefault_value (sym);
-             if (NILP (globals)) continue;
-
-             if (!CONSP (globals) || EQ (XCAR (globals), Qlambda))
-               {
-                 args[0] = globals;
-                 ret = Ffuncall (nargs, args);
-               }
-             else
-               {
-                 for (;
-                      CONSP (globals) && ((cond == to_completion)
-                                          || (cond == until_success ? NILP 
(ret)
-                                              : !NILP (ret)));
-                      globals = XCDR (globals))
-                   {
-                     args[0] = XCAR (globals);
-                     /* In a global value, t should not occur.  If it does, we
-                        must ignore it to avoid an endless loop.  */
-                     if (!EQ (args[0], Qt))
-                       ret = Ffuncall (nargs, args);
-                   }
-               }
-           }
-         else
-           {
-             args[0] = XCAR (val);
-             ret = Ffuncall (nargs, args);
-           }
-       }
-
-      UNGCPRO;
-      return ret;
-    }
+  GCPRO1 (ret);
+
+  {
+    DO_HOOK_FUNCTIONS (state, args[0], fun)
+      {
+       if ((cond == until_success) && !NILP (ret))
+         break;
+       if ((cond == until_failure) && NILP (ret))
+         break;
+       args[0] = fun;
+       ret = Ffuncall (nargs, args);
+      }
+    UNGCPRO;
+  }
+
+  UNGCPRO;
+  return ret;
 }
 
 /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual

=== modified file 'src/lisp.h'
--- src/lisp.h  2010-06-09 22:08:50 +0000
+++ src/lisp.h  2010-06-20 17:35:19 +0000
@@ -2853,6 +2853,40 @@
 EXFUN (Frun_hook_with_args_until_failure, MANY);
 extern Lisp_Object run_hook_list_with_args P_ ((Lisp_Object, int, Lisp_Object 
*));
 extern void run_hook_with_args_2 P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
+
+/* Set up a while loop to iterate over the functions of a hook.
+   STATE a variable used to hold iteration state
+   HOOK_SYMBOL an expression which evaluates to the hook symbol
+   VAR variable to bind to function values
+
+   The macro needs to be used at the beginning of a block and
+   UNGCPRO must be called at the end, e.g.:
+   {
+     DO_HOOK_FUNCTIONS (state, Qkill_buffer_hook, fun) {
+       call0 (fun);
+     }
+     UNGCPRO;
+   }
+
+   Since this is a while loop, "break" can be used to terminate the
+   loop. */
+#define DO_HOOK_FUNCTIONS(STATE, HOOK_SYMBOL, VAR)             \
+  struct hook_iterator_state STATE = { Qnil, Qnil, Qnil };     \
+  struct gcpro gcpro1, gcpro2, gcpro3;                         \
+  Lisp_Object VAR;                                             \
+  GCPRO3 ((STATE.sym), (STATE.val), (STATE.globals));          \
+  STATE.sym = HOOK_SYMBOL;                                     \
+  STATE.val = find_symbol_value (STATE.sym);                   \
+  while (!EQ ((VAR = hook_iterator_next (&STATE)), Qunbound))
+
+/* used by the macro above */
+struct hook_iterator_state {
+  Lisp_Object sym;             /* hook symbol; read-only */
+  Lisp_Object val;             /* (buffer-local) value */
+  Lisp_Object globals;         /* global value */
+};
+Lisp_Object hook_iterator_next (struct hook_iterator_state*);
+
 EXFUN (Fand, UNEVALLED);
 EXFUN (For, UNEVALLED);
 EXFUN (Fif, UNEVALLED);