"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
,(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.