It passes the tests designed for the previous Elisp implementation.
Likely, this isn't the final form of the implementation. For one, the
reader is much slower and allocates a Lisp string for every atom read,
regardless if its already interned or not. This has the potential to
be catastrophic in terms of GC.
Also rename the main variable to elisp-shorthands, from the
repetitive shorthand-shorthands.
For some reason, I had to put 'hack-elisp-shorthands' and
'load-with-shorthands-and-code-conversion', the new source-file
loading functions, in lisp/international/mule.el.
Otherwise, lisp/loadup.el wouldn't see them, for some reason that I
didn't investigate. This should probably be fixed.
* lisp/shorthand.el: Remove.
* test/lisp/shorthand-tests.el: Remove.
* src/lread.c:
(read1, Fintern, Fintern_soft, Funintern): Use
oblookup_considering_shorthand.
(oblookup_considering_shorthand): New helper.
(syms_of_lread): Declare elisp-shorthands.
* lisp/progmodes/elisp-mode.el (elisp-shorthands):
Put a safe-local-variable spec.
* test/lisp/progmodes/elisp-mode-tests.el (elisp-shorthand-read-buffer)
(elisp-shorthand-read-from-string)
(elisp-shorthand-byte-compile-a-file)
(elisp-shorthand-load-a-file): New tests.
* test/lisp/progmodes/elisp-resources/simple-shorthand-test.el: New file
* lisp/loadup.el (load-source-file-function): Set to
load-with-shorthands-and-code-conversion.
* lisp/international/mule.el (hack-elisp-shorthands): Move here.
(load-with-shorthands-and-code-conversion): And here.
(apply 'define-charset-internal name (mapcar 'cdr attrs))))
+(defun hack-elisp-shorthands (fullname)
+ "Return value of the `elisp-shorthands' file-local variable in FULLNAME.
+FULLNAME is the full name of an Elisp file which potentially
+specifies a file-local value for `elisp-shorthands'. The Elisp
+code isn't read or evaluated in any way, we merely extract what
+the buffer-local value of `elisp-shorthands' would be if the file
+had been found by `find-file'."
+ (let ((size (nth 7 (file-attributes fullname))))
+ (with-temp-buffer
+ (insert-file-contents fullname nil (max 0 (- size 3000)) size)
+ (goto-char (point-max))
+ (let* ((found (search-backward-regexp "elisp-shorthands:[ \t]*" 0 t))
+ (val (and found
+ (goto-char (match-end 0))
+ (ignore-errors (read (current-buffer)))))
+ (probe val)
+ aux)
+ (catch 'done
+ (when (consp probe)
+ (while (setq aux (pop probe))
+ (unless (and (consp aux)
+ (stringp (car aux))
+ (stringp (cdr aux)))
+ (throw 'done nil)))
+ val))))))
(defun load-with-code-conversion (fullname file &optional noerror nomessage)
"Execute a file of Lisp code named FILE whose absolute name is FULLNAME.
(message "Loading %s...done" file)))
t)))
+(defun load-with-shorthands-and-code-conversion (fullname file noerror nomessage)
+ "As `load-with-code-conversion', also considering Elisp shorthands."
+ (let ((elisp-shorthands (hack-elisp-shorthands fullname)))
+ (load-with-code-conversion fullname file noerror nomessage)))
+
(defun charset-info (charset)
"Return a vector of information of CHARSET.
This function is provided for backward compatibility.
;; variable its advertised default value (it starts as nil, see
;; xdisp.c).
(setq resize-mini-windows 'grow-only)
-(setq load-source-file-function #'load-with-code-conversion)
+(setq load-source-file-function #'load-with-shorthands-and-code-conversion)
(load "files")
;; Load-time macro-expansion can only take effect after setting
(terpri)
(pp collected)))
+\f
+(put 'elisp-shorthands 'safe-local-variable #'consp)
+
(provide 'elisp-mode)
;;; elisp-mode.el ends here
+++ /dev/null
-;;; shorthand.el --- namespacing system -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2020 Free Software Foundation
-
-;; Author: João Távora <joaotavora@gmail.com>
-;; Keywords: languages, lisp
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Simple-minded namespacing in Emacs:
-
-;; 1. Do this on an Emacs you don't care about, since this advises basic
-;; functions;
-;; 2. Load `shorthand.el` (or byte-compile and load it);
-;; 3. Construct an example user of this library.
-;;
-;; magnar-string.el is constructed by taking s.el, renaming it to
-;; magnar-string.el, and then appending this to the end of the file:
-;;
-;; ;;; magnar-string.el ends here,
-;; Local Variables:
-;; shorthand-shorthands: (("^s-" . "magnar-string-"))
-;; End:
-;;
-;; 4. Load `magnar-string.el` or byte-compile it and load `magnar-string.elc`;
-;; 5. Try C-h f and check there's no "s-" pollution; Not even the `s-`
-;; symbols are interned. All the relevant functions are namespaced
-;; under "magnar-string-";
-;; 6. Open test.el, and play around there. Open test2.el and play around
-;; with magnar-string.el under a different "mstring-" prefix;
-;; 7. Evaluating code should work. Eldoc should also work. Xref (`M-.`)
-;; is broken. Anything else might breaks spectacularly;
-
-;; Read `shorthand.el`: it's less than 50 loc. The idea is to keep only
-;; one obarray, but instruments `read` to not pollute it with symbols
-;; 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)
- (when (file-readable-p file)
- (with-temp-buffer
- (insert-file-contents file)
- (hack-local-variables)
- (setq file-local-shorthands shorthand-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)
-;;; shorthand.el ends here
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);
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 original = *string; /* Save pointer to original string... */
+ Lisp_Object tail = Velisp_shorthands;
+ FOR_EACH_TAIL_SAFE(tail)
+ {
+ Lisp_Object pair = XCAR (tail);
+ if (!CONSP (pair)) goto undo;
+ Lisp_Object shorthand = XCAR (pair);
+ Lisp_Object longhand = XCDR (pair);
+ if (!STRINGP (shorthand) || !STRINGP (longhand)) goto undo;
+ Lisp_Object match = Fstring_match (shorthand, *string, Qnil);
+ if (!NILP(match)){
+ *string = Freplace_match(longhand, Qnil, Qnil, *string, Qnil);
+ }
+ }
+ goto fine;
+ undo:
+ {
+ static const char* warn =
+ "Fishy value of `elisp-shorthands'. "
+ "Consider reviewing before evaluating code.";
+ message_dolog (warn, sizeof(warn), 0, 0);
+ *string = original; /* ...so we can any failed trickery here. */
+ }
+ fine:
+ 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 ("elisp-shorthands", Velisp_shorthands,
+ doc: /* Alist of known symbol name shorthands*/);
+ Velisp_shorthands = Qnil;
}
(should (equal (elisp--xref-infer-namespace p3) 'any))
(should (equal (elisp--xref-infer-namespace p4) 'any))))
+\f
+(ert-deftest elisp-shorthand-read-buffer ()
+ (let* ((gsym (downcase (symbol-name (cl-gensym "sh-"))))
+ (shorthand-sname (format "s-%s" gsym))
+ (expected (intern (format "shorthand-longhand-%s" gsym))))
+ (cl-assert (not (intern-soft shorthand-sname)))
+ (should (equal (let ((elisp-shorthands
+ '(("^s-" . "shorthand-longhand-"))))
+ (with-temp-buffer
+ (insert shorthand-sname)
+ (goto-char (point-min))
+ (read (current-buffer))))
+ expected))
+ (should (not (intern-soft shorthand-sname)))))
+
+(ert-deftest elisp-shorthand-read-from-string ()
+ (let* ((gsym (downcase (symbol-name (cl-gensym "sh-"))))
+ (shorthand-sname (format "s-%s" gsym))
+ (expected (intern (format "shorthand-longhand-%s" gsym))))
+ (cl-assert (not (intern-soft shorthand-sname)))
+ (should (equal (let ((elisp-shorthands
+ '(("^s-" . "shorthand-longhand-"))))
+ (car (read-from-string shorthand-sname)))
+ expected))
+ (should (not (intern-soft shorthand-sname)))))
+
+(defvar elisp--test-resources-dir
+ (expand-file-name "elisp-resources/"
+ (file-name-directory
+ (or load-file-name
+ (error "this file needs to be loaded")))))
+
+(ert-deftest elisp-shorthand-load-a-file ()
+ (let ((test-file (expand-file-name "simple-shorthand-test.el"
+ elisp--test-resources-dir)))
+ (mapatoms (lambda (s)
+ (when (string-match "^elisp--foo-" (symbol-name s))
+ (unintern s obarray))))
+ (load test-file)
+ (should (intern-soft "elisp--foo-test"))
+ (should-not (intern-soft "f-test"))))
+
+(ert-deftest elisp-shorthand-byte-compile-a-file ()
+
+ (let ((test-file (expand-file-name "simple-shorthand-test.el"
+ elisp--test-resources-dir))
+ (byte-compiled (expand-file-name "simple-shorthand-test.elc"
+ elisp--test-resources-dir)))
+ (mapatoms (lambda (s)
+ (when (string-match "^elisp--foo-" (symbol-name s))
+ (unintern s obarray))))
+ (byte-compile-file test-file)
+ (should-not (intern-soft "f-test"))
+ (should (intern-soft "elisp--foo-test"))
+ (should-not (fboundp (intern-soft "elisp--foo-test")))
+ (load byte-compiled)
+ (should (intern-soft "elisp--foo-test"))
+ (should-not (intern-soft "f-test"))))
+
(provide 'elisp-mode-tests)
;;; elisp-mode-tests.el ends here
--- /dev/null
+(defun f-test ()
+ (let ((elisp-shorthands '(("^foo-" . "bar-"))))
+ (with-temp-buffer
+ (insert "(foo-bar)")
+ (goto-char (point-min))
+ (read (current-buffer)))))
+
+(defun f-test2 ()
+ (let ((elisp-shorthands '(("^foo-" . "bar-"))))
+ (read-from-string "(foo-bar)")))
+
+
+(defun f-test3 ()
+ (let ((elisp-shorthands '(("^foo-" . "bar-"))))
+ (intern "foo-bar")))
+
+(when nil
+ (f-test3)
+ (f-test2)
+ (f-test))
+
+
+;; Local Variables:
+;; elisp-shorthands: (("^f-" . "elisp--foo-"))
+;; End:
+++ /dev/null
-;;; shorthand-tests.el --- Tests for shorthand.el -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2020 Free Software Foundation, Inc.
-
-;; Author: João Távora <joaotavora@gmail.com>
-;; Keywords:
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;
-
-;;; Code:
-
-(require 'shorthand)
-(require 'cl-lib)
-(require 'ert)
-
-(ert-deftest shorthand-read-buffer ()
- (let* ((gsym (downcase (symbol-name (cl-gensym "sh-"))))
- (shorthand-sname (format "s-%s" gsym))
- (expected (intern (format "shorthand-longhand-%s" gsym))))
- (cl-assert (not (intern-soft shorthand-sname)))
- (should (equal (let ((shorthand-shorthands
- '(("^s-" . "shorthand-longhand-"))))
- (with-temp-buffer
- (insert shorthand-sname)
- (goto-char (point-min))
- (read (current-buffer))))
- expected))
- (should (not (intern-soft shorthand-sname)))))
-
-(ert-deftest shorthand-read-from-string ()
- (let* ((gsym (downcase (symbol-name (cl-gensym "sh-"))))
- (shorthand-sname (format "s-%s" gsym))
- (expected (intern (format "shorthand-longhand-%s" gsym))))
- (cl-assert (not (intern-soft shorthand-sname)))
- (should (equal (let ((shorthand-shorthands
- '(("^s-" . "shorthand-longhand-"))))
- (car (read-from-string shorthand-sname)))
- expected))
- (should (not (intern-soft shorthand-sname)))))
-
-
-(provide 'shorthand-tests)
-;;; shorthand-tests.el ends here
projects / emacs.git / commitdiff