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 63ce92da86b16e68eef897b0f8bf75e41d1b5c23..8e9cba049c689a506af5869e11c5f3b5562cc130 100644 (file)
--- 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)
 
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -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 2b9367bff0e80ccfe3948df00186dee8fc2d0447..d39f71c7e1ad1365bc6e495978285b668645ebc8 100644 (file)
--- 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;