mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2026-09-10 07:46:51 -04:00
(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)`.
This commit is contained in:
Stefan Monnier
parent
6faf3cb68b
commit
7c7616e3f0
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ().
|
||||
|
|
|
|||
|
|
@ -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]*"
|
||||
|
|
|
|||
43
src/lread.c
43
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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
Loading…
Reference in a new issue