Add a test for byte-compilation

* test/lisp/progmodes/elisp-mode-tests.el
(elisp-shorthand-byte-compile-a-file): New test.
(elisp-shorthand-load-a-file): Simplify.

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.
@@ -356,6 +376,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.

lisp/loadup.el

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

lisp/progmodes/elisp-mode.el

@@ -1814,5 +1814,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

src/lread.c

@@ -2738,6 +2738,7 @@ read_integer (Lisp_Object readcharfun, int radix,
   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
@@ -3563,23 +3564,17 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 	    }
 	  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)
@@ -4182,7 +4177,7 @@ it defaults to the value of `obarray'.  */)
   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);
@@ -4197,7 +4192,8 @@ A second optional argument specifies the obarray to use;
 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);
@@ -4210,7 +4206,7 @@ it defaults to the value of `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
@@ -4226,7 +4222,8 @@ OBARRAY, if nil, defaults to the value of the variable `obarray'.
 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;
@@ -4240,9 +4237,7 @@ usage: (unintern NAME OBARRAY)  */)
       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.  */
@@ -4329,6 +4324,37 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff
   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));
+}
+
 
 void
 map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
@@ -5077,4 +5103,9 @@ that are loaded before your customizations are read!  */);
   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;
+  DEFSYM (Qelisp_shorthands, "elisp-shorthands");
 }

test/lisp/progmodes/elisp-mode-tests.el

@@ -424,7 +424,7 @@ to (xref-elisp-test-descr-to-target xref)."
 ;; causes the batch mode test to fail; the symbol shows up as
 ;; ‘this’. It passes in interactive tests, so I haven't been able to
 ;; track down the problem.
-(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type) arg2)
+(cl-defmethod xref-elisp-generic-no-default ((_this xref-elisp-root-type) _arg2)
   "doc string generic no-default xref-elisp-root-type"
   "non-default for no-default")
 
@@ -436,11 +436,11 @@ to (xref-elisp-test-descr-to-target xref)."
   ;; dispatching code.
   )
 
-(cl-defgeneric xref-elisp-generic-co-located-default (arg1 arg2)
+(cl-defgeneric xref-elisp-generic-co-located-default (_arg1 _arg2)
   "doc string generic co-located-default"
   "co-located default")
 
-(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type) arg2)
+(cl-defmethod xref-elisp-generic-co-located-default ((_this xref-elisp-root-type) _arg2)
   "doc string generic co-located-default xref-elisp-root-type"
   "non-default for co-located-default")
 
@@ -449,19 +449,19 @@ to (xref-elisp-test-descr-to-target xref)."
   ;; default implementation provided separately
   )
 
-(cl-defmethod xref-elisp-generic-separate-default (arg1 arg2)
+(cl-defmethod xref-elisp-generic-separate-default (_arg1 _arg2)
   "doc string generic separate-default default"
   "separate default")
 
-(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type) arg2)
+(cl-defmethod xref-elisp-generic-separate-default ((_this xref-elisp-root-type) _arg2)
   "doc string generic separate-default xref-elisp-root-type"
   "non-default for separate-default")
 
-(cl-defmethod xref-elisp-generic-implicit-generic (arg1 arg2)
+(cl-defmethod xref-elisp-generic-implicit-generic (_arg1 _arg2)
   "doc string generic implicit-generic default"
   "default for implicit generic")
 
-(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type) arg2)
+(cl-defmethod xref-elisp-generic-implicit-generic ((_this xref-elisp-root-type) _arg2)
   "doc string generic implicit-generic xref-elisp-root-type"
   "non-default for implicit generic")
 
@@ -810,5 +810,64 @@ to (xref-elisp-test-descr-to-target xref)."
     (insert "?\\N{HEAVY CHECK MARK}")
     (should (equal (elisp--preceding-sexp) ?\N{HEAVY CHECK MARK}))))
 
+
+(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

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: