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 r398: company: Release 0.6.9


From: Dmitry Gutov
Subject: [ELPA-diffs] /srv/bzr/emacs/elpa r398: company: Release 0.6.9
Date: Fri, 10 May 2013 00:25:25 +0400
User-agent: Bazaar (2.6b2)

------------------------------------------------------------
revno: 398
committer: Dmitry Gutov <address@hidden>
branch nick: elpa
timestamp: Fri 2013-05-10 00:25:25 +0400
message:
  company: Release 0.6.9
  
  * `company-capf` respects `:exit-function` completion property.
  * `company-backends`: `prefix` command can return `t` in the cdr.
  * `company-clang-begin-after-member-access`: New option.
  * Mouse click outside the tooltip aborts completion.
  * `company-clang` uses standard input to pass the contents of current buffer 
to
    Clang 2.9+, otherwise saves the buffer and passes the path to the file.
  * `company-clang-auto-save` option has been removed.
  * Better interaction with `outline-minor-mode`.
  * `company-dabbrev-code` supports all `prog-mode` derivatives.
  
  Git commit 4c735454d91f9674da0ecea950504888b1e10ff7
added:
  packages/company/company-capf.el
modified:
  packages/company/README
  packages/company/company-clang.el
  packages/company/company-dabbrev-code.el
  packages/company/company-eclim.el
  packages/company/company-elisp.el
  packages/company/company-pkg.el
  packages/company/company-tests.el
  packages/company/company.el
=== modified file 'packages/company/README'
--- a/packages/company/README   2013-03-20 20:52:32 +0000
+++ b/packages/company/README   2013-05-09 20:25:25 +0000
@@ -1,3 +1,3 @@
 Company is a modular in-buffer completion framework.
 
-See http://company-mode.github.com/ for more information.
+See http://company-mode.github.io/ for more information.

=== added file 'packages/company/company-capf.el'
--- a/packages/company/company-capf.el  1970-01-01 00:00:00 +0000
+++ b/packages/company/company-capf.el  2013-05-09 20:25:25 +0000
@@ -0,0 +1,80 @@
+;;; company-capf.el --- company-mode completion-at-point-functions back-end 
-*- lexical-binding: t -*-
+
+;; Copyright (C) 2013  Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <address@hidden>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(defun company--capf-data ()
+  (let ((data (run-hook-wrapped 'completion-at-point-functions
+                                ;; Ignore misbehaving functions.
+                                #'completion--capf-wrapper 'optimist)))
+    (when (consp data) data)))
+
+(defun company-capf (command &optional arg &rest _args)
+  "`company-mode' back-end using `completion-at-point-functions'.
+Requires Emacs 24.1 or newer."
+  (interactive (list 'interactive))
+  (case command
+    (interactive (company-begin-backend 'company-capf))
+    (prefix
+     (let ((res (company--capf-data)))
+       (when res
+         (if (> (nth 2 res) (point))
+             'stop
+           (buffer-substring-no-properties (nth 1 res) (point))))))
+    (candidates
+     (let ((res (company--capf-data)))
+       (when res
+         (let* ((table (nth 3 res))
+                (pred (plist-get (nthcdr 4 res) :predicate))
+                (meta (completion-metadata
+                       (buffer-substring (nth 1 res) (nth 2 res))
+                       table pred))
+                (sortfun (cdr (assq 'display-sort-function meta)))
+                (candidates (all-completions arg table pred)))
+           (if sortfun (funcall sortfun candidates) candidates)))))
+    (sorted
+     (let ((res (company--capf-data)))
+       (when res
+         (let ((meta (completion-metadata
+                      (buffer-substring (nth 1 res) (nth 2 res))
+                      (nth 3 res) (plist-get (nthcdr 4 res) :predicate))))
+           (cdr (assq 'display-sort-function meta))))))
+    (duplicates nil)     ;Don't bother.
+    (no-cache t)         ;FIXME: Improve!
+    (meta nil)           ;FIXME: Return one-line docstring for `arg'.
+    (doc-buffer nil)     ;FIXME: Return help buffer for `arg'.
+    (location nil)       ;FIXME: Return (BUF . POS) or (FILE . LINENB) of 
`arg'.
+    (require-match nil)  ;Front-ends should also have a say in this.
+    (init nil)       ;Don't bother: plenty of other ways to initialize the 
code.
+    (post-completion
+     (let* ((res (company--capf-data))
+            (exit-function (plist-get (nthcdr 4 res) :exit-function)))
+       (if exit-function
+           (funcall exit-function arg 'finished))))
+    ))
+
+(provide 'company-capf)
+
+;;; company-capf.el ends here

=== modified file 'packages/company/company-clang.el'
--- a/packages/company/company-clang.el 2013-04-16 11:40:14 +0000
+++ b/packages/company/company-clang.el 2013-05-09 20:25:25 +0000
@@ -38,11 +38,12 @@
   "Location of clang executable."
   :type 'file)
 
-(defcustom company-clang-auto-save t
-  "Determines whether to save the buffer when retrieving completions.
-clang can only complete correctly when the buffer has been saved."
-  :type '(choice (const :tag "Off" nil)
-                 (const :tag "On" t)))
+(defcustom company-clang-begin-after-member-access t
+  "When non-nil, automatic completion will start whenever the current symbol is
+preceded by \".\", \"->\" or \"::\", ignoring `company-minimum-prefix-length'.
+
+If `company-begin-commands' is a list, it should include `c-electric-lt-gt' and
+`c-electric-colon', for automatic completion right after \">\" and \":\".")
 
 (defcustom company-clang-arguments nil
   "Additional arguments to pass to clang when completing.
@@ -109,6 +110,12 @@
 
 (defvar company-clang--meta-cache nil)
 
+(defun company-clang--lang-option ()
+     (if (eq major-mode 'objc-mode)
+         (if (string= "m" (file-name-extension buffer-file-name))
+             "objective-c" "objective-c++")
+       (substring (symbol-name major-mode) 0 -5)))
+
 (defun company-clang--parse-output (prefix objc)
   (goto-char (point-min))
   (let ((pattern (format company-clang--completion-pattern
@@ -142,7 +149,7 @@
          (err (if (re-search-forward pattern nil t)
                   (buffer-substring-no-properties (point-min)
                                                   (1- (match-beginning 0)))
-                ;; Warn the user more agressively if no match was found.
+                ;; Warn the user more aggressively if no match was found.
                 (message "clang failed with error %d:\n%s" res cmd)
                 (buffer-string))))
 
@@ -157,31 +164,41 @@
         (goto-char (point-min))))))
 
 (defun company-clang--call-process (prefix &rest args)
-  (let ((objc (derived-mode-p 'objc-mode)))
-    (with-temp-buffer
-      (let ((res (apply 'call-process company-clang-executable nil t nil 
args)))
-        (unless (eq 0 res)
-          (company-clang--handle-error res args))
-        ;; Still try to get any useful input.
-        (company-clang--parse-output prefix objc)))))
+  (let ((objc (derived-mode-p 'objc-mode))
+        (buf (get-buffer-create "*clang-output*"))
+        res)
+    (with-current-buffer buf (erase-buffer))
+    (setq res (if (company-clang--auto-save-p)
+                  (apply 'call-process company-clang-executable nil buf nil 
args)
+                (apply 'call-process-region (point-min) (point-max)
+                       company-clang-executable nil buf nil args)))
+    (with-current-buffer buf
+      (unless (eq 0 res)
+        (company-clang--handle-error res args))
+      ;; Still try to get any useful input.
+      (company-clang--parse-output prefix objc))))
 
 (defsubst company-clang--build-location (pos)
   (save-excursion
     (goto-char pos)
-    (format "%s:%d:%d" buffer-file-name (line-number-at-pos)
+    (format "%s:%d:%d"
+            (if (company-clang--auto-save-p) buffer-file-name "-")
+            (line-number-at-pos)
             (1+ (current-column)))))
 
 (defsubst company-clang--build-complete-args (pos)
   (append '("-cc1" "-fsyntax-only" "-code-completion-macros")
+          (unless (company-clang--auto-save-p)
+            (list "-x" (company-clang--lang-option)))
           company-clang-arguments
           (when (stringp company-clang--prefix)
             (list "-include" (expand-file-name company-clang--prefix)))
           '("-code-completion-at")
           (list (company-clang--build-location pos))
-          (list buffer-file-name)))
+          (list (if (company-clang--auto-save-p) buffer-file-name "-"))))
 
 (defun company-clang--candidates (prefix)
-  (and company-clang-auto-save
+  (and (company-clang--auto-save-p)
        (buffer-modified-p)
        (basic-save-buffer))
   (when (null company-clang--prefix)
@@ -191,10 +208,26 @@
          prefix
          (company-clang--build-complete-args (- (point) (length prefix)))))
 
+(defun company-clang--prefix ()
+  (let ((symbol (company-grab-symbol)))
+    (if symbol
+        (if (and company-clang-begin-after-member-access
+                 (save-excursion
+                   (forward-char (- (length symbol)))
+                   (looking-back "\\.\\|->\\|::" (- (point) 2))))
+            (cons symbol t)
+          symbol)
+      'stop)))
+
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defconst company-clang-required-version 1.1)
 
+(defvar company-clang--version nil)
+
+(defun company-clang--auto-save-p ()
+  (< company-clang--version 2.9))
+
 (defsubst company-clang-version ()
   "Return the version of `company-clang-executable'."
   (with-temp-buffer
@@ -232,21 +265,23 @@
 with `company-clang-set-prefix' or automatically through a custom
 `company-clang-prefix-guesser'.
 
-Completions only work correctly when the buffer has been saved.
-`company-clang-auto-save' determines whether to do this automatically."
+With Clang versions before 2.9, we have to save the buffer before performing
+completion.  With Clang 2.9 and later, buffer contents are passed via standard
+input."
   (interactive (list 'interactive))
   (case command
     (interactive (company-begin-backend 'company-clang))
     (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)
+            (setq company-clang--version (company-clang-version))
+            (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
                  (not (company-in-string-or-comment))
-                 (or (company-grab-symbol) 'stop)))
+                 (company-clang--prefix)))
     (candidates (company-clang--candidates arg))
     (meta (gethash arg company-clang--meta-cache))
     (crop (and (string-match ":\\|(" arg)

=== modified file 'packages/company/company-dabbrev-code.el'
--- a/packages/company/company-dabbrev-code.el  2013-04-16 11:40:14 +0000
+++ b/packages/company/company-dabbrev-code.el  2013-05-09 20:25:25 +0000
@@ -35,10 +35,9 @@
 
 (defcustom company-dabbrev-code-modes
   '(asm-mode batch-file-mode c++-mode c-mode cperl-mode csharp-mode css-mode
-    emacs-lisp-mode erlang-mode espresso-mode f90-mode fortran-mode
-    haskell-mode java-mode javascript-mode jde-mode js2-mode lisp-mode
-    lua-mode objc-mode perl-mode php-mode python-mode ruby-mode scheme-mode
-    shell-script-mode)
+    emacs-lisp-mode erlang-mode f90-mode fortran-mode haskell-mode java-mode
+    javascript-mode jde-mode js2-mode lisp-mode lua-mode objc-mode perl-mode
+    php-mode prog-mode python-mode ruby-mode scheme-mode shell-script-mode)
   "Modes that use `company-dabbrev-code'.
 In all these modes `company-dabbrev-code' will complete only symbols, not text
 in comments or strings.  In other modes `company-dabbrev-code' will pass 
control

=== modified file 'packages/company/company-eclim.el'
--- a/packages/company/company-eclim.el 2013-04-16 11:40:14 +0000
+++ b/packages/company/company-eclim.el 2013-05-09 20:25:25 +0000
@@ -69,6 +69,8 @@
 (defvar company-eclim--doc nil)
 (make-variable-buffer-local 'company-eclim--doc)
 
+(declare-function json-read "json")
+
 (defun company-eclim--call-process (&rest args)
   (let ((coding-system-for-read 'utf-8)
         res)

=== modified file 'packages/company/company-elisp.el'
--- a/packages/company/company-elisp.el 2013-04-16 11:40:14 +0000
+++ b/packages/company/company-elisp.el 2013-05-09 20:25:25 +0000
@@ -111,7 +111,7 @@
         res)
     (condition-case nil
         (save-excursion
-          (dotimes (i company-elisp-parse-depth)
+          (dotimes (_ company-elisp-parse-depth)
             (up-list -1)
             (save-excursion
               (when (eq (char-after) ?\()
@@ -126,7 +126,7 @@
                                   company-elisp-var-binding-regexp))
                     (down-list 1)
                     (condition-case nil
-                        (dotimes (i company-elisp-parse-limit)
+                        (dotimes (_ company-elisp-parse-limit)
                           (save-excursion
                             (when (looking-at "[ \t\n]*(")
                               (down-list 1))

=== modified file 'packages/company/company-pkg.el'
--- a/packages/company/company-pkg.el   2013-04-16 11:40:14 +0000
+++ b/packages/company/company-pkg.el   2013-05-09 20:25:25 +0000
@@ -1,1 +1,1 @@
-(define-package "company" "0.6.8" "Modular in-buffer completion framework")
+(define-package "company" "0.6.9" "Modular in-buffer completion framework")

=== modified file 'packages/company/company-tests.el'
--- a/packages/company/company-tests.el 2013-04-16 11:40:14 +0000
+++ b/packages/company/company-tests.el 2013-05-09 20:25:25 +0000
@@ -25,9 +25,12 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
 (require 'ert)
 (require 'company)
 (require 'company-keywords)
+(require 'company-elisp)
+(require 'company-clang)
 
 ;;; Core
 
@@ -160,6 +163,7 @@
       (should (null (company-explicit-action-p))))))
 
 (ert-deftest company-pseudo-tooltip-does-not-get-displaced ()
+  :tags '(interactive)
   (with-temp-buffer
     (save-window-excursion
       (set-window-buffer nil (current-buffer))
@@ -175,6 +179,34 @@
         (company-call 'open-line 1)
         (should (eq 2 (overlay-start company-pseudo-tooltip-overlay)))))))
 
+(defun company-test-pseudo-tooltip-overlay-show ()
+  (save-window-excursion
+    (set-window-buffer nil (current-buffer))
+    (insert "aaaa\n bb\nccccc\nddd")
+    (search-backward "bb")
+    (let ((col-row (company--col-row))
+          (company-candidates-length 2)
+          (company-candidates '("123" "45")))
+      (company-pseudo-tooltip-show (cdr col-row) (car col-row) 0)
+      (let ((ov company-pseudo-tooltip-overlay))
+        (should (eq (overlay-get ov 'company-width) 3))
+        ;; FIXME: Make it 2?
+        (should (eq (overlay-get ov 'company-height) 10))
+        (should (eq (overlay-get ov 'company-column) (car col-row)))
+        (should (string= (overlay-get ov 'company-before)
+                         " 123\nc45 c\nddd\n"))))))
+
+(ert-deftest company-pseudo-tooltip-overlay-show ()
+  :tags '(interactive)
+  (with-temp-buffer
+    (company-test-pseudo-tooltip-overlay-show)))
+
+(ert-deftest company-pseudo-tooltip-overlay-show-with-header-line ()
+  :tags '(interactive)
+  (with-temp-buffer
+    (setq header-line-format "foo bar")
+    (company-test-pseudo-tooltip-overlay-show)))
+
 ;;; Template
 
 (ert-deftest company-template-removed-after-the-last-jump ()

=== modified file 'packages/company/company.el'
--- a/packages/company/company.el       2013-04-27 13:48:47 +0000
+++ b/packages/company/company.el       2013-05-09 20:25:25 +0000
@@ -4,9 +4,9 @@
 
 ;; Author: Nikolaj Schumacher
 ;; Maintainer: Dmitry Gutov <address@hidden>
-;; Version: 0.6.8
+;; Version: 0.6.9
 ;; Keywords: abbrev, convenience, matching
-;; URL: http://company-mode.github.com/
+;; URL: http://company-mode.github.io/
 ;; Compatibility: GNU Emacs 22.x, GNU Emacs 23.x, GNU Emacs 24.x
 
 ;; This file is part of GNU Emacs.
@@ -48,11 +48,11 @@
 ;; Here is a simple example completing "foo":
 ;;
 ;; (defun company-my-backend (command &optional arg &rest ignored)
-;;   (pcase command
-;;     (`prefix (when (looking-back "foo\\>")
+;;   (case command
+;;     (prefix (when (looking-back "foo\\>")
 ;;               (match-string 0)))
-;;     (`candidates (list "foobar" "foobaz" "foobarbaz"))
-;;     (`meta (format "This value is named %s" arg))))
+;;     (candidates (list "foobar" "foobaz" "foobarbaz"))
+;;     (meta (format "This value is named %s" arg))))
 ;;
 ;; Sometimes it is a good idea to mix several back-ends together, for example 
to
 ;; enrich gtags with dabbrev-code results (to emulate local variables).
@@ -213,6 +213,7 @@
 
 (defvar company-safe-backends
   '((company-abbrev . "Abbrev")
+    (company-capf . "completion-at-point-functions")
     (company-clang . "Clang")
     (company-css . "CSS")
     (company-dabbrev . "dabbrev for plain text")
@@ -241,56 +242,6 @@
                         (assq backend company-safe-backends))
                 (return t))))))
 
-(defun company--capf-data ()
-  (let ((data (run-hook-wrapped 'completion-at-point-functions
-                                ;; Ignore misbehaving functions.
-                                #'completion--capf-wrapper 'optimist)))
-    (when (consp data) data)))
-
-(defun company-capf (command &optional arg &rest _args)
-  "`company-mode' back-end using `completion-at-point-functions'.
-Requires Emacs 24.1 or newer."
-  (interactive (list 'interactive))
-  (case command
-    (interactive (company-begin-backend 'company-capf))
-    (prefix
-     (let ((res (company--capf-data)))
-       (when res
-         (if (> (nth 2 res) (point))
-             'stop
-           (buffer-substring-no-properties (nth 1 res) (point))))))
-    (candidates
-     (let ((res (company--capf-data)))
-       (when res
-         (let* ((table (nth 3 res))
-                (pred (plist-get (nthcdr 4 res) :predicate))
-                (meta (completion-metadata
-                      (buffer-substring (nth 1 res) (nth 2 res))
-                      table pred))
-                (sortfun (cdr (assq 'display-sort-function meta)))
-                (candidates (all-completions arg table pred)))
-           (if sortfun (funcall sortfun candidates) candidates)))))
-    (sorted
-     (let ((res (company--capf-data)))
-       (when res
-         (let ((meta (completion-metadata
-                      (buffer-substring (nth 1 res) (nth 2 res))
-                      (nth 3 res) (plist-get (nthcdr 4 res) :predicate))))
-           (cdr (assq 'display-sort-function meta))))))
-    (duplicates nil) ;Don't bother.
-    (no-cache t)     ;FIXME: Improve!
-    (meta nil)       ;FIXME: Return one-line docstring for `arg'.
-    (doc-buffer nil) ;FIXME: Return help buffer for `arg'.
-    (location nil)   ;FIXME: Return (BUF . POS) or (FILE . LINENB) of `arg'.
-    (require-match nil)            ;This should be a property of the front-end!
-    (init nil)      ;Don't bother: plenty of other ways to initialize the code.
-    (post-completion
-     (let* ((res (company--capf-data))
-            (exit-function (plist-get (nthcdr 4 res) :exit-function)))
-       (if exit-function
-           (funcall exit-function arg 'finished))))
-    ))
-
 (defcustom company-backends '(company-elisp company-nxml company-css
                               company-semantic company-clang company-eclim
                               company-xcode company-ropemacs
@@ -309,13 +260,12 @@
 The first argument is the command requested from the back-end.  It is one
 of the following:
 
-`prefix': The back-end should return the text to be completed.  It must be
-text immediately before point.  Returning nil passes control to the next
-back-end.  The function should return `stop' if it should complete but cannot
-\(e.g. if it is in the middle of a string\).  If the returned value is only
-part of the prefix (e.g. the part after \"->\" in C), the back-end may return a
-cons of prefix and prefix length, which is then used in the
-`company-minimum-prefix-length' test.
+`prefix': The back-end should return the text to be completed.  It must be text
+immediately before point.  Returning nil passes control to the next back-end.
+The function should return `stop' if it should complete but cannot \(e.g. if it
+is in the middle of a string\).  Instead of a string, the back-end may return a
+cons where car is the prefix and cdr is used in `company-minimum-prefix-length'
+test. It's either number or t, in which case the test automatically succeeds.
 
 `candidates': The second argument is the prefix to be completed.  The
 return value should be a list of candidates that start with the prefix.
@@ -635,6 +585,9 @@
 
 ;;; backends 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defvar company-backend nil)
+(make-variable-buffer-local 'company-backend)
+
 (defun company-grab (regexp &optional expression limit)
   (when (looking-back regexp limit)
     (or (match-string-no-properties (or expression 0)) "")))
@@ -674,8 +627,6 @@
           (setq prev-dir dir
                 dir (file-name-directory (directory-file-name dir))))))))
 
-(defvar company-backend)
-
 (defun company-call-backend (&rest args)
   (if (functionp company-backend)
       (apply company-backend args)
@@ -702,9 +653,6 @@
 
 ;;; completion mechanism 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defvar company-backend nil)
-(make-variable-buffer-local 'company-backend)
-
 (defvar company-prefix nil)
 (make-variable-buffer-local 'company-prefix)
 
@@ -982,8 +930,9 @@
 (defun company--good-prefix-p (prefix)
   (and (or (company-explicit-action-p)
            (unless (eq prefix 'stop)
-             (>= (or (cdr-safe prefix) (length prefix))
-                 company-minimum-prefix-length)))
+             (or (eq (cdr-safe prefix) t)
+                 (>= (or (cdr-safe prefix) (length prefix))
+                     company-minimum-prefix-length))))
        (stringp (or (car-safe prefix) prefix))))
 
 (defun company--continue ()
@@ -1359,14 +1308,48 @@
     (company-abort)
     (company--unread-last-input)))
 
+(defvar company-pseudo-tooltip-overlay)
+
+(defvar company-tooltip-offset)
+
+(defun company--inside-tooltip-p (event-col-row row height)
+  (let* ((ovl company-pseudo-tooltip-overlay)
+         (column (overlay-get ovl 'company-column))
+         (width (overlay-get ovl 'company-width))
+         (evt-col (car event-col-row))
+         (evt-row (cdr event-col-row)))
+    (and (>= evt-col column)
+         (< evt-col (+ column width))
+         (if (> height 0)
+             (and (> evt-row row)
+                  (<= evt-row (+ row height) ))
+           (and (< evt-row row)
+                (>= evt-row (+ row height)))))))
+
 (defun company-select-mouse (event)
   "Select the candidate picked by the mouse."
   (interactive "e")
-  (when (nth 4 (event-start event))
-    (company-set-selection (- (cdr (posn-actual-col-row (event-start event)))
-                              (company--row)
-                              1))
-    t))
+  (let ((event-col-row (posn-actual-col-row (event-start event)))
+        (ovl-row (company--row))
+        (ovl-height (and company-pseudo-tooltip-overlay
+                         (min (overlay-get company-pseudo-tooltip-overlay
+                                           'company-height)
+                              company-candidates-length))))
+    (if (and ovl-height
+             (company--inside-tooltip-p event-col-row ovl-row ovl-height))
+        (progn
+          (company-set-selection (+ (cdr event-col-row)
+                                    (if (zerop company-tooltip-offset)
+                                        -1
+                                      (- company-tooltip-offset 2))
+                                    (- ovl-row)
+                                    (if (< ovl-height 0)
+                                        (- 1 ovl-height)
+                                      0)))
+          t)
+      (company-abort)
+      (company--unread-last-input)
+      nil)))
 
 (defun company-complete-mouse (event)
   "Complete the candidate picked by the mouse."
@@ -1562,18 +1545,19 @@
 
 Example:
 \(company-begin-with '\(\"foo\" \"foobar\" \"foobarbaz\"\)\)"
-  ;; FIXME: Shouldn't `company-begin-with-marker' be removed and replaced
-  ;; by a lexical variable?
+  ;; FIXME: When Emacs 23 is no longer a concern, replace
+  ;; `company-begin-with-marker' with a lexical variable; use a lexical 
closure.
   (setq company-begin-with-marker (copy-marker (point) t))
   (company-begin-backend
-   (lambda (command &optional arg &rest ignored)
-     (case command
-       (prefix
-       (when (equal (point) (marker-position company-begin-with-marker))
-         (buffer-substring (- company-begin-with-marker (or prefix-length 0))
-                           (point))))
-       (candidates (all-completions arg candidates))
-       (require-match require-match)))
+   `(lambda (command &optional arg &rest ignored)
+      (cond
+       ((eq command 'prefix)
+        (when (equal (point) (marker-position company-begin-with-marker))
+          (buffer-substring ,(- (point) (or prefix-length 0)) (point))))
+       ((eq command 'candidates)
+        (all-completions arg ',candidates))
+       ((eq command 'require-match)
+        ,require-match)))
    callback))
 
 ;;; pseudo-tooltip 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1654,12 +1638,13 @@
 (defun company-buffer-lines (beg end)
   (goto-char beg)
   (let (lines)
-    (while (and (= 1 (vertical-motion 1))
-                (<= (point) end))
-      (push (buffer-substring beg (min end (1- (point)))) lines)
-      (setq beg (point)))
-    (unless (eq beg end)
-      (push (buffer-substring beg end) lines))
+    (while (< (point) end)
+      (let ((bol (point)))
+        ;; A visual line can contain several physical lines (e.g. with 
outline's
+        ;; folding overlay).  Take only the first one.
+        (re-search-forward "$")
+        (push (buffer-substring bol (min end (point))) lines))
+      (vertical-motion 1))
     (nreverse lines)))
 
 (defsubst company-modify-line (old new offset)
@@ -1782,6 +1767,10 @@
     (let* ((height (company--pseudo-tooltip-height))
            above)
 
+      (when (and header-line-format
+                 (version< "24" emacs-version))
+        (decf row))
+
       (when (< height 0)
         (setq row (+ row height -1)
               above t))
@@ -1798,10 +1787,11 @@
 
         (setq company-pseudo-tooltip-overlay ov)
         (overlay-put ov 'company-replacement-args args)
-        (overlay-put ov 'company-before
-                     (apply 'company--replacement-string
-                            (company--create-lines selection (abs height))
-                            args))
+
+        (let ((lines (company--create-lines selection (abs height))))
+          (overlay-put ov 'company-before
+                       (apply 'company--replacement-string lines args))
+          (overlay-put ov 'company-width (string-width (car lines))))
 
         (overlay-put ov 'company-column column)
         (overlay-put ov 'company-height height)))))
@@ -1812,9 +1802,8 @@
       (company-pseudo-tooltip-show (1+ (cdr col-row)) (car col-row)
                                    company-selection))))
 
-(defun company-pseudo-tooltip-edit (_lines selection)
-  (let (;;(column (overlay-get company-pseudo-tooltip-overlay 'company-column))
-        (height (overlay-get company-pseudo-tooltip-overlay 'company-height)))
+(defun company-pseudo-tooltip-edit (selection)
+  (let ((height (overlay-get company-pseudo-tooltip-overlay 'company-height)))
     (overlay-put company-pseudo-tooltip-overlay 'company-before
                  (apply 'company--replacement-string
                         (company--create-lines selection (abs height))
@@ -1834,6 +1823,8 @@
 (defun company-pseudo-tooltip-unhide ()
   (when company-pseudo-tooltip-overlay
     (overlay-put company-pseudo-tooltip-overlay 'invisible t)
+    ;; Beat outline's folding overlays, at least.
+    (overlay-put company-pseudo-tooltip-overlay 'priority 1)
     (overlay-put company-pseudo-tooltip-overlay 'before-string
                  (overlay-get company-pseudo-tooltip-overlay 'company-before))
     (overlay-put company-pseudo-tooltip-overlay 'window (selected-window))))
@@ -1866,8 +1857,7 @@
     (hide (company-pseudo-tooltip-hide)
           (setq company-tooltip-offset 0))
     (update (when (overlayp company-pseudo-tooltip-overlay)
-              (company-pseudo-tooltip-edit company-candidates
-                                           company-selection)))))
+              (company-pseudo-tooltip-edit company-selection)))))
 
 (defun company-pseudo-tooltip-unless-just-one-frontend (command)
   "`company-pseudo-tooltip-frontend', but not shown for single candidates."


reply via email to

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