emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[ELPA-diffs] /srv/bzr/emacs/elpa r373: company: Release 0.6.1


From: Dmitry Gutov
Subject: [ELPA-diffs] /srv/bzr/emacs/elpa r373: company: Release 0.6.1
Date: Sat, 23 Mar 2013 08:19:13 +0400
User-agent: Bazaar (2.5.0)

------------------------------------------------------------
revno: 373
committer: Dmitry Gutov <address@hidden>
branch nick: elpa
timestamp: Sat 2013-03-23 08:19:13 +0400
message:
  company: Release 0.6.1
modified:
  packages/company/.dir-locals.el
  packages/company/company-clang.el
  packages/company/company-eclim.el
  packages/company/company-pkg.el
  packages/company/company-template.el
  packages/company/company-tests.el
  packages/company/company.el
=== modified file 'packages/company/.dir-locals.el'
--- a/packages/company/.dir-locals.el   2013-03-19 03:47:51 +0000
+++ b/packages/company/.dir-locals.el   2013-03-23 04:19:13 +0000
@@ -1,2 +1,4 @@
 ((nil . ((indent-tabs-mode . nil)
-         (fill-column . 80))))
+         (fill-column . 80)
+         (sentence-end-double-space . t)
+         (emacs-lisp-docstring-fill-column . t))))

=== modified file 'packages/company/company-clang.el'
--- a/packages/company/company-clang.el 2013-03-19 03:47:51 +0000
+++ b/packages/company/company-clang.el 2013-03-23 04:19:13 +0000
@@ -181,34 +181,42 @@
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defconst company-clang-required-version "1.1")
+(defconst company-clang-required-version 1.1)
 
 (defsubst company-clang-version ()
   "Return the version of `company-clang-executable'."
   (with-temp-buffer
     (call-process company-clang-executable nil t nil "--version")
     (goto-char (point-min))
-    (if (re-search-forward "clang version \\([0-9.]+\\)" nil t)
-        (match-string-no-properties 1)
-      "0")))
+    (if (re-search-forward "clang\\(?: version \\|-\\)\\([0-9.]+\\)" nil t)
+        (let ((ver (string-to-number (match-string-no-properties 1))))
+          (if (> ver 100)
+              (/ ver 100)
+            ver))
+      0)))
 
 (defun company-clang-objc-templatify (selector)
   (let* ((end (point))
          (beg (- (point) (length selector)))
-         (templ (company-template-declare-template beg end)))
+         (templ (company-template-declare-template beg end))
+         (cnt 0))
     (save-excursion
       (goto-char beg)
       (while (search-forward ":" end t)
-        (replace-match ":  ")
-        (incf end 2)
-        (company-template-add-field templ (1- (match-end 0)) "<arg>"))
-      (delete-char -1))
+        (let* ((name (format "arg%d" cnt))
+               (len (length name)))
+          (incf end len)
+          (company-template-add-field templ (match-end 0) name)
+          (goto-char (+ (match-end 0) len))
+          (when (< (point) end)
+            (insert " ")
+            (incf end))
+          (incf cnt))))
     (company-template-move-to-first templ)))
 
 (defun company-clang (command &optional arg &rest ignored)
   "A `company-mode' completion back-end for clang.
-Clang is a parser for C and ObjC.  The unreleased development version of
-clang (1.1) is required.
+Clang is a parser for C and ObjC.  Clang version 1.1 or newer is required.
 
 Additional command line arguments can be specified in
 `company-clang-arguments'.  Prefix files (-include ...) can be selected
@@ -220,11 +228,11 @@
   (interactive (list 'interactive))
   (case command
     (interactive (company-begin-backend 'company-clang))
-    (init (unless company-clang-executable
-            (error "Company found no clang executable"))
-          (when (version< (company-clang-version)
-                          company-clang-required-version)
-            (error "Company requires clang version 1.1")))
+    (init (when (memq major-mode company-clang-modes)
+            (unless company-clang-executable
+              (error "Company found no clang executable"))
+            (when (< (company-clang-version) company-clang-required-version)
+              (error "Company requires clang version 1.1"))))
     (prefix (and (memq major-mode company-clang-modes)
                  buffer-file-name
                  company-clang-executable
@@ -237,6 +245,9 @@
                "#]" " "
                (replace-regexp-in-string "[<{[]#\\|#[>}]" "" meta t)
                t))))
+    (crop (and (derived-mode-p 'objc-mode)
+               (string-match ":" arg)
+               (substring arg 0 (match-beginning 0))))
     (post-completion (and (derived-mode-p 'objc-mode)
                           (string-match ":" arg)
                           (company-clang-objc-templatify arg)))))

=== modified file 'packages/company/company-eclim.el'
--- a/packages/company/company-eclim.el 2013-03-19 03:47:51 +0000
+++ b/packages/company/company-eclim.el 2013-03-23 04:19:13 +0000
@@ -60,7 +60,7 @@
 (defvar company-eclim--project-dir 'unknown)
 (make-variable-buffer-local 'company-eclim--project-dir)
 
-(defvar company-eclim--project-name 'unknown)
+(defvar company-eclim--project-name nil)
 (make-variable-buffer-local 'company-eclim--project-name)
 
 (defvar company-eclim--doc nil)
@@ -93,15 +93,16 @@
     company-eclim--project-dir))
 
 (defun company-eclim--project-name ()
-  (if (eq company-eclim--project-name 'unknown)
-      (setq company-eclim--project-name
-            (let ((project (find-if (lambda (project)
-                                      (equal (cdr (assoc 'path project))
-                                             (company-eclim--project-dir)))
-                                    (company-eclim--project-list))))
-              (when project
-                (cdr (assoc 'name project)))))
-    company-eclim--project-name))
+  (or company-eclim--project-name
+      (let ((dir (company-eclim--project-dir)))
+        (when dir
+          (setq company-eclim--project-name
+                (let ((project (find-if (lambda (project)
+                                          (equal (cdr (assoc 'path project))
+                                                 dir))
+                                        (company-eclim--project-list))))
+                  (when project
+                    (cdr (assoc 'name project)))))))))
 
 (defun company-eclim--candidates (prefix)
   (interactive "d")
@@ -116,25 +117,37 @@
                                    "-p" (company-eclim--project-name)
                                    "-f" project-file))
     (setq company-eclim--doc
-          (cdr (assoc 'completions
-                      (company-eclim--call-process
-                       "java_complete" "-p" (company-eclim--project-name)
-                       "-f" project-file
-                       "-o" (number-to-string (1- (point)))
-                       "-e" "utf-8"
-                       "-l" "standard")))))
+          (make-hash-table :test 'equal))
+    (dolist (item (cdr (assoc 'completions
+                              (company-eclim--call-process
+                               "java_complete" "-p" 
(company-eclim--project-name)
+                               "-f" project-file
+                               "-o" (number-to-string (1- (point)))
+                               "-e" "utf-8"
+                               "-l" "standard"))))
+      (let* ((meta (cdr (assoc 'info item)))
+             (completion meta))
+        (when (string-match " [:-]" completion)
+          (setq completion (substring completion 0 (match-beginning 0))))
+        (puthash completion meta company-eclim--doc))))
   (let ((completion-ignore-case nil))
-    ;; TODO: Handle overloaded methods somehow. Show one candidate per 
overload?
-    ;; That would look nice, but kinda useless: a bunch of candidates for the
-    ;; same completion. Maybe do expansion like 
`company-clang-objc-templatify'.
-    (all-completions prefix (mapcar (lambda (item) (cdr (assoc 'completion 
item)))
-                                    company-eclim--doc))))
+    (all-completions prefix company-eclim--doc)))
 
 (defun company-eclim--meta (candidate)
-  (cdr (assoc 'info (find-if
-                     (lambda (item) (equal (cdr (assoc 'completion item))
-                                      arg))
-                     company-eclim--doc))))
+  (gethash candidate company-eclim--doc))
+
+(defun company-eclim--templatify (call)
+  (let* ((end (point))
+         (beg (- (point) (length call)))
+         (templ (company-template-declare-template beg end)))
+    (save-excursion
+      (goto-char beg)
+      (while (re-search-forward "\\([(,] ?\\)\\([^ ]+ \\)\\([^ ,)]*\\)" end t)
+        (let ((name (match-string 3)))
+          (replace-match "\\1" t)
+          (decf end (length (match-string 2)))
+          (company-template-add-field templ (point) name))))
+    (company-template-move-to-first templ)))
 
 (defun company-eclim (command &optional arg &rest ignored)
   "A `company-mode' completion back-end for eclim.
@@ -153,9 +166,12 @@
                  (or (company-grab-symbol) 'stop)))
     (candidates (company-eclim--candidates arg))
     (meta (company-eclim--meta arg))
-    (duplicates t)
     ;; because "" doesn't return everything
-    (no-cache (equal arg ""))))
+    (no-cache (equal arg ""))
+    (crop (when (string-match "(" arg)
+            (substring arg 0 (match-beginning 0))))
+    (post-completion (when (string-match "([^)]" arg)
+                       (company-eclim--templatify arg)))))
 
 (provide 'company-eclim)
 ;;; company-eclim.el ends here

=== modified file 'packages/company/company-pkg.el'
--- a/packages/company/company-pkg.el   2013-03-19 14:45:31 +0000
+++ b/packages/company/company-pkg.el   2013-03-23 04:19:13 +0000
@@ -1,1 +1,1 @@
-(define-package "company" "0.6" "Modular in-buffer completion framework")
+(define-package "company" "0.6.1" "Modular in-buffer completion framework")

=== modified file 'packages/company/company-template.el'
--- a/packages/company/company-template.el      2013-03-19 03:47:51 +0000
+++ b/packages/company/company-template.el      2013-03-23 04:19:13 +0000
@@ -31,14 +31,12 @@
 
 (defvar company-template-nav-map
   (let ((keymap (make-sparse-keymap)))
-    (define-key keymap [remap forward-word] 'company-template-forward-field)
-    (define-key keymap [remap subword-forward] 'company-template-forward-field)
-    ;; M-n
+    (define-key keymap [tab] 'company-template-forward-field)
     keymap))
 
 ;; interactive 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defsubst company-template-templates-at (pos)
+(defun company-template-templates-at (pos)
   (let (os)
     (dolist (o (overlays-at pos))
       (when (overlay-get o 'company-template-fields)
@@ -53,19 +51,22 @@
 
 (defun company-template-forward-field ()
   (interactive)
-  (let* ((templates (company-template-templates-at (point)))
+  (let* ((start (point))
+         (templates (company-template-templates-at (point)))
          (minimum (apply 'max (mapcar 'overlay-end templates)))
-         (fields (apply 'append
-                        (mapcar (lambda (templ)
-                                  (overlay-get templ 'company-template-fields))
-                                templates))))
+         (fields (loop for templ in templates
+                       append (overlay-get templ 'company-template-fields))))
     (dolist (pos (mapcar 'overlay-start fields))
       (and pos
            (> pos (point))
            (< pos minimum)
            (setq minimum pos)))
     (push-mark)
-    (goto-char minimum)))
+    (goto-char minimum)
+    (let ((field (loop for ovl in (overlays-at start)
+                       when (overlay-get ovl 'company-template-parent)
+                       return ovl)))
+      (company-template-remove-field field))))
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -76,6 +77,7 @@
   (let ((ov (make-overlay beg end)))
     ;; (overlay-put ov 'face 'highlight)
     (overlay-put ov 'keymap company-template-nav-map)
+    (overlay-put ov 'priority 101)
     (overlay-put ov 'evaporate t)
     (push ov company-template--buffer-templates)
     (add-hook 'post-command-hook 'company-template-post-command nil t)
@@ -91,42 +93,47 @@
 (defun company-template-add-field (templ pos text)
   (assert templ)
   (save-excursion
-    ;; (goto-char pos)
-    (let ((ov (make-overlay pos pos))
-          (siblings (overlay-get templ 'company-template-fields))
-          (label (propertize text 'face 'company-template-field
-                             'company-template-parent templ)))
-      (overlay-put ov 'face 'highlight)
-      (add-text-properties 0 1 '(cursor t) label)
-      (overlay-put ov 'after-string label)
+    (save-excursion
+      (goto-char pos)
+      (insert text)
+      (when (> (point) (overlay-end templ))
+        (move-overlay templ (overlay-start templ) (point))))
+    (let ((ov (make-overlay pos (+ pos (length text))))
+          (siblings (overlay-get templ 'company-template-fields)))
       ;; (overlay-put ov 'evaporate t)
       (overlay-put ov 'intangible t)
+      (overlay-put ov 'face 'company-template-field)
       (overlay-put ov 'company-template-parent templ)
-      (overlay-put ov 'insert-in-front-hooks '(company-template-remove))
+      (overlay-put ov 'insert-in-front-hooks '(company-template-insert-hook))
       (push ov siblings)
       (overlay-put templ 'company-template-fields siblings))))
 
-(defun company-template-remove-field (field)
-  (when (overlayp field)
-    ;; (delete-region (overlay-start field) (overlay-end field))
-    (delete-overlay field))
-  ;; TODO: unlink
-  )
+(defun company-template-remove-field (ovl &optional clear)
+  (when (overlayp ovl)
+    (when (overlay-buffer ovl)
+      (when clear
+        (delete-region (overlay-start ovl) (overlay-end ovl)))
+      (delete-overlay ovl))
+    (let* ((templ (overlay-get ovl 'company-template-parent))
+           (siblings (overlay-get templ 'company-template-fields)))
+      (setq siblings (delq ovl siblings))
+      (overlay-put templ 'company-template-fields siblings))))
 
 (defun company-template-clean-up (&optional pos)
   "Clean up all templates that don't contain POS."
   (unless pos (setq pos (point)))
   (let ((local-ovs (overlays-in (- pos 2) pos)))
     (dolist (templ company-template--buffer-templates)
-      (unless (memq templ local-ovs)
+      (unless (and (memq templ local-ovs)
+                   (overlay-get templ 'company-template-fields))
         (company-template-remove-template templ)))))
 
 ;; hooks 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defun company-template-remove (overlay after-p beg end &optional r)
+(defun company-template-insert-hook (ovl after-p &rest ignore)
   "Called when a snippet input prompt is modified."
-  (when after-p
-    (delete-overlay overlay)))
+  (unless after-p
+    (company-template-remove-field ovl t)))
 
 (defun company-template-post-command ()
   (company-template-clean-up)

=== modified file 'packages/company/company-tests.el'
--- a/packages/company/company-tests.el 2013-03-19 14:15:57 +0000
+++ b/packages/company/company-tests.el 2013-03-23 04:19:13 +0000
@@ -1,6 +1,6 @@
 ;;; company-tests.el --- company-mode tests
 
-;; Copyright (C) 2011  Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2013  Free Software Foundation, Inc.
 
 ;; Author: Nikolaj Schumacher
 
@@ -29,7 +29,7 @@
 (require 'company)
 (require 'company-keywords)
 
-(ert-deftest sorted-keywords ()
+(ert-deftest company-sorted-keywords ()
   "Test that keywords in `company-keywords-alist' are in alphabetical order."
   (dolist (pair company-keywords-alist)
     (when (consp (cdr pair))
@@ -38,3 +38,39 @@
           (should (not (equal prev next)))
           (should (string< prev next))
           (setq prev next))))))
+
+(ert-deftest company-good-prefix ()
+  (let ((company-minimum-prefix-length 5)
+        company--explicit-action)
+    (should (eq t (company--good-prefix-p "address@hidden")))
+    (should (eq nil (company--good-prefix-p "abcd")))
+    (should (eq nil (company--good-prefix-p 'stop)))
+    (should (eq t (company--good-prefix-p '("foo" . 5))))
+    (should (eq nil (company--good-prefix-p '("foo" . 4))))))
+
+(ert-deftest company-multi-backend-with-lambdas ()
+  (let ((company-backend
+         (list (lambda (command &optional arg &rest ignore)
+                 (case command
+                   (prefix "z")
+                   (candidates '("a" "b"))))
+               (lambda (command &optional arg &rest ignore)
+                 (case command
+                   (prefix "z")
+                   (candidates '("c" "d")))))))
+    (should (equal (company-call-backend 'candidates "z") '("a" "b" "c" 
"d")))))
+
+(ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
+  (with-temp-buffer
+    (insert "a")
+    (company-mode)
+    (should-error
+     (company-begin-backend (lambda (command &rest ignore))))
+    (let ((company-backends
+           (list (lambda (command &optional arg)
+                   (case command
+                     (prefix "a")
+                     (candidates '("a" "ab" "ac")))))))
+      (company-complete)
+      (setq this-command 'company-complete)
+      (should (eq 3 company-candidates-length)))))

=== modified file 'packages/company/company.el'
--- a/packages/company/company.el       2013-03-19 14:45:31 +0000
+++ b/packages/company/company.el       2013-03-23 04:19:13 +0000
@@ -4,7 +4,7 @@
 
 ;; Author: Nikolaj Schumacher
 ;; Maintainer: Dmitry Gutov <address@hidden>
-;; Version: 0.6
+;; Version: 0.6.1
 ;; Keywords: abbrev, convenience, matching
 ;; URL: http://company-mode.github.com/
 ;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x, GNU Emacs 24.x
@@ -65,93 +65,7 @@
 ;;
 ;;; Change Log:
 ;;
-;; 2013-03-19 (0.6)
-;;    Switching between tag files now works correctly with `company-etags'.
-;;    Clang completions now include macros and are case-sensitive.
-;;    Added `company-capf': completion adapter using
-;;    `completion-at-point-functions'.  (Stefan Monnier)
-;;    `company-elisp' has some improvements.
-;;    Instead of `overrriding-terminal-local-map', we're now using
-;;    `emulation-mode-map-alists' (experimental).  This largely means that when
-;;    the completion keymap is active, other minor modes' keymaps are still
-;;    used, so, for example, it's not as easy to circumvent `paredit-mode'
-;;    accidentally when it's enabled.
-;;    Fixed two old tooltip annoyances.
-;;    Some performance improvements.
-;;    `company-clang' now shows meta information, too.
-;;    Candidates from grouped back-ends are merged more conservatively: only
-;;    back-ends that return the same prefix at point are used.
-;;    Loading of `nxml', `semantic', `pymacs' and `ropemacs' is now deferred.
-;;    `company-pysmell' is not used by default anymore.
-;;    Across-the-board bugfixing.
-;;
-;; 2010-02-24 (0.5)
-;;    `company-ropemacs' now provides location and docs.  (Fernando H. Silva)
-;;    Added `company-with-candidate-inserted' macro.
-;;    Added `company-clang' back-end.
-;;    Added new mechanism for non-consecutive insertion.
-;;      (So far only used by clang for ObjC.)
-;;    The semantic back-end now shows meta information for local symbols.
-;;    Added compatibility for CEDET in Emacs 23.2 and from CVS.  (Oleg Andreev)
-;;
-;; 2009-05-07 (0.4.3)
-;;    Added `company-other-backend'.
-;;    Idle completion no longer interrupts multi-key command input.
-;;    Added `company-ropemacs' and `company-pysmell' back-ends.
-;;
-;; 2009-04-25 (0.4.2)
-;;    In C modes . and -> now count towards `company-minimum-prefix-length'.
-;;    Reverted default front-end back to 
`company-preview-if-just-one-frontend'.
-;;    The pseudo tooltip will no longer be clipped at the right window edge.
-;;    Added `company-tooltip-minimum'.
-;;    Windows compatibility fixes.
-;;
-;; 2009-04-19 (0.4.1)
-;;    Added `global-company-mode'.
-;;    Performance enhancements.
-;;    Added `company-eclim' back-end.
-;;    Added safer workaround for Emacs `posn-col-row' bug.
-;;
-;; 2009-04-18 (0.4)
-;;    Automatic completion is now aborted if the prefix gets too short.
-;;    Added option `company-dabbrev-time-limit'.
-;;    `company-backends' now supports merging back-ends.
-;;    Added back-end `company-dabbrev-code' for generic code.
-;;    Fixed `company-begin-with'.
-;;
-;; 2009-04-15 (0.3.1)
-;;    Added 'stop prefix to prevent dabbrev from completing inside of symbols.
-;;    Fixed issues with tabbar-mode and line-spacing.
-;;    Performance enhancements.
-;;
-;; 2009-04-12 (0.3)
-;;    Added `company-begin-commands' option.
-;;    Added abbrev, tempo and Xcode back-ends.
-;;    Back-ends are now interactive.  You can start them with M-x backend-name.
-;;    Added `company-begin-with' for starting company from elisp-code.
-;;    Added hooks.
-;;    Added `company-require-match' and `company-auto-complete' options.
-;;
-;; 2009-04-05 (0.2.1)
-;;    Improved Emacs Lisp back-end behavior for local variables.
-;;    Added `company-elisp-detect-function-context' option.
-;;    The mouse can now be used for selection.
-;;
-;; 2009-03-22 (0.2)
-;;    Added `company-show-location'.
-;;    Added etags back-end.
-;;    Added work-around for end-of-buffer bug.
-;;    Added `company-filter-candidates'.
-;;    More local Lisp variables are now included in the candidates.
-;;
-;; 2009-03-21 (0.1.5)
-;;    Fixed elisp documentation buffer always showing the same doc.
-;;    Added `company-echo-strip-common-frontend'.
-;;    Added `company-show-numbers' option and M-0 ... M-9 default bindings.
-;;    Don't hide the echo message if it isn't shown.
-;;
-;; 2009-03-20 (0.1)
-;;    Initial release.
+;; See NEWS.md in the repository.
 
 ;;; Code:
 
@@ -406,6 +320,14 @@
 user that choice with `company-require-match'.  Return value 'never overrides
 that option the other way around.
 
+`init': Called once for each buffer, the back-end can check for external
+programs and files and load any required libraries.  Raising an error here will
+show up in message log once, and the backend will not be used for completion.
+
+`post-completion': Called after a completion candidate has been inserted into
+the buffer.  The second argument is the candidate.  Can be used to modify it,
+e.g. to expand a snippet.
+
 The back-end should return nil for all commands it does not support or
 does not know about.  It should also be callable interactively and use
 `company-begin-backend' to start itself in that case."
@@ -544,8 +466,8 @@
     (define-key keymap "\C-g" 'company-abort)
     (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)
-    (define-key keymap (kbd "<up>") '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 [down-mouse-1] 'ignore)
     (define-key keymap [down-mouse-3] 'ignore)
     (define-key keymap [mouse-1] 'company-complete-mouse)
@@ -733,14 +655,16 @@
     (apply 'company--multi-backend-adapter company-backend args)))
 
 (defun company--multi-backend-adapter (backends command &rest args)
-  (let ((backends (remove-if (lambda (b) (eq 'failed (get b 'company-init)))
+  (let ((backends (remove-if (lambda (b)
+                               (and (symbolp b)
+                                    (eq 'failed (get b 'company-init))))
                              backends)))
     (case command
       (candidates
        (loop for backend in backends
              when (equal (funcall backend 'prefix)
                          (car args))
-             nconc (apply backend 'candidates args)))
+             append (apply backend 'candidates args)))
       (sorted nil)
       (duplicates t)
       (otherwise
@@ -782,6 +706,10 @@
   "Non-nil, if explicit completion took place.")
 (make-variable-buffer-local 'company--explicit-action)
 
+(defvar company--auto-completion nil
+  "Non-nil when current candidate is being completed automatically.
+Controlled by `company-auto-complete'.")
+
 (defvar company--point-max nil)
 (make-variable-buffer-local 'company--point-max)
 
@@ -873,10 +801,15 @@
   (push (cons company-prefix company-candidates) company-candidates-cache)
   ;; Calculate common.
   (let ((completion-ignore-case (company-call-backend 'ignore-case)))
-    (setq company-common (try-completion company-prefix company-candidates)))
+    (setq company-common (company--safe-candidate
+                          (try-completion company-prefix company-candidates))))
   (when (eq company-common t)
     (setq company-candidates nil)))
 
+(defun company--safe-candidate (str)
+  (or (company-call-backend 'crop str)
+      str))
+
 (defun company-calculate-candidates (prefix)
   (let ((candidates (cdr (assoc prefix company-candidates-cache)))
         (ignore-case (company-call-backend 'ignore-case)))
@@ -909,9 +842,9 @@
              (or (cdr candidates)
                  (not (eq t (compare-strings (car candidates) nil nil
                                              prefix nil nil ignore-case)))))
-        ;; Don't start when already completed and unique.
         candidates
-      ;; Not the right place? maybe when setting?
+      ;; Already completed and unique; don't start.
+      ;; FIXME: Not the right place? maybe when setting?
       (and company-candidates t))))
 
 (defun company-idle-begin (buf win tick pos)
@@ -1006,7 +939,8 @@
         ;; auto-complete
         (save-excursion
           (goto-char company-point)
-          (company-complete-selection)
+          (let ((company--auto-completion t))
+            (company-complete-selection))
           nil))
        ((and (company--string-incremental-p company-prefix new-prefix)
              (company-require-match-p))
@@ -1022,8 +956,9 @@
 
 (defun company--good-prefix-p (prefix)
   (and (or (company-explicit-action-p)
-           (>= (or (cdr-safe prefix) (length prefix))
-               company-minimum-prefix-length))
+           (unless (eq prefix 'stop)
+             (>= (or (cdr-safe prefix) (length prefix))
+                 company-minimum-prefix-length)))
        (stringp (or (car-safe prefix) prefix))))
 
 (defun company--continue ()
@@ -1277,9 +1212,7 @@
   (interactive)
   (company-search-assert-enabled)
   (company-search-mode 0)
-  (when last-input-event
-    (clear-this-command-keys t)
-    (setq unread-command-events (list last-input-event))))
+  (company--unread-last-input))
 
 (defvar company-search-map
   (let ((i 0)
@@ -1288,7 +1221,7 @@
         (set-char-table-range (nth 1 keymap) (cons #x100 (max-char))
                               'company-search-printing-char)
       (with-no-warnings
-        ;; obselete in Emacs 23
+        ;; obsolete in Emacs 23
         (let ((l (generic-character-list))
               (table (nth 1 keymap)))
           (while l
@@ -1383,6 +1316,24 @@
   (when (company-manual-begin)
     (company-set-selection (1- company-selection))))
 
+(defun company-select-next-or-abort ()
+  "Select the next candidate if more than one, else abort
+and invoke the normal binding."
+  (interactive)
+  (if (> company-candidates-length 1)
+      (company-select-next)
+    (company-abort)
+    (company--unread-last-input)))
+
+(defun company-select-previous-or-abort ()
+  "Select the previous candidate if more than one, else abort
+and invoke the normal binding."
+  (interactive)
+  (if (> company-candidates-length 1)
+      (company-select-previous)
+    (company-abort)
+    (company--unread-last-input)))
+
 (defun company-select-mouse (event)
   "Select the candidate picked by the mouse."
   (interactive "e")
@@ -1402,7 +1353,10 @@
   "Complete the selected candidate."
   (interactive)
   (when (company-manual-begin)
-    (company-finish (nth company-selection company-candidates))))
+    (let ((result (nth company-selection company-candidates)))
+      (when company--auto-completion
+        (setq result (company--safe-candidate result)))
+      (company-finish result))))
 
 (defun company-complete-common ()
   "Complete the common part of all candidates."
@@ -1501,9 +1455,12 @@
          (while (memq (setq cmd (key-binding (vector (list (read-event)))))
                       company--electric-commands)
            (call-interactively cmd))
-         (when last-input-event
-           (clear-this-command-keys t)
-           (setq unread-command-events (list last-input-event)))))))
+         (company--unread-last-input)))))
+
+(defun company--unread-last-input ()
+  (when last-input-event
+    (clear-this-command-keys t)
+    (setq unread-command-events (list last-input-event))))
 
 (defun company-show-doc-buffer ()
   "Temporarily show a buffer with the complete documentation for the 
selection."
@@ -1565,7 +1522,9 @@
   (setq company-backend backend)
   ;; Return non-nil if active.
   (or (company-manual-begin)
-      (error "Cannot complete at point")))
+      (progn
+        (setq company-backend nil)
+        (error "Cannot complete at point"))))
 
 (defun company-begin-with (candidates
                            &optional prefix-length require-match callback)
@@ -1819,8 +1778,7 @@
                             args))
 
         (overlay-put ov 'company-column column)
-        (overlay-put ov 'company-height (abs height))
-        (overlay-put ov 'window (selected-window))))))
+        (overlay-put ov 'company-height (abs height))))))
 
 (defun company-pseudo-tooltip-show-at-point (pos)
   (let ((col-row (company--col-row pos)))


reply via email to

[Prev in Thread] Current Thread [Next in Thread]