(defvar eldoc-message-commands
;; Don't define as `defconst' since it would then go to (read-only) purespace.
- (make-vector eldoc-message-commands-table-size 0)
+ (make-package "eldoc-message-commands")
"Commands after which it is appropriate to print in the echo area.
ElDoc does not try to print function arglists, etc., after just any command,
because some commands print their own messages in the echo area and these
char buf[1024 + 1];
int filled;
EMACS_INT pos;
- Lisp_Object sym;
char *p, *name;
char const *dirname;
ptrdiff_t dirlen;
But this meant the doc had to be kept and updated in
multiple files. Nowadays we keep the doc only in eg xterm.
The (f)boundp checks below ensure we don't report
- docs for eg w32-specific items on X.
- */
-
- sym = oblookup (Vobarray, p + 2,
- multibyte_chars_in_text ((unsigned char *) p + 2,
- end - p - 2),
- end - p - 2);
- /* Ignore docs that start with SKIP. These mark
- placeholders where the real doc is elsewhere. */
- if (SYMBOLP (sym))
+ docs for eg w32-specific items on X. */
+
+ const ptrdiff_t nbytes = end - p - 2;
+ const ptrdiff_t nchars = multibyte_chars_in_text ((unsigned char *) p + 2, nbytes);
+ const Lisp_Object sym = pkg_lookup_non_keyword_c_string (p + 2, nchars, nbytes);
+ if (!EQ (sym, Qunbound))
{
/* Attach a docstring to a variable? */
if (p[1] == 'V')
{
+ /* Ignore docs that start with SKIP. These mark
+ placeholders where the real doc is elsewhere. */
/* Install file-position as variable-documentation property
and make it negative for a user-variable
(doc starts with a `*'). */
make_fixnum ((pos + end + 1 - buf)
* (end[1] == '*' ? -1 : 1)));
}
-
/* Attach a docstring to a function? */
else if (p[1] == 'F')
{
}
else if (p[1] == 'S')
; /* Just a source file name boundary marker. Ignore it. */
-
else
error ("DOC file invalid at position %"pI"d", pos);
}
attributes: noreturn)
(Lisp_Object error_symbol, Lisp_Object data)
{
+ if (EQ (error_symbol, Qwrong_type_argument))
+ pkg_break ();
+
/* If they call us with nonsensical arguments, produce "peculiar error". */
if (NILP (error_symbol) && NILP (data))
error_symbol = Qerror;
Lisp_Object
font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
{
- ptrdiff_t i, nbytes, nchars;
- Lisp_Object tem, name, obarray;
+ ptrdiff_t i;
if (len == 1 && *str == '*')
return Qnil;
}
}
- /* This code is similar to intern function from lread.c. */
- obarray = check_obarray (Vobarray);
+ /* PKG-FIXME: These many make_xyz_string variants are confusing.
+ Simplify. */
+ ptrdiff_t nbytes, nchars;
parse_str_as_multibyte ((unsigned char *) str, len, &nchars, &nbytes);
- tem = oblookup (obarray, str,
- (len == nchars || len != nbytes) ? len : nchars, len);
- if (SYMBOLP (tem))
- return tem;
- name = make_specified_string (str, nchars, len,
- len != nchars && len == nbytes);
- return intern_driver (name, obarray, tem);
+ Lisp_Object name = make_specified_string (str, nchars, len,
+ len != nchars && len == nbytes);
+ return pkg_intern_maybe_keyword (name);
}
/* Return a pixel size of font-spec SPEC on frame F. */
extern void pkg_error (const char *fmt, ...);
extern Lisp_Object pkg_unqualified_symbol (Lisp_Object name);
extern bool pkg_keywordp (Lisp_Object obj);
-extern Lisp_Object pkg_add_keyword (Lisp_Object sym);
-extern Lisp_Object pkg_add_symbol (Lisp_Object symbol, Lisp_Object package);
+extern Lisp_Object pkg_intern_keyword (Lisp_Object sym);
+extern Lisp_Object pkg_define_keyword (Lisp_Object sym);
+extern Lisp_Object pkg_define_non_keyword (Lisp_Object sym);
+extern Lisp_Object pkg_intern_symbol (Lisp_Object sym, Lisp_Object package);
extern Lisp_Object pkg_emacs_intern (Lisp_Object name, Lisp_Object package);
extern Lisp_Object pkg_emacs_intern_soft (Lisp_Object name, Lisp_Object package);
extern Lisp_Object pkg_emacs_unintern (Lisp_Object name, Lisp_Object package);
-extern bool pkg_intern_name_c_string (const char *p, ptrdiff_t len, Lisp_Object *symbol);
-extern void pkg_early_intern_symbol (Lisp_Object symbol);
-extern Lisp_Object pkg_lookup_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes);
+extern Lisp_Object pkg_intern_non_keyword (Lisp_Object name);
+extern Lisp_Object pkg_intern_non_keyword_c_string (const char *p, ptrdiff_t len);
+extern Lisp_Object pkg_lookup_non_keyword_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes);
+extern Lisp_Object pkg_intern_maybe_keyword (Lisp_Object name);
extern void pkg_break (void);
extern void pkg_define_builtin_symbols (void);
extern void pkg_map_package_symbols (Lisp_Object fn, Lisp_Object package);
ATTRIBUTE_FORMAT_PRINTF (5, 0);
/* Defined in lread.c. */
-extern Lisp_Object check_obarray (Lisp_Object);
extern void init_symbol (Lisp_Object, Lisp_Object);
-extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
INLINE void
LOADHIST_ATTACH (Lisp_Object x)
{
Lisp_Object *, Lisp_Object, bool, bool);
enum { S2N_IGNORE_TRAILING = 1 };
extern Lisp_Object string_to_number (char const *, int, ptrdiff_t *);
-extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
- Lisp_Object);
extern void dir_warning (const char *, Lisp_Object);
extern void init_obarray_once (void);
extern void init_lread (void);
extern void syms_of_lread (void);
extern void mark_lread (void);
extern Lisp_Object intern_1 (const char *str, ptrdiff_t len);
-extern Lisp_Object intern_c_string_1 (const char *str, ptrdiff_t len);
-extern Lisp_Object intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index);
+extern Lisp_Object intern_c_string_1 (const char *str, ptrdiff_t len,
+ bool allow_pure_p);
INLINE Lisp_Object
intern (const char *str)
INLINE Lisp_Object
intern_c_string (const char *str)
{
- return intern_c_string_1 (str, strlen (str));
+ return intern_c_string_1 (str, strlen (str), true);
}
/* Defined in eval.c. */
}
\f
-static Lisp_Object initial_obarray;
-
-/* `oblookup' stores the bucket number here, for the sake of Funintern. */
-
-static size_t oblookup_last_bucket_number;
-
-/* Get an error if OBARRAY is not an obarray.
- If it is one, return it. */
+/* Intern symbol with name given by STR and LEN. ALLOW_PURE_P means
+ that the symbol name may be allocated from pure space if necessary.
+ If STR starts with a colon, consider it a keyword. */
Lisp_Object
-check_obarray (Lisp_Object obarray)
+intern_c_string_1 (const char *str, ptrdiff_t len, bool allow_pure_p)
{
- /* We don't want to signal a wrong-type-argument error when we are
- shutting down due to a fatal error, and we don't want to hit
- assertions in VECTORP and ASIZE if the fatal error was during GC. */
- if (!fatal_error_in_progress
- && (!VECTORP (obarray) || ASIZE (obarray) == 0))
- {
- /* If Vobarray is now invalid, force it to be valid. */
- if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
- wrong_type_argument (Qvectorp, obarray);
- }
- return obarray;
-}
-
-/* Intern symbol SYM in OBARRAY using bucket INDEX. */
-
-static Lisp_Object
-intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
-{
- Lisp_Object *ptr;
-
- if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
- {
- make_symbol_constant (sym);
- XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL;
- /* Mark keywords as special. This makes (let ((:key 'foo)) ...)
- in lexically bound elisp signal an error, as documented. */
- XSYMBOL (sym)->u.s.declared_special = true;
- SET_SYMBOL_VAL (XSYMBOL (sym), sym);
- pkg_add_keyword (sym);
- }
- else
- pkg_early_intern_symbol (sym);
-
- ptr = aref_addr (obarray, XFIXNUM (index));
- set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL);
- *ptr = sym;
- return sym;
-}
-
-/* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */
-
-Lisp_Object
-intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index)
-{
- SET_SYMBOL_VAL (XSYMBOL (Qobarray_cache), Qnil);
- return intern_sym (Fmake_symbol (string), obarray, index);
+ const bool keyword = *str == ':';
+ const char *name_start = keyword ? str + 1 : str;
+ const ptrdiff_t name_len = keyword ? len - 1 : len;
+ const Lisp_Object name = ((!allow_pure_p || NILP (Vpurify_flag))
+ ? make_string (name_start, name_len)
+ : make_pure_c_string (name_start, name_len));
+ if (keyword)
+ return pkg_intern_keyword (name);
+ return pkg_intern_non_keyword (name);
}
-/* Intern the C string STR: return a symbol with that name,
- interned in the current obarray. */
-
Lisp_Object
intern_1 (const char *str, ptrdiff_t len)
{
- /* If we can find a symbol with that name "normally", return that
- symbol. */
- Lisp_Object symbol;
- if (pkg_intern_name_c_string (str, len, &symbol))
- return symbol;
-
- /* Not found: Do the obarray dance. */
- Lisp_Object obarray = check_obarray (Vobarray);
- Lisp_Object tem = oblookup (obarray, str, len, len);
-
- return (SYMBOLP (tem) ? tem
- /* The above `oblookup' was done on the basis of nchars==nbytes, so
- the string has to be unibyte. */
- : intern_driver (make_unibyte_string (str, len),
- obarray, tem));
-}
-
-Lisp_Object
-intern_c_string_1 (const char *str, ptrdiff_t len)
-{
- Lisp_Object obarray = check_obarray (Vobarray);
- Lisp_Object tem = oblookup (obarray, str, len, len);
-
- if (!SYMBOLP (tem))
- {
- Lisp_Object string;
-
- if (NILP (Vpurify_flag))
- string = make_string (str, len);
- else
- string = make_pure_c_string (str, len);
-
- tem = intern_driver (string, obarray, tem);
- }
- return tem;
+ return intern_c_string_1 (str, len, false);
}
static void
if (!BASE_EQ (sym, Qunbound))
{
if (keyword)
- pkg_add_keyword (sym);
+ pkg_define_keyword (sym);
else
- pkg_add_symbol (sym, Vemacs_package);
+ pkg_define_non_keyword (sym);
}
}
return pkg_emacs_unintern (name, obarray);
}
\f
-/* Return the symbol in OBARRAY whose names matches the string
- of SIZE characters (SIZE_BYTE bytes) at PTR.
- If there is no such symbol, return the integer bucket number of
- where the symbol would be if it were present.
-
- Also store the bucket number in oblookup_last_bucket_number. */
-
-Lisp_Object
-oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte)
-{
- const Lisp_Object found = pkg_lookup_c_string (ptr, size, size_byte);
- if (!EQ (found, Qunbound))
- return found;
-
- size_t hash;
- size_t obsize;
- register Lisp_Object tail;
- Lisp_Object bucket, tem;
-
- obarray = check_obarray (obarray);
- /* This is sometimes needed in the middle of GC. */
- obsize = gc_asize (obarray);
- hash = hash_string (ptr, size_byte) % obsize;
- bucket = AREF (obarray, hash);
- oblookup_last_bucket_number = hash;
- if (BASE_EQ (bucket, make_fixnum (0)))
- ;
- else if (!SYMBOLP (bucket))
- /* Like CADR error message. */
- xsignal2 (Qwrong_type_argument, Qobarrayp,
- build_string ("Bad data in guts of obarray"));
- else
- for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next))
- {
- if (SBYTES (SYMBOL_NAME (tail)) == size_byte
- && SCHARS (SYMBOL_NAME (tail)) == size
- && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
- return tail;
- else if (XSYMBOL (tail)->u.s.next == 0)
- break;
- }
- XSETINT (tem, hash);
- return tem;
-}
-
-\f
-void
-map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
-{
- eassert (false);
- ptrdiff_t i;
- register Lisp_Object tail;
- CHECK_VECTOR (obarray);
- for (i = ASIZE (obarray) - 1; i >= 0; i--)
- {
- tail = AREF (obarray, i);
- if (SYMBOLP (tail))
- while (1)
- {
- (*fn) (tail, arg);
- if (XSYMBOL (tail)->u.s.next == 0)
- break;
- XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
- }
- }
-}
DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
doc: /* Call FUNCTION on every symbol in OBARRAY.
return Qnil;
}
-#define OBARRAY_SIZE 15121
-
void
init_obarray_once (void)
{
- Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0));
- initial_obarray = Vobarray;
- staticpro (&initial_obarray);
+ Vobarray = Vemacs_package;
DEFSYM (Qunbound, "unbound");
ptrdiff_t bestmatchsize = 0;
/* These are in bytes, too. */
ptrdiff_t compare, matchsize;
- enum { function_table, list_table, obarray_table, hash_table}
- type = (HASH_TABLE_P (collection) ? hash_table
- : VECTORP (collection) ? obarray_table
- : ((NILP (collection)
- || (CONSP (collection) && !FUNCTIONP (collection)))
- ? list_table : function_table));
- ptrdiff_t idx = 0, obsize = 0;
- int matchcount = 0;
- Lisp_Object bucket, zero, end, tem;
CHECK_STRING (string);
- if (type == function_table)
+
+ if (FUNCTIONP (collection))
return call3 (collection, string, predicate, Qnil);
+ if (PACKAGEP (collection))
+ collection = PACKAGE_SYMBOLS (collection);
+
+ ptrdiff_t idx = 0;
+ int matchcount = 0;
+ Lisp_Object bucket, zero, end, tem;
+
bestmatch = bucket = Qnil;
zero = make_fixnum (0);
+ eassert (HASH_TABLE_P (collection) || NILP (collection) || CONSP (collection));
+
/* If COLLECTION is not a list, set TAIL just for gc pro. */
tail = collection;
- if (type == obarray_table)
- {
- collection = check_obarray (collection);
- obsize = ASIZE (collection);
- bucket = AREF (collection, idx);
- }
while (1)
{
/* elt gets the alist element or symbol.
eltstring gets the name to check as a completion. */
- if (type == list_table)
- {
- if (!CONSP (tail))
- break;
- elt = XCAR (tail);
- eltstring = CONSP (elt) ? XCAR (elt) : elt;
- tail = XCDR (tail);
- }
- else if (type == obarray_table)
- {
- if (!EQ (bucket, zero))
- {
- if (!SYMBOLP (bucket))
- error ("Bad data in guts of obarray");
- elt = bucket;
- eltstring = elt;
- if (XSYMBOL (bucket)->u.s.next)
- XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
- else
- XSETFASTINT (bucket, 0);
- }
- else if (++idx >= obsize)
- break;
- else
- {
- bucket = AREF (collection, idx);
- continue;
- }
- }
- else /* if (type == hash_table) */
+ if (HASH_TABLE_P (collection))
{
while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
&& BASE_EQ (HASH_KEY (XHASH_TABLE (collection), idx),
else
elt = eltstring = HASH_KEY (XHASH_TABLE (collection), idx++);
}
+ else
+ {
+ if (!CONSP (tail))
+ break;
+ elt = XCAR (tail);
+ eltstring = CONSP (elt) ? XCAR (elt) : elt;
+ tail = XCDR (tail);
+ }
/* Is this element a possible completion? */
tem = Fcommandp (elt, Qnil);
else
{
- tem = (type == hash_table
+ tem = (HASH_TABLE_P (collection)
? call2 (predicate, elt,
HASH_VALUE (XHASH_TABLE (collection),
idx - 1))
Lisp_Object tail, elt, eltstring;
Lisp_Object allmatches;
int type = HASH_TABLE_P (collection) ? 3
- : VECTORP (collection) ? 2
+ : PACKAGEP (collection) ? 2
: NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection));
- ptrdiff_t idx = 0, obsize = 0;
+ ptrdiff_t idx = 0;
Lisp_Object bucket, tem, zero;
CHECK_STRING (string);
if (type == 0)
return call3 (collection, string, predicate, Qt);
+
+ if (type == 2)
+ {
+ collection = PACKAGE_SYMBOLS (collection);
+ type = 3;
+ }
+
allmatches = bucket = Qnil;
zero = make_fixnum (0);
/* If COLLECTION is not a list, set TAIL just for gc pro. */
tail = collection;
- if (type == 2)
- {
- collection = check_obarray (collection);
- obsize = ASIZE (collection);
- bucket = AREF (collection, idx);
- }
while (1)
{
eltstring = CONSP (elt) ? XCAR (elt) : elt;
tail = XCDR (tail);
}
- else if (type == 2)
- {
- if (!EQ (bucket, zero))
- {
- if (!SYMBOLP (bucket))
- error ("Bad data in guts of obarray");
- elt = bucket;
- eltstring = elt;
- if (XSYMBOL (bucket)->u.s.next)
- XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
- else
- XSETFASTINT (bucket, 0);
- }
- else if (++idx >= obsize)
- break;
- else
- {
- bucket = AREF (collection, idx);
- continue;
- }
- }
else /* if (type == 3) */
{
while (idx < HASH_TABLE_SIZE (XHASH_TABLE (collection))
the values STRING, PREDICATE and `lambda'. */)
(Lisp_Object string, Lisp_Object collection, Lisp_Object predicate)
{
- Lisp_Object tail, tem = Qnil;
+ Lisp_Object tem = Qnil;
ptrdiff_t i = 0;
CHECK_STRING (string);
+ if (PACKAGEP (collection))
+ collection = PACKAGE_SYMBOLS (collection);
+
if (NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)))
{
tem = Fassoc_string (string, collection, completion_ignore_case ? Qt : Qnil);
if (NILP (tem))
return Qnil;
}
- else if (VECTORP (collection))
- {
- /* Bypass intern-soft as that loses for nil. */
- tem = oblookup (collection,
- SSDATA (string),
- SCHARS (string),
- SBYTES (string));
- if (completion_ignore_case && !SYMBOLP (tem))
- {
- for (i = ASIZE (collection) - 1; i >= 0; i--)
- {
- tail = AREF (collection, i);
- if (SYMBOLP (tail))
- while (1)
- {
- if (BASE_EQ (Fcompare_strings (string, make_fixnum (0),
- Qnil,
- Fsymbol_name (tail),
- make_fixnum (0) , Qnil, Qt),
- Qt))
- {
- tem = tail;
- break;
- }
- if (XSYMBOL (tail)->u.s.next == 0)
- break;
- XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
- }
- }
- }
-
- if (!SYMBOLP (tem))
- return Qnil;
- }
else if (HASH_TABLE_P (collection))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (collection);
#include "lisp.h"
#include "character.h"
-/* Lists of keywords and other symbols that are defined before
- packages are ready to use. These are fixed up and the lists set
- to nil when the package system is ready. */
-
-static Lisp_Object early_keywords, early_symbols;
+/* The package registry, a hash-table of package names to package
+ objects. */
Lisp_Object Vpackage_registry;
+
+/* The two standard packages. */
+
Lisp_Object Vemacs_package, Vkeyword_package;
+
+/* The current package. */
+
Lisp_Object Vearmuffs_package;
+
+/* If nil, */
+
Lisp_Object Vpackage_prefixes;
/***********************************************************************
return symbol;
}
+static Lisp_Object
+lookup_symbol (Lisp_Object name, Lisp_Object package)
+{
+ return lookup_symbol1(name, package, Qnil);
+}
+
static Lisp_Object
add_to_package_symbols (Lisp_Object symbol, Lisp_Object package)
{
Fremhash (SYMBOL_NAME (symbol), XPACKAGE (package)->symbols);
}
-static Lisp_Object
-lookup_symbol (Lisp_Object name, Lisp_Object package)
-{
- return lookup_symbol1(name, package, Qnil);
-}
-
/* Add a new SYMBOL to package PACKAGE. Value is SYMBOL. The symbol
is made external if PACKAGE is the keyword package. Otherwise it
is internal. */
-Lisp_Object
+static Lisp_Object
pkg_add_symbol (Lisp_Object symbol, Lisp_Object package)
{
eassert (SYMBOLP (symbol));
return add_to_package_symbols (symbol, package);
}
-/* Add a new keyword by adding SYMBOL to the keyword package. */
-
-Lisp_Object
-pkg_add_keyword (Lisp_Object symbol)
-{
- /* Symbol-value of a keyword is itself, and cannot be set. */
- XSYMBOL (symbol)->u.s.redirect = SYMBOL_PLAINVAL;
- XSYMBOL (symbol)->u.s.val.value = symbol;
- make_symbol_constant (symbol);
-
- /* Mark keywords as special. This makes (let ((:key 'foo)) ...)
- in lexically bound elisp signal an error, as documented. */
- XSYMBOL (symbol)->u.s.declared_special = true;
-
- pkg_add_symbol (symbol, Vkeyword_package);
- return symbol;
-}
-
/* Add SYMBOL to PACKAGE's shadowing symbols, if not already
present. */
Otherwise, add a new symbol to PACKAGE. Value is the symbol found
or newly inserted. */
-static Lisp_Object
+Lisp_Object
pkg_intern_symbol (const Lisp_Object symbol_or_name, Lisp_Object package)
{
+ /* PKG-FIXME this symbol_or_name is shit. */
eassert (PACKAGEP (package));
const Lisp_Object name
/* Not found. If intended as a keyword, add it there. */
if (EQ (package, Vkeyword_package))
- return pkg_add_keyword (Fmake_symbol (name));
+ return pkg_intern_keyword (name);
/* Not found, and we have already a symbol, use that symbol. */
if (SYMBOLP (symbol_or_name))
return pkg_add_symbol (Fmake_symbol (name), package);
}
-bool
-pkg_intern_name_c_string (const char *p, ptrdiff_t len, Lisp_Object *symbol)
+/* Lookup or create a new keyword with name NAME. */
+
+Lisp_Object
+pkg_intern_keyword (Lisp_Object name)
{
- Lisp_Object name = make_unibyte_string (p, len);
- *symbol = pkg_intern_symbol (name, Vearmuffs_package);
- return true;
+ eassert (STRINGP (name));
+ eassert (SREF (name, 0) != ':');
+ Lisp_Object keyword = lookup_symbol (name, Vkeyword_package);
+ if (EQ (keyword, Qunbound))
+ {
+ keyword = Fmake_symbol (name);
+ /* Symbol-value of a keyword is itself, and cannot be set. */
+ XSYMBOL (keyword)->u.s.redirect = SYMBOL_PLAINVAL;
+ XSYMBOL (keyword)->u.s.val.value = keyword;
+ make_symbol_constant (keyword);
+ /* Mark keywords as special. This makes (let ((:key 'foo)) ...)
+ in lexically bound elisp signal an error, as documented. */
+ XSYMBOL (keyword)->u.s.declared_special = true;
+ pkg_add_symbol (keyword, Vkeyword_package);
+ }
+ else
+ eassert (EQ (SYMBOL_PACKAGE (keyword), Vkeyword_package));
+
+ return keyword;
}
+/* Define KEYWORD as keyword symbol. */
+
Lisp_Object
-pkg_lookup_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes)
+pkg_define_keyword (Lisp_Object keyword)
{
- const Lisp_Object name = make_string_from_bytes (ptr, nchars, nbytes);
- return lookup_symbol (name, Vearmuffs_package);
+ eassert (SYMBOLP (keyword));
+ eassert (!EQ (keyword, Qunbound));
+ eassert (SREF (SYMBOL_NAME (keyword), 0) != ':');
+
+ /* Symbol-value of a keyword is itself, and cannot be set. */
+ XSYMBOL (keyword)->u.s.redirect = SYMBOL_PLAINVAL;
+ XSYMBOL (keyword)->u.s.val.value = keyword;
+ make_symbol_constant (keyword);
+ /* Mark keywords as special. This makes (let ((:key 'foo)) ...)
+ in lexically bound elisp signal an error, as documented. */
+ XSYMBOL (keyword)->u.s.declared_special = true;
+ return pkg_add_symbol (keyword, Vkeyword_package);
}
-void
-pkg_early_intern_symbol (Lisp_Object symbol)
+Lisp_Object
+pkg_define_non_keyword (Lisp_Object symbol)
+{
+ eassert (!EQ (symbol, Qunbound));
+ return pkg_add_symbol (symbol, Vemacs_package);
+}
+
+Lisp_Object
+pkg_intern_non_keyword (Lisp_Object name)
{
- pkg_intern_symbol (symbol, Vemacs_package);
+ return pkg_intern_symbol (name, Vearmuffs_package);
+}
+
+Lisp_Object
+pkg_intern_non_keyword_c_string (const char *p, ptrdiff_t len)
+{
+ const Lisp_Object name = make_unibyte_string (p, len);
+ return pkg_intern_non_keyword (name);
+}
+
+Lisp_Object
+pkg_intern_maybe_keyword (Lisp_Object name)
+{
+ CHECK_STRING (name);
+ if (SREF (name, 0) == ':')
+ {
+ const Lisp_Object keyword_name = Fsubstring (name, make_fixnum (1), Qnil);
+ return pkg_intern_keyword (keyword_name);
+ }
+ return pkg_intern_non_keyword (name);
+}
+
+Lisp_Object
+pkg_lookup_non_keyword_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes)
+{
+ eassert (*ptr != ':');
+ const Lisp_Object name = make_string_from_bytes (ptr, nchars, nbytes);
+ return lookup_symbol (name, Vearmuffs_package);
}
static Lisp_Object
DEFSYM (Qpackage_registry, "package-registry");
DEFSYM (Qpackagep, "packagep");
- staticpro (&early_symbols);
- early_keywords = Qnil;
- staticpro (&early_keywords);
- early_keywords = Qnil;
-
staticpro (&Vpackage_registry);
/* PKG-FIXME: Not sure about the purecopy (last arg). */
Vpackage_registry = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE,
projects / emacs.git / commitdiff