;; that with the shorthands for other longer named symbols.
;;; Code:
-
(require 'cl-lib)
-(defvar shorthand-shorthands nil)
(put 'shorthand-shorthands 'safe-local-variable #'consp)
-(defun shorthand--expand-shorthand (form)
- (cl-typecase form
- (cons (setcar form (shorthand--expand-shorthand (car form)))
- (setcdr form (shorthand--expand-shorthand (cdr form))))
- (vector (cl-loop for i from 0 for e across form
- do (aset form i (shorthand--expand-shorthand e))))
- (symbol (let* ((name (symbol-name form)))
- (cl-loop for (short-pat . long-pat) in shorthand-shorthands
- when (string-match short-pat name)
- do (setq name (replace-match long-pat t nil name)))
- (setq form (intern name))))
- (string) (number)
- (t (message "[shorthand] unexpected %s" (type-of form))))
- form)
-
-(defun shorthand-read-wrapper (wrappee stream &rest stuff)
- "Read a form from STREAM.
-Do this in two steps, read the form while shadowing the global
-`obarray' so that symbols aren't just automatically interned into
-`obarray' as usual. Then walk the form using
-`shorthand--expand-shorthand' and every time a symbol is found,
-apply the transformations of `shorthand-shorthands' to it before
-interning it the \"real\" global `obarray'. This ensures that
-longhand, _not_ shorthand, versions of each symbol is interned."
- (if (and load-file-name (string-match "\\.elc$" load-file-name))
- (apply wrappee stream stuff)
- (shorthand--expand-shorthand
- (let ((obarray (obarray-make))) (apply wrappee stream stuff)))))
-
-(defun shorthand-intern-soft-wrapper (wrappee name &rest stuff)
- "Tell if string NAME names an interned symbol.
-Even if NAME directly doesn't, its longhand expansion might."
- (let ((res (apply wrappee name stuff)))
- (or res (cl-loop
- for (short-pat . long-pat) in shorthand-shorthands
- thereis (apply wrappee
- (replace-regexp-in-string short-pat
- long-pat name)
- stuff)))))
-
(defun shorthand-load-wrapper (wrappee file &rest stuff)
"Load Elisp FILE, aware of file-local `shortand-shorthands'."
(let (file-local-shorthands)
(let ((shorthand-shorthands file-local-shorthands))
(apply wrappee file stuff))))
-(advice-add 'read :around #'shorthand-read-wrapper)
-(advice-add 'intern-soft :around #'shorthand-intern-soft-wrapper)
(advice-add 'load :around #'shorthand-load-wrapper)
(provide 'shorthand)
return unbind_to (count, string_to_number (read_buffer, radix, NULL));
}
+Lisp_Object oblookup_considering_shorthand (Lisp_Object, Lisp_Object*);
/* If the next token is ')' or ']' or '.', we store that character
in *PCH and the return value is not interesting. Else, we store
}
else
{
- /* Don't create the string object for the name unless
- we're going to retain it in a new symbol.
-
- Like intern_1 but supports multibyte names. */
+ /* Like intern_1 but supports multibyte names. */
Lisp_Object obarray = check_obarray (Vobarray);
- Lisp_Object tem = oblookup (obarray, read_buffer,
- nchars, nbytes);
+ Lisp_Object name
+ = make_specified_string (read_buffer, nchars, nbytes,
+ multibyte);
+ Lisp_Object tem = oblookup_considering_shorthand (obarray, &name);
if (SYMBOLP (tem))
result = tem;
else
- {
- Lisp_Object name
- = make_specified_string (read_buffer, nchars, nbytes,
- multibyte);
- result = intern_driver (name, obarray, tem);
- }
+ result = intern_driver (name, obarray, tem);
}
if (EQ (Vread_with_symbol_positions, Qt)
obarray = check_obarray (NILP (obarray) ? Vobarray : obarray);
CHECK_STRING (string);
- tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
+ tem = oblookup_considering_shorthand (obarray, &string);
if (!SYMBOLP (tem))
tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string),
obarray, tem);
it defaults to the value of `obarray'. */)
(Lisp_Object name, Lisp_Object obarray)
{
- register Lisp_Object tem, string;
+ register Lisp_Object tem;
+ Lisp_Object string;
if (NILP (obarray)) obarray = Vobarray;
obarray = check_obarray (obarray);
else
string = SYMBOL_NAME (name);
- tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
+ tem = oblookup_considering_shorthand (obarray, &string);
if (FIXNUMP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
return Qnil;
else
usage: (unintern NAME OBARRAY) */)
(Lisp_Object name, Lisp_Object obarray)
{
- register Lisp_Object string, tem;
+ register Lisp_Object tem;
+ Lisp_Object string;
size_t hash;
if (NILP (obarray)) obarray = Vobarray;
string = name;
}
- tem = oblookup (obarray, SSDATA (string),
- SCHARS (string),
- SBYTES (string));
+ tem = oblookup_considering_shorthand (obarray, &string);
if (FIXNUMP (tem))
return Qnil;
/* If arg was a symbol, don't delete anything but that symbol itself. */
XSETINT (tem, hash);
return tem;
}
+
+Lisp_Object
+oblookup_considering_shorthand (Lisp_Object obarray, Lisp_Object* string)
+{
+ Lisp_Object tail = Vshorthand_shorthands;
+ FOR_EACH_TAIL_SAFE(tail)
+ {
+ Lisp_Object pair = XCAR (tail);
+ Lisp_Object shorthand = XCAR (pair);
+ Lisp_Object longhand = XCDR (pair);
+ CHECK_STRING (shorthand);
+ CHECK_STRING (longhand);
+ Lisp_Object match = Fstring_match(shorthand, *string, Qnil);
+ if (!NILP(match)){
+ *string = Freplace_match(longhand, Qnil, Qnil, *string, Qnil);
+ }
+ }
+ return oblookup(obarray, SSDATA (*string), SCHARS (*string), SBYTES (*string));
+}
+
\f
void
map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
DEFSYM (Qrehash_threshold, "rehash-threshold");
DEFSYM (Qchar_from_name, "char-from-name");
+
+ DEFVAR_LISP ("shorthand-shorthands", Vshorthand_shorthands,
+ doc: /* Alist of known symbol name shorthands*/);
+ Vshorthand_shorthands = Qnil;
+ DEFSYM (Qshorthand_shorthands, "shorthand-shorthands");
}