Add new Lisp implementation of substitute-command-keys

This is only the first step towards a full Lisp implementation, and
does not remove the old C code.  On the contrary, it is partly based
on using the old C code, which is to be replaced in steps.  This also
makes it easy to test that it produces the same output as the old.

* src/doc.c (Fsubstitute_command_keys_old): Rename from
Fsubstitute_command_keys.
(Fget_quoting_style): New defun to expose text_quoting_style to Lisp.
(syms_of_doc): Expose above symbols.
* lisp/help.el (substitute-command-keys): New Lisp version of
substitute-command-keys.  (Bug#8951)

* src/keymap.c
(Fdescribe_map_tree): New defun to expose describe_map_tree to Lisp.
(syms_of_keymap): New defsubr for Fdescribe_map_tree.

* src/keyboard.c (help_echo_substitute_command_keys):
* src/doc.c (Fdocumentation, Fdocumentation_property):
* src/print.c (print_error_message):
* src/syntax.c (Finternal_describe_syntax_value): Fix calls to use new
Lisp implementation of substitute-command-keys.

* test/src/doc-tests.el: Remove file.
* test/lisp/help-tests.el: Add tests for substitute-command-keys
copied from above file.

5 files changed, 65 insertions, 11 deletions

diff --git a/src/doc.c b/src/doc.c
index 18ab346cd11..212ebe96334 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -415,7 +415,7 @@ string is passed through `substitute-command-keys'.  */)
     }
 
   if (NILP (raw))
-    doc = Fsubstitute_command_keys (doc);
+    doc = call1 (Qsubstitute_command_keys, doc);
   return doc;
 }
 
@@ -472,7 +472,7 @@ aren't strings.  */)
     tem = Feval (tem, Qnil);
 
   if (NILP (raw) && STRINGP (tem))
-    tem = Fsubstitute_command_keys (tem);
+    tem = call1 (Qsubstitute_command_keys, tem);
   return tem;
 }
 
@@ -696,8 +696,27 @@ text_quoting_style (void)
     return CURVE_QUOTING_STYLE;
 }
 
-DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
-       Ssubstitute_command_keys, 1, 1, 0,
+/* This is just a Lisp wrapper for text_quoting_style above.  */
+DEFUN ("get-quoting-style", Fget_quoting_style,
+       Sget_quoting_style, 0, 0, 0,
+       doc: /* Return the current effective text quoting style.
+See variable `text-quoting-style'.  */)
+  (void)
+{
+  switch (text_quoting_style ())
+    {
+    case STRAIGHT_QUOTING_STYLE:
+      return Qstraight;
+    case CURVE_QUOTING_STYLE:
+      return Qcurve;
+    case GRAVE_QUOTING_STYLE:
+    default:
+      return Qgrave;
+    }
+}
+
+DEFUN ("substitute-command-keys-old", Fsubstitute_command_keys_old,
+       Ssubstitute_command_keys_old, 1, 1, 0,
        doc: /* Substitute key descriptions for command names in STRING.
 Each substring of the form \\=\\[COMMAND] is replaced by either a
 keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
@@ -884,12 +903,12 @@ Otherwise, return a new string (without any text properties).  */)
             {
               name = Fsymbol_name (name);
               AUTO_STRING (msg_prefix, "\nUses keymap `");
-              insert1 (Fsubstitute_command_keys (msg_prefix));
+              insert1 (Fsubstitute_command_keys_old (msg_prefix));
               insert_from_string (name, 0, 0,
                                   SCHARS (name),
                                   SBYTES (name), 1);
               AUTO_STRING (msg_suffix, "', which is not currently defined.\n");
-              insert1 (Fsubstitute_command_keys (msg_suffix));
+              insert1 (Fsubstitute_command_keys_old (msg_suffix));
               if (!generate_summary)
                 keymap = Qnil;
             }
@@ -1002,9 +1021,11 @@ Otherwise, return a new string (without any text properties).  */)
 void
 syms_of_doc (void)
 {
+  DEFSYM (Qsubstitute_command_keys, "substitute-command-keys");
   DEFSYM (Qfunction_documentation, "function-documentation");
   DEFSYM (Qgrave, "grave");
   DEFSYM (Qstraight, "straight");
+  DEFSYM (Qcurve, "curve");
 
   DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
                doc: /* Name of file containing documentation strings of built-in symbols.  */);
@@ -1036,5 +1057,6 @@ otherwise.  */);
   defsubr (&Sdocumentation);
   defsubr (&Sdocumentation_property);
   defsubr (&Ssnarf_documentation);
-  defsubr (&Ssubstitute_command_keys);
+  defsubr (&Sget_quoting_style);
+  defsubr (&Ssubstitute_command_keys_old);
 }
diff --git a/src/keyboard.c b/src/keyboard.c
index 10d2f6323ed..2e0143379a0 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2040,7 +2040,7 @@ help_echo_substitute_command_keys (Lisp_Object help)
                                     help)))
     return help;
 
-  return Fsubstitute_command_keys (help);
+  return call1 (Qsubstitute_command_keys, help);
 }
 
 /* Display the help-echo property of the character after the mouse pointer.
@@ -7856,7 +7856,7 @@ parse_menu_item (Lisp_Object item, int inmenubar)
     /* The previous code preferred :key-sequence to :keys, so we
        preserve this behavior.  */
     if (STRINGP (keyeq) && !CONSP (keyhint))
-      keyeq = concat2 (space_space, Fsubstitute_command_keys (keyeq));
+      keyeq = concat2 (space_space, call1 (Qsubstitute_command_keys, keyeq));
     else
       {
         Lisp_Object prefix = keyeq;
diff --git a/src/keymap.c b/src/keymap.c
index 0608bdddeea..05b0814c475 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -2915,6 +2915,37 @@ You type        Translation\n\
 
    Any inserted text ends in two newlines (used by `help-make-xrefs').  */
 
+DEFUN ("describe-map-tree", Fdescribe_map_tree, Sdescribe_map_tree, 1, 8, 0,
+       doc: /* This is just temporary.  */)
+  (Lisp_Object startmap, Lisp_Object partial, Lisp_Object shadow,
+   Lisp_Object prefix, Lisp_Object title, Lisp_Object nomenu,
+   Lisp_Object transl, Lisp_Object always_title)
+{
+  ptrdiff_t count = SPECPDL_INDEX ();
+  char *title_string;
+
+  if ( !NILP (title) )
+    {
+      CHECK_STRING (title);
+      title_string = SSDATA(title);
+    }
+  else
+    {
+      title_string = NULL;
+    }
+
+  bool b_partial = NILP (partial) ? false : true;
+  bool b_nomenu = NILP (nomenu) ? false : true;
+  bool b_transl = NILP (transl) ? false : true;
+  bool b_always_title = NILP (always_title) ? false : true;
+
+  /* specbind (Qstandard_output, Fcurrent_buffer ()); */
+  describe_map_tree (startmap, b_partial, shadow, prefix, title_string,
+                     b_nomenu, b_transl, b_always_title, true);
+
+  return unbind_to (count, Qnil);
+}
+
 void
 describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow,
                    Lisp_Object prefix, const char *title, bool nomenu,
@@ -3708,6 +3739,7 @@ be preferred.  */);
   defsubr (&Scurrent_active_maps);
   defsubr (&Saccessible_keymaps);
   defsubr (&Skey_description);
+  defsubr (&Sdescribe_map_tree);
   defsubr (&Sdescribe_vector);
   defsubr (&Ssingle_key_description);
   defsubr (&Stext_char_description);
diff --git a/src/print.c b/src/print.c
index dca095f2812..53aa353769b 100644
--- a/src/print.c
+++ b/src/print.c
@@ -941,7 +941,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
   else
     {
       Lisp_Object error_conditions = Fget (errname, Qerror_conditions);
-      errmsg = Fsubstitute_command_keys (Fget (errname, Qerror_message));
+      errmsg = call1 (Qsubstitute_command_keys, Fget (errname, Qerror_message));
       file_error = Fmemq (Qfile_error, error_conditions);
     }
 
diff --git a/src/syntax.c b/src/syntax.c
index 066972e6d88..df07809aaaf 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -1421,7 +1421,7 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
     {
       AUTO_STRING (prefixdoc,
                    ",\n\t  is a prefix character for `backward-prefix-chars'");
-      insert1 (Fsubstitute_command_keys (prefixdoc));
+      insert1 (call1 (Qsubstitute_command_keys, prefixdoc));
     }
 
   return syntax;