[elpa] externals/company 4f3a74b 1/5: `company-select-mouse': per-frontend interface

[ELPA Syncer]

branch: externals/company
commit 4f3a74ba4f79e3c0fd78541e670d6b97ea934a09
Author: Nikita Bloshchanevich <nikblos@outlook.com>
Commit: Nikita Bloshchanevich <nikblos@outlook.com>

    `company-select-mouse': per-frontend interface
    
    `company-select-mouse' now delegates to `company-call-frontends' with
    `select-mouse'. If at least one frontend reports success (returns t), the
    candidate is considered selected. This allows other,
    `company-pseudo-tooltip-overlay'-like frontends (e.g. `company-box') to 
support
    mouse-selection.
    
    To implement this, refactor `company-call-frontends' to return t if at 
least one
    frontend did the same. The mouse event is passed trough the
    `company-mouse-event' global, which is `let'-bound in 
`company-select-mouse'.
    
    Fixes #1044.
---
 company.el | 82 +++++++++++++++++++++++++++++++++++---------------------------
 1 file changed, 46 insertions(+), 36 deletions(-)

diff --git a/company.el b/company.el
index 1bffc7a..ac38996 100644
--- a/company.el
+++ b/company.el
@@ -1188,11 +1188,14 @@ can retrieve meta-data for them."
                  (string-match-p "\\`company-" (symbol-name this-command)))))))
 
 (defun company-call-frontends (command)
-  (dolist (frontend company-frontends)
-    (condition-case-unless-debug err
-        (funcall frontend command)
-      (error (error "Company: frontend %s error \"%s\" on command %s"
-                    frontend (error-message-string err) command)))))
+  (let (success)
+    (dolist (frontend company-frontends)
+      (condition-case-unless-debug err
+          (when (funcall frontend command)
+            (setq success t))
+        (error (error "Company: frontend %s error \"%s\" on command %s"
+                      frontend (error-message-string err) command))))
+    success))
 
 (defun company-set-selection (selection &optional force-update)
   "Set SELECTION for company candidates.
@@ -2151,31 +2154,19 @@ With ARG, move by that many elements."
 (defun company--event-col-row (event)
   (company--posn-col-row (event-start event)))
 
+(defvar company-mouse-event nil
+  "Holds the mouse event from `company-select-mouse'.
+For use in the `select-mouse' frontend action.  `let'-bound.")
+
 (defun company-select-mouse (event)
   "Select the candidate picked by the mouse."
   (interactive "e")
-  (let ((event-col-row (company--event-col-row 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)
-                                    (1- company-tooltip-offset)
-                                    (if (and (eq 
company-tooltip-offset-display 'lines)
-                                             (not (zerop 
company-tooltip-offset)))
-                                        -1 0)
-                                    (- ovl-row)
-                                    (if (< ovl-height 0)
-                                        (- 1 ovl-height)
-                                      0)))
-          t)
-      (company-abort)
-      (company--unread-this-command-keys)
-      nil)))
+  (or (let ((company-mouse-event event))
+        (company-call-frontends 'select-mouse))
+      (progn
+        (company-abort)
+        (company--unread-this-command-keys)
+        nil)))
 
 (defun company-complete-mouse (event)
   "Insert the candidate picked by the mouse."
@@ -3066,14 +3057,14 @@ Returns a negative number if the tooltip should be 
displayed above point."
     (pre-command (company-pseudo-tooltip-hide-temporarily))
     (post-command
      (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)))))
+               (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
@@ -3083,7 +3074,26 @@ Returns a negative number if the tooltip should be 
displayed above point."
     (hide (company-pseudo-tooltip-hide)
           (setq company-tooltip-offset 0))
     (update (when (overlayp company-pseudo-tooltip-overlay)
-              (company-pseudo-tooltip-edit company-selection)))))
+              (company-pseudo-tooltip-edit company-selection)))
+    (select-mouse
+     (let ((event-col-row (company--event-col-row company-mouse-event))
+           (ovl-row (company--row))
+           (ovl-height (and company-pseudo-tooltip-overlay
+                            (min (overlay-get company-pseudo-tooltip-overlay
+                                              'company-height)
+                                 company-candidates-length))))
+       (cond ((and ovl-height
+                   (company--inside-tooltip-p event-col-row ovl-row 
ovl-height))
+              (company-set-selection (+ (cdr event-col-row)
+                                        (1- company-tooltip-offset)
+                                        (if (and (eq 
company-tooltip-offset-display 'lines)
+                                                 (not (zerop 
company-tooltip-offset)))
+                                            -1 0)
+                                        (- ovl-row)
+                                        (if (< ovl-height 0)
+                                            (- 1 ovl-height)
+                                          0)))
+              t))))))
 
 (defun company-pseudo-tooltip-unless-just-one-frontend (command)
   "`company-pseudo-tooltip-frontend', but not shown for single candidates."