master c1337758a6c: Merge remote-tracking branch 'origin/scratch/intern-without-shorthands'
Stefan Monnier via Mailing list for Emacs changes <[email protected]> Wed, 29 Jul 2026 22:19:22 -0400 (EDT)
| Newsgroups | gmane.emacs.diffs |
|---|---|
| Message-ID | <[email protected]> |
branch: master commit c1337758a6c00e22e2a685e0556068fd73fa9a54 Merge: e0d2d80a628 201520c0f4f Author: Stefan Monnier <[email protected]> Commit: Stefan Monnier <[email protected]> Merge remote-tracking branch 'origin/scratch/intern-without-shorthands' --- doc/lispref/symbols.texi | 39 ++++++++++++++++++++++ etc/NEWS | 7 ++++ lisp/emacs-lisp/cl-generic.el | 5 ++- lisp/emacs-lisp/find-func.el | 76 +++++++++++++++++++++++++------------------ 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 +++++++++++++-------------- 11 files changed, 208 insertions(+), 151 deletions(-) diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 4fd0c83450e..8f8ec84b137 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -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 diff --git a/etc/NEWS b/etc/NEWS index 6282d8cf9f6..13810f81054 100644 --- a/etc/NEWS +++ b/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 +++ diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 320bc4c3d8e..5fc89836abe 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -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 diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 76b8798ca25..96358870888 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -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. 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 c293789cee3..c9aa2011940 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"))