From 901b7f77f933f246c71cdbd544e8fda7019d5c73 Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Thu, 12 Jun 2025 07:52:10 +0200
Subject: [PATCH] (c-a-p-f-with-frecency-sorting): Add argument CONTEXT-FN.

---
 lisp/minibuffer.el | 45 ++++++++++++++++++++++++++++++---------------
 1 file changed, 30 insertions(+), 15 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index be3cfd3dcb5..495039ac3fc 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3379,11 +3379,20 @@ obey `completion-styles').")
   "Completion backend function with frecency sorting."
   (cache :mutable t))
 
-(defun completion-at-point-function-with-frecency-sorting (capf)
+(defun completion-at-point-function-with-frecency-sorting
+    (capf &optional context-fn)
   "Add frecency based sorting to completion backend function CAPF.
 
 This function returns a new completion backend function; it does not
-modify CAPF."
+modify CAPF.
+
+Optional argument CONTEXT-FN is a nullary function that returns a
+context identifier, an arbitrary object that uniquely identifies the
+appropriate scope for preserving frecency data.  For example, if CAPF is
+sensitive to the current project, you can use `project-current' as the
+CONTEXT-FN.  If CONTEXT-FN is nil or omitted, it defaults to `ignore',
+in which case there is only one context (whose identifier is nil)."
+  (unless context-fn (setq context-fn #'ignore))
   (oclosure-lambda (capfrecency (cache (make-hash-table :test #'equal))) ()
     (let ((res (ignore-errors (funcall capf))))
       (and
@@ -3399,23 +3408,29 @@ modify CAPF."
               ,(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))))))
+                   . ,(lambda (comps)
+                        (let ((comps (if sf (funcall sf comps) comps)))
+                          (if-let ((cc (gethash (funcall context-fn) cache))
+                                   (now (float-time)))
+                              (sort comps
+                                    :key (lambda (c)
+                                           (if-let ((ts (gethash c cc)))
+                                               (- (log (- now (car ts))) (cdr ts))
+                                             1.0e+INF))
+                                    :in-place t)
+                            comps))))))
               ,@(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)))))
-                   (when (functionp ef) (funcall ef str sts)))))))))))
+                   (let ((context (funcall context-fn)))
+                     (unless (gethash context cache)
+                       (puthash context (make-hash-table :test #'equal) cache))
+                     (let* ((key (substring-no-properties str))
+                            (cc (gethash context cache))
+                            (ts (gethash key cc)))
+                       (puthash key (cons (float-time) (1+ (or (cdr ts) 0))) cc))
+                     (when (functionp ef) (funcall ef str sts))))))))))))
 
 (defun completion-at-point ()
   "Perform completion on the text around point.
-- 
2.39.5