scratch/pkg 6835bc5e5a5: Setting buffer-local *package*

[Gerd Moellmann]

branch: scratch/pkg
commit 6835bc5e5a5e6313fe73ffb34a7999b6d9149796
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>

    Setting buffer-local *package*
    
    * lisp/emacs-lisp/pkg.el (buffer-package): Get buffer's *package*.
    (set-buffer-package): Set it.
    * src/eval.c (Fdefault_buffer_local_value): Rewrite.
    (Fset_default_buffer_local_value): New function.
---
 lisp/emacs-lisp/pkg.el | 19 +++++++++++++------
 src/eval.c             | 38 +++++++++++++++++++++++++-------------
 src/pkg.c              |  1 +
 3 files changed, 39 insertions(+), 19 deletions(-)

diff --git a/lisp/emacs-lisp/pkg.el b/lisp/emacs-lisp/pkg.el
index aea6d3712a9..17a76e2c168 100644
--- a/lisp/emacs-lisp/pkg.el
+++ b/lisp/emacs-lisp/pkg.el
@@ -39,6 +39,7 @@
 (gv-define-simple-setter package-%shadowing-symbols
                          package-%set-shadowing-symbols)
 (gv-define-simple-setter package-%lock package-%set-lock)
+(gv-define-simple-setter buffer-package set-buffer-package)
 
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -178,12 +179,18 @@ Otherwise assume that "
              (package-name package) name))))
 
 ;;;###autoload
-(cl-defun buffer-package (&optional (buffer (current-buffer)))
-  "Return the value of *package* set in BUFFER.
-BUFFER must be either a buffer object or the name of an existing buffer."
-  (let ((buffer (or (get-buffer buffer)
-                    (error "Buffer not found: %s" buffer))))
-    (default-buffer-local-value '*package* buffer)))
+(cl-defun buffer-package (buffer)
+  "Return the value of *package* set in BUFFER."
+  (default-buffer-local-value '*package* buffer))
+
+;;;###autoload
+(cl-defun set-buffer-package (buffer package)
+  "Set the value of *package* in BUFFER to PACKAGE."
+  (unless (local-variable-p '*package* buffer)
+    (with-current-buffer buffer
+      (make-local-variable '*package*)))
+  (let ((*package* *emacs-package*))
+    (set-default-buffer-local-value '*package* package buffer)))
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                                  Macros
diff --git a/src/eval.c b/src/eval.c
index f66353b7faf..540da7dd0bf 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -690,6 +690,30 @@ default_buffer_local_binding (Lisp_Object symbol, 
Lisp_Object buffer)
   return binding;
 }
 
+DEFUN ("default-buffer-local-value", Fdefault_buffer_local_value,
+       Sdefault_buffer_local_value, 2, 2, 0,
+       doc: /* Return SYMBOL's toplevel buffer-local value in BUFFER. */)
+  (Lisp_Object symbol, Lisp_Object buffer)
+{
+  union specbinding *binding = default_buffer_local_binding (symbol, buffer);
+  if (binding)
+    return specpdl_old_value (binding);
+  return Fdefault_toplevel_value (symbol);
+}
+
+DEFUN ("set-default-buffer-local-value", Fset_default_buffer_local_value,
+       Sset_default_buffer_local_value, 3, 3, 0,
+       doc: /* Return SYMBOL's toplevel buffer-local value in BUFFER. */)
+  (Lisp_Object symbol, Lisp_Object value, Lisp_Object buffer)
+{
+  union specbinding *binding = default_buffer_local_binding (symbol, buffer);
+  if (binding)
+    set_specpdl_old_value (binding, value);
+  else
+    Fset_default (symbol, value);
+  return Qnil;
+}
+
 /* 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.  */
@@ -732,19 +756,6 @@ DEFUN ("default-toplevel-value", Fdefault_toplevel_value, 
Sdefault_toplevel_valu
   xsignal1 (Qvoid_variable, symbol);
 }
 
-DEFUN ("default-buffer-local-value", Fdefault_buffer_local_value,
-       Sdefault_buffer_local_value, 2, 2, 0,
-       doc: /* Return SYMBOL's toplevel buffer-local value in BUFFER. */)
-  (Lisp_Object symbol, Lisp_Object buffer)
-{
-  union specbinding *binding = default_buffer_local_binding (symbol, buffer);
-  Lisp_Object value
-    = binding ? specpdl_old_value (binding) : Fdefault_value (symbol);
-  if (!BASE_EQ (value, Qunbound))
-    return value;
-  xsignal1 (Qvoid_variable, symbol);
-}
-
 DEFUN ("set-default-toplevel-value", Fset_default_toplevel_value,
        Sset_default_toplevel_value, 2, 2, 0,
        doc: /* Set SYMBOL's toplevel default value to VALUE.
@@ -4470,6 +4481,7 @@ alist of active lexical bindings.  */);
   defsubr (&Sfunction);
   defsubr (&Sdefault_toplevel_value);
   defsubr (&Sdefault_buffer_local_value);
+  defsubr (&Sset_default_buffer_local_value);
   defsubr (&Sset_default_toplevel_value);
   defsubr (&Sdefvar);
   defsubr (&Sdefvar_1);
diff --git a/src/pkg.c b/src/pkg.c
index 0ebb2094620..272a2b5868f 100644
--- a/src/pkg.c
+++ b/src/pkg.c
@@ -1105,6 +1105,7 @@ syms_of_pkg (void)
                     doc: /* The keyword package.  For internal use only.  */);
   DEFVAR_LISP_NOPRO ("*package*", Vearmuffs_package,
                     doc: /* The current package.  */);
+  /* This make *package* have a buffer-local binding only if set.  */
   Fmake_variable_buffer_local (Qearmuffs_package);
   Fadd_variable_watcher (Qearmuffs_package, Fsymbol_function 
(Qwatch_earmuffs_package));
   DEFVAR_LISP_NOPRO ("symbol-packages", Vsymbol_packages,