scratch/pkg 942c092bd6c: Package locks

[Gerd Moellmann]

branch: scratch/pkg
commit 942c092bd6c2554f80b1a5228f09481aa7dbfeff
Author: Gerd Moellmann <gerd.moellmann@gmail.com>
Commit: Gerd Moellmann <gerd.moellmann@gmail.com>

    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.
---
 lisp/emacs-lisp/pkg.el | 22 ++++++++++++++++++++++
 src/pkg.c              |  7 +++++--
 2 files changed, 27 insertions(+), 2 deletions(-)

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;