- ;;; company-statistics-tests.el --- company-statistics tests
+ ;;; company-statistics-tests.el --- company-statistics tests -*- lexical-binding: t -*-
- ;; Copyright (C) 2014 Free Software Foundation, Inc.
+ ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Ingo Lohmar
;;; 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:
(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
(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."
- ;;; company-statistics.el --- Sort candidates using completion history -*- lexical-binding:t -*-
+ ;;; company-statistics.el --- Sort candidates using completion history -*- lexical-binding: t -*-
;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Ingo Lohmar <i.lohmar@gmail.com>
;; URL: https://github.com/company-mode/company-statistics
- ;; Version: 0.1.1
+ ;; Version: 0.2.1
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.3") (company "0.8.5"))
;;
;; Package installed from elpa.gnu.org:
;;
- ;; (add-hook 'after-init-hook 'company-statistics-mode)
+ ;; (add-hook 'after-init-hook #'company-statistics-mode)
;;
;; Manually installed: make sure that this file is in load-path, and
;;
;;
;; 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:
"Number of completion choices that `company-statistics' keeps track of.
As this is a global cache, making it too small defeats the purpose."
:type 'integer
- :initialize (lambda (_option init-size) (setq company-statistics-size init-size))
+ :initialize #'custom-initialize-default
:set #'company-statistics--log-resize)
(defcustom company-statistics-file
not been used before."
: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."
+ :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
the global context."
: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)."
(defun company-statistics--init ()
"Initialize company-statistics."
(setq company-statistics--scores
- (make-hash-table :test 'equal :size company-statistics-size))
+ (make-hash-table :test #'equal :size company-statistics-size))
(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--log-resize (_option new-size)
+ (defun company-statistics--log-resize (option new-size)
(when (company-statistics--initialized-p)
;; hash scoresheet auto-resizes, but log does not
(let ((new-hist (make-vector new-size nil))
;; 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
(company-statistics--alist-update
(gethash cand company-statistics--scores)
score-updates
- '+)
+ #'+)
company-statistics--scores))
(defun company-statistics--log-revert (&optional index)
(company-statistics--alist-update
(gethash cand company-statistics--scores)
score-updates
- '-
- 'zerop)))
+ #'-
+ #'zerop)))
(if new-scores ;sth left
(puthash cand new-scores company-statistics--scores)
(remhash cand company-statistics--scores))))))
;; 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))
(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)))