From: F. Jason Park <jp@neverwas.me>
Date: Mon, 13 Jun 2022 07:26:22 +0000 (-0700)
Subject: Cache shortened channel names in erc-track
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0f058244ab7c4c2e5cb3fa5e4775c0f3cbe78e19;p=emacs.git

Cache shortened channel names in erc-track

* lisp/erc/erc-track.el (erc-track--shortened-names): New variable to
stash both the latest inputs and most recent result of
`erc-track-shorten-function'.
(erc-track--shortened-names-current-hash,
erc-track--shortened-names-set, erc-track--shortened-names-get): New
pair of generalized-variable functions and helper variable for
accessing and mutating `erc-track--shorten-prefixes'.
(erc-modified-channels-display): Avoid redundant calls to
`erc-track-shorten-function'.  Mainly for use during batch processing.
* test/lisp/erc/erc-track-tests.el (erc-track--shortened-names): New
test.  (Bug#67767)
---

diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index b704575ebca..27f20d5c503 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -378,6 +378,37 @@ See `erc-track-position-in-mode-line' for possible values."
 
 ;;; Shortening of names
 
+(defvar erc-track--shortened-names nil
+  "A cons of the last novel name-shortening params and the result.
+The CAR is a hash of environmental inputs such as options and
+parameters passed to `erc-track-shorten-function'.  Its effect is
+only really noticeable during batch processing.")
+
+(defvar erc-track--shortened-names-current-hash nil)
+
+(defun erc-track--shortened-names-set (_ shortened)
+  "Remember SHORTENED names with hash of contextual params."
+  (cl-assert erc-track--shortened-names-current-hash)
+  (setq erc-track--shortened-names
+        (cons erc-track--shortened-names-current-hash shortened)))
+
+(defun erc-track--shortened-names-get (channel-names)
+  "Cache CHANNEL-NAMES with various contextual parameters.
+For now, omit relevant options like `erc-track-shorten-start' and
+friends, even though they do affect the outcome, because they
+likely change too infrequently to matter over sub-second
+intervals and are unlikely to be let-bound or set locally."
+  (when-let ((hash (setq erc-track--shortened-names-current-hash
+                         (sxhash-equal (list channel-names
+                                             (buffer-list)
+                                             erc-track-shorten-function))))
+             (erc-track--shortened-names)
+             ((= hash (car erc-track--shortened-names))))
+    (cdr erc-track--shortened-names)))
+
+(gv-define-simple-setter erc-track--shortened-names-get
+                         erc-track--shortened-names-set)
+
 (defun erc-track-shorten-names (channel-names)
   "Call `erc-unique-channel-names' with the correct parameters.
 This function is a good value for `erc-track-shorten-function'.
@@ -793,10 +824,13 @@ Use `erc-make-mode-line-buffer-name' to create buttons."
                                            (or (buffer-name buf)
                                                ""))
 					 buffers))
-		     (short-names (if (functionp erc-track-shorten-function)
-				      (funcall erc-track-shorten-function
-					       long-names)
-				    long-names))
+                     (erc-track--shortened-names-current-hash nil)
+                     (short-names
+                      (if (functionp erc-track-shorten-function)
+                          (with-memoization
+                              (erc-track--shortened-names-get long-names)
+                            (funcall erc-track-shorten-function long-names))
+                        long-names))
 		     strings)
 		(while buffers
 		  (when (car short-names)
diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el
index 4477727be8a..ed3d190928f 100644
--- a/test/lisp/erc/erc-track-tests.el
+++ b/test/lisp/erc/erc-track-tests.el
@@ -104,6 +104,42 @@
                                       '("#emacs" "#vi"))
             '("#e" "#v"))) ))
 
+(ert-deftest erc-track--shortened-names ()
+  (let (erc-track--shortened-names
+        erc-track--shortened-names-current-hash
+        results)
+
+    (with-memoization (erc-track--shortened-names-get
+                       '("apple" "banana" "cherries"))
+      '("a" "b" "c"))
+    (should (integerp (car erc-track--shortened-names)))
+    (should (equal (cdr erc-track--shortened-names) '("a" "b" "c")))
+    (push erc-track--shortened-names results)
+
+    ;; Redundant call doesn't run.
+    (with-memoization (erc-track--shortened-names-get
+                       '("apple" "banana" "cherries"))
+      (should-not 'run)
+      '("a" "b" "c"))
+    (should (equal erc-track--shortened-names (car results)))
+
+    ;; Change in environment or context forces run.
+    (with-temp-buffer
+      (with-memoization (erc-track--shortened-names-get
+                         '("apple" "banana" "cherries"))
+        '("x" "y" "z")))
+    (should (and (integerp (car erc-track--shortened-names))
+                 (/= (car erc-track--shortened-names) (caar results))))
+    (should (equal (cdr erc-track--shortened-names) '("x" "y" "z")))
+    (push erc-track--shortened-names results)
+
+    (with-memoization (erc-track--shortened-names-get
+                       '("apple" "banana" "cherries"))
+      '("1" "2" "3"))
+    (should (and (integerp (car erc-track--shortened-names))
+                 (/= (car erc-track--shortened-names) (caar results))))
+    (should (equal (cdr erc-track--shortened-names) '("1" "2" "3")))))
+
 (ert-deftest erc-track--erc-faces-in ()
   "`erc-faces-in' should pick up both 'face and 'font-lock-face properties."
   (let ((str0 (copy-sequence "is bold"))