pestctrl/emacs
1
0
Fork 0
forked from Github/emacs
Code Issues Pull requests Projects Releases Packages Wiki Activity

Integrate shorthand functionality into elisp-mode.el

Browse source 
Also rename the main variable to elisp-shorthands, from the
silly pleonastic shorthand-shorthands.

For some reason, I had to stick the new source-file loading functions
in lisp/international/mule.el, otherwise lisp/loadup.el wouldn't see
them.  This should probably be fixed.

* lisp/shorthand.el: Remove.

* lisp/progmodes/elisp-mode.el (elisp--shorthand-load-wrapper):
Move here.

* src/lread.c (oblookup_considering_shorthand, syms_of_lread):
Rename variable elisp-shorthand, from shorthand-shorthands.

* test/lisp/shorthand-tests.el: Remove.

* test/lisp/progmodes/elisp-mode-tests.el (elisp-shorthand-read-buffer)
(elisp-shorthand-read-from-string)
(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.
This commit is contained in:
João Távora 2020-09-20 21:21:32 +01:00
parent 82528bcb59
commit fe4e4c28ec
8 changed files with 98 additions and 136 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
lisp/international/mule.el
View file

@ -294,6 +294,26 @@ attribute."
(apply 'define-charset-internal name (mapcar 'cdr attrs))))
(defun hack-elisp-shorthands (fullname)
"Return buffer-local value of `elisp-shorthands' in file FULLNAME."
(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.
@ -354,6 +374,11 @@ Return t if file exists."
(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.

2
lisp/loadup.el
View file

@ -151,7 +151,7 @@
;; 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

3
lisp/progmodes/elisp-mode.el
View file

@ -2078,5 +2078,8 @@ Runs in a batch-mode Emacs. Interactively use variable
(terpri)
(pp collected)))
(put 'elisp-shorthands 'safe-local-variable #'consp)
(provide 'elisp-mode)
;;; elisp-mode.el ends here

70
lisp/shorthand.el
View file

@ -1,70 +0,0 @@
;;; 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)
(put 'shorthand-shorthands 'safe-local-variable #'consp)
(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 'load :around #'shorthand-load-wrapper)
(provide 'shorthand)
;;; shorthand.el ends here

10
src/lread.c
View file

@ -4554,7 +4554,7 @@ Lisp_Object
oblookup_considering_shorthand (Lisp_Object obarray, Lisp_Object* string)
{
Lisp_Object original = *string; /* Save pointer to original string... */
Lisp_Object tail = Vshorthand_shorthands;
Lisp_Object tail = Velisp_shorthands;
FOR_EACH_TAIL_SAFE(tail)
{
Lisp_Object pair = XCAR (tail);
@ -4571,7 +4571,7 @@ oblookup_considering_shorthand (Lisp_Object obarray, Lisp_Object* string)
undo:
{
static const char* warn =
"Fishy value of `shorthand-shorthands'. "
"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. */
@ -5337,8 +5337,8 @@ that are loaded before your customizations are read! */);
DEFSYM (Qchar_from_name, "char-from-name");
DEFVAR_LISP ("shorthand-shorthands", Vshorthand_shorthands,
DEFVAR_LISP ("elisp-shorthands", Velisp_shorthands,
doc: /* Alist of known symbol name shorthands*/);
Vshorthand_shorthands = Qnil;
DEFSYM (Qshorthand_shorthands, "shorthand-shorthands");
Velisp_shorthands = Qnil;
DEFSYM (Qelisp_shorthands, "elisp-shorthands");
}

39
test/lisp/progmodes/elisp-mode-tests.el
View file

@ -1021,5 +1021,44 @@ evaluation of BODY."
(should (equal (elisp--xref-infer-namespace p3) 'any))
(should (equal (elisp--xref-infer-namespace p4) 'any))))
(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 ((load-path (cons elisp--test-resources-dir
load-path)))
(load "simple-shorthand-test")
(should (intern-soft "elisp--foo-test"))
(should-not (intern-soft "f-test"))))
(provide 'elisp-mode-tests)
;;; elisp-mode-tests.el ends here

25
test/lisp/progmodes/elisp-resources/simple-shorthand-test.el Normal file
View file

@ -0,0 +1,25 @@
(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:

60
test/lisp/shorthand-tests.el
View file

@ -1,60 +0,0 @@
;;; 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