branch: master
commit 1c8bf18da2ffaf6660468c9695f6cc5e112682d9
Author: Ingo Lohmar <i.loh...@gmail.com>
Commit: Ingo Lohmar <i.loh...@gmail.com>
Flexible context handling, refactoring
Default: major-mode, buffer-file-name
---
company-statistics.el | 194 +++++++++++++++++++++++++++++++++----------------
1 files changed, 130 insertions(+), 64 deletions(-)
diff --git a/company-statistics.el b/company-statistics.el
index eadd49e..b206475 100644
--- a/company-statistics.el
+++ b/company-statistics.el
@@ -1,4 +1,4 @@
-;;; company-statistics.el --- history scoring using company-transformers
+;;; company-statistics.el --- sort candidates using completion history
;; Copyright (C) 2014 Free Software Foundation, Inc.
@@ -21,12 +21,10 @@
;;; Commentary:
-;; - backends decide on available candidates --- depends on prefix
-;; - we store how often a candidate is chosen --- independent of prefixes
-;; - for sorted candidates: stable sort keeps incoming order if same/no score
-;; - TODO add ert tests
-;; - TODO how to treat case, use backend's ignore-case?
-;; - TODO maybe later depend on the mode, file, project: all in score functions
+;; - backends decide on available candidates (depends on prefix)
+;; - we store how often a candidate is chosen (independent of prefixes)
+;; - challenge: same candidate in several modes/projects/files,
+;; but with different meaning --- handled by context information
;;; Code:
@@ -42,7 +40,7 @@ As this is a global cache, making it too small defeats the
purpose."
:group 'company-statistics
:type 'integer
:initialize (lambda (option init-size) (setq company-statistics-size
init-size))
- :set 'company-statistics--history-resize)
+ :set 'company-statistics--log-resize)
(defcustom company-statistics-file
(concat user-emacs-directory "company-statistics-cache.el")
@@ -61,51 +59,65 @@ not been used before."
:group 'company-statistics
:type 'boolean)
+(defcustom company-statistics-score-change
'company-statistics-score-change-default
+ "Function called with completion choice. Using arbitrary other info,
+it should produce an alist, each entry labeling a context and the
+associated score update: ((ctx-a . 1) (\"str\" . 0.5) (nil . 1)). Nil is
+the global context."
+ :group 'company-statistics
+ :type 'function)
+
+(defcustom company-statistics-score-calc 'company-statistics-score-calc-default
+ "Function called with completion candidate. Using arbitrary other info,
+eg, on the current context, it should evaluate to the candidate's score (a
+number)."
+ :group 'company-statistics
+ :type 'function)
+
;; internal vars, persistence
(defvar company-statistics--scores nil
- "Store selection frequency of candidates.")
+ "Store selection frequency of candidates in given contexts.")
-(defvar company-statistics--history nil
- "Ring keeping the history of chosen candidates.")
+(defvar company-statistics--log nil
+ "Ring keeping a log of statistics updates.")
-(defvar company-statistics--history-replace nil
- "Index into the completion history.")
+(defvar company-statistics--index nil
+ "Index into the log.")
(defun company-statistics--init ()
"Initialize company-statistics."
(setq company-statistics--scores
(make-hash-table :test 'equal :size company-statistics-size))
- (setq company-statistics--history (make-vector company-statistics-size nil)
- company-statistics--history-replace 0))
+ (setq company-statistics--log (make-vector company-statistics-size nil)
+ company-statistics--index 0))
(defun company-statistics--initialized-p ()
(hash-table-p company-statistics--scores))
-(defun company-statistics--history-resize (option new-size)
+(defun company-statistics--log-resize (option new-size)
(when (company-statistics--initialized-p)
- ;; hash scoresheet auto-resizes, but history does not
+ ;; hash scoresheet auto-resizes, but log does not
(let ((new-hist (make-vector new-size nil))
- ;; use actual length, to also work for freshly restored history
- (company-statistics-size (length company-statistics--history)))
+ ;; use actual length, to also work for freshly restored stats
+ (company-statistics-size (length company-statistics--log)))
;; copy newest entries (possibly nil) to new-hist
(dolist (i (number-sequence 0 (1- (min new-size
company-statistics-size))))
- (let ((old-i (mod (+ (- company-statistics--history-replace new-size)
i)
+ (let ((old-i (mod (+ (- company-statistics--index new-size) i)
company-statistics-size)))
- (aset new-hist i (aref company-statistics--history old-i))))
- ;; remove discarded history (when shrinking) from scores
+ (aset new-hist i (aref company-statistics--log old-i))))
+ ;; remove discarded log entry (when shrinking) from scores
(when (< new-size company-statistics-size)
(dolist (i (number-sequence
- company-statistics--history-replace
+ company-statistics--index
(+ company-statistics-size
- company-statistics--history-replace
+ company-statistics--index
(1- new-size))))
- (company-statistics--score-down
- (aref company-statistics--history (mod i
company-statistics-size)))))
- (setq company-statistics--history new-hist)
- (setq company-statistics--history-replace (if (<= new-size
company-statistics-size)
- 0
- company-statistics-size))))
+ (company-statistics--log-revert (mod i company-statistics-size))))
+ (setq company-statistics--log new-hist)
+ (setq company-statistics--index (if (<= new-size company-statistics-size)
+ 0
+ company-statistics-size))))
(setq company-statistics-size new-size))
(defun company-statistics--save ()
@@ -117,8 +129,8 @@ not been used before."
"%S"
`(setq
company-statistics--scores ,company-statistics--scores
- company-statistics--history ,company-statistics--history
- company-statistics--history-replace
,company-statistics--history-replace))))
+ company-statistics--log ,company-statistics--log
+ company-statistics--index ,company-statistics--index))))
(write-file company-statistics-file)))
(defun company-statistics--maybe-save ()
@@ -129,46 +141,100 @@ not been used before."
"Restore statistics."
(load company-statistics-file 'noerror nil 'nosuffix))
-;; score manipulation in one place
-
-(defun company-statistics--score-get (cand)
- (gethash cand company-statistics--scores 0))
-
-(defun company-statistics--score-up (cand)
+;; score calculation for insert/retrieval --- can be changed on-the-fly
+
+(defun company-statistics-score-change-default (cand)
+ "Count for global score, mode context, filename context."
+ (nconc ;when's nil is removed
+ (list (cons nil 1) (cons major-mode 1)) ;major-mode is never nil
+ (when buffer-file-name
+ (list (cons buffer-file-name 1)))))
+
+(defun company-statistics-score-calc-default (cand)
+ "Global score, and bonus for matching major mode and filename."
+ (let ((scores (gethash cand company-statistics--scores)))
+ (if scores
+ (+ (cdr (assoc nil scores))
+ (or (cdr (assoc major-mode scores)) 0)
+ (or (cdr (when buffer-file-name ;to not get nil context
+ (assoc buffer-file-name scores))) 0))
+ 0)))
+
+;; score manipulation in one place --- know about hash value alist structure
+
+(defun company-statistics--alist-update (alist updates merger &optional filter)
+ "Return new alist with conses from ALIST. Their cdrs are updated
+to (merger cdr update-cdr) if the UPDATES alist contains an entry with an
+equal-matching car. If FILTER called with the result is non-nil, remove
+the cons from the result. If no matching cons exists in ALIST, add the new
+one. ALIST structure and cdrs may be changed!"
+ (let ((filter (or filter 'ignore))
+ (updated alist)
+ (new nil))
+ (mapc
+ (lambda (upd)
+ (let ((found (assoc (car upd) alist)))
+ (if found
+ (let ((result (funcall merger (cdr found) (cdr upd))))
+ (if (funcall filter result)
+ (setq updated (delete found updated))
+ (setcdr found result)))
+ (push upd new))))
+ updates)
+ (nconc updated new)))
+
+(defun company-statistics--scores-add (cand score-updates)
(puthash cand
- (1+ (company-statistics--score-get cand))
+ (company-statistics--alist-update
+ (gethash cand company-statistics--scores)
+ score-updates
+ '+)
company-statistics--scores))
-(defun company-statistics--score-down (cand)
- (when cand ;ignore nil
- (let ((old-score (company-statistics--score-get cand)))
- ;; on scoresheet, decrease corresponding score or remove entry
- (if (> old-score 1)
- (puthash cand (1- old-score) company-statistics--scores)
- (remhash cand company-statistics--scores)))))
+(defun company-statistics--log-revert (&optional index)
+ "Revert score updates for log entry. INDEX defaults to
+`company-statistics--index'."
+ (let ((hist-entry
+ (aref company-statistics--log
+ (or index company-statistics--index))))
+ (when hist-entry ;ignore nil entry
+ (let* ((cand (car hist-entry))
+ (score-updates (cdr hist-entry))
+ (new-scores
+ (company-statistics--alist-update
+ (gethash cand company-statistics--scores)
+ score-updates
+ '-
+ 'zerop)))
+ (if new-scores ;sth left
+ (puthash cand new-scores company-statistics--scores)
+ (remhash cand company-statistics--scores))))))
+
+(defun company-statistics--log-store (result score-updates)
+ "Insert/overwrite result and associated score updates."
+ (aset company-statistics--log company-statistics--index
+ (cons result score-updates))
+ (setq company-statistics--index
+ (mod (1+ company-statistics--index) company-statistics-size)))
+
+;; core functions: updater, actual sorting transformer, minor-mode
-;; core functions: actual sorting transformer, statistics updater
+(defun company-statistics--finished (result)
+ "After completion, update scores and log."
+ (let* ((result (substring-no-properties result))
+ (score-updates (funcall company-statistics-score-change result)))
+ (company-statistics--scores-add result score-updates)
+ (company-statistics--log-revert)
+ (company-statistics--log-store result score-updates)))
(defun company-sort-by-statistics (candidates)
- "Sort candidates by historical statistics."
+ "Sort candidates by historical statistics. Stable sort, so order is only
+changed for candidates distinguishable by score."
(setq candidates
(sort candidates
(lambda (cand1 cand2)
- (> (company-statistics--score-get cand1)
- (company-statistics--score-get cand2))))))
-
-(defun company-statistics--finished (result)
- "After completion, update scores and history."
- (setq result (substring-no-properties result)) ;on the safe side
- (company-statistics--score-up result)
- ;; update cyclic completion history
- (let ((replace-result
- (aref company-statistics--history
company-statistics--history-replace)))
- (company-statistics--score-down replace-result)) ;void if nil
- ;; insert new result
- (aset company-statistics--history company-statistics--history-replace result)
- (setq company-statistics--history-replace
- (mod (1+ company-statistics--history-replace)
company-statistics-size)))
+ (> (funcall company-statistics-score-calc cand1)
+ (funcall company-statistics-score-calc cand2))))))
;;;###autoload
(define-minor-mode company-statistics-mode
@@ -189,7 +255,7 @@ configuration. You can customize this behavior with
(if company-statistics-auto-restore
(progn
(company-statistics--load) ;maybe of different size
- (company-statistics--history-resize nil
company-statistics-size))
+ (company-statistics--log-resize nil company-statistics-size))
(company-statistics--init)))
(add-to-list 'company-transformers
'company-sort-by-statistics 'append)
