From: Gerd Moellmann <gerd.moellmann@gmail.com>
Date: Mon, 4 Sep 2023 07:14:41 +0000 (+0200)
Subject: Package locks
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=942c092bd6c2554f80b1a5228f09481aa7dbfeff;p=emacs.git

Package locks

* lisp/emacs-lisp/pkg.el (lock-package, unlock-package,
package-locked-p): New functions.
* src/pkg.c (pkg_intern_symbol1): Signal an error if package is
locked.
---

diff --git a/lisp/emacs-lisp/pkg.el b/lisp/emacs-lisp/pkg.el
index 63ce92da86b..8e9cba049c6 100644
--- a/lisp/emacs-lisp/pkg.el
+++ b/lisp/emacs-lisp/pkg.el
@@ -38,6 +38,7 @@
 (gv-define-simple-setter package-%use-list package-%set-use-list)
 (gv-define-simple-setter package-%shadowing-symbols
                          package-%set-shadowing-symbols)
+(gv-define-simple-setter package-%lock package-%set-lock)
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -347,6 +348,27 @@ 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
+(defun package-locked-p (package)
+  "Return non-nnil if PACKAGE is locked.
+If PACKAGE is not a package object already, it must the name of a
+registered package."
+  (package-%lock (pkg--package-or-lose package)))
+
+;;;###autoload
+(defun lock-package (package)
+  "Lock PACKAGE.
+If PACKAGE is not a package object already, it must the name of a
+registered package."
+  (setf (package-%lock (pkg--package-or-lose package)) t))
+
+;;;###autoload
+(defun unlock-package (package)
+  "Lock PACKAGE.
+If PACKAGE is not a package object already, it must the name of a
+registered package."
+  (setf (package-%lock (pkg--package-or-lose package)) nil))
+
 ;;;###autoload
 (defun package-use-list (package)
   (package-%use-list (pkg--package-or-lose package)))
diff --git a/src/pkg.c b/src/pkg.c
index 2b9367bff0e..d39f71c7e1a 100644
--- a/src/pkg.c
+++ b/src/pkg.c
@@ -21,7 +21,6 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 /* Common Lisp style packages.
 
    Useful features that could be added:
-   package locks
    hierarchical packages
    package-local nicknames  */
 
@@ -315,7 +314,11 @@ pkg_intern_symbol1 (const Lisp_Object name, Lisp_Object package,
   if (!EQ (existing_symbol, Qunbound))
     symbol = existing_symbol;
   else
-    symbol = Fmake_symbol (name);
+    {
+      if (!NILP (XPACKAGE (package)->lock))
+	error ("Package %s is locked", SDATA (XPACKAGE (package)->name));
+      symbol = Fmake_symbol (name);
+    }
 
   /* PACKAGE becomes the home package of the symbol created.  */
   XSYMBOL (symbol)->u.s.package = package;