emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Consistent face for keys in *Help* and `substitute-command-keys'


From: Stefan Kangas
Subject: Re: Consistent face for keys in *Help* and `substitute-command-keys'
Date: Wed, 24 Feb 2021 19:56:00 -0600

Eli Zaretskii <eliz@gnu.org> writes:

> Using Fpropertize here is suboptimal: it does several thing you don't
> need when calling it from C, including consing a new string, which is
> just a waste of cycles.
>
> Please use Fadd_text_properties instead.

How's this?

diff --git a/src/keymap.c b/src/keymap.c
index 782931fadf..e38c9b908a 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -2846,6 +2846,23 @@ DEFUN ("describe-vector", Fdescribe_vector,
Sdescribe_vector, 1, 2, 0,
   return unbind_to (count, Qnil);
 }

+static Lisp_Object fontify_key_properties;
+
+static Lisp_Object
+describe_key_maybe_fontify (Lisp_Object str, Lisp_Object prefix,
+                                  bool keymap_p)
+{
+  Lisp_Object key_desc = Fkey_description (str, prefix);
+
+  if (keymap_p)
+    return Fadd_text_properties (make_fixnum (0),
+                                make_fixnum (SCHARS (key_desc)),
+                                fontify_key_properties,
+                                key_desc);
+  else
+    return key_desc;
+}
+
 DEFUN ("help--describe-vector", Fhelp__describe_vector,
Shelp__describe_vector, 7, 7, 0,
        doc: /* Insert in the current buffer a description of the
contents of VECTOR.
 Call DESCRIBER to insert the description of one value found in VECTOR.
@@ -3021,7 +3038,7 @@ describe_vector (Lisp_Object vector, Lisp_Object
prefix, Lisp_Object args,
       if (!NILP (elt_prefix))
        insert1 (elt_prefix);

-      insert1 (Fkey_description (kludge, prefix));
+      insert1 (describe_key_maybe_fontify (kludge, prefix, keymap_p));

       /* Find all consecutive characters or rows that have the same
         definition.  But, if VECTOR is a char-table, we had better
@@ -3071,7 +3088,7 @@ describe_vector (Lisp_Object vector, Lisp_Object
prefix, Lisp_Object args,
          if (!NILP (elt_prefix))
            insert1 (elt_prefix);

-         insert1 (Fkey_description (kludge, prefix));
+         insert1 (describe_key_maybe_fontify (kludge, prefix, keymap_p));
        }

       /* Print a description of the definition of this character.
@@ -3200,6 +3217,12 @@ syms_of_keymap (void)
   staticpro (&where_is_cache);
   staticpro (&where_is_cache_keymaps);

+  DEFSYM (Qfont_lock_face, "font-lock-face");
+  DEFSYM (Qhelp_key_binding, "help-key-binding");
+  staticpro (&fontify_key_properties);
+  fontify_key_properties = Fcons (Qfont_lock_face,
+                                 Fcons (Qhelp_key_binding, Qnil));
+
   defsubr (&Skeymapp);
   defsubr (&Skeymap_parent);
   defsubr (&Skeymap_prompt);



reply via email to

[Prev in Thread] Current Thread [Next in Thread]