bug#68006: 30.0.50; Image-mode speed

[Manuel Giraud via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

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

Hi,

I'm trying to revisit this idea of having a user controlled image cache.
The goal is to have, for instance, image-mode use it because (hopefully)
it would have a better idea of when to cache/uncache images for its
usage.

Here is a patch of such a prototype « user image cache ».

For the moment, I wanted to keep it minimal so the only interface to use
it goes as follow.  When a user (or a program) use the image attribute
":ttl TIME_IN_SECONDS" with `create-image' such image will be stored in
the « user cache » and not in the internal one.  Images lookups use both
caches (internal and internal, in that order).  A negative
TIME_IN_SECONDS means « cache this image forever ».

I think there will be a need for user function that completely flushes
the images in this new cache.  But do you think we need others commands
for such interface?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-User-controlled-image-cache.patch --]
[-- Type: text/x-patch, Size: 14043 bytes --]

From a51924c295e2141ef7b712e98d9c45adcae3bf96 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel@ledu-giraud.fr>
Date: Thu, 17 Oct 2024 11:27:56 +0200
Subject: [PATCH] User controlled image cache

---
 src/dispextern.h |   4 +
 src/frame.h      |   4 +
 src/image.c      | 205 +++++++++++++++++++++++++++++++++++++++++------
 3 files changed, 188 insertions(+), 25 deletions(-)

diff --git a/src/dispextern.h b/src/dispextern.h
index cc248a4472e..69e4d1171b3 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -3141,6 +3141,9 @@ reset_mouse_highlight (Mouse_HLInfo *hlinfo)
      in prepare_image_for_display.  */
   struct timespec timestamp;
 
+  /* The end of life for an image in the user's image cache */
+  struct timespec eol;
+
   /* Pixmaps of the image.  */
   Emacs_Pixmap pixmap, mask;
 
@@ -3632,6 +3635,7 @@ #define TRY_WINDOW_IGNORE_FONTS_CHANGE	(1 << 1)
 #ifdef HAVE_WINDOW_SYSTEM
 
 extern void clear_image_cache (struct frame *, Lisp_Object);
+extern void clear_user_image_cache (struct frame *);
 extern ptrdiff_t image_bitmap_pixmap (struct frame *, ptrdiff_t);
 extern void image_reference_bitmap (struct frame *, ptrdiff_t);
 extern ptrdiff_t image_create_bitmap_from_data (struct frame *, char *,
diff --git a/src/frame.h b/src/frame.h
index 1d920d1a6bc..984568234f1 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -292,6 +292,9 @@ #define EMACS_FRAME_H
   /* Cache of realized images, which may be shared with other
      frames.  */
   struct image_cache *image_cache;
+
+  /* Another image cache that can be managed from Emacs. */
+  struct image_cache *user_image_cache;
 #endif /* HAVE_WINDOW_SYSTEM */
 
   /* Tab-bar item index of the item on which a mouse button was pressed.  */
@@ -916,6 +919,7 @@ #define FRAME_KBOARD(f) ((f)->terminal->kboard)
 
 /* Return a pointer to the image cache of frame F.  */
 #define FRAME_IMAGE_CACHE(F) ((F)->image_cache)
+#define FRAME_USER_IMAGE_CACHE(F) ((F)->user_image_cache)
 
 #define XFRAME(p) \
   (eassert (FRAMEP (p)), XUNTAG (p, Lisp_Vectorlike, struct frame))
diff --git a/src/image.c b/src/image.c
index 34936977a40..8676ba27632 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1744,6 +1744,7 @@ make_image (Lisp_Object spec, EMACS_UINT hash)
 {
   struct image *img = xzalloc (sizeof *img);
   Lisp_Object file = image_spec_value (spec, QCfile, NULL);
+  Lisp_Object ttl = image_spec_value (spec, QCttl, NULL);
 
   eassert (valid_image_p (spec));
   img->dependencies = NILP (file) ? Qnil : list1 (file);
@@ -1754,19 +1755,35 @@ make_image (Lisp_Object spec, EMACS_UINT hash)
   img->ascent = DEFAULT_IMAGE_ASCENT;
   img->hash = hash;
   img->corners[BOT_CORNER] = -1;  /* Full image */
+  if (! NILP (ttl) && FIXNUMP (ttl))
+    {
+      struct timespec now = current_timespec ();
+      struct timespec ttl_spec;
+
+      /* A negative TTL is used to mean forever.  */
+      if (XFIXNUM (ttl) < 0)
+	(img->eol).tv_sec = -1;
+      else
+	{
+	  ttl_spec.tv_sec = XFIXNUM (ttl);
+	  ttl_spec.tv_nsec = 0;
+	  img->eol = timespec_add(now, ttl_spec);
+	}
+    }
+  else
+    (img->eol).tv_sec = (img->eol).tv_nsec = 0;
+
   return img;
 }
 
 
-/* Free image IMG which was used on frame F, including its resources.  */
+/* Free image IMG from the cache C, including its resources on frame F.  */
 
 static void
-free_image (struct frame *f, struct image *img)
+free_image (struct image_cache *c, struct frame *f, struct image *img)
 {
   if (img)
     {
-      struct image_cache *c = FRAME_IMAGE_CACHE (f);
-
       /* Remove IMG from the hash table of its cache.  */
       if (img->prev)
 	img->prev->next = img->next;
@@ -2179,6 +2196,7 @@ image_alloc_image_color (struct frame *f, struct image *img,
  ***********************************************************************/
 
 static void cache_image (struct frame *f, struct image *img);
+static void user_cache_image (struct frame *f, struct image *img);
 
 /* Return a new, initialized image cache that is allocated from the
    heap.  Call free_image_cache to free an image cache.  */
@@ -2197,15 +2215,14 @@ make_image_cache (void)
   return c;
 }
 
-/* Find an image matching SPEC in the cache, and return it.  If no
+/* Find an image matching SPEC in the cache C, and return it.  If no
    image is found, return NULL.  */
 static struct image *
-search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash,
+search_image_cache (struct image_cache *c, Lisp_Object spec, EMACS_UINT hash,
                     unsigned long foreground, unsigned long background,
                     int font_size, char *font_family, bool ignore_colors)
 {
   struct image *img;
-  struct image_cache *c = FRAME_IMAGE_CACHE (f);
   int i = hash % IMAGE_CACHE_BUCKETS_SIZE;
 
   if (!c) return NULL;
@@ -2258,11 +2275,13 @@ filter_image_spec (Lisp_Object spec)
 	  spec = XCDR (spec);
 
 	  /* Some animation-related data doesn't affect display, but
-	     breaks the image cache.  Filter those out.  */
+	     breaks the image cache.  Filter those out.  Also filter out
+	     the user's cache time to live.  */
 	  if (!(EQ (key, QCanimate_buffer)
 		|| EQ (key, QCanimate_tardiness)
 		|| EQ (key, QCanimate_position)
-		|| EQ (key, QCanimate_multi_frame_data)))
+		|| EQ (key, QCanimate_multi_frame_data)
+		|| EQ (key, QCttl)))
 	    {
 	      out = Fcons (value, out);
 	      out = Fcons (key, out);
@@ -2279,14 +2298,15 @@ uncache_image (struct frame *f, Lisp_Object spec)
 {
   struct image *img;
   EMACS_UINT hash = sxhash (filter_image_spec (spec));
+  struct image_cache *c = FRAME_IMAGE_CACHE (f);
 
   /* Because the background colors are based on the current face, we
      can have multiple copies of an image with the same spec. We want
      to remove them all to ensure the user doesn't see an old version
      of the image when the face changes.  */
-  while ((img = search_image_cache (f, spec, hash, 0, 0, 0, NULL, true)))
+  while ((img = search_image_cache (c, spec, hash, 0, 0, 0, NULL, true)))
     {
-      free_image (f, img);
+      free_image (c, f, img);
       /* As display glyphs may still be referring to the image ID, we
 	 must garbage the frame (Bug#6426).  */
       SET_FRAME_GARBAGED (f);
@@ -2310,7 +2330,7 @@ free_image_cache (struct frame *f)
   eassert (c->refcount == 0);
 
   for (i = 0; i < c->used; ++i)
-    free_image (f, c->images[i]);
+    free_image (c, f, c->images[i]);
   xfree (c->images);
   xfree (c->buckets);
   xfree (c);
@@ -2346,7 +2366,7 @@ clear_image_cache (struct frame *f, Lisp_Object filter)
 	      if (img && (EQ (Qt, filter)
 			  || !NILP (Fmember (filter, img->dependencies))))
 		{
-		  free_image (f, img);
+		  free_image (c, f, img);
 		  ++nfreed;
 		}
 	    }
@@ -2377,7 +2397,7 @@ clear_image_cache (struct frame *f, Lisp_Object filter)
 	      struct image *img = c->images[i];
 	      if (img && timespec_cmp (img->timestamp, old) < 0)
 		{
-		  free_image (f, img);
+		  free_image (c, f, img);
 		  ++nfreed;
 		}
 	    }
@@ -2405,6 +2425,56 @@ clear_image_cache (struct frame *f, Lisp_Object filter)
     }
 }
 
+void
+clear_user_image_cache (struct frame *f)
+{
+  struct image_cache *c = FRAME_USER_IMAGE_CACHE (f);
+
+  if (c && !f->inhibit_clear_image_cache)
+    {
+      ptrdiff_t i, nfreed = 0;
+      struct timespec t = current_timespec ();
+
+      /* Block input so that we won't be interrupted by a SIGIO
+	 while being in an inconsistent state.  */
+      block_input ();
+
+      /* Filter image cache based on image's time to live.  */
+      for (i = 0; i < c->used; ++i)
+	{
+	  struct image *img = c->images[i];
+	  if (img)
+	    {
+	      if (((img->eol).tv_sec >= 0) && timespec_cmp (t, img->eol) > 0)
+		{
+		  free_image (c, f, img);
+		  ++nfreed;
+		}
+	    }
+	}
+
+      /* We may be clearing the image cache because, for example,
+	 Emacs was iconified for a longer period of time.  In that
+	 case, current matrices may still contain references to
+	 images freed above.  So, clear these matrices.  */
+      if (nfreed)
+	{
+	  Lisp_Object tail, frame;
+
+	  FOR_EACH_FRAME (tail, frame)
+	    {
+	      struct frame *fr = XFRAME (frame);
+	      if (FRAME_USER_IMAGE_CACHE (fr) == c)
+		clear_current_matrices (fr);
+	    }
+
+	  windows_or_buffers_changed = 19;
+	}
+
+      unblock_input ();
+    }
+}
+
 void
 clear_image_caches (Lisp_Object filter)
 {
@@ -2415,7 +2485,10 @@ clear_image_caches (Lisp_Object filter)
   Lisp_Object tail, frame;
   FOR_EACH_FRAME (tail, frame)
     if (FRAME_WINDOW_P (XFRAME (frame)))
-      clear_image_cache (XFRAME (frame), filter);
+      {
+	clear_image_cache (XFRAME (frame), filter);
+	clear_user_image_cache (XFRAME (frame));
+      }
 }
 
 DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
@@ -2444,7 +2517,11 @@ DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
   if (! (NILP (filter) || FRAMEP (filter)))
     clear_image_caches (filter);
   else
-    clear_image_cache (decode_window_system_frame (filter), Qt);
+    {
+      struct frame *decoded_frame = decode_window_system_frame (filter);
+      clear_image_cache (decoded_frame, Qt);
+      clear_user_image_cache (decoded_frame);
+    }
 
   /* Also clear the animation caches.  */
   image_prune_animation_caches (true);
@@ -2501,9 +2578,8 @@ image_size_in_bytes (struct image *img)
 }
 
 static size_t
-image_frame_cache_size (struct frame *f)
+image_frame_cache_size (struct image_cache *c)
 {
-  struct image_cache *c = FRAME_IMAGE_CACHE (f);
   if (!c)
     return 0;
 
@@ -3495,6 +3571,7 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id)
   unsigned long background = face->background;
   int font_size = face->font->pixel_size;
   char *font_family = SSDATA (face->lface[LFACE_FAMILY_INDEX]);
+  struct image_cache *c;
 
   /* F must be a window-system frame, and SPEC must be a valid image
      specification.  */
@@ -3503,20 +3580,39 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id)
 
   /* Look up SPEC in the hash table of the image cache.  */
   hash = sxhash (filter_image_spec (spec));
-  img = search_image_cache (f, spec, hash, foreground, background,
+  c = FRAME_IMAGE_CACHE (f);
+  img = search_image_cache (c, spec, hash, foreground, background,
 			    font_size, font_family, false);
   if (img && img->load_failed_p)
     {
-      free_image (f, img);
+      free_image (c, f, img);
       img = NULL;
     }
 
-  /* If not found, create a new image and cache it.  */
+  /* If not found, try the user's image cache.  */
+  if (img == NULL)
+    {
+      c = FRAME_USER_IMAGE_CACHE (f);
+      img = search_image_cache (c, spec, hash, foreground, background,
+				font_size, font_family, false);
+      if (img && img->load_failed_p)
+	{
+	  free_image (c, f, img);
+	  img = NULL;
+	}
+    }
+
+  /* If not found again, create a new image and cache it.  */
   if (img == NULL)
     {
       block_input ();
       img = make_image (spec, hash);
-      cache_image (f, img);
+      /* If image's end of life is set store it in the user's image
+	 cache instead.  */
+      if ((img->eol).tv_sec != 0)
+	user_cache_image (f, img);
+      else
+	cache_image (f, img);
       img->face_foreground = foreground;
       img->face_background = background;
       img->face_font_size = font_size;
@@ -3647,6 +3743,42 @@ cache_image (struct frame *f, struct image *img)
   c->buckets[i] = img;
 }
 
+static void
+user_cache_image (struct frame *f, struct image *img)
+{
+  struct image_cache *c = FRAME_USER_IMAGE_CACHE (f);
+  ptrdiff_t i;
+
+  if (!c)
+    {
+      c = FRAME_USER_IMAGE_CACHE (f) = make_image_cache ();
+      c->refcount++;
+    }
+
+  /* Find a free slot in c->images.  */
+  for (i = 0; i < c->used; ++i)
+    if (c->images[i] == NULL)
+      break;
+
+  /* If no free slot found, maybe enlarge c->images.  */
+  if (i == c->used && c->used == c->size)
+    c->images = xpalloc (c->images, &c->size, 1, -1, sizeof *c->images);
+
+  /* Add IMG to c->images, and assign IMG an id.  */
+  c->images[i] = img;
+  img->id = i;
+  if (i == c->used)
+    ++c->used;
+
+  /* Add IMG to the cache's hash table.  */
+  i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
+  img->next = c->buckets[i];
+  if (img->next)
+    img->next->prev = img;
+  img->prev = NULL;
+  c->buckets[i] = img;
+}
+
 
 #if defined (HAVE_WEBP) || defined (HAVE_GIF)
 
@@ -12793,11 +12925,14 @@ DEFUN ("image-cache-size", Fimage_cache_size, Simage_cache_size, 0, 0, 0,
 {
   Lisp_Object tail, frame;
   size_t total = 0;
+  struct frame *f;
 
   FOR_EACH_FRAME (tail, frame)
-    if (FRAME_WINDOW_P (XFRAME (frame)))
-      total += image_frame_cache_size (XFRAME (frame));
-
+    {
+      f = XFRAME (frame);
+      if (FRAME_WINDOW_P (f))
+	total += image_frame_cache_size (FRAME_IMAGE_CACHE (f));
+    }
 #if defined (HAVE_WEBP) || defined (HAVE_GIF)
   struct anim_cache *pcache = anim_cache;
   while (pcache)
@@ -12810,6 +12945,24 @@ DEFUN ("image-cache-size", Fimage_cache_size, Simage_cache_size, 0, 0, 0,
   return make_int (total);
 }
 
+DEFUN ("user-image-cache-size", Fuser_image_cache_size, Suser_image_cache_size, 0, 0, 0,
+       doc: /* Return the size of the user's image cache.  */)
+  (void)
+{
+  Lisp_Object tail, frame;
+  size_t total = 0;
+  struct frame *f;
+
+  FOR_EACH_FRAME (tail, frame)
+    {
+      f = XFRAME (frame);
+      if (FRAME_WINDOW_P (f))
+	total += image_frame_cache_size (FRAME_USER_IMAGE_CACHE (f));
+    }
+
+  return make_int (total);
+}
+
 
 DEFUN ("init-image-library", Finit_image_library, Sinit_image_library, 1, 1, 0,
        doc: /* Initialize image library implementing image type TYPE.
@@ -12979,6 +13132,7 @@ syms_of_image (void)
   DEFSYM (QCcolor_adjustment, ":color-adjustment");
   DEFSYM (QCmask, ":mask");
   DEFSYM (QCflip, ":flip");
+  DEFSYM (QCttl, ":ttl");
 
   /* Other symbols.  */
   DEFSYM (Qlaplace, "laplace");
@@ -13142,6 +13296,7 @@ syms_of_image (void)
   defsubr (&Simage_mask_p);
   defsubr (&Simage_metadata);
   defsubr (&Simage_cache_size);
+  defsubr (&Suser_image_cache_size);
   defsubr (&Simagep);
 
 #ifdef GLYPH_DEBUG
-- 
2.46.2


[-- Attachment #3: Type: text/plain, Size: 18 bytes --]

-- 
Manuel Giraud