mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2026-09-10 07:46:51 -04:00
Merge remote-tracking branch 'origin/scratch/intern-without-shorthands'
This commit is contained in:
Stefan Monnier
commit
c1337758a6
|
|
@ -781,6 +781,45 @@ those names.
|
|||
Symbol forms whose names start with @samp{#_} are not transformed.
|
||||
@end itemize
|
||||
|
||||
@subsection Converting to/from shorthands
|
||||
|
||||
Shorthands are automatically expanded by the Lisp reader.
|
||||
If you want to apply @code{read-symbol-shorthands} to a symbol
|
||||
name without going through the reader, for example because the symbol
|
||||
comes from another buffer (e.g., the minibuffer), you can use
|
||||
@code{shorthands-to-longhand}. Similarly, if you are looking for
|
||||
a symbol in a buffer, you can consider all its possible
|
||||
shorthand forms with the use of @code{shorthands-of-symbol}.
|
||||
|
||||
@defun shorthands-to-longhand string
|
||||
Return the full name (so called ``longhand'' form) of the symbol whose
|
||||
shorthand is @var{string}. It always returns a string since
|
||||
if there is no use of any shorthand notation in @var{string}, it just
|
||||
returns @var{string} unchanged.
|
||||
@end defun
|
||||
|
||||
@defun shorthands-of-symbol string-or-symbol
|
||||
Return the list of all the alternative ways to write this symbol.
|
||||
The argument can be a symbol or its name, and
|
||||
the return value is a list of strings. Note that the return value
|
||||
includes only the shorthand forms of the argument, not its longhand
|
||||
form, so it is common and normal for the return value to be @code{nil}.
|
||||
@end defun
|
||||
|
||||
@defun shorthands-intern string &optional obarray
|
||||
Interns the string @var{string} in the obarray @var{obarray},
|
||||
just like @code{intern}, except that it obeys
|
||||
@code{read-symbol-shorthands} and thus expands any shorthand in
|
||||
@var{string} if applicable before interning it.
|
||||
Returns the interned symbol.
|
||||
@end defun
|
||||
|
||||
@defun shorthands-intern-soft string &optional obarray
|
||||
Same as @code{shorthands-intern}, except that it returns @code{nil}
|
||||
if there is no symbol by that name in the obarray instead of
|
||||
interning a new symbol.
|
||||
@end defun
|
||||
|
||||
@node Symbols with Position
|
||||
@section Symbols with Position
|
||||
@cindex symbol with position
|
||||
|
|
|
|||
7
etc/NEWS
7
etc/NEWS
|
|
@ -226,6 +226,13 @@ To install the grammars, use 'M-x markdown-ts-mode-install-parsers'.
|
|||
|
||||
* Incompatible Lisp Changes in Emacs 32.1
|
||||
|
||||
+++
|
||||
** 'intern' and 'intern-soft' ignore 'read-symbol-shorthands'.
|
||||
This means they revert to the behavior of Emacs<28.
|
||||
In those cases where shorthands need to be obeyed, you now need to use
|
||||
'shorthands-intern', 'shorthands-intern-soft', or 'shorthands-to-longhand'.
|
||||
And 'shorthands-of-symbol' provides the reverse mapping.
|
||||
|
||||
** Pcase
|
||||
|
||||
+++
|
||||
|
|
|
|||
|
|
@ -1166,8 +1166,11 @@ Can only be used from within the lexical body of a primary or around method."
|
|||
(defun cl--generic-search-method (met-name)
|
||||
"For `find-function-regexp-alist'. Search for a `cl-defmethod'.
|
||||
MET-NAME is as returned by `cl--generic-load-hist-format'."
|
||||
;; Presumably our caller is `find-function-search-for-symbol'.
|
||||
(declare-function find-func--regexp-of-symbol-name "find-func" (name))
|
||||
;; FIXME: Handle also shorthands in the cdr of MET-NAME!
|
||||
(let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+"
|
||||
(regexp-quote (format "%s" (car met-name)))
|
||||
(find-func--regexp-of-symbol-name (car met-name))
|
||||
"\\_>")))
|
||||
(or
|
||||
(re-search-forward
|
||||
|
|
|
|||
|
|
@ -403,6 +403,20 @@ See `find-library' for more details."
|
|||
(find-library-name library)))
|
||||
(run-hooks 'find-function-after-hook)))
|
||||
|
||||
(defun find-func--regexp-of-symbol-name (name)
|
||||
(let ((names (cons (if (stringp name) name
|
||||
(symbol-name name))
|
||||
(shorthands-of-symbol name))))
|
||||
(regexp-opt
|
||||
(mapcar (lambda (name)
|
||||
;; Definitions like the ` (backquote) need to backslash
|
||||
;; quote their name in the file, but (symbol-name symbol)
|
||||
;; doesn't. Add a \ to catch this.
|
||||
(replace-regexp-in-string "[][\\()\"`' ,]"
|
||||
"\\\\\\&" name))
|
||||
names))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun find-function-search-for-symbol (symbol type library)
|
||||
"Search for SYMBOL's definition of type TYPE in LIBRARY.
|
||||
|
|
@ -442,35 +456,33 @@ The search is done in the source for library LIBRARY."
|
|||
(car regexp-symbol)
|
||||
regexp-symbol)))
|
||||
(with-current-buffer (find-file-noselect filename)
|
||||
(let ((regexp (if (functionp regexp-symbol) regexp-symbol
|
||||
(format (symbol-value regexp-symbol)
|
||||
;; Entry for ` (backquote) macro in loaddefs.el,
|
||||
;; (defalias (quote \`)..., has a \ but
|
||||
;; (symbol-name symbol) doesn't. Add an
|
||||
;; optional \ to catch this.
|
||||
(concat "\\\\?"
|
||||
(regexp-quote (symbol-name symbol))))))
|
||||
(case-fold-search))
|
||||
(let ((case-fold-search))
|
||||
(save-restriction
|
||||
(widen)
|
||||
(with-syntax-table emacs-lisp-mode-syntax-table
|
||||
(goto-char (point-min))
|
||||
(if (if (functionp regexp)
|
||||
(funcall regexp symbol)
|
||||
(or (re-search-forward regexp nil t)
|
||||
;; `regexp' matches definitions using known forms like
|
||||
;; `defun', or `defvar'. But some functions/variables
|
||||
;; are defined using special macros (or functions), so
|
||||
;; if `regexp' can't find the definition, we look for
|
||||
;; something of the form "(SOMETHING <symbol> ...)".
|
||||
;; This fails to distinguish function definitions from
|
||||
;; variable declarations (or even uses thereof), but is
|
||||
;; a good pragmatic fallback.
|
||||
(re-search-forward
|
||||
(concat "^([^ ]+" find-function-space-re "['(]?"
|
||||
(regexp-quote (symbol-name symbol))
|
||||
"\\_>")
|
||||
nil t)))
|
||||
(if (if (functionp regexp-symbol)
|
||||
(funcall regexp-symbol symbol)
|
||||
(let ((regexp-of-symbol
|
||||
(find-func--regexp-of-symbol-name symbol)))
|
||||
(or (re-search-forward
|
||||
(format (symbol-value regexp-symbol)
|
||||
regexp-of-symbol)
|
||||
nil t)
|
||||
;; `regexp' matches definitions using known forms
|
||||
;; like `defun', or `defvar'.
|
||||
;; But some functions/variables are defined using
|
||||
;; special macros (or functions), so if `regexp'
|
||||
;; can't find the definition, we look for
|
||||
;; something of the form "(SOMETHING <symbol> ...)".
|
||||
;; This doesn't pay attention to TYPE (or even
|
||||
;; distinguish definitions from uses),
|
||||
;; but is a good pragmatic fallback.
|
||||
(re-search-forward
|
||||
(concat "^([^ ]+" find-function-space-re "['(]?"
|
||||
regexp-of-symbol
|
||||
"\\_>")
|
||||
nil t))))
|
||||
(progn
|
||||
(beginning-of-line)
|
||||
(cons (current-buffer) (point)))
|
||||
|
|
@ -682,7 +694,7 @@ See also `find-function-recenter-line' and `find-function-after-hook'.
|
|||
Use \\[xref-find-definitions] to find definitions of functions and variables
|
||||
that are not part of Emacs."
|
||||
(interactive (find-function-read))
|
||||
(find-function-do-it function nil 'switch-to-buffer))
|
||||
(find-function-do-it function nil #'switch-to-buffer))
|
||||
|
||||
;;;###autoload
|
||||
(defun find-function-other-window (function)
|
||||
|
|
@ -690,7 +702,7 @@ that are not part of Emacs."
|
|||
|
||||
See `find-function' for more details."
|
||||
(interactive (find-function-read))
|
||||
(find-function-do-it function nil 'switch-to-buffer-other-window))
|
||||
(find-function-do-it function nil #'switch-to-buffer-other-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun find-function-other-frame (function)
|
||||
|
|
@ -698,7 +710,7 @@ See `find-function' for more details."
|
|||
|
||||
See `find-function' for more details."
|
||||
(interactive (find-function-read))
|
||||
(find-function-do-it function nil 'switch-to-buffer-other-frame))
|
||||
(find-function-do-it function nil #'switch-to-buffer-other-frame))
|
||||
|
||||
;;;###autoload
|
||||
(defun find-variable-noselect (variable &optional file)
|
||||
|
|
@ -726,7 +738,7 @@ Set mark before moving, if the buffer already existed.
|
|||
|
||||
See also `find-function-recenter-line' and `find-function-after-hook'."
|
||||
(interactive (find-function-read 'defvar))
|
||||
(find-function-do-it variable 'defvar 'switch-to-buffer))
|
||||
(find-function-do-it variable 'defvar #'switch-to-buffer))
|
||||
|
||||
;;;###autoload
|
||||
(defun find-variable-other-window (variable)
|
||||
|
|
@ -734,7 +746,7 @@ See also `find-function-recenter-line' and `find-function-after-hook'."
|
|||
|
||||
See `find-variable' for more details."
|
||||
(interactive (find-function-read 'defvar))
|
||||
(find-function-do-it variable 'defvar 'switch-to-buffer-other-window))
|
||||
(find-function-do-it variable 'defvar #'switch-to-buffer-other-window))
|
||||
|
||||
;;;###autoload
|
||||
(defun find-variable-other-frame (variable)
|
||||
|
|
@ -742,7 +754,7 @@ See `find-variable' for more details."
|
|||
|
||||
See `find-variable' for more details."
|
||||
(interactive (find-function-read 'defvar))
|
||||
(find-function-do-it variable 'defvar 'switch-to-buffer-other-frame))
|
||||
(find-function-do-it variable 'defvar #'switch-to-buffer-other-frame))
|
||||
|
||||
;;;###autoload
|
||||
(defun find-definition-noselect (symbol type &optional file)
|
||||
|
|
@ -776,7 +788,7 @@ Set mark before moving, if the buffer already existed.
|
|||
|
||||
See also `find-function-recenter-line' and `find-function-after-hook'."
|
||||
(interactive (find-function-read 'defface))
|
||||
(find-function-do-it face 'defface 'switch-to-buffer))
|
||||
(find-function-do-it face 'defface #'switch-to-buffer))
|
||||
|
||||
(defun find-function-on-key-do-it (key find-fn)
|
||||
"Find the function that KEY invokes. KEY is a string.
|
||||
|
|
|
|||
|
|
@ -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