Re: Help sought understanding shorthands wrt modules/packages

[Richard Stallman <rms@gnu.org>]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

I just wrote changes which ought to provide the missing
functionality in the shorthands feature.  It adds an argument to Fload
which specifies additional shorthands to apply to that file.
See below.

I have made it compile but I have not had a chance yet to test running
it.  I hope to find a chance to do that soon.

This is intended to make it possible to have a file strings.el which
loads the file s.el (unmodified) and renames all the functions in it
so that they start with `string-' (or whatever prefix we like).
We could then include `strings.el' in the standard Emacs Lisp namespace
and document its facilities in the Emacs Lisp Reference Manual.

Because this avoids modifying s.el, we would not have to maintain
our own version of that file.  That would be good for cooperating with
its developer.


diff --git a/src/lread.c b/src/lread.c
index dfa4d9afb51..abd818cfa5a 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -151,7 +151,7 @@ static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
 
 static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool,
                           Lisp_Object, Lisp_Object,
-                          Lisp_Object, Lisp_Object);
+                          Lisp_Object, Lisp_Object, Lisp_Object);
 
 static void build_load_history (Lisp_Object, bool);
 
@@ -1170,7 +1170,7 @@ loadhist_initialize (Lisp_Object filename)
   specbind (Qcurrent_load_list, Fcons (filename, Qnil));
 }
 
-DEFUN ("load", Fload, Sload, 1, 5, 0,
+DEFUN ("load", Fload, Sload, 1, 6, 0,
        doc: /* Execute a file of Lisp code named FILE.
 First try FILE with `.elc' appended, then try with `.el', then try
 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
@@ -1206,6 +1206,13 @@ When searching suffixes, this function normally stops at the first
 one that exists.  If the option `load-prefer-newer' is non-nil,
 however, it tries all suffixes, and uses whichever file is the newest.
 
+ADD-SHORTHANDS specifies a list of additional shorthands (symbol
+renamings) to perform when loading this file,
+in addition to those specified in the file itself.
+Normally you should call `load-with-shorthands' to specify this,
+rather than calling `load' with nil for all args
+except for FILE and ADD-SHORTHANDS.
+
 Loading a file records its definitions, and its `provide' and
 `require' calls, in an element of `load-history' whose
 car is the file name loaded.  See `load-history'.
@@ -1216,7 +1223,7 @@ is bound to the file's name.
 
 Return t if the file exists and loads successfully.  */)
   (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
-   Lisp_Object nosuffix, Lisp_Object must_suffix)
+   Lisp_Object nosuffix, Lisp_Object must_suffix, Lisp_Object add_shorthands)
 {
   FILE *stream UNINIT;
   int fd;
@@ -1236,7 +1243,8 @@ Return t if the file exists and loads successfully.  */)
   /* If file name is magic, call the handler.  */
   handler = Ffind_file_name_handler (file, Qload);
   if (!NILP (handler))
-    return call5 (handler, Qload, file, noerror, nomessage, nosuffix);
+    return call7 (handler, Qload, file, noerror, nomessage,
+		  nosuffix, must_suffix, add_shorthands);
 
   /* The presence of this call is the result of a historical accident:
      it used to be in every file-operation and when it got removed
@@ -1325,7 +1333,8 @@ Return t if the file exists and loads successfully.  */)
       else
 	handler = Ffind_file_name_handler (found, Qload);
       if (! NILP (handler))
-	return call5 (handler, Qload, found, noerror, nomessage, Qt);
+	return call6 (handler, Qload, found, noerror, nomessage, Qt,
+		      add_shorthands);
 #ifdef DOS_NT
       /* Tramp has to deal with semi-broken packages that prepend
 	 drive letters to remote files.  For that reason, Tramp
@@ -1480,9 +1489,11 @@ Return t if the file exists and loads successfully.  */)
 	      emacs_close (fd);
 	      clear_unwind_protect (fd_index);
 	    }
-	  val = call4 (Vload_source_file_function, found, hist_file_name,
+	  val = call5 (Vload_source_file_function, found, hist_file_name,
 		       NILP (noerror) ? Qnil : Qt,
-		       (NILP (nomessage) || force_load_messages) ? Qnil : Qt);
+		       (NILP (nomessage) || force_load_messages) ? Qnil : Qt,
+		       add_shorthands);
+	  /* ???  Fix  ‘load-with-code-conversion’.  */
 	  return unbind_to (count, val);
 	}
     }
@@ -1557,6 +1568,7 @@ Return t if the file exists and loads successfully.  */)
 
   if (is_module)
     {
+      /* ??? Does this require fixing for shorthands?  */
 #ifdef HAVE_MODULES
       loadhist_initialize (found);
       Fmodule_load (found);
@@ -1570,6 +1582,7 @@ Return t if the file exists and loads successfully.  */)
     {
 #ifdef HAVE_NATIVE_COMP
       loadhist_initialize (hist_file_name);
+      /* ??? Does this require fixing for shorthands?  */
       Fnative_elisp_load (found, Qnil);
       build_load_history (hist_file_name, true);
 #else
@@ -1585,14 +1598,14 @@ Return t if the file exists and loads successfully.  */)
 
       if (! version || version >= 22)
         readevalloop (Qget_file_char, &input, hist_file_name,
-                      0, Qnil, Qnil, Qnil, Qnil);
+                      0, Qnil, Qnil, Qnil, Qnil, add_shorthands);
       else
         {
           /* We can't handle a file which was compiled with
              byte-compile-dynamic by older version of Emacs.  */
           specbind (Qload_force_doc_strings, Qt);
           readevalloop (Qget_emacs_mule_file_char, &input, hist_file_name,
-                        0, Qnil, Qnil, Qnil, Qnil);
+                        0, Qnil, Qnil, Qnil, Qnil, add_shorthands);
         }
     }
   unbind_to (count, Qnil);
@@ -1633,7 +1646,8 @@ save_match_data_load (Lisp_Object file, Lisp_Object noerror,
 {
   specpdl_ref count = SPECPDL_INDEX ();
   record_unwind_save_match_data ();
-  Lisp_Object result = Fload (file, noerror, nomessage, nosuffix, must_suffix);
+  Lisp_Object result
+    = Fload (file, noerror, nomessage, nosuffix, must_suffix, Qnil);
   return unbind_to (count, result);
 }
 \f
@@ -2166,7 +2180,9 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
    READFUN, if non-nil, is used instead of `read'.
 
    START, END specify region to read in current buffer (from eval-region).
-   If the input is not from a buffer, they must be nil.  */
+   If the input is not from a buffer, they must be nil.
+
+   ADD_SHORTHANDS is copied from the argument to `load' of the same name.  */
 
 static void
 readevalloop (Lisp_Object readcharfun,
@@ -2174,7 +2190,7 @@ readevalloop (Lisp_Object readcharfun,
 	      Lisp_Object sourcename,
 	      bool printflag,
 	      Lisp_Object unibyte, Lisp_Object readfun,
-	      Lisp_Object start, Lisp_Object end)
+	      Lisp_Object start, Lisp_Object end, Lisp_Object add_shorthands)
 {
   int c;
   Lisp_Object val;
@@ -2225,6 +2241,7 @@ readevalloop (Lisp_Object readcharfun,
 	    (NILP (lex_bound) || BASE_EQ (lex_bound, Qunbound)
 	     ? Qnil : list1 (Qt)));
   specbind (Qmacroexp__dynvars, Vmacroexp__dynvars);
+  specbind (Qread_symbol_added_shorthands, add_shorthands);
 
   /* Ensure sourcename is absolute, except whilst preloading.  */
   if (!will_dump_p ()
@@ -2414,7 +2431,7 @@ This function preserves the position of point.  */)
   specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil);
   BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
   readevalloop (buf, 0, filename,
-		!NILP (printflag), unibyte, Qnil, Qnil, Qnil);
+		!NILP (printflag), unibyte, Qnil, Qnil, Qnil, Qnil);
   return unbind_to (count, Qnil);
 }
 
@@ -2449,7 +2466,7 @@ This function does not move point.  */)
   /* `readevalloop' calls functions which check the type of start and end.  */
   readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename),
 		!NILP (printflag), Qnil, read_function,
-		start, end);
+		start, end, Qnil);
 
   return unbind_to (count, Qnil);
 }
@@ -4933,43 +4950,65 @@ oblookup_considering_shorthand (Lisp_Object obarray, const char *in,
 				ptrdiff_t size, ptrdiff_t size_byte, char **out,
 				ptrdiff_t *size_out, ptrdiff_t *size_byte_out)
 {
-  Lisp_Object tail = Vread_symbol_shorthands;
+  Lisp_Object tail = Qnil;
+  int stage = 0;
 
   /* First, assume no transformation will take place.  */
   *out = NULL;
-  /* Then, iterate each pair in Vread_symbol_shorthands.  */
-  FOR_EACH_TAIL_SAFE (tail)
+
+  /* Check each of the shorthands now in effect.  */
+  while (1)
     {
-      Lisp_Object pair = XCAR (tail);
-      /* Be lenient to 'read-symbol-shorthands': if some element isn't a
-	 cons, or some member of that cons isn't a string, just skip
-	 to the next element.  */
-      if (!CONSP (pair))
-	continue;
-      Lisp_Object sh_prefix = XCAR (pair);
-      Lisp_Object lh_prefix = XCDR (pair);
-      if (!STRINGP (sh_prefix) || !STRINGP (lh_prefix))
-	continue;
-      ptrdiff_t sh_prefix_size = SBYTES (sh_prefix);
-
-      /* Compare the prefix of the transformation pair to the symbol
-	 name.  If a match occurs, do the renaming and exit the loop.
-	 In other words, only one such transformation may take place.
-	 Calculate the amount of memory to allocate for the longhand
-	 version of the symbol name with xrealloc.  This isn't
-	 strictly needed, but it could later be used as a way for
-	 multiple transformations on a single symbol name.  */
-      if (sh_prefix_size <= size_byte
-	  && memcmp (SSDATA (sh_prefix), in, sh_prefix_size) == 0)
+      /* Do stage 1: iterate each pair in Vread_symbol_added_shorthands.  */
+      if (stage == 0)
 	{
-	  ptrdiff_t lh_prefix_size = SBYTES (lh_prefix);
-	  ptrdiff_t suffix_size = size_byte - sh_prefix_size;
-	  *out = xrealloc (*out, lh_prefix_size + suffix_size);
-	  memcpy (*out, SSDATA(lh_prefix), lh_prefix_size);
-	  memcpy (*out + lh_prefix_size, in + sh_prefix_size, suffix_size);
-	  *size_out = SCHARS (lh_prefix) - SCHARS (sh_prefix) + size;
-	  *size_byte_out = lh_prefix_size + suffix_size;
-	  break;
+	  tail = Vread_symbol_added_shorthands;
+	  stage = 1;
+	}
+      /* Then stage 2: iterate each pair in Vread_symbol_shorthands.  */
+      else if (stage == 1)
+	{
+	  tail = Vread_symbol_shorthands;
+	  stage = 2;
+	}
+      /* There are no more stages after stage 2.  */
+      else
+	break;
+
+      /* Check each of the shorthands of this stage.  */
+      FOR_EACH_TAIL_SAFE (tail)
+	{
+	  Lisp_Object pair = XCAR (tail);
+	  /* Be lenient to 'read-symbol-shorthands': if some element isn't a
+	     cons, or some member of that cons isn't a string, just skip
+	     to the next element.  */
+	  if (!CONSP (pair))
+	    continue;
+	  Lisp_Object sh_prefix = XCAR (pair);
+	  Lisp_Object lh_prefix = XCDR (pair);
+	  if (!STRINGP (sh_prefix) || !STRINGP (lh_prefix))
+	    continue;
+	  ptrdiff_t sh_prefix_size = SBYTES (sh_prefix);
+
+	  /* Compare the prefix of the transformation pair to the symbol
+	     name.  If a match occurs, do the renaming and exit the loop.
+	     In other words, only one such transformation may take place.
+	     Calculate the amount of memory to allocate for the longhand
+	     version of the symbol name with xrealloc.  This isn't
+	     strictly needed, but it could later be used as a way for
+	     multiple transformations on a single symbol name.  */
+	  if (sh_prefix_size <= size_byte
+	      && memcmp (SSDATA (sh_prefix), in, sh_prefix_size) == 0)
+	    {
+	      ptrdiff_t lh_prefix_size = SBYTES (lh_prefix);
+	      ptrdiff_t suffix_size = size_byte - sh_prefix_size;
+	      *out = xrealloc (*out, lh_prefix_size + suffix_size);
+	      memcpy (*out, SSDATA(lh_prefix), lh_prefix_size);
+	      memcpy (*out + lh_prefix_size, in + sh_prefix_size, suffix_size);
+	      *size_out = SCHARS (lh_prefix) - SCHARS (sh_prefix) + size;
+	      *size_byte_out = lh_prefix_size + suffix_size;
+	      break;
+	    }
 	}
     }
   /* Now, as promised, call oblookup with the "final" symbol name to
@@ -5715,6 +5754,13 @@ that are loaded before your customizations are read!  */);
 This variable's value can only be set via file-local variables.
 See Info node `(elisp)Shorthands' for more details.  */);
   Vread_symbol_shorthands = Qnil;
+  DEFVAR_LISP ("read-symbol-added-shorthands", Vread_symbol_added_shorthands,
+          doc: /* Alist of symbol-name shorthands added by `load'.
+This variable's value comes from the ADDED-SHORTHANDS argument to `load'.
+See Info node `(elisp)Shorthands' for more details.  */);
+  Vread_symbol_added_shorthands = Qnil;
+
+  DEFSYM (Qread_symbol_added_shorthands, "read-symbol-added-shorthands");
   DEFSYM (Qobarray_cache, "obarray-cache");
   DEFSYM (Qobarrayp, "obarrayp");
 

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)