From 105d66146f71f7d1060d845255d81c4fb9b9919d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 13 Jun 2022 00:26:22 -0700 Subject: [PATCH 4/5] [5.7] 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) --- lisp/erc/erc-track.el | 42 +++++++++++++++++++++++++++++--- test/lisp/erc/erc-track-tests.el | 36 +++++++++++++++++++++++++++ 2 files changed, 74 insertions(+), 4 deletions(-) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 490fc52d42c..a6a1539b044 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -382,6 +382,37 @@ erc-track-add-to-mode-line ;;; 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'. @@ -797,10 +828,13 @@ erc-modified-channels-display (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 @@ erc-track--shorten-aggressive-max '("#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")) -- 2.42.0