Add lexspace-make-from

diff --git a/src/lexspaces.c b/src/lexspaces.c
index bfb59a1d108b0961c5f67830c5083fdff938d0d7..600facc3b9a33a7db5f22375e89a7116711a1bdc 100644 (file)
--- a/src/lexspaces.c
+++ b/src/lexspaces.c
@@ -22,6 +22,61 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
 EMACS_INT curr_lexspace;
 
+/* Store lexnumber in closure + set lexspace calling subrs.  */
+
+static void
+lexspace_copy (EMACS_INT dst, EMACS_INT src)
+{
+  Lisp_Object tail;
+  for (ptrdiff_t i = ASIZE (Vobarray) - 1; i >= 0; i--)
+    {
+      tail = AREF (Vobarray, i);
+      if (SYMBOLP (tail))
+       while (1)
+         {
+           struct Lisp_Symbol *sym = XSYMBOL (tail);
+           if (sym->u.s.redirect == SYMBOL_PLAINVAL
+               && !EQ (sym->u.s.val.value, Qunbound))
+             {
+               struct Lisp_Binding *binding = XBINDING (sym->u.s.val.value);
+               binding->b[dst] = binding->b[src];
+             }
+           if (!NILP (sym->u.s._function))
+             {
+               struct Lisp_Binding *binding = XBINDING (sym->u.s._function);
+               binding->b[dst] = binding->b[src];
+             }
+           if (sym->u.s.next == 0)
+             break;
+           XSETSYMBOL (tail, sym->u.s.next);
+         }
+    }
+}
+
+\f
+/**********************************/
+/* Entry points exposed to Lisp.  */
+/**********************************/
+
+DEFUN ("lexspace-make-from", Flexspace_make_from, Slexspace_make_from, 2, 2, 0,
+       doc: /* Make lexspace NAME from SRC.   */)
+  (Lisp_Object name, Lisp_Object src)
+{
+  CHECK_SYMBOL (name);
+  CHECK_SYMBOL (src);
+  EMACS_INT lexspace_num = XFIXNUM (Fhash_table_count (Vlexspaces));
+  if (lexspace_num == MAX_LEXSPACES)
+    error ("Max number of lexspaces reached");
+  Lisp_Object src_lex_n = Fgethash (src, Vlexspaces, Qnil);
+  if (NILP (src_lex_n))
+    error ("lexspace %s does not exists", SSDATA (SYMBOL_NAME (src)));
+
+  Fputhash (name, make_fixnum (lexspace_num), Vlexspaces);
+  lexspace_copy (lexspace_num, XFIXNUM (src_lex_n));
+
+  return name;
+}
+
 DEFUN ("in-lexspace", Fin_lexspace, Sin_lexspace, 1, 1, 0,
        doc: /* Set NAME as current lexspace.  Create it in case.   */)
   (Lisp_Object name)
@@ -34,11 +89,17 @@ void
 syms_of_lexspaces (void)
 {
   DEFSYM (Qbinding, "binding");
-
   DEFSYM (Qel, "el");
+
+  /* Internal use!  */
   DEFVAR_LISP ("current-lexspace-name", Vcurrent_lexspace_name,
               doc: /* Internal use.  */);
   Vcurrent_lexspace_name = Qel;
+  DEFVAR_LISP ("lexspaces", Vlexspaces,
+              doc: /* Internal use.  */);
+  Vlexspaces = CALLN (Fmake_hash_table, QCtest, Qeq);
+  Fputhash (Qel, make_fixnum (0), Vlexspaces);
 
   defsubr (&Sin_lexspace);
+  defsubr (&Slexspace_make_from);
 }