branch: master
commit c9874f0a8b134c87717264f21104101d87023faf
Author: Ingo Lohmar <i.loh...@gmail.com>
Commit: Ingo Lohmar <i.loh...@gmail.com>
Offer light and heavy context scoring
- add context capturing per run
- unify file name context for clarity, now use keyword as well
---
company-statistics-tests.el | 116 ++++++++++++++++++++++++++++++-------------
company-statistics.el | 116 +++++++++++++++++++++++++++++++++++++------
2 files changed, 182 insertions(+), 50 deletions(-)
diff --git a/company-statistics-tests.el b/company-statistics-tests.el
index 6e0b460..fb04049 100644
--- a/company-statistics-tests.el
+++ b/company-statistics-tests.el
@@ -21,7 +21,7 @@
;;; Commentary:
-;; emacs -batch -L . -l ert -l company-statistics-tests.el -f
ert-run-tests-batch-and-exit
+;; emacs -batch -L . -L ../company-mode/ -l ert -l company-statistics-tests.el
-f ert-run-tests-batch-and-exit
;;; Code:
@@ -77,16 +77,25 @@ V2 (starting at index I2) satisfy the binary predicate
PRED, default
(let ((company-statistics-size 5))
(company-statistics--init)
(let ((major-mode 'foo-mode)
- (buffer-file-name nil))
+ (company-statistics--context
+ '((:keyword "if")
+ (:symbol "parent")
+ (:file "foo-file"))))
(company-statistics--finished "foo"))
(let ((major-mode 'foo-mode)
- (buffer-file-name "bar-file"))
+ (company-statistics--context
+ '((:symbol "statistics")
+ (:file "bar-file"))))
(company-statistics--finished "bar"))
(let ((major-mode 'baz-mode)
- (buffer-file-name nil))
+ (company-statistics--context
+ '((:keyword "unless")
+ (:symbol "company"))))
(company-statistics--finished "baz"))
(let ((major-mode 'baz-mode)
- (buffer-file-name "quux-file"))
+ (company-statistics--context
+ '((:keyword "when")
+ (:file "quux-file"))))
(company-statistics--finished "quux"))
,@body)
;; tear down to clean slate
@@ -155,43 +164,82 @@ V2 (starting at index I2) satisfy the binary predicate
PRED, default
(should (equal company-statistics--log cs-history))
(should (equal company-statistics--index cs-index))))))
-(ert-deftest c-s-score-change-default ()
+(ert-deftest c-s-score-change-light ()
"Test a few things about the default score updates."
- (let ((major-mode 'foobar-mode)
- (buffer-file-name nil)) ;must not generate context entries
- (should (equal (company-statistics-score-change-default "dummy")
- '((nil . 1) (foobar-mode . 1))))
- (let ((buffer-file-name "test-file.XYZ"))
- (should (equal (company-statistics-score-change-default "dummy")
- '((nil . 1) (foobar-mode . 1) ("test-file.XYZ" . 1)))))))
+ (let ((major-mode 'foobar-mode))
+ (should (equal (company-statistics-score-change-light "dummy")
+ '((nil . 1) (foobar-mode . 1))))))
-(ert-deftest c-s-score-calc-default ()
+(ert-deftest c-s-score-calc-light ()
"Test score calculation default."
(cs-fixture
+ ;; FIXME assumes that light context is a subset of the heavy context?
+ (let ((major-mode 'foo-mode))
+ (should (eq (company-statistics-score-calc-light "foo") 2))
+ (should (eq (company-statistics-score-calc-light "bar") 2))
+ (should (eq (company-statistics-score-calc-light "baz") 1))
+ (should (eq (company-statistics-score-calc-light "quux") 1)))
+ (let ((major-mode 'baz-mode))
+ (should (eq (company-statistics-score-calc-light "foo") 1))
+ (should (eq (company-statistics-score-calc-light "bar") 1))
+ (should (eq (company-statistics-score-calc-light "baz") 2))
+ (should (eq (company-statistics-score-calc-light "quux") 2)))))
+
+(ert-deftest c-s-score-change-heavy ()
+ "Test a few things about the heavy score updates."
+ (let ((major-mode 'foobar-mode))
+ (should (equal (company-statistics-score-change-heavy "dummy")
+ '((nil . 1) (foobar-mode . 1))))
+ (let ((company-statistics--context
+ '((:keyword "kwd")
+ nil ;deliberately omit parent symbol
+ (:file "test-file.XYZ"))))
+ (should (equal (company-statistics-score-change-heavy "dummy")
+ '((nil . 1) (foobar-mode . 1)
+ ((:keyword "kwd") . 1)
+ ((:file "test-file.XYZ") . 1)))))))
+
+(ert-deftest c-s-score-calc-heavy ()
+ "Test heavy score calculation."
+ (cs-fixture
(let ((major-mode 'foo-mode)
- (buffer-file-name nil))
- (should (eq (company-statistics-score-calc-default "foo") 2))
- (should (eq (company-statistics-score-calc-default "bar") 2))
- (should (eq (company-statistics-score-calc-default "baz") 1))
- (should (eq (company-statistics-score-calc-default "quux") 1)))
+ (company-statistics--context
+ '((:symbol "company")
+ (:file "foo-file"))))
+ (should (eq (company-statistics-score-calc-heavy "dummy") 0))
+ (should (eq (company-statistics-score-calc-heavy "foo") 3))
+ (should (eq (company-statistics-score-calc-heavy "bar") 2))
+ (should (eq (company-statistics-score-calc-heavy "baz") 2))
+ (should (eq (company-statistics-score-calc-heavy "quux") 1)))
(let ((major-mode 'foo-mode)
- (buffer-file-name "bar-file"))
- (should (eq (company-statistics-score-calc-default "foo") 2))
- (should (eq (company-statistics-score-calc-default "bar") 3))
- (should (eq (company-statistics-score-calc-default "baz") 1))
- (should (eq (company-statistics-score-calc-default "quux") 1)))
+ (company-statistics--context
+ '((:keyword "unless")
+ (:symbol "parent")
+ (:file "quux-file"))))
+ (should (eq (company-statistics-score-calc-heavy "dummy") 0))
+ (should (eq (company-statistics-score-calc-heavy "foo") 3))
+ (should (eq (company-statistics-score-calc-heavy "bar") 2))
+ (should (eq (company-statistics-score-calc-heavy "baz") 2))
+ (should (eq (company-statistics-score-calc-heavy "quux") 2)))
(let ((major-mode 'baz-mode)
- (buffer-file-name nil))
- (should (eq (company-statistics-score-calc-default "foo") 1))
- (should (eq (company-statistics-score-calc-default "bar") 1))
- (should (eq (company-statistics-score-calc-default "baz") 2))
- (should (eq (company-statistics-score-calc-default "quux") 2)))
+ (company-statistics--context
+ '((:keyword "when")
+ (:file "baz-file"))))
+ (should (eq (company-statistics-score-calc-heavy "dummy") 0))
+ (should (eq (company-statistics-score-calc-heavy "foo") 1))
+ (should (eq (company-statistics-score-calc-heavy "bar") 1))
+ (should (eq (company-statistics-score-calc-heavy "baz") 2))
+ (should (eq (company-statistics-score-calc-heavy "quux") 3)))
(let ((major-mode 'baz-mode)
- (buffer-file-name "quux-file"))
- (should (eq (company-statistics-score-calc-default "foo") 1))
- (should (eq (company-statistics-score-calc-default "bar") 1))
- (should (eq (company-statistics-score-calc-default "baz") 2))
- (should (eq (company-statistics-score-calc-default "quux") 3)))))
+ (company-statistics--context
+ '((:keyword "if")
+ (:symbol "statistics")
+ (:file "quux-file"))))
+ (should (eq (company-statistics-score-calc-heavy "dummy") 0))
+ (should (eq (company-statistics-score-calc-heavy "foo") 2))
+ (should (eq (company-statistics-score-calc-heavy "bar") 2))
+ (should (eq (company-statistics-score-calc-heavy "baz") 2))
+ (should (eq (company-statistics-score-calc-heavy "quux") 3)))))
(ert-deftest c-s-alist-update ()
"Test central helper function for context/score alist update."
diff --git a/company-statistics.el b/company-statistics.el
index 3346c96..356dac0 100644
--- a/company-statistics.el
+++ b/company-statistics.el
@@ -40,10 +40,10 @@
;;
;; The same candidate might occur in different modes, projects, files etc., and
;; possibly has a different meaning each time. Therefore along with the
-;; completion, we store some context information. In the default
configuration,
-;; we track the overall frequency, the major-mode of the buffer, and the
-;; filename (if it applies), and the same criteria are used to score all
-;; possible candidates.
+;; completion, we store some context information. In the default (heavy)
+;; configuration, we track the overall frequency, the major-mode of the buffer,
+;; the last preceding keyword, the parent symbol, and the filename (if it
+;; applies), and the same criteria are used to score all possible candidates.
;;; Code:
@@ -78,7 +78,13 @@ not been used before."
:group 'company-statistics
:type 'boolean)
-(defcustom company-statistics-score-change
'company-statistics-score-change-default
+(defcustom company-statistics-capture-context
'company-statistics-capture-context-heavy
+ "Function called with single argument (t if completion started manually).
+This is the place to store any context information for a completion run."
+ :group 'company-statistics
+ :type 'function)
+
+(defcustom company-statistics-score-change
'company-statistics-score-change-heavy
"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
@@ -86,7 +92,7 @@ the global context."
:group 'company-statistics
:type 'function)
-(defcustom company-statistics-score-calc 'company-statistics-score-calc-default
+(defcustom company-statistics-score-calc 'company-statistics-score-calc-heavy
"Function called with completion candidate. Using arbitrary other info,
eg, on the current context, it should evaluate to the candidate's score (a
number)."
@@ -163,22 +169,93 @@ number)."
;; 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-change-light (cand)
+ "Count for global score and mode context."
+ (list (cons nil 1)
+ (cons major-mode 1))) ;major-mode is never nil
-(defun company-statistics-score-calc-default (cand)
- "Global score, and bonus for matching major mode and filename."
+(defun company-statistics-score-calc-light (cand)
+ "Global score, and bonus for matching major mode."
(let ((scores (gethash cand company-statistics--scores)))
(if scores
;; cand may be in scores and still have no global score left
(+ (or (cdr (assoc nil scores)) 0)
+ (or (cdr (assoc major-mode scores)) 0))
+ 0)))
+
+(defvar company-statistics--context nil
+ "Current completion context, a list of entries searched using `assoc'.")
+
+(defun company-statistics--last-keyword ()
+ "Return last keyword, ie, text of region fontified with the
+font-lock-keyword-face up to point, or nil."
+ (let ((face-pos (point)))
+ (while (and (number-or-marker-p face-pos)
+ (< 1 face-pos)
+ (not (eq (get-text-property (1- face-pos) 'face)
+ 'font-lock-keyword-face)))
+ (setq face-pos
+ (previous-single-property-change face-pos 'face nil (point-min))))
+ (when (and (number-or-marker-p face-pos)) ;else eval to nil
+ (list :keyword
+ (buffer-substring-no-properties
+ (previous-single-property-change face-pos 'face nil (point-min))
+ face-pos)))))
+
+(defun company-statistics--parent-symbol ()
+ "Return symbol immediately preceding current completion prefix, or nil.
+May be separated by punctuation, but not by whitespace."
+ ;; expects to be at start of company-prefix; little sense for lisps
+ (let ((preceding (save-excursion
+ (unless (zerop (skip-syntax-backward "."))
+ (substring-no-properties (symbol-name
(symbol-at-point)))))))
+ (when preceding
+ (list :symbol preceding))))
+
+(defun company-statistics--file-name ()
+ "Return buffer file name, or nil."
+ (when buffer-file-name
+ (list :file buffer-file-name)))
+
+(defun company-statistics-capture-context-heavy (manual)
+ "Calculate some context, once for the whole completion run."
+ (save-excursion
+ (backward-char (length company-prefix))
+ (setq company-statistics--context
+ (delq nil
+ (list (company-statistics--last-keyword)
+ (company-statistics--parent-symbol)
+ (company-statistics--file-name))))))
+
+(defun company-statistics-score-change-heavy (cand)
+ "Count for global score, mode context, last keyword, parent symbol,
+buffer file name."
+ (let ((last-kwd (assoc :keyword company-statistics--context))
+ (parent-symbol (assoc :symbol company-statistics--context))
+ (file (assoc :file company-statistics--context)))
+ (nconc ;when's nil is removed
+ (list (cons nil 1)
+ (cons major-mode 1)) ;major-mode is never nil
+ ;; only add pieces of context if non-nil
+ (when last-kwd (list (cons last-kwd 1)))
+ (when parent-symbol (list (cons parent-symbol 1)))
+ (when file (list (cons file 1))))))
+
+(defun company-statistics-score-calc-heavy (cand)
+ "Global score, and bonus for matching major mode, last keyword, parent
+symbol, buffer file name."
+ (let ((scores (gethash cand company-statistics--scores))
+ (last-kwd (assoc :keyword company-statistics--context))
+ (parent-symbol (assoc :symbol company-statistics--context))
+ (file (assoc :file company-statistics--context)))
+ (if scores
+ ;; cand may be in scores and still have no global score left
+ (+ (or (cdr (assoc nil scores)) 0)
(or (cdr (assoc major-mode scores)) 0)
- (or (cdr (when buffer-file-name ;to not get nil context
- (assoc buffer-file-name scores))) 0))
+ ;; some context may not apply, make sure to not get nil context
+ (or (cdr (when last-kwd (assoc last-kwd scores))) 0)
+ (or (cdr (when parent-symbol (assoc parent-symbol scores))) 0)
+ (or (cdr (when file (assoc file scores))) 0))
0)))
;; score manipulation in one place --- know about hash value alist structure
@@ -240,6 +317,9 @@ one. ALIST structure and cdrs may be changed!"
;; core functions: updater, actual sorting transformer, minor-mode
+(defun company-statistics--start (manual)
+ (funcall company-statistics-capture-context manual))
+
(defun company-statistics--finished (result)
"After completion, update scores and log."
(let* ((score-updates (funcall company-statistics-score-change result))
@@ -280,10 +360,14 @@ configuration. You can customize this behavior with
(company-statistics--init)))
(add-to-list 'company-transformers
'company-sort-by-statistics 'append)
+ (add-hook 'company-completion-started-hook
+ 'company-statistics--start)
(add-hook 'company-completion-finished-hook
'company-statistics--finished))
(setq company-transformers
(delq 'company-sort-by-statistics company-transformers))
+ (remove-hook 'company-completion-started-hook
+ 'company-statistics--start)
(remove-hook 'company-completion-finished-hook
'company-statistics--finished)))
