From: João Távora Date: Sun, 20 Sep 2020 20:21:32 +0000 (+0100) Subject: Integrate shorthand functionality into elisp-mode.el X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fe4e4c28ecdf08d32dbd9546f7b80a949358c69b;p=emacs.git Integrate shorthand functionality into elisp-mode.el 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. --- diff --git a/lisp/international/mule.el b/lisp/international/mule.el index ee116976eaa..6e4492efdb9 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -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. diff --git a/lisp/loadup.el b/lisp/loadup.el index fce17bf1137..942057c838f 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -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 diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index ce45de7f6cf..a6fb759973f 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -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 diff --git a/lisp/shorthand.el b/lisp/shorthand.el deleted file mode 100644 index f40af92e1c7..00000000000 --- a/lisp/shorthand.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; shorthand.el --- namespacing system -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Free Software Foundation - -;; Author: João Távora -;; 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 . - -;;; 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 diff --git a/src/lread.c b/src/lread.c index 33a7bd00235..1e919c8bbd5 100644 --- a/src/lread.c +++ b/src/lread.c @@ -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"); } diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 60946c2f446..bc9e103768e 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -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 diff --git a/test/lisp/progmodes/elisp-resources/simple-shorthand-test.el b/test/lisp/progmodes/elisp-resources/simple-shorthand-test.el new file mode 100644 index 00000000000..7e1ed952291 --- /dev/null +++ b/test/lisp/progmodes/elisp-resources/simple-shorthand-test.el @@ -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: diff --git a/test/lisp/shorthand-tests.el b/test/lisp/shorthand-tests.el deleted file mode 100644 index e3d5615ec7d..00000000000 --- a/test/lisp/shorthand-tests.el +++ /dev/null @@ -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 -;; 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 . - -;;; 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