From: Gerd Möllmann <gerd@gnu.org>
Date: Mon, 24 Oct 2022 13:39:05 +0000 (+0200)
Subject: shodow
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0d16f5747682dda89c5ce7ee0400dc3fac7b33df;p=emacs.git

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.
---

diff --git a/lisp/emacs-lisp/pkg.el b/lisp/emacs-lisp/pkg.el
index 08cb3d8304e..38b412a8eb1 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 9515d37e6a9..25c4fa7fa68 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 d2c8557b3b4..b24e71427a1 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 ()