bug#41200: Displaying a tooltip with x-show-tip gets very slow as more faces are defined

["Clément Pit-Claudel" <cpitclaudel@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 3577 bytes --]

Hi Eli,

Thanks a lot for the review.  I have attached an updated version of the patch.

On 15/05/2020 07.05, Eli Zaretskii wrote:
> I'd like to keep the old face-new-frame-defaults and frame-face-alist
> for compatibility, but mention in the doc strings that they no longer
> return modifiable values, and perhaps deprecate them.

Done for frame-face-alist.  But how can one do a read-only variable?  Using the new variable watchers facility?

>> * The name face_hash isn't ideal, since there's already a distinct notion of face hashes (hash codes).  Can you think of a better name? 
> 
> face_hash_table?

Thanks, good idea.  I also liked Stefan's frame_face_map.

>> +  // QUESTION: is this where this should be initialized?
> 
> Yes, I think so.  But do we need to do anything when frame is deleted
> as well?

I'm not sure (I don't know how garbage collection works on the C side in Elisp; I assumed the map would be collected).

>> -DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist,
>> +// QUESTION: Should I add an ELisp version of frame-face-hash?
> 
> You mean, frame-face-alist, right?  Yes, most definitely: I imagine a
> lot of code out there uses that, and we wouldn't want to break that.

Done.

I looked around, but I didn't find many uses at all (for example, there are none in ELPA).  I think this is likely because the function is documented as "For internal use only."

There are no uses of face-new-frame-defaults in ELPA either; online, I found many copies of lisp-mode and emacs-lisp-mode, which refer it, and a few functions derived from edebug-eval-defun, which references it.

> And I'm not sure we should have it only in Lisp: perhaps we should
> maintain the alist as well, and add/remove to/from it when a face is
> added or removed in the hash table.  Otherwise this change of
> internals will have painful effect on packages that use the current
> APIs.

frame-face-alist is likely less crucial than face-new-frame-defaults, because it was already a function, so the return value has to be mutated in place to modify it (it couldn't be directly assigned).  For both of these, however, how would we ensure that the alist remains in sync with the hashmap (that is, how do we catch modifications?)

>> +	  Lisp_Object lface = HASH_KEY(table, idx);
>> +          Lisp_Object face_id = Fget (lface, Qface);
>> +          // FIXME why is (get 'tab-line 'face) 0?
> 
> A bug, I guess.

As far as I can see, these IDs are assigned by Finternal_make_lisp_face, and I *think* it is never called for tab-line?  Should I make sure that it is? If so, where from?

> 
>> +          if (!FIXNATP (face_id))
>> +            // FIXME: I'm not sure what to do in this case
> 
> I'm not sure I understand why do you need to look at the existing
> face's 'face' property?  The original code didn't.

The original code iterated over face-frame-alist in the order in which entries were added to it.  If I understand correctly, iteration order isn't guaranteed on hash tables (is it?), so I had to find a different source of truth for these.

> 
>>    DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults,
>>      doc: /* List of global face definitions (for internal use only.)  */);
>> -  Vface_new_frame_defaults = Qnil;
>> +  Vface_new_frame_defaults =
>> +    make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
>> +                     DEFAULT_REHASH_THRESHOLD, Qnil, Qnil);
> 
> Why do we need to start with a non-default hash-table?

I wanted to use `eq' instead of `eql' as the test (is that what you were asking?)


[-- Attachment #2: 0001-Store-frame-faces-in-hash-tables-instead-of-alists.patch --]
[-- Type: text/x-patch, Size: 13026 bytes --]

From 86ea2f96e4e3a2161f68f13b251620b98489fd35 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Pit-Claudel?= <clement.pitclaudel@live.com>
Date: Tue, 12 May 2020 21:48:32 -0400
Subject: [PATCH] Store frame faces in hash tables instead of alists

* lisp/emacs-lisp/edebug.el (edebug-eval-defun):
* lisp/progmodes/elisp-mode.el (elisp--eval-defun-1):
* lisp/frame.el (frame-set-background-mode):
* lisp/faces.el (face-list): Update to work with hash
tables instead of alists.
(frame-face-alist): Reimplement using frame-face-map.

* src/frame.h (struct frame): Remove face_alist, add face_map.
(fset_face_alist): Remove.
(fset_face_map): New function.
* src/frame.c (make_frame): Initialize f->face_map.
(Fmake_terminal_frame): Update to work with hash tables instead of
alists.
* src/xfaces.c (lface_from_face_name_no_resolve):
(Finternal_make_lisp_face):
(update_face_from_frame_parameter): Update to work with hash tables
instead of alists.
* src/xfaces.c (Fframe_face_map): New function.
(Fframe_face_alist): Move to face.el.
(init_xfaces): Compute face IDs from they face property, not from
their position in face_alist.
(syms_of_xfaces): Remove frame_face_alist, add frame_face_map;
change Vface_new_frame_defaults into a hash table.
---
 lisp/emacs-lisp/edebug.el    |  3 +-
 lisp/faces.el                | 13 +++++++-
 lisp/frame.el                |  2 +-
 lisp/progmodes/elisp-mode.el |  3 +-
 src/frame.c                  | 20 +++++++----
 src/frame.h                  |  8 ++---
 src/xfaces.c                 | 65 +++++++++++++++++++-----------------
 7 files changed, 67 insertions(+), 47 deletions(-)

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 78461185d3..97ca964eef 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -488,8 +488,7 @@ edebug-eval-defun
 	   (set-default (nth 1 form) (eval (nth 2 form) lexical-binding)))
           ((eq (car form) 'defface)
            ;; Reset the face.
-           (setq face-new-frame-defaults
-                 (assq-delete-all (nth 1 form) face-new-frame-defaults))
+           (remhash (nth 1 form) face-new-frame-defaults)
            (put (nth 1 form) 'face-defface-spec nil)
            (put (nth 1 form) 'face-documentation (nth 3 form))
 	   ;; See comments in `eval-defun-1' for purpose of code below
diff --git a/lisp/faces.el b/lisp/faces.el
index e707f6f4b6..c45921bb48 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -176,10 +176,21 @@ face-font-registry-alternatives
 ;;; Creation, copying.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defun frame-face-alist (&optional frame)
+  "Return an alist of frame-local faces defined on FRAME.
+This alist is a copy of the contents of `frame-face-map'.
+For internal use only."
+  (declare (obsolete frame-face-map "28.1"))
+  (let ((faces))
+    (maphash (lambda (face spec) (push (cons face spec) faces))
+             (frame-face-map frame))
+    faces))
 
 (defun face-list ()
   "Return a list of all defined faces."
-  (mapcar #'car face-new-frame-defaults))
+  (let ((faces nil))
+    (maphash (lambda (face _) (push face faces)) face-new-frame-defaults)
+    faces))
 
 (defun make-face (face)
   "Define a new face with name FACE, a symbol.
diff --git a/lisp/frame.el b/lisp/frame.el
index 6c2f774709..14c9112aad 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1227,7 +1227,7 @@ frame-set-background-mode
                          ;; during startup with -rv on the command
                          ;; line for the initial frame, because frames
                          ;; are not recorded in the pdump file.
-                         (assq face (frame-face-alist))
+                         (gethash face (frame-face-map))
                          (face-spec-match-p face
                                             (face-user-default-spec face)
                                             ;; FIXME: why selected-frame and
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index b737134f90..dc8688c864 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1304,8 +1304,7 @@ elisp--eval-defun-1
 	((eq (car form) 'custom-declare-face)
 	 ;; Reset the face.
 	 (let ((face-symbol (eval (nth 1 form) lexical-binding)))
-	   (setq face-new-frame-defaults
-		 (assq-delete-all face-symbol face-new-frame-defaults))
+	   (remhash face-new-frame-defaults face-symbol)
 	   (put face-symbol 'face-defface-spec nil)
 	   (put face-symbol 'face-override-spec nil))
 	 form)
diff --git a/src/frame.c b/src/frame.c
index c871e4fd99..514b390910 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -946,6 +946,10 @@ make_frame (bool mini_p)
   rw->total_lines = mini_p ? 9 : 10;
   rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f);
 
+  fset_face_map
+    (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
+                         DEFAULT_REHASH_THRESHOLD, Qnil, false));
+
   if (mini_p)
     {
       mw->top_line = rw->total_lines;
@@ -1254,7 +1258,7 @@ DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
 {
   struct frame *f;
   struct terminal *t = NULL;
-  Lisp_Object frame, tem;
+  Lisp_Object frame;
   struct frame *sf = SELECTED_FRAME ();
 
 #ifdef MSDOS
@@ -1336,14 +1340,16 @@ DEFUN ("make-terminal-frame", Fmake_terminal_frame, Smake_terminal_frame,
   store_in_alist (&parms, Qminibuffer, Qt);
   Fmodify_frame_parameters (frame, parms);
 
-  /* Make the frame face alist be frame-specific, so that each
+  /* Make the frame face hash be frame-specific, so that each
      frame could change its face definitions independently.  */
-  fset_face_alist (f, Fcopy_alist (sf->face_alist));
-  /* Simple Fcopy_alist isn't enough, because we need the contents of
-     the vectors which are the CDRs of associations in face_alist to
+  fset_face_map (f, Fcopy_hash_table (sf->face_map));
+  /* Simple copy_hash_table isn't enough, because we need the contents of
+     the vectors which are the values in face_map to
      be copied as well.  */
-  for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
-    XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
+  ptrdiff_t idx = 0;
+  struct Lisp_Hash_Table *table = XHASH_TABLE (f->face_map);
+  for (idx = 0; idx < table->count; ++idx)
+    set_hash_value_slot (table, idx, Fcopy_sequence (HASH_VALUE (table, idx)));
 
   f->can_set_window_size = true;
   f->after_make_frame = true;
diff --git a/src/frame.h b/src/frame.h
index 476bac67fa..f8915b3c1a 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -158,8 +158,8 @@ #define EMACS_FRAME_H
      There are four additional elements of nil at the end, to terminate.  */
   Lisp_Object menu_bar_items;
 
-  /* Alist of elements (FACE-NAME . FACE-VECTOR-DATA).  */
-  Lisp_Object face_alist;
+  /* Hash table of FACE-NAME keys and FACE-VECTOR-DATA values.  */
+  Lisp_Object face_map;
 
   /* A vector that records the entire structure of this frame's menu bar.
      For the format of the data, see extensive comments in xmenu.c.
@@ -661,9 +661,9 @@ fset_condemned_scroll_bars (struct frame *f, Lisp_Object val)
   f->condemned_scroll_bars = val;
 }
 INLINE void
-fset_face_alist (struct frame *f, Lisp_Object val)
+fset_face_map (struct frame *f, Lisp_Object val)
 {
-  f->face_alist = val;
+  f->face_map = val;
 }
 #if defined (HAVE_WINDOW_SYSTEM)
 INLINE void
diff --git a/src/xfaces.c b/src/xfaces.c
index 7d7aff95c1..89e9a10a0a 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -1843,13 +1843,11 @@ lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name,
   Lisp_Object lface;
 
   if (f)
-    lface = assq_no_quit (face_name, f->face_alist);
+    lface = Fgethash (face_name, f->face_map, Qnil);
   else
-    lface = assq_no_quit (face_name, Vface_new_frame_defaults);
+    lface = Fgethash (face_name, Vface_new_frame_defaults, Qnil);
 
-  if (CONSP (lface))
-    lface = XCDR (lface);
-  else if (signal_p)
+  if (signal_p && NILP (lface))
     signal_error ("Invalid face", face_name);
 
   check_lface (lface);
@@ -2736,8 +2734,7 @@ DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face,
     {
       global_lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
       ASET (global_lface, 0, Qface);
-      Vface_new_frame_defaults = Fcons (Fcons (face, global_lface),
-					Vface_new_frame_defaults);
+      Fputhash (face, global_lface, Vface_new_frame_defaults);
 
       /* Assign the new Lisp face a unique ID.  The mapping from Lisp
 	 face id to Lisp face is given by the vector lface_id_to_name.
@@ -2763,7 +2760,7 @@ DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face,
 	{
 	  lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
 	  ASET (lface, 0, Qface);
-	  fset_face_alist (f, Fcons (Fcons (face, lface), f->face_alist));
+	  Fputhash (face, lface, f->face_map);
 	}
       else
 	for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
@@ -3508,7 +3505,7 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param,
   /* If there are no faces yet, give up.  This is the case when called
      from Fx_create_frame, and we do the necessary things later in
      face-set-after-frame-defaults.  */
-  if (NILP (f->face_alist))
+  if (XFIXNAT (Fhash_table_count (f->face_map)) == 0)
     return;
 
   if (EQ (param, Qforeground_color))
@@ -4174,14 +4171,13 @@ DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p,
   return i == LFACE_VECTOR_SIZE ? Qt : Qnil;
 }
 
-
-DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist,
+DEFUN ("frame-face-map", Fframe_face_map, Sframe_face_map,
        0, 1, 0,
-       doc: /* Return an alist of frame-local faces defined on FRAME.
+       doc: /* Return a hash table of frame-local faces defined on FRAME.
 For internal use only.  */)
   (Lisp_Object frame)
 {
-  return decode_live_frame (frame)->face_alist;
+  return decode_live_frame (frame)->face_map;
 }
 
 
@@ -6678,30 +6674,37 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
 
 #ifdef HAVE_PDUMPER
 /* All the faces defined during loadup are recorded in
-   face-new-frame-defaults, with the last face first in the list.  We
-   need to set next_lface_id to the next face ID number, so that any
-   new faces defined in this session will have face IDs different from
-   those defined during loadup.  We also need to set up the
-   lface_id_to_name[] array for the faces that were defined during
-   loadup.  */
+   face-new-frame-defaults.  We need to set next_lface_id to the next
+   face ID number, so that any new faces defined in this session will
+   have face IDs different from those defined during loadup.  We also
+   need to set up the lface_id_to_name[] array for the faces that were
+   defined during loadup.  */
 void
 init_xfaces (void)
 {
-  if (CONSP (Vface_new_frame_defaults))
+  int nfaces = XFIXNAT (Fhash_table_count (Vface_new_frame_defaults));
+  if (nfaces > 0)
     {
       /* Allocate the lface_id_to_name[] array.  */
-      lface_id_to_name_size = next_lface_id =
-	XFIXNAT (Flength (Vface_new_frame_defaults));
+      lface_id_to_name_size = next_lface_id = nfaces;
       lface_id_to_name = xnmalloc (next_lface_id, sizeof *lface_id_to_name);
 
       /* Store the faces.  */
-      Lisp_Object tail;
-      int i = next_lface_id - 1;
-      for (tail = Vface_new_frame_defaults; CONSP (tail); tail = XCDR (tail))
+      struct Lisp_Hash_Table* table = XHASH_TABLE (Vface_new_frame_defaults);
+      for (ptrdiff_t idx = 0; idx < nfaces; ++idx)
 	{
-	  Lisp_Object lface = XCAR (tail);
-	  eassert (i >= 0);
-	  lface_id_to_name[i--] = XCAR (lface);
+	  Lisp_Object lface = HASH_KEY (table, idx);
+          Lisp_Object face_id = Fget (lface, Qface);
+          // FIXME why is (get 'tab-line 'face) 0?
+          if (!FIXNATP (face_id))
+            // FIXME: I'm not sure what to do in this case
+            printf ("Face %s has no id\n",  SDATA (SYMBOL_NAME (lface)));
+          else
+            {
+              int id = XFIXNAT (face_id);
+              eassert (id >= 0);
+              lface_id_to_name[id] = lface;
+            }
 	}
     }
   face_attr_sym[0] = Qface;
@@ -6855,7 +6858,7 @@ syms_of_xfaces (void)
   defsubr (&Sinternal_copy_lisp_face);
   defsubr (&Sinternal_merge_in_global_face);
   defsubr (&Sface_font);
-  defsubr (&Sframe_face_alist);
+  defsubr (&Sframe_face_map);
   defsubr (&Sdisplay_supports_face_attributes_p);
   defsubr (&Scolor_distance);
   defsubr (&Sinternal_set_font_selection_order);
@@ -6881,7 +6884,9 @@ syms_of_xfaces (void)
 
   DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults,
     doc: /* List of global face definitions (for internal use only.)  */);
-  Vface_new_frame_defaults = Qnil;
+  Vface_new_frame_defaults =
+    make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
+                     DEFAULT_REHASH_THRESHOLD, Qnil, false);
 
   DEFVAR_LISP ("face-default-stipple", Vface_default_stipple,
     doc: /* Default stipple pattern used on monochrome displays.
-- 
2.17.1