scratch/intern-without-shorthands 7c7616e3f09 1/3: (intern): Don't obey `read-symbol-shorthands` any more (bug#80574)
Stefan Monnier via Mailing list for Emacs changes <[email protected]> Wed, 22 Jul 2026 13:13:35 -0400 (EDT)
| Newsgroups | gmane.emacs.diffs |
|---|---|
| Message-ID | <[email protected]> |
branch: scratch/intern-without-shorthands commit 7c7616e3f09c80723da7c766b6d188d717247ae3 Author: Stefan Monnier <[email protected]> Commit: Stefan Monnier <[email protected]> (intern): Don't obey `read-symbol-shorthands` any more (bug#80574) * src/lread.c (Fintern, Fintern_soft, Funintern): Don't obey `read-symbol-shorthands` any more. * lisp/emacs-lisp/shorthands.el (shorthands-of-symbol): New function, adapted from `elisp--read-symbols-shorthands`. (shorthands-to-longhand, shorthands-intern, shorthands-intern-soft) (shorthands-unintern): New functions. (shorthands-font-lock-shorthands): Use `shorthands-intern-soft`. * lisp/progmodes/elisp-mode.el (elisp-context-menu) (elisp--company-doc-buffer, elisp--company-doc-string) (elisp--company-location, elisp--company-kind) (elisp--company-deprecated, xref-backend-definitions) (elisp--xref-find-definitions, eval-sexp-add-defvars) (elisp--current-symbol): Use `shorthands-intern(-soft)`. (elisp--read-symbol-shorthands): Use `shorthands-of-symbol`. (elisp-completion-at-point): Use the `elisp--longhand` to simplify. Use `shorthands-intern(-soft)`. * lisp/minibuffer.el (completion-shorthand-try-completion): Simplify using `shorthands-to-longhand`. * lisp/emacs-lisp/lisp-mode.el (lisp-indent-function): * lisp/thingatpt.el (symbol-at-point): Use `shorthands-intern(-soft)`. * test/src/lread-tests.el (lread-unintern): Use `shorthands-(un)intern(-soft)`. --- lisp/emacs-lisp/lisp-mode.el | 3 +- lisp/emacs-lisp/shorthands.el | 44 ++++++++++++++++++++++++++++- lisp/minibuffer.el | 24 ++++------------ lisp/progmodes/elisp-mode.el | 66 +++++++++++++++++++++---------------------- lisp/thingatpt.el | 4 ++- src/lread.c | 43 +++------------------------- test/src/lread-tests.el | 48 +++++++++++++++---------------- 7 files changed, 114 insertions(+), 118 deletions(-) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index d9e11761657..1ea1916ff4a 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1276,7 +1276,8 @@ Lisp function does not specify a special indentation." ;; inside the innermost containing sexp. (backward-prefix-chars) (current-column)) - (let* ((function (intern-soft + ;; FIXME: Using `shorthands-intern-soft' is wrong for non-Emacs Lisp. + (let* ((function (shorthands-intern-soft (buffer-substring (point) (progn (forward-sexp 1) (point))))) (local (assq function lisp-indent-local-overrides)) diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el index 9c668bb3720..c57bb53aa21 100644 --- a/lisp/emacs-lisp/shorthands.el +++ b/lisp/emacs-lisp/shorthands.el @@ -29,6 +29,48 @@ (require 'files) (require 'mule) +(defun shorthands-of-symbol (s) + "Return a list of shorthand alternative spellings of S. +S can be either a string or a symbol. The returned shorthands are strings, +in the order they are found in `read-symbol-shorthands'." + (let ((retval ()) + (full-name (if (symbolp s) (symbol-name s) s))) + (dolist (mapping read-symbol-shorthands) + (let ((shorthand (car mapping)) + (longhand (cdr mapping))) + (when (string-prefix-p longhand full-name) + (push (concat shorthand + (substring full-name (length longhand))) + retval)))) + (nreverse retval))) + +(defun shorthands-to-longhand (string) + "Return the longhand form of STRING according to `read-symbol-shorthands'. +Returns a string. If no shorthand applies, returns STRING." + (let ((mappings read-symbol-shorthands)) + (while (and mappings (not (string-prefix-p (caar mappings) string))) + (setq mappings (cdr mappings))) + (if mappings + (concat (cdar mappings) (substring string (length (caar mappings)))) + string))) + +(defun shorthands-intern (string &optional ob) + "`intern' STRING into the obarray OB, obeying `read-symbol-shorthands'." + (intern (shorthands-to-longhand string) ob)) + +(defun shorthands-intern-soft (string &optional ob) + "Return the interned symbol of name STRING in the obarray OB, if any. +If not found, return nil. +Contrary to `intern-soft', this obeys `read-symbol-shorthands'." + (intern-soft (shorthands-to-longhand string) ob)) + +(defun shorthands-unintern (string ob) + "`unintern's the symbol of shorthand name STRING in obarray OB. +Obeys `read-symbol-shorthands'." + (unless (obarrayp ob) + (signal 'wrong-type-argument (list #'obarrayp ob))) + (unintern (shorthands-to-longhand string) ob)) + (defun hack-read-symbol-shorthands () "Compute `read-symbol-shorthands' from Local Variables section." ;; FIXME: relies on the `hack-local-variables--find-variables' @@ -65,7 +107,7 @@ (print-name (match-string 1)) (probe (and (not (memq existing '(font-lock-comment-face font-lock-string-face))) - (intern-soft print-name))) + (shorthands-intern-soft print-name))) (symbol-name (and probe (symbol-name probe))) (prefix (and symbol-name (not (string-equal print-name symbol-name)) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 74c7cd9baa2..6c13fcabe54 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -5127,24 +5127,12 @@ usual. Returns (ALL PAT PREFIX SUFFIX)." (defun completion-shorthand-try-completion (string table pred point) "Try completion with `read-symbol-shorthands' of original buffer." - (cl-loop with expanded - for (short . long) in - (with-current-buffer minibuffer--original-buffer - read-symbol-shorthands) - for probe = - (and (> point (length short)) - (string-prefix-p short string) - (try-completion (setq expanded - (concat long - (substring - string - (length short)))) - table pred)) - when probe - do (message "Shorthand expansion") - and return (cons expanded (max (length long) - (+ (- point (length short)) - (length long)))))) + (let ((expanded (with-current-buffer minibuffer--original-buffer + (shorthands-to-longhand string)))) + (when (and (not (equal expanded string)) + (try-completion expanded table pred)) + (cons expanded (+ (- point (length string)) + (length expanded)))))) (defun completion-shorthand-all-completions (_string _table _pred _point) ;; no-op: For now, we don't want shorthands to list all the possible diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index be98e03d342..1b7323cad39 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -160,7 +160,8 @@ All commands in `lisp-mode-shared-map' are inherited by this map." 'middle-separator) (let* ((string (thing-at-mouse click 'symbol t)) - (symbol (when (stringp string) (intern string))) + ;; FIXME: Why don't we know if we receive a string or a symbol? + (symbol (when (stringp string) (shorthands-intern string))) (title (cond ((not (symbolp symbol)) nil) ((and (facep symbol) (not (fboundp symbol))) @@ -981,7 +982,7 @@ It can be quoted, or be inside a quoted form." ;; the *Completions* buffer. (defun elisp--company-doc-buffer (str) - (let ((symbol (intern-soft str))) + (let ((symbol (shorthands-intern-soft str))) ;; FIXME: we really don't want to "display-buffer and then undo it". (save-window-excursion ;; Make sure we don't display it in another frame, otherwise @@ -998,7 +999,7 @@ It can be quoted, or be inside a quoted form." (help-buffer)))))) (defun elisp--company-doc-string (str) - (let* ((symbol (intern-soft str)) + (let* ((symbol (shorthands-intern-soft str)) (doc (if (fboundp symbol) (documentation symbol t) (documentation-property symbol 'variable-documentation t)))) @@ -1011,7 +1012,7 @@ It can be quoted, or be inside a quoted form." (declare-function find-function-library "find-func" (function &optional l-o v)) (defun elisp--company-location (str) - (let ((sym (intern-soft str))) + (let ((sym (shorthands-intern-soft str))) (cond ((fboundp sym) (find-definition-noselect sym nil)) ((boundp sym) (find-definition-noselect sym 'defvar)) @@ -1029,20 +1030,13 @@ Elisp obarray. If the obarray is modified by any means (such as interning or uninterning a symbol), this variable is set to nil.") (defun elisp--read-symbol-shorthands (s) - "Return a fresh list of shorthand-ed alternative spellings of symbol S." - (let ((retval ())) - (cl-loop - for (shorthand . longhand) in read-symbol-shorthands - for full-name = (symbol-name s) - when (string-prefix-p longhand full-name) - do (let ((sym (make-symbol - (concat shorthand - (substring full-name - (length longhand)))))) - (put sym 'elisp--longhand s) - (push sym retval) - retval)) - retval)) + (let ((shs (shorthands-of-symbol s))) + (when shs + (mapcar (lambda (sh) + (let ((sym (make-symbol sh))) + (put sym 'elisp--longhand s) + sym)) + shs)))) (defun elisp--completion-local-symbols () "Compute collections of all Elisp symbols for completion purposes. @@ -1142,15 +1136,18 @@ functions are annotated with \"<f>\" via the (quoted (list nil (elisp--completion-local-symbols) ;; Don't include all symbols (bug#16646). - :predicate (lambda (sym) - ;; shorthand-aware - (let ((sym (intern-soft (symbol-name sym)))) - (or (boundp sym) - (fboundp sym) - (featurep sym) - (symbol-plist sym)))) + :predicate + (lambda (sym) + (let ((sym (or (get sym 'elisp--longhand) + sym))) + (or (boundp sym) + (fboundp sym) + (featurep sym) + (symbol-plist sym)))) :annotation-function - (lambda (str) (if (fboundp (intern-soft str)) " <f>")) + (lambda (str) + (if (fboundp (shorthands-intern-soft str)) + " <f>")) :company-kind #'elisp--company-kind :company-doc-buffer #'elisp--company-doc-buffer :company-docsig #'elisp--company-doc-string @@ -1183,8 +1180,9 @@ functions are annotated with \"<f>\" via the (if (memq (char-syntax c) '(?w ?_)) (let ((pt (point))) (forward-sexp) - (intern-soft - (buffer-substring pt (point)))))))) + (shorthands-intern-soft + (buffer-substring + pt (point)))))))) (error nil)))) (pcase parent ;; FIXME: Rather than hardcode special cases here, @@ -1247,7 +1245,7 @@ functions are annotated with \"<f>\" via the (cddr table-etc))))))))) (defun elisp--company-kind (str) - (let ((sym (intern-soft str))) + (let ((sym (shorthands-intern-soft str))) (cond ((or (macrop sym) (special-form-p sym)) 'keyword) ((fboundp sym) 'function) @@ -1257,7 +1255,7 @@ functions are annotated with \"<f>\" via the (t 'text)))) (defun elisp--company-deprecated (str) - (let ((sym (intern-soft str))) + (let ((sym (shorthands-intern-soft str))) (or (get sym 'byte-obsolete-variable) (get sym 'byte-obsolete-info)))) @@ -1466,7 +1464,7 @@ namespace but with lower confidence." (cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier) (require 'find-func) - (let ((sym (intern-soft identifier))) + (let ((sym (shorthands-intern-soft identifier))) (when sym (let* ((pos (get-text-property 0 'pos identifier)) (namespace (if (and pos @@ -1571,7 +1569,7 @@ namespace but with lower confidence." ;; `symbol' is a name for the default constructor created by ;; cl-defstruct, so return the location of the cl-defstruct. (let* ((type-name (match-string 1 doc)) - (type-symbol (intern type-name)) + (type-symbol (shorthands-intern type-name)) (file (find-lisp-object-file-name type-symbol 'define-type)) (summary (format elisp--xref-format-extra @@ -2044,7 +2042,7 @@ POS specifies the starting position where EXP was found and defaults to point." (while (re-search-forward "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)" pos t) - (let ((var (intern (match-string 1)))) + (let ((var (shorthands-intern (match-string 1)))) (unless (or (special-variable-p var) (syntax-ppss-toplevel-pos (save-excursion @@ -2580,7 +2578,7 @@ ARGS is the argument list of function SYM." (let ((c (char-after (point)))) (and c (memq (char-syntax c) '(?w ?_)) - (intern-soft (current-word))))) + (shorthands-intern-soft (current-word))))) (defun elisp-function-argstring (arglist) "Return ARGLIST as a string enclosed by (). diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 578f4ab9819..f17c02f35da 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -787,7 +787,9 @@ expression at point regardless of Lisp syntax." (defun symbol-at-point () "Return the symbol at point, or nil if none is found." (let ((thing (thing-at-point 'symbol))) - (if thing (intern thing)))) + ;; FIXME: Should we use the reader so as to properly handle + ;; backslashes and such? + (if thing (shorthands-intern thing)))) (defvar thing-at-point-decimal-regexp "-?[0-9]+\\.?[0-9]*" diff --git a/src/lread.c b/src/lread.c index b079e83dd06..48d2420f96e 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4782,27 +4782,10 @@ it defaults to the value of `obarray'. */) obarray = check_obarray (NILP (obarray) ? Vobarray : obarray); CHECK_STRING (string); - - char* longhand = NULL; - ptrdiff_t longhand_chars = 0; - ptrdiff_t longhand_bytes = 0; - tem = oblookup_considering_shorthand (obarray, SSDATA (string), - SCHARS (string), SBYTES (string), - &longhand, &longhand_chars, - &longhand_bytes); + tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); if (!BARE_SYMBOL_P (tem)) - { - if (longhand) - { - tem = intern_driver (make_multibyte_string (longhand, longhand_chars, - longhand_bytes), - obarray, tem); - xfree (longhand); - } - else - tem = intern_driver (string, obarray, tem); - } + tem = intern_driver (string, obarray, tem); return tem; } @@ -4821,24 +4804,13 @@ it defaults to the value of `obarray'. */) if (!SYMBOLP (name)) { - char *longhand = NULL; - ptrdiff_t longhand_chars = 0; - ptrdiff_t longhand_bytes = 0; - CHECK_STRING (name); string = name; - tem = oblookup_considering_shorthand (obarray, SSDATA (string), - SCHARS (string), SBYTES (string), - &longhand, &longhand_chars, - &longhand_bytes); - if (longhand) - xfree (longhand); + tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); return FIXNUMP (tem) ? Qnil : tem; } else { - /* If already a symbol, we don't do shorthand-longhand translation, - as promised in the docstring. */ Lisp_Object sym = maybe_remove_pos_from_symbol (name); string = XSYMBOL (name)->u.s.name; tem @@ -4872,14 +4844,7 @@ OBARRAY, if nil, defaults to the value of the variable `obarray'. */) else { CHECK_STRING (name); - char *longhand = NULL; - ptrdiff_t longhand_chars = 0; - ptrdiff_t longhand_bytes = 0; - sym = oblookup_considering_shorthand (obarray, SSDATA (name), - SCHARS (name), SBYTES (name), - &longhand, &longhand_chars, - &longhand_bytes); - xfree(longhand); + sym = oblookup (obarray, SSDATA (name), SCHARS (name), SBYTES (name)); if (FIXNUMP (sym)) return Qnil; } diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index e621a9d58b9..d6676ce9bf6 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -454,47 +454,47 @@ literals (Bug#20852)." ;; with shorthand (let* ((oa (obarray-make)) (read-symbol-shorthands '(("a·" . "ZZ•"))) - (s1 (intern "a·abc" oa)) - (s2 (intern "a·def" oa)) - (s3 (intern "a·ghi" oa))) + (s1 (shorthands-intern "a·abc" oa)) + (s2 (shorthands-intern "a·def" oa)) + (s3 (shorthands-intern "a·ghi" oa))) (should (equal (oa-syms oa) (list s1 s2 s3))) (should (equal (symbol-name s1) "ZZ•abc")) - (should (eq (intern-soft "ZZ•abc" oa) s1)) - (should (eq (intern-soft "a·abc" oa) s1)) - (should (eq (intern-soft "ZZ•def" oa) s2)) - (should (eq (intern-soft "a·def" oa) s2)) - (should (eq (intern-soft "ZZ•ghi" oa) s3)) - (should (eq (intern-soft "a·ghi" oa) s3)) + (should (eq (shorthands-intern-soft "ZZ•abc" oa) s1)) + (should (eq (shorthands-intern-soft "a·abc" oa) s1)) + (should (eq (shorthands-intern-soft "ZZ•def" oa) s2)) + (should (eq (shorthands-intern-soft "a·def" oa) s2)) + (should (eq (shorthands-intern-soft "ZZ•ghi" oa) s3)) + (should (eq (shorthands-intern-soft "a·ghi" oa) s3)) ;; unintern using long name - (should (eq (unintern "ZZ•abc" oa) t)) - (should-not (intern-soft "ZZ•abc" oa)) - (should-not (intern-soft "a·abc" oa)) + (should (eq (shorthands-unintern "ZZ•abc" oa) t)) + (should-not (shorthands-intern-soft "ZZ•abc" oa)) + (should-not (shorthands-intern-soft "a·abc" oa)) (should (equal (oa-syms oa) (list s2 s3))) - (should (eq (intern-soft "ZZ•def" oa) s2)) - (should (eq (intern-soft "a·def" oa) s2)) - (should (eq (intern-soft "ZZ•ghi" oa) s3)) - (should (eq (intern-soft "a·ghi" oa) s3)) + (should (eq (shorthands-intern-soft "ZZ•def" oa) s2)) + (should (eq (shorthands-intern-soft "a·def" oa) s2)) + (should (eq (shorthands-intern-soft "ZZ•ghi" oa) s3)) + (should (eq (shorthands-intern-soft "a·ghi" oa) s3)) ;; unintern using short name - (should (eq (unintern "a·def" oa) t)) - (should-not (intern-soft "ZZ•def" oa)) - (should-not (intern-soft "a·def" oa)) + (should (eq (shorthands-unintern "a·def" oa) t)) + (should-not (shorthands-intern-soft "ZZ•def" oa)) + (should-not (shorthands-intern-soft "a·def" oa)) (should (equal (oa-syms oa) (list s3))) - (should (eq (intern-soft "ZZ•ghi" oa) s3)) - (should (eq (intern-soft "a·ghi" oa) s3)) + (should (eq (shorthands-intern-soft "ZZ•ghi" oa) s3)) + (should (eq (shorthands-intern-soft "a·ghi" oa) s3)) ;; unintern using symbol (should (eq (unintern s3 oa) t)) - (should-not (intern-soft "ZZ•ghi" oa)) - (should-not (intern-soft "a·ghi" oa)) + (should-not (shorthands-intern-soft "ZZ•ghi" oa)) + (should-not (shorthands-intern-soft "a·ghi" oa)) (should (eq (oa-syms oa) nil))) ;; edge case: a symbol whose true name is another's shorthand (let* ((oa (obarray-make)) (s1 (intern "a·abc" oa)) (read-symbol-shorthands '(("a·" . "ZZ•"))) - (s2 (intern "a·abc" oa))) + (s2 (shorthands-intern "a·abc" oa))) (should (equal (oa-syms oa) (list s2 s1))) (should (equal (symbol-name s1) "a·abc")) (should (equal (symbol-name s2) "ZZ•abc"))