[elpa] master b727d25 7/7: Merge commit '45bc13aec56fcd0b55686d2305cf6e6852d467e8' from company-statistics

[Ingo Lohmar]

branch: master
commit b727d25a5e586cdefb6e37c5a812b1d6a67f68e8
Merge: f727b53 45bc13a
Author: Ingo Lohmar <address@hidden>
Commit: Ingo Lohmar <address@hidden>

    Merge commit '45bc13aec56fcd0b55686d2305cf6e6852d467e8' from 
company-statistics
    
    * commit '45bc13aec56fcd0b55686d2305cf6e6852d467e8':
      Bump version
      Cleanup similar to ELPA version
      Update version
      Offer light and heavy context scoring
      fix typo
    
    Conflicts:
        packages/company-statistics/company-statistics.el
---
 packages/company-statistics/README.org             |    2 +-
 .../company-statistics/company-statistics-tests.el |  120 ++++++++++++------
 packages/company-statistics/company-statistics.el  |  133 ++++++++++++++++----
 3 files changed, 193 insertions(+), 62 deletions(-)

diff --git a/packages/company-statistics/README.org 
b/packages/company-statistics/README.org
index 3fef3a4..012b63b 100644
--- a/packages/company-statistics/README.org
+++ b/packages/company-statistics/README.org
@@ -11,7 +11,7 @@ Using the package is simple.
 If you install it from the elpa.gnu.org repository with Emacs' package manager,
 you only need to enable the mode, e.g., in your =init.el= file:
 #+begin_src emacs-lisp
-(add-to-hook 'after-init-hook 'company-statistics-mode)
+(add-hook 'after-init-hook 'company-statistics-mode)
 #+end_src
 
 Alternatively, make sure =company-statistics.el= is in your =load-path=, and 
add
diff --git a/packages/company-statistics/company-statistics-tests.el 
b/packages/company-statistics/company-statistics-tests.el
index 6e0b460..3fa336a 100644
--- a/packages/company-statistics/company-statistics-tests.el
+++ b/packages/company-statistics/company-statistics-tests.el
@@ -1,6 +1,6 @@
-;;; 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
 
@@ -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/packages/company-statistics/company-statistics.el 
b/packages/company-statistics/company-statistics.el
index bf6a50f..b982c48 100644
--- a/packages/company-statistics/company-statistics.el
+++ b/packages/company-statistics/company-statistics.el
@@ -1,10 +1,10 @@
-;;; 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 <address@hidden>
 ;; 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"))
 
@@ -27,7 +27,7 @@
 ;;
 ;; 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
 ;;
@@ -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:
 
@@ -57,7 +57,7 @@
   "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
@@ -74,14 +74,19 @@ As this is a global cache, making it too small defeats the 
purpose."
 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)."
@@ -101,14 +106,14 @@ 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))
@@ -157,22 +162,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
@@ -203,7 +279,7 @@ one.  ALIST structure and cdrs may be changed!"
            (company-statistics--alist-update
             (gethash cand company-statistics--scores)
             score-updates
-            '+)
+            #'+)
            company-statistics--scores))
 
 (defun company-statistics--log-revert (&optional index)
@@ -219,8 +295,8 @@ one.  ALIST structure and cdrs may be changed!"
               (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))))))
@@ -234,6 +310,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))
@@ -274,10 +353,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)))