/* Common Lisp style packages. Copyright (C) 2022 Free Software Foundation, Inc. Author: Gerd Möllmann This file is part of GNU Emacs. GNU Emacs is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ /* Common Lisp style packages. Useful features that could be added: package locks hierarchical packages package-local nicknames */ #include #include "lisp.h" #include "character.h" /*********************************************************************** Useless tools ***********************************************************************/ /* Signal an error with arguments like printf. */ void pkg_error (const char *fmt, ...) { va_list ap; va_start (ap, fmt); verror (fmt, ap); } /* Iterator for hash tables. */ struct h_iter { /* Hash table being iterated over. */ struct Lisp_Hash_Table *h; /* Current index in key/value vector of H. */ ptrdiff_t i; /* Key and value at I, or nil. */ Lisp_Object key, value; }; /* Return a freshly initialized iterator for iterating over hash table TABLE. */ static struct h_iter h_init (Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); struct h_iter it = {.h = h, .i = 0, .key = Qnil, .value = Qnil}; return it; } /* Value is true if iterator IT is on a valid poisition. If it is, IT->key and IT->value are set to key and value at that position. */ static bool h_valid (struct h_iter *it) { for (; it->i < HASH_TABLE_SIZE (it->h); ++it->i) if (!EQ (HASH_KEY (it->h, it->i), Qunbound)) { it->key = HASH_KEY (it->h, it->i); it->value = HASH_VALUE (it->h, it->i); return true; } return false; } /* Advance to next element. */ static void h_next (struct h_iter *it) { ++it->i; } /* Macrology. IT is a variable name that is bound to an iterator over hash table TABLE for the duration of the loop. */ #define FOR_EACH_KEY_VALUE(it, table) \ for (struct h_iter it = h_init (table); h_valid (&it); h_next (&it)) /* Sometimes useful for setting a breakpoint, after inserting it somewhere in the code. */ void pkg_break (void) { } /*********************************************************************** Package registry ***********************************************************************/ /* Create and return a new Lisp package object for a package with name NAME, a string. NSYMBOLS is the sieo of the symbol-table to allocate. */ static Lisp_Object pkg_make_package (Lisp_Object name, Lisp_Object nsymbols) { struct Lisp_Package *pkg = ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Package, symbols, PVEC_PACKAGE); pkg->name = name; pkg->symbols = CALLN (Fmake_hash_table, QCtest, Qstring_equal, QCsize, nsymbols); Lisp_Object package; XSETPACKAGE (package, pkg); return package; } /* Find a package named NAME in the package registry. Value is the package found, or nil if nothing was found. */ Lisp_Object pkg_find_package (Lisp_Object name) { CHECK_STRING (name); return Fgethash (name, Vpackage_registry, Qnil); } /* Register package PACKAGE in the package registry, that is, make it known under its name and all its nicknames. */ static void pkg_register_package (Lisp_Object package) { const struct Lisp_Package *pkg = XPACKAGE (package); Fputhash (pkg->name, package, Vpackage_registry); Lisp_Object tail = pkg->nicknames; FOR_EACH_TAIL (tail) Fputhash (XCAR (tail), package, Vpackage_registry); } /*********************************************************************** String and package designators ***********************************************************************/ /* Return a string for DESIGNATOR. If DESIGNATOR is a symbol, return the symbol's name. If DESIGNATOR is a string, return that string. If DESIGNATOR is a character, return a string that contains only that character. If it is neither, signal an error. */ static Lisp_Object pkg_string_from_designator (Lisp_Object designator) { if (SYMBOLP (designator)) return SYMBOL_NAME (designator); if (STRINGP (designator)) return designator; if (CHARACTERP (designator)) return Fchar_to_string (designator); signal_error ("Not a string designator", designator); } /* Value is PACKAGE if it is a package, otherwise signal an error. */ static Lisp_Object pkg_package_or_lose (Lisp_Object package) { if (PACKAGEP (package)) return package; CHECK_PACKAGE (package); return Qnil; } /* Return a package for a package designator DESIGNATOR. If DESIGNATOR is a package, return that package. Otherwise, DESIGNATOR must a string designator for a registered package. Signal an error in the designator case if the package is not registered. */ static Lisp_Object pkg_package_from_designator (Lisp_Object designator) { /* Not signaling here if DESIGNATOR is not registered is odd, but I think that's what CLHS says. */ if (PACKAGEP (designator)) return designator; const Lisp_Object name = pkg_string_from_designator (designator); const Lisp_Object package = pkg_find_package (name); return pkg_package_or_lose (package); } /* Value is the package designated by DESIGNATOR, or the value of "*package*" if DESIGNATOR is nil. */ static Lisp_Object pkg_package_or_default (Lisp_Object designator) { if (NILP (designator)) return pkg_package_or_lose (Vearmuffs_package); return pkg_package_from_designator (designator); } /*********************************************************************** Symbol table ***********************************************************************/ /* Find a symbol with name NAME in PACKAGE or one of the packages it inherits from. Value is Qunbound if no symbol is found. SEEN is a list of packages that have already been checked, to prevent infinte recursion. If STATUS is not null, return in it the status of the symbol, one of :internal, :external, :inhertied. */ static Lisp_Object pkg_find_symbol1 (Lisp_Object name, Lisp_Object package, Lisp_Object seen, Lisp_Object *status) { eassert (STRINGP (name)); eassert (PACKAGEP (package)); eassert (CONSP (seen) || NILP (seen)); Lisp_Object symbol = Qunbound; if (status) *status = Qnil; const struct Lisp_Package *pkg = XPACKAGE (package); struct Lisp_Hash_Table *h = XHASH_TABLE (PACKAGE_SYMBOLS (package)); ptrdiff_t i = hash_lookup (h, name, NULL); if (i >= 0) { symbol = HASH_KEY (h, i); if (status) *status = HASH_VALUE (h, i); } else { if (status) *status = QCinherited; Lisp_Object tail = pkg->use_list; FOR_EACH_TAIL (tail) { const Lisp_Object used_package = XCAR (tail); if (NILP (Fmemq (used_package, seen))) { seen = Fcons (used_package, seen); symbol = pkg_find_symbol1 (name, used_package, seen, NULL); if (!EQ (symbol, Qunbound)) return symbol; } } } return symbol; } /* Find a symbol with name NAME in PACKAGE or one of the packages it inherits from. Value is Qunbound if no symbol is found. If STATUS is not null, return in it the status of the symbol, one of :internal, :external, :inhertied. */ Lisp_Object pkg_find_symbol (Lisp_Object name, Lisp_Object package, Lisp_Object *status) { return pkg_find_symbol1 (name, package, Qnil, status); } /* Add SYMBOL to package PACKAGE. Value is SYMBOL. The symbol gets status STATUS in PACKAGE (one of :external or :internal). */ static Lisp_Object pkg_add_symbol (Lisp_Object symbol, Lisp_Object status, Lisp_Object package) { eassert (SYMBOLP (symbol)); eassert (SYMBOLP (status)); eassert (PACKAGEP (package)); Fputhash (symbol, status, PACKAGE_SYMBOLS (package)); return symbol; } /* Remove SYMBOL from PACKAGE. */ static void pkg_remove_symbol (Lisp_Object symbol, Lisp_Object package) { eassert (SYMBOLP (symbol)); eassert (PACKAGEP (package)); XPACKAGE (package)->shadowing_symbols = Fdelq (symbol, XPACKAGE (package)->shadowing_symbols); Fremhash (symbol, PACKAGE_SYMBOLS (package)); } /* Intern a symbol with name NAME to PACKAGE. If a symbol with name NAME is already accessible in PACKAGE, return that symbol. Otherwise, add a new symbol to PACKAGE. If EXISTING_SYMBOL is not Qunbound, use that symbol instead of making a new one. This is used for built-in symbols. Value is the symbol found or newly inserted. Return in *STATUS the status of the SYMBOL in PACKAGE. */ static Lisp_Object pkg_intern_symbol1 (const Lisp_Object name, Lisp_Object package, Lisp_Object *status, Lisp_Object existing_symbol) { /* PKG-FIXME this symbol_or_name is shit. */ CHECK_STRING (name); eassert (PACKAGEP (package)); /* If already accessible in package, return that. */ Lisp_Object symbol = pkg_find_symbol (name, package, status); if (!EQ (symbol, Qunbound)) return symbol; /* Not found. If we have an existing symbol (which should be a built-in symbol), use that, otherwise make a new one. */ if (!EQ (existing_symbol, Qunbound)) symbol = existing_symbol; else symbol = Fmake_symbol (name); /* PACKAGE becomes the home package of the symbol created. */ XSYMBOL (symbol)->u.s.package = package; if (EQ (package, Vkeyword_package)) { if (status) *status = QCexternal; /* 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, QCexternal, Vkeyword_package); } else { if (status) *status = QCinternal; pkg_add_symbol (symbol, QCinternal, package); } return symbol; } /* Intern a symbol that is not a built-in symbol. */ Lisp_Object pkg_intern_symbol (const Lisp_Object name, Lisp_Object package, Lisp_Object *status) { return pkg_intern_symbol1 (name, package, status, Qunbound); } /* Define SYMBOL in package. This is called from define_symbol for built-in symbols. */ Lisp_Object pkg_define_symbol (Lisp_Object symbol, Lisp_Object package) { return pkg_intern_symbol1 (SYMBOL_NAME (symbol), package, NULL, symbol); } /* Intern NAME, which may or may not have a ':' in its name, that is might be intended to be a keyword. */ Lisp_Object pkg_intern_maybe_keyword (Lisp_Object name) { CHECK_STRING (name); if (SREF (name, 0) == ':') { name = Fsubstring (name, make_fixnum (1), Qnil); return pkg_intern_symbol (name, Vkeyword_package, NULL); } return pkg_intern_symbol (name, Vearmuffs_package, NULL); } /* Find a symbol in *package* that has a name given by PTR, NCHARS, and NBYTES. */ 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 pkg_find_symbol (name, Vearmuffs_package, NULL); } /* Unintern SYMBOL from PACKAGE. Value is Qt if removed. */ static Lisp_Object pkg_unintern_symbol (Lisp_Object symbol, Lisp_Object package) { CHECK_SYMBOL (symbol); package = pkg_package_or_default (package); Lisp_Object status; Lisp_Object found = pkg_find_symbol (SYMBOL_NAME (symbol), package, &status); Lisp_Object removedp = Qnil; if (!EQ (found, Qunbound) && !EQ (status, QCinherited)) { /* Symbol is present in the package. Remove it from the symbol table and shadowing list. */ removedp = Qt; pkg_remove_symbol (symbol, package); } if (EQ (package, SYMBOL_PACKAGE (symbol))) XSYMBOL (symbol)->u.s.package = Qnil; return removedp; } /* Map function FN over symbols in PACKAGE. */ static void pkg_map_package_symbols (Lisp_Object fn, Lisp_Object package) { package = pkg_package_or_lose (package); FOR_EACH_KEY_VALUE (it, PACKAGE_SYMBOLS (package)) call1 (fn, it.key); } /* Return a list of all registered packages. */ static Lisp_Object pkg_list_all_packages (void) { Lisp_Object all = Qnil; FOR_EACH_KEY_VALUE (it, Vpackage_registry) if (NILP (Fmemq (it.value, all))) all = Fcons (it.value, all); return all; } /* Map FUNCTION over all symbols in PACKAGE. */ static void pkg_map_symbols (Lisp_Object function) { Lisp_Object tail = pkg_list_all_packages (); FOR_EACH_TAIL (tail) pkg_map_package_symbols (function, XCAR (tail)); } /* Map a C funtion FN over all symbols in all registered packages. The function is called with first argument being the symbol, and second argument ARG. */ void pkg_map_symbols_c_fn (void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) { Lisp_Object tail = pkg_list_all_packages (); FOR_EACH_TAIL (tail) FOR_EACH_KEY_VALUE (it, PACKAGE_SYMBOLS (XCAR (tail))) fn (it.key, arg); } /* Value is true if obj is a keyword symbol. */ bool pkg_keywordp (Lisp_Object obj) { return SYMBOLP (obj) && EQ (SYMBOL_PACKAGE (obj), Vkeyword_package); } static Lisp_Object pkg_set_status (Lisp_Object symbol, Lisp_Object package, Lisp_Object status) { CHECK_SYMBOL (symbol); CHECK_PACKAGE (package); if (!EQ (status, QCinternal) && !EQ (status, QCexternal)) pkg_error ("Invalid symbol status %s", status); struct Lisp_Hash_Table *h = XHASH_TABLE (PACKAGE_SYMBOLS (package)); ptrdiff_t i = hash_lookup (h, SYMBOL_NAME (symbol), NULL); eassert (i >= 0); ASET (h->key_and_value, 2 * i + 1, status); return Qnil; } /*********************************************************************** Traditional Emacs intern stuff ***********************************************************************/ /* The idea behinf this is as follows: We want to get rid of Lisp_Symbol::next. But legcacy code may still obarrays. We accept these in some place (they are just vectors, which no indication that they are obarrays). When we come across such a vector, create a package and store it in its slot 0. Then we use that package behind the scenes. */ static Lisp_Object pkg_fake_me_an_obarray (Lisp_Object vector) { eassert (VECTORP (vector)); Lisp_Object package = Faref (vector, make_fixnum (0)); if (!PACKAGEP (package)) { package = pkg_make_package (build_string ("obarray"), Flength (vector)); Faset (vector, make_fixnum (0), package); } return package; } /* Implements Emacs' traditional Fintern function. */ Lisp_Object pkg_emacs_intern (Lisp_Object name, Lisp_Object package) { CHECK_STRING (name); /* PKG-FIXME: We are assuming that this is intended to be a keyword like it was before. */ if (SREF (name, 0) == ':' && NILP (package)) { name = Fsubstring (name, make_fixnum (1), Qnil); package = Vkeyword_package; } eassert (SREF (name, 0) != ':'); if (VECTORP (package)) package = pkg_fake_me_an_obarray (package); package = pkg_package_or_default (package); return pkg_intern_symbol (name, package, NULL); } /* Implements Emacs' traditional Fintern_soft function. */ Lisp_Object pkg_emacs_intern_soft (Lisp_Object name, Lisp_Object package) { /* intern-soft allows symbols. */ Lisp_Object orig = name; if (SYMBOLP (name)) name = SYMBOL_NAME (name); CHECK_STRING (name); /* PKG-FIXME: We are assuming that this is intended to be a keyword like it was before. */ if (SREF (name, 0) == ':' && NILP (package)) { name = Fsubstring (name, make_fixnum (1), Qnil); package = Vkeyword_package; } if (VECTORP (package)) package = pkg_fake_me_an_obarray (package); package = pkg_package_or_default (package); Lisp_Object found = pkg_find_symbol (name, package, NULL); if (EQ (found, Qunbound)) return Qnil; if (SYMBOLP (orig) && !EQ (found, orig)) return Qnil; /* We should never find an uninterned symbol in a package. */ eassert (!NILP (SYMBOL_PACKAGE (found))); return found; } /* Implements Emacs' traditional Funintern function. */ Lisp_Object pkg_emacs_unintern (Lisp_Object name, Lisp_Object package) { if (VECTORP (package)) package = pkg_fake_me_an_obarray (package); package = pkg_package_or_default (package); return pkg_unintern_symbol (name, package); } /* Implements Emacs mapatoms. */ Lisp_Object pkg_emacs_mapatoms (Lisp_Object function, Lisp_Object package) { if (VECTORP (package)) package = pkg_fake_me_an_obarray (package); if (NILP (package)) pkg_map_symbols (function); else pkg_map_package_symbols (function, package); return Qnil; } /*********************************************************************** Reader ***********************************************************************/ /* We have read a symbol with NAME, and a package prefix for PACKAGE. EXTERNAL means that we have seen ':' and not '::'. Value is the symbol for that case. */ Lisp_Object pkg_qualified_symbol (Lisp_Object name, Lisp_Object package, bool external) { /* If we want a symbol for a given package, check the package has that symbol and its accessibily. */ Lisp_Object status; Lisp_Object found = pkg_find_symbol (name, package, &status); if (EQ (package, Vkeyword_package)) { /* If found, use that symbol, else make a new one. PKG-FIXME: there might already be a symbol named 'test' in the obarray, and we'd like to use that name for ':test'. That's a problem. */ if (EQ (found, Qunbound)) return pkg_intern_symbol (name, package, NULL); return found; } if (EQ (found, Qunbound)) pkg_error ("Symbol '%s' is not accessible in package '%s'", SDATA (name), SDATA (PACKAGE_NAMEX (package))); /* Check if the symbol is accesible in the package as external symbol. PKG-FIXME: Check what to do for inherited symbols. */ if (external && EQ (status, QCinternal)) pkg_error ("Symbol '%s' is internal in package '%s'", SDATA (name), SDATA (PACKAGE_NAMEX (package))); return found; } /* Return symbol with name NAME when accessed without qualification in the current package. */ Lisp_Object pkg_unqualified_symbol (Lisp_Object name) { const Lisp_Object package = pkg_package_or_lose (Vearmuffs_package); if (EQ (package, Vkeyword_package)) return pkg_qualified_symbol (name, package, true); /* If we want a symbol for a given package, check the package has that symboland its accessibily. */ Lisp_Object status; const Lisp_Object found = pkg_find_symbol (name, package, &status); if (!EQ (found, Qunbound)) return found; return pkg_intern_symbol (name, package, NULL); } /*********************************************************************** Lisp functions ***********************************************************************/ DEFUN ("make-%package", Fmake_percent_package, Smake_percent_package, 2, 2, 0, doc: /**/) (Lisp_Object name, Lisp_Object size) { CHECK_STRING (name); CHECK_FIXNAT (size); return pkg_make_package (name, size); } DEFUN ("packagep", Fpackagep, Spackagep, 1, 1, 0, doc: /* Value is non-nil if PACKAGE is a package object. */) (Lisp_Object package) { return PACKAGEP (package) ? Qt : Qnil; } DEFUN ("find-symbol", Ffind_symbol, Sfind_symbol, 1, 2, 0, doc: /* Find symbol with name NAME in PACKAGE. If PACKAGE is omitted, use the current package. Value is nil if no symbol is found. Otherwise, value is a list (SYMBOL STATUS), where SYMBOL is the symbol that was found, and STATUS is one of the following: `internal' if SYMBOL is present in PACKAGE as an internal symbol. `external' if SYMBOL is present in PACKAGE as an external symbol. `inherited' if SYMBOL is inherited via `use-package'. */) (Lisp_Object name, Lisp_Object package) { CHECK_STRING (name); package = pkg_package_or_default (package); Lisp_Object status; const Lisp_Object symbol = pkg_find_symbol (name, package, &status); if (EQ (symbol, Qunbound)) return Qnil; return list2 (symbol, status); } /* PKG-FIXME: Make this somehow compatible with Emacs' intern? */ DEFUN ("cl-intern", Fcl_intern, Scl_intern, 1, 2, 0, doc: /* Enter a symbol with name NAME into PACKAGE. If PACKAGE is omitted, use the current package. Value is a list (SYMBOL STATUS). If a symbol with name NAME is already accessible, SYMBOL is that symbol, and STATUS is it's status in the package. Otherwise, a new SYMBOL is created, whose status 'external' if package is the keyword package, or 'internal' if not. */) (Lisp_Object name, Lisp_Object package) { CHECK_STRING (name); package = pkg_package_or_default (package); Lisp_Object status; const Lisp_Object symbol = pkg_intern_symbol (name, package, &status); return list2 (symbol, status); } DEFUN ("cl-unintern", Fcl_unintern, Scl_unintern, 1, 2, 0, doc: /* tbd */) (Lisp_Object symbol, Lisp_Object package) { return pkg_unintern_symbol (symbol, package); } DEFUN ("pkg-break", Fpkg_read, Spkg_read, 1, 1, 0, doc: /* tbd */) (Lisp_Object stream) { pkg_break (); return Qnil; } /*********************************************************************** Internal access to packages ***********************************************************************/ DEFUN ("package-%name", Fpackage_percent_name, Spackage_percent_name, 1, 1, 0, doc: /* Internal use only. */) (Lisp_Object package) { CHECK_PACKAGE (package); return PACKAGE_NAMEX (package); } DEFUN ("package-%set-name", Fpackage_percent_set_name, Spackage_percent_set_name, 2, 2, 0, doc: /* Internal use only. */) (Lisp_Object package, Lisp_Object name) { CHECK_PACKAGE (package); CHECK_STRING (name); return XPACKAGE (package)->name = name; } DEFUN ("package-%nicknames", Fpackage_percent_nicknames, Spackage_percent_nicknames, 1, 1, 0, doc: /* Internal use only. */) (Lisp_Object package) { CHECK_PACKAGE (package); return XPACKAGE (package)->nicknames; } DEFUN ("package-%set-nicknames", Fpackage_percent_set_nicknames, Spackage_percent_set_nicknames, 2, 2, 0, doc: /* Internal use only. */) (Lisp_Object package, Lisp_Object nicknames) { CHECK_PACKAGE (package); return XPACKAGE (package)->nicknames = nicknames; } DEFUN ("package-%use-list", Fpackage_percent_use_list, Spackage_percent_use_list, 1, 1, 0, doc: /* Internal use only. */) (Lisp_Object package) { CHECK_PACKAGE (package); return XPACKAGE (package)->use_list; } DEFUN ("package-%set-use-list", Fpackage_percent_set_use_list, Spackage_percent_set_use_list, 2, 2, 0, doc: /* Internal use only. */) (Lisp_Object package, Lisp_Object use_list) { CHECK_PACKAGE (package); return XPACKAGE (package)->use_list = use_list; } DEFUN ("package-%shadowing-symbols", Fpackage_percent_shadowing_symbols, Spackage_percent_shadowing_symbols, 1, 1, 0, doc: /* Internal use only. */) (Lisp_Object package) { CHECK_PACKAGE (package); return XPACKAGE (package)->shadowing_symbols; } DEFUN ("package-%set-shadowing-symbols", Fpackage_percent_set_shadowing_symbols, Spackage_percent_set_shadowing_symbols, 2, 2, 0, doc: /* Internal use only. */) (Lisp_Object package, Lisp_Object shadowing_symbols) { CHECK_PACKAGE (package); return XPACKAGE (package)->shadowing_symbols = shadowing_symbols; } DEFUN ("package-%symbols", Fpackage_percent_symbols, Spackage_percent_symbols, 1, 1, 0, doc: /* Internal use only. */) (Lisp_Object package) { CHECK_PACKAGE (package); return XPACKAGE (package)->symbols; } DEFUN ("package-%set-status", Fpackage_percent_set_status, Spackage_percent_set_status, 3, 3, 0, doc: /* Internal use only. */) (Lisp_Object symbol, Lisp_Object package, Lisp_Object status) { return pkg_set_status (symbol, package, status); } /*********************************************************************** Initialization ***********************************************************************/ /* Called very early, after init_alloc_once and init_obarray_once. Not called when starting a dumped Emacs. */ void init_pkg_once (void) { DEFSYM (QCexternal, ":external"); DEFSYM (QCinherited, ":inherited"); DEFSYM (QCinternal, ":internal"); DEFSYM (QCnicknames, ":nicknames"); DEFSYM (QCuse, ":use"); DEFSYM (Qearmuffs_package, "*package*"); DEFSYM (Qemacs_package, "emacs-package"); DEFSYM (Qkeyword, "keyword"); DEFSYM (Qkeyword_package, "keyword-package"); DEFSYM (Qpackage, "package"); DEFSYM (Qpackage_prefixes, "package-prefixes"); DEFSYM (Qpackage_registry, "package-registry"); DEFSYM (Qpackagep, "packagep"); staticpro (&Vpackage_registry); Vpackage_registry = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, Qnil, false); staticpro (&Vemacs_package); Vemacs_package = pkg_make_package (build_string ("emacs"), make_fixnum (100000)); pkg_register_package (Vemacs_package); staticpro (&Vkeyword_package); Vkeyword_package = pkg_make_package (build_string ("keyword"), make_fixnum (5000)); XPACKAGE (Vkeyword_package)->nicknames = Fcons (build_string (""), Qnil); pkg_register_package (Vkeyword_package); staticpro (&Vearmuffs_package); Vearmuffs_package = Vemacs_package; XSYMBOL (Qearmuffs_package)->u.s.declared_special = true; DEFSYM (Qpackage_prefixes, "package-prefixes"); staticpro (&Vpackage_prefixes); Vpackage_prefixes = Qnil; pkg_define_builtin_symbols (); } /* Not called when starting a dumped Emacs. */ void syms_of_pkg (void) { DEFVAR_LISP_NOPRO ("*package-registry*", Vpackage_registry, doc: /* The package registry. For internal use only. */); DEFVAR_LISP_NOPRO ("*emacs-package*", Vemacs_package, doc: /* The Emacs package. For internal use only. */); DEFVAR_LISP_NOPRO ("*keyword-package*", Vkeyword_package, doc: /* The keyword package. For internal use only. */); DEFVAR_LISP_NOPRO ("*package*", Vearmuffs_package, doc: /* The current package. */); DEFVAR_LISP_NOPRO ("package-prefixes", Vpackage_prefixes, doc: /* */); Fmake_variable_buffer_local (Qpackage_prefixes); defsubr (&Scl_intern); defsubr (&Scl_unintern); defsubr (&Sfind_symbol); defsubr (&Smake_percent_package); defsubr (&Spackage_percent_name); defsubr (&Spackage_percent_nicknames); defsubr (&Spackage_percent_set_name); defsubr (&Spackage_percent_set_nicknames); defsubr (&Spackage_percent_set_shadowing_symbols); defsubr (&Spackage_percent_set_status); defsubr (&Spackage_percent_set_use_list); defsubr (&Spackage_percent_shadowing_symbols); defsubr (&Spackage_percent_symbols); defsubr (&Spackage_percent_use_list); defsubr (&Spackagep); defsubr (&Spkg_read); Fmake_variable_buffer_local (Qpackage_prefixes); } /* Called when starting a dumped Emacs. */ void init_pkg (void) { }