]> git.eshelyaron.com Git - emacs.git/commitdiff
New top-level buffer-local value functions
authorSean Whitton <spwhitton@spwhitton.name>
Tue, 13 May 2025 11:21:21 +0000 (12:21 +0100)
committerEshel Yaron <me@eshelyaron.com>
Tue, 20 May 2025 20:51:26 +0000 (22:51 +0200)
* src/eval.c (local_toplevel_binding)
(Fbuffer_local_toplevel_value, Fset_buffer_local_toplevel_value)
(syms_of_eval): New functions.
* doc/lispref/variables.texi (Default Value):
* lisp/subr.el (setq-local):
* etc/NEWS: Document them.
* test/lisp/emacs-lisp/lisp-tests.el
(core-elisp-tests-4-toplevel-values): New test.
* lisp/progmodes/xref.el (xref--show-xref-buffer)
(xref-show-definitions-buffer-at-bottom):
* lisp/vc/vc-dispatcher.el (vc-setup-buffer):
Use set-buffer-local-toplevel-value.

(cherry picked from commit 45627ca7ccd0e84452d497997a7f75535ed83864)

doc/lispref/variables.texi
lisp/progmodes/xref.el
lisp/subr.el
lisp/vc/vc-dispatcher.el
src/eval.c
src/lisp.h
test/lisp/emacs-lisp/lisp-tests.el

index c007d857c37bf2789f754e1d62ea56391d0424dc..005db3401b12a09f01b898d933d15511d17ff957 100644 (file)
@@ -1941,6 +1941,38 @@ global value of @var{symbol} regardless of whether your code runs in
 the context of @var{symbol}'s let-binding.
 @end defun
 
+@cindex top-level buffer-local value
+  In addition, a variable's buffer-local value may be shadowed by a
+let-binding.  There are two further functions to get and set the
+top-level buffer-local value of a variable.
+
+@defun buffer-local-toplevel-value symbol &optional buffer
+This function returns the local value for @var{symbol} in @var{buffer},
+defaulting to the current buffer, outside of any let-binding.  If
+@var{symbol} is not local in @var{buffer}, this function signals an
+error.
+@end defun
+
+@defun set-buffer-local-toplevel-value symbol value &optional buffer
+This function sets the local value of @var{symbol} to @var{value} in
+@var{buffer}, defaulting to the current buffer, outside of any
+let-binding.
+
+@var{symbol} is made local in @var{buffer} if it was not already.  For
+global variables, this means @var{symbol} will have a separate value in
+@var{buffer}; for variables that are automatically buffer-local, this
+function causes a local value for them to exist in @var{buffer}.  If
+@var{symbol} is permanently buffer-local, @var{value} will now persist
+as the buffer-local value for the variable across changes of major mode.
+
+This is useful when you want to make a change to a buffer-local value
+that will persist after the command now being executed completes, but
+where your code may be executed with that variable let-bound.  In this
+case the usual tool for setting buffer-local values, @code{setq-local},
+will only change the value of the let-binding, and not the underlying
+buffer-local value.  This function sets the latter.
+@end defun
+
 
 @node File Local Variables
 @section File Local Variables
index 0ba209bc72d37f734923cd6dd80b016ea51e41f7..b5b2e368e43bfd107676ceed2a6c0f64cf4296de 100644 (file)
@@ -1372,7 +1372,9 @@ this variable to an alist with the following key-value pairs:
          (xref-alist (xref--analyze xrefs))
          (dd default-directory))
     (with-current-buffer (get-buffer-create xref-buffer-name)
-      (xref--ensure-default-directory dd (current-buffer))
+      (if (fboundp 'set-buffer-local-toplevel-value)
+          (set-buffer-local-toplevel-value 'default-directory dd)
+        (xref--ensure-default-directory dd (current-buffer)))
       (xref--xref-buffer-mode)
       (xref--show-common-initialize xref-alist fetcher (append xref-fetcher-alist alist))
       (setq mode-line-process (list xref-mode-line-matches))
@@ -1495,7 +1497,9 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'."
       (setq xref-alist (xref--analyze xrefs))
 
       (with-current-buffer (get-buffer-create xref-buffer-name)
-        (xref--ensure-default-directory dd (current-buffer))
+        (if (fboundp 'set-buffer-local-toplevel-value)
+            (set-buffer-local-toplevel-value 'default-directory dd)
+          (xref--ensure-default-directory dd (current-buffer)))
         (xref--transient-buffer-mode)
         (xref--show-common-initialize xref-alist fetcher (append xref-fetcher-alist alist))
         (pop-to-buffer (current-buffer)
index bbd0b32a31cff5785ed239f56582c5d277a66869..d6f05ab4d6c554af30ae147fdcc348c441c62cfc 100644 (file)
@@ -174,6 +174,9 @@ of VARIABLEs set by earlier pairs.
 The return value of the `setq-local' form is the VALUE of the last
 pair.
 
+In some corner cases you may need to resort to
+`set-buffer-local-toplevel-value' instead, which see.
+
 \(fn [VARIABLE VALUE]...)"
   (declare (debug setq))
   (unless (evenp (length pairs))
index 8f72deb355a94f4183cf145d1758bd3e8822acb9..5bcbc648600ea3a705df6f8a8abf7b01c3f0b023 100644 (file)
@@ -199,19 +199,7 @@ Another is that undo information is not kept."
       (setq-local vc-parent-buffer-name
                   (concat " from " (buffer-name camefrom))))
 
-    ;; We want to set the buffer-local value of `default-directory' to
-    ;; olddir.  This `setq' alone ought to be sufficient.  But if there
-    ;; is a let-binding of `default-directory' in effect, such as the
-    ;; one established by `vc-print-root-log', then all we are able to
-    ;; do is change the let-binding, and not affect the underlying
-    ;; buffer-local cell.  Work around this using `run-with-timer'.
-    ;; See bug#53626 and bug#77306.
-    (setq default-directory olddir)
-    (run-with-timer 0 nil (lambda ()
-                            (when (buffer-live-p buf)
-                              (with-current-buffer buf
-                                (setq default-directory olddir)))))
-
+    (set-buffer-local-toplevel-value 'default-directory olddir)
     (let ((buffer-undo-list t)
           (inhibit-read-only t))
       (erase-buffer))))
index 348157c87be4600a1ff08bb5f7cb6256dbc65c88..ede79b9f77d1cc6be406db1863dede1e16376f1c 100644 (file)
@@ -759,6 +759,27 @@ default_toplevel_binding (Lisp_Object symbol)
   return binding;
 }
 
+static union specbinding *
+local_toplevel_binding (Lisp_Object symbol, Lisp_Object buf)
+{
+  union specbinding *binding = NULL;
+  union specbinding *pdl = specpdl_ptr;
+  while (pdl > specpdl)
+    {
+      switch ((--pdl)->kind)
+       {
+       case SPECPDL_LET_LOCAL:
+         if (BASE_EQ (specpdl_where (pdl), buf)
+             && EQ (specpdl_symbol (pdl), symbol))
+           binding = pdl;
+         break;
+
+       default: break;
+       }
+    }
+  return binding;
+}
+
 /* Look for a lexical-binding of SYMBOL somewhere up the stack.
    This will only find bindings created with interpreted code, since once
    compiled names of lexical variables are basically gone anyway.  */
@@ -813,6 +834,53 @@ DEFUN ("set-default-toplevel-value", Fset_default_toplevel_value,
   return Qnil;
 }
 
+DEFUN ("buffer-local-toplevel-value",
+       Fbuffer_local_toplevel_value,
+       Sbuffer_local_toplevel_value, 1, 2, 0,
+       doc: /* Return SYMBOL's toplevel local value in BUFFER.
+"Toplevel" means outside of any let binding.
+BUFFER defaults to the current buffer.
+If SYMBOL has no local value in BUFFER, signals an error.  */)
+  (Lisp_Object symbol, Lisp_Object buffer)
+{
+  if (NILP (buffer))
+    buffer = Fcurrent_buffer ();
+  if (NILP (Flocal_variable_p (symbol, buffer)))
+    xsignal1 (Qvoid_variable, symbol);
+  union specbinding *binding = local_toplevel_binding (symbol, buffer);
+  return binding
+    ? specpdl_old_value (binding)
+    : Fbuffer_local_value (symbol, buffer);
+}
+
+DEFUN ("set-buffer-local-toplevel-value",
+       Fset_buffer_local_toplevel_value,
+       Sset_buffer_local_toplevel_value, 2, 3, 0,
+       doc: /* Set SYMBOL's toplevel local value to VALUE in BUFFER.
+"Toplevel" means outside of any let binding.
+BUFFER defaults to the current buffer.
+Makes SYMBOL buffer-local in BUFFER if it was not already.  */)
+     (Lisp_Object symbol, Lisp_Object value, Lisp_Object buffer)
+{
+  Lisp_Object buf = !NILP (buffer) ? buffer : Fcurrent_buffer ();
+  union specbinding *binding = local_toplevel_binding (symbol, buf);
+
+  if (binding)
+    set_specpdl_old_value (binding, value);
+  else if (NILP (buffer))
+    Fset (Fmake_local_variable (symbol), value);
+  else
+    {
+      specpdl_ref count = SPECPDL_INDEX ();
+      record_unwind_current_buffer ();
+      Fset_buffer (buffer);
+      Fset (Fmake_local_variable (symbol), value);
+      unbind_to (count, Qnil);
+    }
+
+  return Qnil;
+}
+
 DEFUN ("internal--define-uninitialized-variable",
        Finternal__define_uninitialized_variable,
        Sinternal__define_uninitialized_variable, 1, 2, 0,
@@ -4503,6 +4571,8 @@ alist of active lexical bindings.  */);
   defsubr (&Smake_interpreted_closure);
   defsubr (&Sdefault_toplevel_value);
   defsubr (&Sset_default_toplevel_value);
+  defsubr (&Sbuffer_local_toplevel_value);
+  defsubr (&Sset_buffer_local_toplevel_value);
   defsubr (&Sdefvar);
   defsubr (&Sdefvar_1);
   defsubr (&Sdefvaralias);
index 156455dd35bafff2c557fb7e0ae74163dab0febf..ad4f2506126b8f7241502d5dea9e07d96297b769 100644 (file)
@@ -3496,7 +3496,7 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd const *, char const *);
    These are used in the syms_of_FILENAME functions.
 
    An ordinary (not in buffer_defaults, per-buffer, or per-keyboard)
-   lisp variable is actually a field in `struct emacs_globals'.  The
+   Lisp variable is actually a field in `struct emacs_globals'.  The
    field's name begins with "f_", which is a convention enforced by
    these macros.  Each such global has a corresponding #define in
    globals.h; the plain name should be used in the code.
@@ -3547,6 +3547,7 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd const *, char const *);
    - The specpdl stack keeps track of backtraces, unwind-protects and
      dynamic let-bindings.  It is allocated from the 'specpdl' array,
      a manually managed stack.
+     ("pdl" stands for "push-down list" which just means "stack".)
    - The handler stack keeps track of active catch tags and condition-case
      handlers.  It is allocated in a manually managed stack implemented by a
      doubly-linked list allocated via xmalloc and never freed.  */
index 9bd9fc3d4f36ef5d5f52150062f2beaddbb0ffa6..1ef6bc864a7db3f15f7802166d235e8e0df15d91 100644 (file)
 (ert-deftest core-elisp-tests-3-backquote ()
   (should (eq 3 (eval ``,,'(+ 1 2) t))))
 
+(defvar-local c-e-l 'foo)
+(ert-deftest core-elisp-tests-4-toplevel-values ()
+  (setq-default c-e-l 'foo)
+  (let ((c-e-l 'bar))
+    (let ((c-e-l 'baz))
+      (setq-default c-e-l 'bar)
+      (should (eq c-e-l 'bar))
+      (should (eq (default-toplevel-value 'c-e-l) 'foo))
+      (set-default-toplevel-value 'c-e-l 'baz)
+      (should (eq c-e-l 'bar))
+      (should (eq (default-toplevel-value 'c-e-l) 'baz))))
+  (let ((c-e-u 'foo))
+    (should (condition-case _
+                (default-toplevel-value 'c-e-u)
+              (void-variable t))))
+  (with-temp-buffer
+    (setq-local c-e-l 'bar)
+    (should (eq (buffer-local-toplevel-value 'c-e-l) 'bar))
+    (let ((c-e-l 'baz))
+      (let ((c-e-l 'quux))
+        (setq-local c-e-l 'baz)
+        (should (eq c-e-l 'baz))
+        (should (eq (buffer-local-toplevel-value 'c-e-l) 'bar))
+        (set-buffer-local-toplevel-value 'c-e-l 'foo)
+        (should (eq c-e-l 'baz))
+        (should (eq (buffer-local-toplevel-value 'c-e-l) 'foo)))))
+  (with-temp-buffer
+    (should (condition-case _
+                (buffer-local-toplevel-value 'c-e-l)
+              (void-variable t)))))
+
 ;; Test up-list and backward-up-list.
 (defun lisp-run-up-list-test (fn data start instructions)
   (cl-labels ((posof (thing)