]> git.eshelyaron.com Git - emacs.git/commitdiff
shodow
authorGerd Möllmann <gerd@gnu.org>
Mon, 24 Oct 2022 13:39:05 +0000 (15:39 +0200)
committerGerd Möllmann <gerd@gnu.org>
Mon, 24 Oct 2022 13:39:05 +0000 (15:39 +0200)
* 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
src/pkg.c
test/src/pkg-tests.el

index 08cb3d8304ed66bb7208e5e1d9349048ffb79ec8..38b412a8eb1bc88306abe2f72228740a7e8c3f1c 100644 (file)
@@ -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)
index 9515d37e6a9e8d944bb7d8c3c47c4f4e11308edb..25c4fa7fa68f87f090dff3b3754fb6c3bebecb12 100644 (file)
--- 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;
+}
+
 \f
 /***********************************************************************
                            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);
index d2c8557b3b4d941626621f29e660e4c408930932..b24e71427a18766eeaedab5a24f4f3bcc25cbe6c 100644 (file)
 
 (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 ()