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
(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))
(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)
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))
(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))))
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. */
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,
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);
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.
- 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. */
(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)