[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/lexspaces 3a57250 06/17: Add lexspace-make-from
From: |
Andrea Corallo |
Subject: |
scratch/lexspaces 3a57250 06/17: Add lexspace-make-from |
Date: |
Fri, 8 May 2020 16:43:07 -0400 (EDT) |
branch: scratch/lexspaces
commit 3a57250170d178f95b75df77c779fb3c6498ff4a
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>
Add lexspace-make-from
---
src/lexspaces.c | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 62 insertions(+), 1 deletion(-)
diff --git a/src/lexspaces.c b/src/lexspaces.c
index bfb59a1..600facc 100644
--- 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);
+ }
+ }
+}
+
+
+/**********************************/
+/* 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);
}
- branch scratch/lexspaces created (now e2f183c), Andrea Corallo, 2020/05/08
- scratch/lexspaces 67e28d9 02/17: Adding binding pseudovector, Andrea Corallo, 2020/05/08
- scratch/lexspaces 2d1e916 01/17: Add lexspaces.c, Andrea Corallo, 2020/05/08
- scratch/lexspaces 64e442b 04/17: Add SYMBOL_FUNCTION accessor function, Andrea Corallo, 2020/05/08
- scratch/lexspaces 02d8ef2 05/17: Move symbol value into separate binding, Andrea Corallo, 2020/05/08
- scratch/lexspaces 3a57250 06/17: Add lexspace-make-from,
Andrea Corallo <=
- scratch/lexspaces 7fecbf5 08/17: Add lexspace redirection, Andrea Corallo, 2020/05/08
- scratch/lexspaces 09821e3 03/17: Store symbol value into the binding, Andrea Corallo, 2020/05/08
- scratch/lexspaces 04ac507 14/17: Remove unnecessary assertion, Andrea Corallo, 2020/05/08
- scratch/lexspaces 00108a5 15/17: Fix sweep_symbols, Andrea Corallo, 2020/05/08
- scratch/lexspaces 295ac3d 07/17: Make in-lexspace do something, Andrea Corallo, 2020/05/08
- scratch/lexspaces 610552d 10/17: Add SYMBOL_FUNC_LEXSPACE, Andrea Corallo, 2020/05/08
- scratch/lexspaces 9091913 13/17: Rename lexspace-make-from -> lexspace-make, Andrea Corallo, 2020/05/08
- scratch/lexspaces e2f183c 17/17: Shallow setters by default are not a good idea, Andrea Corallo, 2020/05/08
- scratch/lexspaces 73363e9 09/17: Store lexspace in closures, Andrea Corallo, 2020/05/08
- scratch/lexspaces b46c504 12/17: Add lexspace-import-symbol, Andrea Corallo, 2020/05/08