(c-a-p-f-with-frecency-sorting): Simplify, use OClosure.

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index de6d464f9b7ad843f3becd91ebaf3a8eb4383370..915c930a9dd1068f1bb1f6043f18fe49c8840fea 100644 (file)
--- 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.