From b63880e9fc5cedcf84198eba2b6d20b4a39e3e2a Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Wed, 11 Jun 2025 20:58:53 +0200
Subject: [PATCH] (c-a-p-f-with-frecency-sorting): Simplify, use OClosure.

---
 lisp/minibuffer.el | 72 +++++++++++++++++++++++++---------------------
 1 file changed, 39 insertions(+), 33 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index de6d464f9b7..915c930a9dd 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3375,39 +3375,45 @@ obey `completion-styles').")
            (setq res nil))))
     res))
 
-(defun completion-at-point-function-with-frecency-sorting
-    (capf &optional num-ts)
-  (let ((cache (make-hash-table :test #'equal))
-        (num-ts (or num-ts 64)))
-    (lambda ()
-      (let ((res (ignore-errors (funcall capf))))
-        (and (consp res)
-             (not (functionp res))
-             (seq-let (beg end table &rest plist) res
-               (let* ((pred (plist-get plist :predicate))
-                      (completion-extra-properties plist)
-                      (md (completion-metadata (buffer-substring beg end) table pred))
-                      (sf (completion-metadata-get md 'sort-function)))
-                 `( ,beg ,end
-                    ,(completion-table-with-metadata
-                      table
-                      `((sort-function
-                         . ,(lambda (completions)
-                              (sort (if sf (funcall sf completions) completions)
-                                    :key (let ((now (float-time)))
-                                           (lambda (c)
-                                             (if-let ((ts (gethash c cache)))
-                                                 (- (log (- now (car ts))) (length ts))
-                                               1.0e+INF)))
-                                    :in-place t)))))
-                    ,@(plist-put
-                       (copy-sequence plist)
-                       :exit-function
-                       (lambda (str _sts)
-                         (let* ((str (substring-no-properties str))
-                                (ts (gethash str cache)))
-                           (setf (gethash str cache)
-                                 (cons (float-time) (take num-ts ts))))))))))))))
+(oclosure-define capfrecency
+  "Completion backend function with frecency sorting."
+  (cache :mutable t))
+
+(defun completion-at-point-function-with-frecency-sorting (capf)
+  "Add frecency based sorting to completion backend function CAPF.
+
+This function returns a new completion backend function; it does not
+modify CAPF."
+  (oclosure-lambda (capfrecency (cache (make-hash-table :test #'equal))) ()
+    (let ((res (ignore-errors (funcall capf))))
+      (and
+       (consp res)
+       (not (functionp res))
+       (seq-let (beg end table &rest plist) res
+         (let* ((pred (plist-get plist :predicate))
+                (completion-extra-properties plist)
+                (md (completion-metadata (buffer-substring beg end) table pred))
+                (sf (completion-metadata-get md 'sort-function)))
+           `( ,beg ,end
+              ,(completion-table-with-metadata
+                table
+                `((sort-function
+                   . ,(lambda (completions)
+                        (let ((now (float-time)))
+                          (sort (if sf (funcall sf completions) completions)
+                                :key (lambda (c)
+                                       (if-let ((ts (gethash c cache)))
+                                           (- (log (- now (car ts))) (cdr ts))
+                                         1.0e+INF))
+                                :in-place t))))))
+              ,@(plist-put
+                 (copy-sequence plist)
+                 :exit-function
+                 (lambda (str _sts)
+                   (let* ((str (substring-no-properties str))
+                          (ts (gethash str cache)))
+                     (setf (gethash str cache)
+                           (cons (float-time) (1+ (or (cdr ts) 0))))))))))))))
 
 (defun completion-at-point ()
   "Perform completion on the text around point.
-- 
2.39.5