Merge branch 'search-hl-fix'

[gnu-emacs-elpa] / company.el

diff --git a/company.el b/company.el
index cd78bd930af6c316f2c4195b0dc0b50666c466ec..99c7eb5ec457910bef91a3697c49ef04520b0e92 100644 (file)
--- a/company.el
+++ b/company.el
@@ -5,7 +5,7 @@
 ;; Author: Nikolaj Schumacher
 ;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
 ;; URL: http://company-mode.github.io/
-;; Version: 0.8.9-cvs
+;; Version: 0.9.0-cvs
 ;; Keywords: abbrev, convenience, matching
 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
 
@@ -662,9 +662,26 @@ asynchronous call into synchronous.")
       (unless (keywordp b)
         (company-init-backend b))))))
 
-(defvar company-default-lighter " company")
+(defcustom company-lighter-base "company"
+  "Base string to use for the `company-mode' lighter."
+  :type 'string
+  :package-version '(company . "0.8.10"))
 
-(defvar-local company-lighter company-default-lighter)
+(defvar company-lighter '(" "
+                          (company-backend
+                           (:eval
+                            (if (consp company-backend)
+                                (company--group-lighter (nth company-selection
+                                                             company-candidates)
+                                                        company-lighter-base)
+                              (symbol-name company-backend)))
+                           company-lighter-base))
+  "Mode line lighter for Company.
+
+The value of this variable is a mode line template as in
+`mode-line-format'.")
+
+(put 'company-lighter 'risky-local-variable t)
 
 ;;;###autoload
 (define-minor-mode company-mode
@@ -1045,34 +1062,36 @@ can retrieve meta-data for them."
             (mod selection company-candidates-length)
           (max 0 (min (1- company-candidates-length) selection))))
   (when (or force-update (not (equal selection company-selection)))
-    (company--update-group-lighter (nth selection company-candidates))
     (setq company-selection selection
           company-selection-changed t)
     (company-call-frontends 'update)))
 
-(defun company--update-group-lighter (candidate)
-  (when (listp company-backend)
-    (let ((backend (or (get-text-property 0 'company-backend candidate)
-                       (car company-backend))))
-      (when (and backend (symbolp backend))
-        (let ((name (replace-regexp-in-string "company-\\|-company" ""
-                                              (symbol-name backend))))
-          (setq company-lighter (format " company-<%s>" name)))))))
+(defun company--group-lighter (candidate base)
+  (let ((backend (or (get-text-property 0 'company-backend candidate)
+                     (car company-backend))))
+    (when (and backend (symbolp backend))
+      (let ((name (replace-regexp-in-string "company-\\|-company" ""
+                                            (symbol-name backend))))
+        (format "%s-<%s>" base name)))))
 
 (defun company-update-candidates (candidates)
   (setq company-candidates-length (length candidates))
-  (if (> company-selection 0)
+  (if company-selection-changed
       ;; Try to restore the selection
       (let ((selected (nth company-selection company-candidates)))
         (setq company-selection 0
               company-candidates candidates)
         (when selected
-          (while (and candidates (string< (pop candidates) selected))
-            (cl-incf company-selection))
-          (unless candidates
-            ;; Make sure selection isn't out of bounds.
-            (setq company-selection (min (1- company-candidates-length)
-                                         company-selection)))))
+          (catch 'found
+            (while candidates
+              (let ((candidate (pop candidates)))
+                (when (and (string= candidate selected)
+                           (equal (company-call-backend 'annotation candidate)
+                                  (company-call-backend 'annotation selected)))
+                  (throw 'found t)))
+              (cl-incf company-selection))
+            (setq company-selection 0
+                  company-selection-changed nil))))
     (setq company-selection 0
           company-candidates candidates))
   ;; Calculate common.
@@ -1448,9 +1467,6 @@ from the rest of the back-ends in the group, if any, will be left at the end."
                 (message "No completion found"))
             (when company--manual-action
               (setq company--manual-prefix prefix))
-            (if (symbolp backend)
-                (setq company-lighter (concat " " (symbol-name backend)))
-              (company--update-group-lighter (car c)))
             (company-update-candidates c)
             (run-hook-with-args 'company-completion-started-hook
                                 (company-explicit-action-p))
@@ -1488,7 +1504,6 @@ from the rest of the back-ends in the group, if any, will be left at the end."
           company-selection-changed nil
           company--manual-action nil
           company--manual-prefix nil
-          company-lighter company-default-lighter
           company--point-max nil
           company-point nil)
     (when company-timer
@@ -1573,13 +1588,19 @@ from the rest of the back-ends in the group, if any, will be left at the end."
 
 (defvar-local company-search-string "")
 
-(defvar-local company-search-lighter " Search: \"\"")
+(defvar company-search-lighter '(" "
+                                 (company-search-filtering "Filter" "Search")
+                                 ": \""
+                                 company-search-string
+                                 "\""))
 
 (defvar-local company-search-filtering nil
   "Non-nil to filter the completion candidates by the search string")
 
 (defvar-local company--search-old-selection 0)
 
+(defvar-local company--search-old-changed nil)
+
 (defun company--search (text lines)
   (let ((quoted (regexp-quote text))
         (i 0))
@@ -1615,12 +1636,7 @@ from the rest of the back-ends in the group, if any, will be left at the end."
   (let* ((pos (company--search new (nthcdr company-selection company-candidates))))
     (if (null pos)
         (ding)
-      (setq company-search-string new
-            company-search-lighter (format " %s: \"%s\""
-                                           (if company-search-filtering
-                                               "Filter"
-                                             "Search")
-                                           new))
+      (setq company-search-string new)
       (company-set-selection (+ company-selection pos) t))))
 
 (defun company--search-assert-input ()
@@ -1665,7 +1681,8 @@ from the rest of the back-ends in the group, if any, will be left at the end."
   (interactive)
   (company--search-assert-enabled)
   (company-search-mode 0)
-  (company-set-selection company--search-old-selection t))
+  (company-set-selection company--search-old-selection t)
+  (setq company-selection-changed company--search-old-changed))
 
 (defun company-search-other-char ()
   (interactive)
@@ -1711,6 +1728,8 @@ from the rest of the back-ends in the group, if any, will be left at the end."
     (define-key keymap (vector meta-prefix-char t) 'company-search-other-char)
     (define-key keymap (kbd "M-n") 'company-select-next)
     (define-key keymap (kbd "M-p") 'company-select-previous)
+    (define-key keymap (kbd "<down>") 'company-select-next-or-abort)
+    (define-key keymap (kbd "<up>") 'company-select-previous-or-abort)
     (define-key keymap "\e\e\e" 'company-search-other-char)
     (define-key keymap [escape escape escape] 'company-search-other-char)
     (define-key keymap (kbd "DEL") 'company-search-delete-char)
@@ -1719,6 +1738,8 @@ from the rest of the back-ends in the group, if any, will be left at the end."
     (define-key keymap "\C-s" 'company-search-repeat-forward)
     (define-key keymap "\C-r" 'company-search-repeat-backward)
     (define-key keymap "\C-o" 'company-search-toggle-filtering)
+    (dotimes (i 10)
+      (define-key keymap (read-kbd-macro (format "M-%d" i)) 'company-complete-number))
     keymap)
   "Keymap used for incrementally searching the completion candidates.")
 
@@ -1730,13 +1751,15 @@ Don't start this directly, use `company-search-candidates' or
   (if company-search-mode
       (if (company-manual-begin)
           (progn
-            (setq company--search-old-selection company-selection)
-            (company-call-frontends 'update))
+            (setq company--search-old-selection company-selection
+                  company--search-old-changed company-selection-changed)
+            (company-call-frontends 'update)
+            (company-enable-overriding-keymap company-search-map))
         (setq company-search-mode nil))
     (kill-local-variable 'company-search-string)
-    (kill-local-variable 'company-search-lighter)
     (kill-local-variable 'company-search-filtering)
     (kill-local-variable 'company--search-old-selection)
+    (kill-local-variable 'company--search-old-changed)
     (when company-backend
       (company--search-update-predicate "")
       (company-call-frontends 'update))
@@ -1762,8 +1785,7 @@ Regular characters are appended to the search string.
 The command `company-search-toggle-filtering' (\\[company-search-toggle-filtering])
 uses the search string to filter the completion candidates."
   (interactive)
-  (company-search-mode 1)
-  (company-enable-overriding-keymap company-search-map))
+  (company-search-mode 1))
 
 (defvar company-filter-map
   (let ((keymap (make-keymap)))
@@ -2209,9 +2231,12 @@ If SHOW-VERSION is non-nil, show the version in the echo area."
                (string-match (regexp-quote company-search-string) value
                              (length company-prefix)))
           (let ((beg (+ margin (match-beginning 0)))
-                (end (+ margin (match-end 0))))
-            (add-text-properties beg end '(face company-tooltip-search)
-                                 line))
+                (end (+ margin (match-end 0)))
+                (width (- width (length right))))
+            (when (< beg width)
+              (add-text-properties beg (min end width)
+                                   '(face company-tooltip-search)
+                                   line)))
         (add-text-properties 0 width '(face company-tooltip-selection
                                        mouse-face company-tooltip-selection)
                              line)