Merge commit 'b1d019a4c815ac8bdc240d69eaa74eb4e34640e8' from company-master

diff --git a/packages/company/NEWS.md b/packages/company/NEWS.md
index af8ea70cbfd183c0ff1d1c6f10d8dad8dd06fe5e..fe1313cc607b0949caefdc86aebce1401de76b22 100644 (file)
--- a/packages/company/NEWS.md
+++ b/packages/company/NEWS.md
@@ -1,5 +1,11 @@
 # History of user-visible changes
 
+## 2014-07-26 (0.8.2)
+
+* New user option `company-occurrence-weight-function`, allowing to tweak the
+  behavior of the transformer `company-sort-by-occurrence`.
+* Setting `company-idle-delay` to `t` is deprecated. Use the value 0 instead.
+
 ## 2014-07-01 (0.8.1)
 
 * `company-require-match` is not in effect when the new input doesn't continue

diff --git a/packages/company/company-capf.el b/packages/company/company-capf.el
index cc075df2017e0e04c675ad324763a7c6a4ef026a..e27ae7a4609c5854200fd259ae596c815551b3eb 100644 (file)
--- a/packages/company/company-capf.el
+++ b/packages/company/company-capf.el
@@ -28,13 +28,6 @@
 (require 'company)
 (require 'cl-lib)
 
-(defvar-local company--capf-data nil)
-
-(defun company--capf-clear-data (&optional _ignore)
-  (setq company--capf-data nil)
-  (remove-hook 'company-completion-cancelled-hook 'company--capf-clear-data t)
-  (remove-hook 'company-completion-finished-hook 'company--capf-clear-data t))
-
 (defun company--capf-data ()
   (cl-letf* (((default-value 'completion-at-point-functions)
               ;; Ignore tags-completion-at-point-function because it subverts
@@ -57,12 +50,9 @@
        (when res
          (if (> (nth 2 res) (point))
              'stop
-           (setq company--capf-data res)
-           (add-hook 'company-completion-cancelled-hook 'company--capf-clear-data nil t)
-           (add-hook 'company-completion-finished-hook 'company--capf-clear-data nil t)
            (buffer-substring-no-properties (nth 1 res) (point))))))
     (`candidates
-     (let ((res company--capf-data))
+     (let ((res (company--capf-data)))
        (when res
          (let* ((table (nth 3 res))
                 (pred (plist-get (nthcdr 4 res) :predicate))
@@ -84,7 +74,7 @@
                          candidates))
              candidates)))))
     (`sorted
-     (let ((res company--capf-data))
+     (let ((res (company--capf-data)))
        (when res
          (let ((meta (completion-metadata
                       (buffer-substring (nth 1 res) (nth 2 res))
@@ -107,28 +97,34 @@
     (`no-cache t)   ;Not much can be done here, as long as we handle
                     ;non-prefix matches.
     (`meta
-     (let ((f (plist-get (nthcdr 4 company--capf-data) :company-docsig)))
+     (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-docsig)))
        (when f (funcall f arg))))
     (`doc-buffer
-     (let ((f (plist-get (nthcdr 4 company--capf-data) :company-doc-buffer)))
+     (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-doc-buffer)))
        (when f (funcall f arg))))
     (`location
-     (let ((f (plist-get (nthcdr 4 company--capf-data) :company-location)))
+     (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location)))
        (when f (funcall f arg))))
     (`annotation
      (save-excursion
        ;; FIXME: `company-begin' sets `company-point' after calling
        ;; `company--begin-new'.  We shouldn't rely on `company-point' here,
-       ;; better to cache the capf-data value instead.
+       ;; better to cache the capf-data value instead.  However: we can't just
+       ;; save the last capf-data value in `prefix', because that command can
+       ;; get called more often than `candidates', and at any point in the
+       ;; buffer (https://github.com/company-mode/company-mode/issues/153).
+       ;; We could try propertizing the returned prefix string, but it's not
+       ;; passed to `annotation', and `company-prefix' is set only after
+       ;; `company--strip-duplicates' is called.
        (when company-point
          (goto-char company-point))
-       (let ((f (plist-get (nthcdr 4 company--capf-data) :annotation-function)))
+       (let ((f (plist-get (nthcdr 4 (company--capf-data)) :annotation-function)))
          (when f (funcall f arg)))))
     (`require-match
-     (plist-get (nthcdr 4 company--capf-data) :company-require-match))
+     (plist-get (nthcdr 4 (company--capf-data)) :company-require-match))
     (`init nil)      ;Don't bother: plenty of other ways to initialize the code.
     (`post-completion
-     (let* ((res company--capf-data)
+     (let* ((res (company--capf-data))
             (exit-function (plist-get (nthcdr 4 res) :exit-function)))
        (if exit-function
            (funcall exit-function arg 'finished))))

diff --git a/packages/company/company-css.el b/packages/company/company-css.el
index b8bd639c188985fad6e39c9112bb096f48048615..ec48653907d6257e119e0ea71ea62a330f7de1f4 100644 (file)
--- a/packages/company/company-css.el
+++ b/packages/company/company-css.el
@@ -345,7 +345,11 @@
                 (push child results))
             (push value results)))
         (setq results (sort results 'string<))
-        (puthash attribute results company-css-property-cache)
+        (puthash attribute
+                 (if (fboundp 'delete-consecutive-dups)
+                     (delete-consecutive-dups results)
+                   (delete-dups results))
+                 company-css-property-cache)
         results)))
 
 ;;; bracket detection
@@ -402,7 +406,7 @@ Returns \"\" if no property found, but feasible at this position."
 
 ;;; values
 (defconst company-css-property-value-regexp
-  "\\_<\\([[:alpha:]-]+\\):\\(?:[^};]*[[:space:]]+\\)?\\([^};]*\\_>\\|\\)\\="
+  "\\_<\\([[:alpha:]-]+\\):\\(?:[^{};]*[[:space:]]+\\)?\\([^{};]*\\_>\\|\\)\\="
   "A regular expression matching CSS tags.")
 
 ;;;###autoload

diff --git a/packages/company/company-tests.el b/packages/company/company-tests.el
index 14b18bc4d29ea503f8f648bcc0572485feaae518..005bf3a544224e7fca03ef6c17de65c15e14545d 100644 (file)
--- a/packages/company/company-tests.el
+++ b/packages/company/company-tests.el
@@ -461,7 +461,7 @@
                                  (cdr (assoc arg '(("123" . "(4)")))))))
             (company-candidates '("123" "45"))
             company-tooltip-align-annotations)
-        (company-pseudo-tooltip-show-at-point (point))
+        (company-pseudo-tooltip-show-at-point (point) 0)
         (let ((ov company-pseudo-tooltip-overlay))
           ;; With margins.
           (should (eq (overlay-get ov 'company-width) 8))
@@ -482,7 +482,7 @@
                                                    ("67" . "(891011)")))))))
             (company-candidates '("123" "45" "67"))
             (company-tooltip-align-annotations t))
-        (company-pseudo-tooltip-show-at-point (point))
+        (company-pseudo-tooltip-show-at-point (point) 0)
         (let ((ov company-pseudo-tooltip-overlay))
           ;; With margins.
           (should (eq (overlay-get ov 'company-width) 13))
@@ -714,6 +714,44 @@
       (let ((company-backend (list immediate)))
         (should (equal '("f") (company-call-backend 'candidates "foo")))))))
 
+;;; Transformers
+
+(ert-deftest company-occurrence-prefer-closest-above ()
+  (with-temp-buffer
+    (save-window-excursion
+      (set-window-buffer nil (current-buffer))
+      (insert "foo0
+foo1
+")
+      (save-excursion
+        (insert "
+foo3
+foo2"))
+      (let ((company-backend 'company-dabbrev)
+            (company-occurrence-weight-function
+             'company-occurrence-prefer-closest-above))
+        (should (equal '("foo1" "foo0" "foo3" "foo2" "foo4")
+                       (company-sort-by-occurrence
+                        '("foo0" "foo1" "foo2" "foo3" "foo4"))))))))
+
+(ert-deftest company-occurrence-prefer-any-closest ()
+  (with-temp-buffer
+    (save-window-excursion
+      (set-window-buffer nil (current-buffer))
+      (insert "foo0
+foo1
+")
+      (save-excursion
+        (insert "
+foo3
+foo2"))
+      (let ((company-backend 'company-dabbrev)
+            (company-occurrence-weight-function
+             'company-occurrence-prefer-any-closest))
+        (should (equal '("foo1" "foo3" "foo0" "foo2" "foo4")
+                       (company-sort-by-occurrence
+                        '("foo0" "foo1" "foo2" "foo3" "foo4"))))))))
+
 ;;; Template
 
 (ert-deftest company-template-removed-after-the-last-jump ()

diff --git a/packages/company/company.el b/packages/company/company.el
index 5d8562a3052d6cae5a14adeb01cde84dfecc8bef..7b4834706af9ecc99679daa573172a29d6b7fae9 100644 (file)
--- a/packages/company/company.el
+++ b/packages/company/company.el
@@ -5,7 +5,7 @@
 ;; Author: Nikolaj Schumacher
 ;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
 ;; URL: http://company-mode.github.io/
-;; Version: 0.8.1
+;; Version: 0.8.2
 ;; Keywords: abbrev, convenience, matching
 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
 
@@ -193,23 +193,22 @@ buffer-local wherever it is set."
   "Face used for the common part of completions in the echo area.")
 
 (defun company-frontends-set (variable value)
-  ;; uniquify
-  (let ((remainder value))
-    (setcdr remainder (delq (car remainder) (cdr remainder))))
-  (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
-       (memq 'company-pseudo-tooltip-frontend value)
-       (error "Pseudo tooltip frontend cannot be used twice"))
-  (and (memq 'company-preview-if-just-one-frontend value)
-       (memq 'company-preview-frontend value)
-       (error "Preview frontend cannot be used twice"))
-  (and (memq 'company-echo value)
-       (memq 'company-echo-metadata-frontend value)
-       (error "Echo area cannot be used twice"))
-  ;; preview must come last
-  (dolist (f '(company-preview-if-just-one-frontend company-preview-frontend))
-    (when (memq f value)
-      (setq value (append (delq f value) (list f)))))
-  (set variable value))
+  ;; Uniquify.
+  (let ((value (delete-dups (copy-sequence value))))
+    (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
+         (memq 'company-pseudo-tooltip-frontend value)
+         (error "Pseudo tooltip frontend cannot be used twice"))
+    (and (memq 'company-preview-if-just-one-frontend value)
+         (memq 'company-preview-frontend value)
+         (error "Preview frontend cannot be used twice"))
+    (and (memq 'company-echo value)
+         (memq 'company-echo-metadata-frontend value)
+         (error "Echo area cannot be used twice"))
+    ;; Preview must come last.
+    (dolist (f '(company-preview-if-just-one-frontend company-preview-frontend))
+      (when (cdr (memq f value))
+        (setq value (append (delq f value) (list f)))))
+    (set variable value)))
 
 (defcustom company-frontends '(company-pseudo-tooltip-unless-just-one-frontend
                                company-preview-if-just-one-frontend
@@ -545,10 +544,10 @@ A character that is part of a valid candidate never triggers auto-completion."
 
 (defcustom company-idle-delay .5
   "The idle delay in seconds until completion starts automatically.
-A value of nil means no idle completion, t means show candidates
-immediately when a prefix of `company-minimum-prefix-length' is reached."
+The prefix still has to satisfy `company-minimum-prefix-length' before that
+happens.  The value of nil means no idle completion."
   :type '(choice (const :tag "never (nil)" nil)
-                 (const :tag "immediate (t)" t)
+                 (const :tag "immediate (0)" 0)
                  (number :tag "seconds")))
 
 (defcustom company-begin-commands '(self-insert-command org-self-insert-command)
@@ -693,6 +692,9 @@ keymap during active completions (`company-active-map'):
   nil company-lighter company-mode-map
   (if company-mode
       (progn
+        (when (eq company-idle-delay t)
+          (setq company-idle-delay 0)
+          (warn "Setting `company-idle-delay' to t is deprecated.  Set it to 0 instead."))
         (add-hook 'pre-command-hook 'company-pre-command nil t)
         (add-hook 'post-command-hook 'company-post-command nil t)
         (mapc 'company-init-backend company-backends))
@@ -1011,7 +1013,7 @@ can retrieve meta-data for them."
     candidate))
 
 (defun company--should-complete ()
-  (and (eq company-idle-delay t)
+  (and (eq company-idle-delay 'now)
        (not (or buffer-read-only overriding-terminal-local-map
                 overriding-local-map))
        ;; Check if in the middle of entering a key combination.
@@ -1189,43 +1191,74 @@ can retrieve meta-data for them."
       (setq c (funcall tr c)))
     c))
 
+(defcustom company-occurrence-weight-function
+  #'company-occurrence-prefer-closest-above
+  "Function to weigh matches in `company-sort-by-occurrence'.
+It's called with three arguments: cursor position, the beginning and the
+end of the match."
+  :type '(choice
+          (const :tag "First above point, then below point"
+                 company-occurrence-prefer-closest-above)
+          (const :tag "Prefer closest in any direction"
+                 company-occurrence-prefer-any-closest)))
+
+(defun company-occurrence-prefer-closest-above (pos match-beg match-end)
+  "Give priority to the matches above point, then those below point."
+  (if (< match-beg pos)
+      (- pos match-end)
+    (- match-beg (window-start))))
+
+(defun company-occurrence-prefer-any-closest (pos _match-beg match-end)
+  "Give priority to the matches closest to the point."
+  (abs (- pos match-end)))
+
 (defun company-sort-by-occurrence (candidates)
   "Sort CANDIDATES according to their occurrences.
 Searches for each in the currently visible part of the current buffer and
-gives priority to the closest ones above point, then closest ones below
-point. The rest of the list is appended unchanged.
+prioritizes the matches according to `company-occurrence-weight-function'.
+The rest of the list is appended unchanged.
 Keywords and function definition names are ignored."
-  (let* (occurs
+  (let* ((w-start (window-start))
+         (w-end (window-end))
+         (start-point (point))
+         occurs
          (noccurs
-          (cl-delete-if
-           (lambda (candidate)
-             (when (or
-                    (save-excursion
-                      (progn (forward-char (- (length company-prefix)))
-                             (search-backward candidate (window-start) t)))
-                    (save-excursion
-                      (search-forward candidate (window-end) t)))
-               (let ((beg (match-beginning 0))
-                     (end (match-end 0)))
-                 (when (save-excursion
-                         (goto-char end)
-                         (and (not (memq (get-text-property (point) 'face)
-                                         '(font-lock-function-name-face
-                                           font-lock-keyword-face)))
-                              (let ((prefix (company--prefix-str
-                                             (company-call-backend 'prefix))))
-                                (and (stringp prefix)
-                                     (= (length prefix) (- end beg))))))
-                   (push (cons candidate (if (< beg (point))
-                                             (- (point) end)
-                                           (- beg (window-start))))
-                         occurs)
-                   t))))
-           candidates)))
+          (save-excursion
+            (cl-delete-if
+             (lambda (candidate)
+               (when (catch 'done
+                       (goto-char w-start)
+                       (while (search-forward candidate w-end t)
+                         (when (and (not (eq (point) start-point))
+                                    (save-match-data
+                                      (company--occurrence-predicate)))
+                           (throw 'done t))))
+                 (push
+                  (cons candidate
+                        (funcall company-occurrence-weight-function
+                                 start-point
+                                 (match-beginning 0)
+                                 (match-end 0)))
+                  occurs)
+                 t))
+             candidates))))
     (nconc
      (mapcar #'car (sort occurs (lambda (e1 e2) (<= (cdr e1) (cdr e2)))))
      noccurs)))
 
+(defun company--occurrence-predicate ()
+  (let ((beg (match-beginning 0))
+        (end (match-end 0)))
+    (save-excursion
+      (goto-char end)
+      (and (not (memq (get-text-property (1- (point)) 'face)
+                      '(font-lock-function-name-face
+                        font-lock-keyword-face)))
+           (let ((prefix (company--prefix-str
+                          (company-call-backend 'prefix))))
+             (and (stringp prefix)
+                  (= (length prefix) (- end beg))))))))
+
 (defun company-sort-by-backend-importance (candidates)
   "Sort CANDIDATES as two priority groups.
 If `company-backend' is a function, do nothing.  If it's a list, move
@@ -1257,7 +1290,7 @@ from the rest of the back-ends in the group, if any, will be left at the end."
 (defun company-auto-begin ()
   (and company-mode
        (not company-candidates)
-       (let ((company-idle-delay t))
+       (let ((company-idle-delay 'now))
          (condition-case-unless-debug err
              (company--perform)
            (error (message "Company: An error occurred in auto-begin")
@@ -1509,9 +1542,7 @@ from the rest of the back-ends in the group, if any, will be left at the end."
     (condition-case err
         (progn
           (unless (equal (point) company-point)
-            (let ((company-idle-delay (and (eq company-idle-delay t)
-                                           (company--should-begin)
-                                           t)))
+            (let (company-idle-delay) ; Against misbehavior while debugging.
               (company--perform)))
           (if company-candidates
               (company-call-frontends 'post-command)
@@ -2388,9 +2419,10 @@ Returns a negative number if the tooltip should be displayed above point."
         (overlay-put ov 'company-column column)
         (overlay-put ov 'company-height height)))))
 
-(defun company-pseudo-tooltip-show-at-point (pos)
+(defun company-pseudo-tooltip-show-at-point (pos column-offset)
   (let ((row (company--row pos))
-        (col (company--column pos)))
+        (col (- (company--column pos) column-offset)))
+    (when (< col 0) (setq col 0))
     (company-pseudo-tooltip-show (1+ row) col company-selection)))
 
 (defun company-pseudo-tooltip-edit (selection)
@@ -2427,29 +2459,30 @@ Returns a negative number if the tooltip should be displayed above point."
     (overlay-put company-pseudo-tooltip-overlay 'window (selected-window))))
 
 (defun company-pseudo-tooltip-guard ()
-  (buffer-substring-no-properties
-   (point) (overlay-start company-pseudo-tooltip-overlay)))
+  (list
+   (save-excursion (beginning-of-visual-line))
+   (let ((ov company-pseudo-tooltip-overlay))
+     (when (>= (overlay-get ov 'company-height) 0)
+       (buffer-substring-no-properties (point) (overlay-start ov))))))
 
 (defun company-pseudo-tooltip-frontend (command)
   "`company-mode' front-end similar to a tooltip but based on overlays."
   (cl-case command
     (pre-command (company-pseudo-tooltip-hide-temporarily))
     (post-command
-     (let ((old-height (if (overlayp company-pseudo-tooltip-overlay)
-                           (overlay-get company-pseudo-tooltip-overlay
-                                        'company-height)
-                         0))
-           (new-height (company--pseudo-tooltip-height)))
-       (unless (and (>= (* old-height new-height) 0)
-                    (>= (abs old-height) (abs new-height))
-                    (equal (company-pseudo-tooltip-guard)
-                           (overlay-get company-pseudo-tooltip-overlay
-                                        'company-guard)))
-         ;; Redraw needed.
-         (company-pseudo-tooltip-show-at-point (- (point)
-                                                  (length company-prefix)))
-         (overlay-put company-pseudo-tooltip-overlay
-                      'company-guard (company-pseudo-tooltip-guard))))
+     (unless (when (overlayp company-pseudo-tooltip-overlay)
+              (let* ((ov company-pseudo-tooltip-overlay)
+                     (old-height (overlay-get ov 'company-height))
+                     (new-height (company--pseudo-tooltip-height)))
+                (and
+                 (>= (* old-height new-height) 0)
+                 (>= (abs old-height) (abs new-height))
+                 (equal (company-pseudo-tooltip-guard)
+                        (overlay-get ov 'company-guard)))))
+       ;; Redraw needed.
+       (company-pseudo-tooltip-show-at-point (point) (length company-prefix))
+       (overlay-put company-pseudo-tooltip-overlay
+                    'company-guard (company-pseudo-tooltip-guard)))
      (company-pseudo-tooltip-unhide))
     (hide (company-pseudo-tooltip-hide)
           (setq company-tooltip-offset 0))