From b3cdb8a3d3aba0ea537ecabd2900a3682e7c0660 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Gerd=20M=C3=B6llmann?= Date: Wed, 12 Oct 2022 13:53:07 +0200 Subject: [PATCH] Intern keywords differently Instead of something like (intern (format ":%s" ...)) do (intern (format "%s" :keyword). Likewise in C. --- lisp/auth-source.el | 2 +- lisp/emacs-lisp/cl-macs.el | 2 +- lisp/emacs-lisp/macroexp.el | 2 +- lisp/net/nsm.el | 2 +- lisp/obsolete/cl-compat.el | 2 +- lisp/org/ox-ascii.el | 2 +- lisp/org/ox-html.el | 2 +- lisp/org/ox-koma-letter.el | 2 +- lisp/org/ox.el | 2 +- src/image.c | 2 +- src/lisp.h | 2 ++ src/lread.c | 35 +++++++++++++++++++------- src/pkg.c | 13 ++++++++++ test/lisp/erc/resources/erc-d/erc-d.el | 2 +- 14 files changed, 52 insertions(+), 20 deletions(-) diff --git a/lisp/auth-source.el b/lisp/auth-source.el index feefd391a87..5d1e58d303b 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -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) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index beafee1d631..394ba1e1e0e 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -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 diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index f4df40249de..abcb3e3e6b5 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -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 !!! diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 3146189be63..ed8228d97e9 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -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 diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el index e58f475d1c2..a68bec8d2de 100644 --- a/lisp/obsolete/cl-compat.el +++ b/lisp/obsolete/cl-compat.el @@ -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 diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el index 76a1a71fabe..c488d6d10b9 100644 --- a/lisp/org/ox-ascii.el +++ b/lisp/org/ox-ascii.el @@ -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))) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 9cf9125aebd..e3f0cb569f5 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -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 diff --git a/lisp/org/ox-koma-letter.el b/lisp/org/ox-koma-letter.el index 5f62cd1c040..dbc23be5875 100644 --- a/lisp/org/ox-koma-letter.el +++ b/lisp/org/ox-koma-letter.el @@ -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)))))) diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 56bb4b74df3..6b8925b0db4 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -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)) diff --git a/src/image.c b/src/image.c index 1e323ba66a0..f6209149313 100644 --- a/src/image.c +++ b/src/image.c @@ -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; diff --git a/src/lisp.h b/src/lisp.h index 68a7233abd0..c5ce309306f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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; diff --git a/src/lread.c b/src/lread.c index 4260850399f..edd50efd16b 100644 --- a/src/lread.c +++ b/src/lread.c @@ -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"); diff --git a/src/pkg.c b/src/pkg.c index 03533dceacd..5a021ac39de 100644 --- a/src/pkg.c +++ b/src/pkg.c @@ -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 diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el index d6082227c52..6cbe26bb8b4 100644 --- a/test/lisp/erc/resources/erc-d/erc-d.el +++ b/test/lisp/erc/resources/erc-d/erc-d.el @@ -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))) -- 2.39.2