Intern keywords differently

Instead of something like (intern (format ":%s" ...)) do
(intern (format "%s" :keyword).  Likewise in C.
This commit is contained in:
Gerd Möllmann 2022-10-12 13:53:07 +02:00
parent 3e29407122
commit b3cdb8a3d3
14 changed files with 52 additions and 20 deletions

View file

@ -1160,7 +1160,7 @@ FILE is the file from which we obtained this token."
(point-max))))))
(defun auth-source--symbol-keyword (symbol)
(intern (format ":%s" symbol)))
(intern (format "%s" symbol) :keyword))
(defun auth-source-netrc-normalize (alist filename)
(mapcar (lambda (entry)

View file

@ -611,7 +611,7 @@ its argument list allows full Common Lisp conventions."
;; shouldn't affect the key's name (bug#12367).
(if (eq ?_ (aref name 0))
(setq name (substring name 1)))
(intern (format ":%s" name)))))
(intern (format "%s" name) :keyword))))
(varg (if (consp (car arg)) (cadar arg) (car arg)))
(def (if (cdr arg) (cadr arg)
;; The ordering between those two or clauses is

View file

@ -819,7 +819,7 @@ test of free variables in the following ways:
;; Hopefully this shouldn't happen thanks to the cycle detection,
;; but in case it does happen, let's catch the error and give the
;; code a chance to macro-expand later.
(error "Eager macro-expansion failure: %S" err)
(error "Eager macro-expansion failure: %S in %S" err form)
form))))))
;; ¡¡¡ Big Ugly Hack !!!

View file

@ -273,7 +273,7 @@ See also: `network-security-protocol-checks' and `nsm-noninteractive'"
(let* ((results
(cl-loop
for check in network-security-protocol-checks
for type = (intern (format ":%s" (car check)))
for type = (intern (format "%s" (car check)) :keyword)
;; Skip the check if the user has already said that this
;; host is OK for this type of "error".
for result = (and (not (memq type

View file

@ -56,7 +56,7 @@
(cl-list* 'defconst x (list 'quote x) (and doc (list doc))))
(defun keyword-of (sym)
(or (keywordp sym) (keywordp (intern (format ":%s" sym)))))
(or (keywordp sym) (keywordp (intern (format "%s" sym) :keyword))))
;; Multiple values. Note that the new package uses a different

View file

@ -1157,7 +1157,7 @@ holding export options."
(defun org-ascii--translate (s info)
"Translate string S according to specified language and charset.
INFO is a plist used as a communication channel."
(let ((charset (intern (format ":%s" (plist-get info :ascii-charset)))))
(let ((charset (intern (format "%s" (plist-get info :ascii-charset)) :keyword)))
(org-export-translate s charset info)))

View file

@ -1979,7 +1979,7 @@ INFO is a plist used as a communication channel."
"Return document preamble or postamble as a string, or nil.
TYPE is either `preamble' or `postamble', INFO is a plist used as a
communication channel."
(let ((section (plist-get info (intern (format ":html-%s" type))))
(let ((section (plist-get info (intern (format "html-%s" type) :keyword)))
(spec (org-html-format-spec info)))
(when section
(let ((section-contents

View file

@ -774,7 +774,7 @@ a communication channel."
(let* ((check-scope
;; Non-nil value when SETTING was defined in SCOPE.
(lambda (setting)
(let ((property (intern (format ":inbuffer-%s" setting))))
(let ((property (intern (format "inbuffer-%s" setting) :keyword)))
(if (eq scope 'global)
(eq (plist-get info property) 'koma-letter:empty)
(not (eq (plist-get info property) 'koma-letter:empty))))))

View file

@ -1969,7 +1969,7 @@ Return a string."
;; as in the original buffer, and call appropriate filters.
(t
(org-export-filter-apply-functions
(plist-get info (intern (format ":filter-%s" type)))
(plist-get info (intern (format "filter-%s" type) :keyword))
(let ((blank (or (org-element-property :post-blank data) 0)))
(if (eq (org-element-class data parent) 'object)
(concat results (make-string blank ?\s))

View file

@ -10072,7 +10072,7 @@ imagemagick_filename_hint (Lisp_Object spec, char hint_buffer[MaxTextExtent])
if (! CONSP (val))
return NULL;
format = image_spec_value (spec, intern (":format"), NULL);
format = image_spec_value (spec, QCformat, NULL);
val = Fcar_safe (Fcdr_safe (Fassq (format, val)));
if (! STRINGP (val))
return NULL;

View file

@ -2268,6 +2268,8 @@ 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 void pkg_break (void);
extern bool package_system_ready;

View file

@ -4138,7 +4138,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
/* If of the form ||, everything except '|' is considered quoted.
the bars doesn't belong to the symbol name. */
bool in_vertical_bar = false;
if (c == '|')
if (!read_emacs_syntax && c == '|')
{
in_vertical_bar = true;
c = READCHAR;
@ -4160,19 +4160,22 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
{
if (c == ':' && !last_was_backslash && !in_vertical_bar)
{
/* #:xyz should not contain a colon. */
if (uninterned_symbol)
invalid_syntax ("colon in uninterned symbol", readcharfun);
/* Remember where the first : is. */
if (colon == NULL)
colon = p;
++ncolons;
/* Up to two colons are allowed if they are
consecutive. PKG-FIXME check consecutive :. */
if (ncolons > 2)
invalid_syntax ("too many colons", readcharfun);
if (!read_emacs_syntax)
{
/* #:xyz should not contain a colon. */
if (uninterned_symbol)
invalid_syntax ("colon in uninterned symbol", readcharfun);
/* Up to two colons are allowed if they are
consecutive. PKG-FIXME check consecutive :. */
if (ncolons > 2)
invalid_syntax ("too many colons", readcharfun);
}
}
/* Handle backslash. The first backslash is not part of
@ -4219,6 +4222,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
symbol. */
if (in_vertical_bar)
{
eassert (!read_emacs_syntax);
if (c < 0)
end_of_file_error ();
if (c == '|')
@ -4826,6 +4830,8 @@ A second optional argument specifies the obarray to use;
it defaults to the value of `obarray'. */)
(Lisp_Object string, Lisp_Object package)
{
/* PKG-FIXME: Remove this eassert. */
eassert (SREF (string, 0) != ':' || !package_system_ready);
return pkg_emacs_intern (string, package);
}
@ -4862,6 +4868,10 @@ usage: (unintern NAME OBARRAY) */)
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;
@ -4897,6 +4907,7 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff
void
map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
{
eassert (package_system_ready);
ptrdiff_t i;
register Lisp_Object tail;
CHECK_VECTOR (obarray);
@ -4917,6 +4928,7 @@ map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Ob
static void
mapatoms_1 (Lisp_Object sym, Lisp_Object function)
{
eassert (package_system_ready);
call1 (function, sym);
}
@ -4925,6 +4937,7 @@ DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
OBARRAY defaults to the value of `obarray'. */)
(Lisp_Object function, Lisp_Object obarray)
{
eassert (package_system_ready);
if (NILP (obarray)) obarray = Vobarray;
obarray = check_obarray (obarray);
@ -5575,6 +5588,10 @@ that are loaded before your customizations are read! */);
doc: /* Non-nil means not to load a .eln file when a .elc was requested. */);
load_no_native = false;
DEFVAR_BOOL ("read-emacs-syntax", read_emacs_syntax,
doc: /* Non-nil means don't treat ':' or '|' specially in symbols. */);
read_emacs_syntax = true;
/* Vsource_directory was initialized in init_lread. */
DEFSYM (Qcurrent_load_list, "current-load-list");

View file

@ -555,6 +555,15 @@ pkg_intern_name_c_string (const char *p, ptrdiff_t len, Lisp_Object *symbol)
return true;
}
Lisp_Object
pkg_lookup_c_string (const char *ptr, ptrdiff_t nchars, ptrdiff_t nbytes)
{
if (!package_system_ready)
return Qunbound;
const Lisp_Object name = make_string_from_bytes (ptr, nchars, nbytes);
return lookup_symbol (name, Vearmuffs_package);
}
void
pkg_early_intern_symbol (Lisp_Object symbol)
{
@ -582,6 +591,10 @@ pkg_unintern_symbol (Lisp_Object symbol, Lisp_Object package)
return Qnil;
}
void pkg_break (void)
{
}
/***********************************************************************
Old Emacs intern stuff

View file

@ -951,7 +951,7 @@ appearing among DIALOGS."
erc-d-match-handlers))))
(pcase-dolist (`(,var . ,def) defaults)
(push (or (plist-get kwds var) def) args)
(push (intern (format ":dialog-%s" var)) args))
(push (intern (format "dialog-%s" var) :keyword) args))
(apply #'erc-d--start host service (or server-name erc-d-server-name)
args)))