feature/pkg 0d16f57476: shodow

[Gerd Moellmann]

branch: feature/pkg
commit 0d16f5747682dda89c5ce7ee0400dc3fac7b33df
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>

    shodow
    
    * lisp/emacs-lisp/pkg.el (package-shadowing-symbols): Implement.
    (shadow): Implement.
    * src/pkg.c (Fpackage_percent_set_symbol_package): New function.
    (syms_of_pkg): defsubr it.
    * test/src/pkg-tests.el (pkg-tests-use-package): Fix byte compiler
    warning.
---
 lisp/emacs-lisp/pkg.el | 23 ++++++++++++++++++++---
 src/pkg.c              | 11 +++++++++++
 test/src/pkg-tests.el  |  2 +-
 3 files changed, 32 insertions(+), 4 deletions(-)

diff --git a/lisp/emacs-lisp/pkg.el b/lisp/emacs-lisp/pkg.el
index 08cb3d8304..38b412a8eb 100644
--- a/lisp/emacs-lisp/pkg.el
+++ b/lisp/emacs-lisp/pkg.el
@@ -242,6 +242,9 @@ registered package."
 
 ;;;###autoload
 (defun package-shadowing-symbols (package)
+  "Return the list of shadowing symbols of PACKAGE.
+If PACKAGE is not a package object already, it must the name of a
+registered package."
   (package-%shadowing-symbols (pkg--package-or-lose package)))
 
 ;;;###autoload
@@ -395,9 +398,23 @@ Value is the renamed package object."
     (list package symbols)))
 
 ;;;###autoload
-(defun shadow (_symbols &optional package)
-  (setq package (pkg--package-or-default package))
-  (error "not yet implemented"))
+(defun shadow (symbols &optional package)
+  "Make an internal symbol in PACKAGE with the same name as each of the
+  specified SYMBOLS, adding the new symbols to the Package-Shadowing-Symbols.
+  If a symbol with the given name is already present in PACKAGE, then
+  the existing symbol is placed in the shadowing symbols list if it is
+  not already present."
+  (let* ((package (pkg--package-or-lose package)))
+    (dolist (name (mapcar #'string
+                         (if (listp symbols) symbols (list symbols))))
+      (cl-multiple-value-bind (sym status) (find-symbol name package)
+       (when (or (not status) (eq status :inherited))
+         (setq sym (make-symbol name))
+         (package-%set-symbol-package sym package)
+          (puthash sym :internal (package-%symbols package)))
+       (cl-pushnew s (package-%shadowing-symbols package)))))
+  t)
+
 
 ;;;###autoload
 (defun shadowing-import (_symbols &optional package)
diff --git a/src/pkg.c b/src/pkg.c
index 9515d37e6a..25c4fa7fa6 100644
--- a/src/pkg.c
+++ b/src/pkg.c
@@ -865,6 +865,16 @@ DEFUN ("package-%register", Fpackage_percent_register,
   return package;
 }
 
+DEFUN ("package-%set-symbol-package", Fpackage_percent_set_symbol_package,
+       Spackage_percent_set_symbol_package, 2, 2, 0, doc:  /* Internal use 
only.  */)
+  (Lisp_Object symbol, Lisp_Object package)
+{
+  CHECK_SYMBOL (symbol);
+  CHECK_PACKAGE (package);
+  XSYMBOL (symbol)->u.s.package = package;
+  return symbol;
+}
+
 
 /***********************************************************************
                            Initialization
@@ -949,6 +959,7 @@ syms_of_pkg (void)
   defsubr (&Spackage_percent_set_nicknames);
   defsubr (&Spackage_percent_set_shadowing_symbols);
   defsubr (&Spackage_percent_set_status);
+  defsubr (&Spackage_percent_set_symbol_package);
   defsubr (&Spackage_percent_set_use_list);
   defsubr (&Spackage_percent_shadowing_symbols);
   defsubr (&Spackage_percent_symbols);
diff --git a/test/src/pkg-tests.el b/test/src/pkg-tests.el
index d2c8557b3b..b24e71427a 100644
--- a/test/src/pkg-tests.el
+++ b/test/src/pkg-tests.el
@@ -151,7 +151,7 @@
 
 (ert-deftest pkg-tests-use-package ()
   (with-packages (x y)
-    (let ((ax (intern "a" x)))
+    (let ((_a (intern "a" x)))
       (use-package x y))))
 
 ;; (ert-deftest pkg-tests-find-symbol ()