ycmd-eldoc.el

;;; ycmd-eldoc.el --- Eldoc support for ycmd-mode    -*- lexical-binding: t; -*-

;; Copyright (C) 2016, 2017  Peter Vasil

;; Author: Peter Vasil <mail@petervasil.net>
;; URL: https://github.com/abingham/emacs-ycmd
;; Version: 0.2
;; Package-Requires: ((ycmd "1.3") (deferred "0.5.1") (s "1.11.0") (dash "2.13.0") (let-alist "1.0.5"))

;; This program 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.

;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; To use this package, add these lines to your init.el file:
;;
;;     (require 'ycmd-eldoc)
;;     (add-hook 'ycmd-mode-hook 'ycmd-eldoc-setup)
;;

;;; Code:

(eval-when-compile
  (require 'let-alist))
(require 'eldoc)
(require 'ycmd)
(require 'deferred)
(require 'dash)
(require 's)

(defgroup ycmd-eldoc nil
  "Eldoc support for `ycmd-mode'."
  :group 'ycmd
  :group 'eldoc)

(defcustom ycmd-eldoc-always-semantic-server-query-modes
  '(not c-mode c++-mode objc-mode)
  "Modes for which `ycmd-eldoc' always queries semantic completion.

If t, the ycmd server query is always semantic.  If a list, server
query is semantic for all `major-mode' symbols in that list.  If
the `car' of the list is `not', server query is sematic for all
`major-mode' symbols _not_ in that list.  If nil, the server query
is only semantic after a semantic trigger."
  :type 'list)

(defvar-local ycmd-eldoc--cache (make-vector 2 nil))

(defvar-local ycmd-eldoc--cached-get-type-command 'none)

(defun ycmd-eldoc--documentation-function ()
  "Eldoc function for `ycmd-mode'."
  (when (and ycmd-mode (not (ycmd-parsing-in-progress-p)))
    (deferred:$
      (ycmd-eldoc--check-if-semantic-completer-exists-for-mode)
      (deferred:nextc it
        (lambda (response)
          (when response
            (ycmd-eldoc--info-at-point))))
      (deferred:nextc it
        (lambda (text)
          (eldoc-message text))))
    ;; Don't show deferred object as ElDoc message
    nil))

(defun ycmd-eldoc--check-if-semantic-completer-exists-for-mode ()
  "Return a deferred object whose return value is t if semantic completer exists."
  (deferred:$
    (deferred:next
      (lambda ()
        (ycmd-semantic-completer-available-p)))
    (deferred:nextc it
      (lambda (response)
        (when (and response (eq response 'none))
          (message (concat "No semantic completer exists for major-mode: `%s'."
                           " Ycmd ELDoc mode disabled in current buffer.")
                   major-mode)
          (ycmd-eldoc-mode -1))
        (eq response t)))))

(defun ycmd-eldoc-always-semantic-server-query-p ()
  "Check whether server query should be semantic."
  (pcase ycmd-eldoc-always-semantic-server-query-modes
    (`t t)
    (`(not . ,modes) (not (memq major-mode modes)))
    (modes (memq major-mode modes))))

(defmacro ycmd-eldoc--with-point-at-func-name (body)
  "Move cursor to function name and evluate BODY."
  (declare (indent 0) (debug t))
  `(save-excursion
     (ycmd-eldoc--goto-func-name)
     ,body))

(defun ycmd-eldoc--info-at-point ()
  "Get function info at point."
  (let ((symbol (ycmd-eldoc--with-point-at-func-name (symbol-at-point))))
    (if (and symbol (eq symbol (aref ycmd-eldoc--cache 0)))
        (aref ycmd-eldoc--cache 1)
      (deferred:$
        (deferred:next
          (lambda ()
            (when symbol
              (ycmd-eldoc--with-point-at-func-name
                (let ((ycmd-force-semantic-completion
                       (or ycmd-force-semantic-completion
                           (ycmd-eldoc-always-semantic-server-query-p))))
                  (ycmd-with-handled-server-exceptions
                      (ycmd-get-completions)))))))
        (deferred:nextc it
          (lambda (completions)
            (-when-let (candidates (cdr (assq 'completions completions)))
              (ycmd-eldoc--generate-message
               (symbol-name symbol) candidates))))
        (deferred:nextc it
          (lambda (text)
            (or text (ycmd-eldoc--get-type))))
        (deferred:nextc it
          (lambda (text)
            (when text
              (setq text (ycmd--fontify-code text))
              (ycmd-eldoc--cache-store symbol text))))))))

(defun ycmd-eldoc--cache-store (symbol text)
  "Store SYMBOL and TEXT to `ycmd-eldoc--cache'."
  (aset ycmd-eldoc--cache 0 symbol)
  ;; Store text only if we have a symbol for lookup
  (aset ycmd-eldoc--cache 1 (and symbol text))
  text)

;; Source: https://github.com/racer-rust/emacs-racer/blob/master/racer.el
(defun ycmd-eldoc--goto-func-name ()
  "If point is inside a function call, move to the function name.
foo(bar, |baz); -> foo|(bar, baz);"
  (let ((last-paren-pos (nth 1 (syntax-ppss)))
        (start-pos (point)))
    (when last-paren-pos
      ;; Move to just before the last paren.
      (goto-char last-paren-pos)
      ;; If we're inside a round paren, we're inside a function call.
      (unless (looking-at "(")
        ;; Otherwise, return to our start position, as point may have been on a
        ;; function already:
        ;; foo|(bar, baz);
        (goto-char start-pos)))))

(defun ycmd-eldoc--generate-message (symbol result)
  "Generate eldoc message for SYMBOL from RESULT."
  (-when-let* ((filtered-list
                (--filter
                 (let-alist it
                   (and (s-equals? .insertion_text symbol)
                        (or (not .extra_menu_info)
                            (not (-contains?
                                  '("[ID]" "[File]" "[Dir]" "[File&Dir]")
                                  .extra_menu_info)))))
                 result))
               (item (car filtered-list))
               (msg (or (cdr (assq 'detailed_info item))
                        (cdr (assq 'extra_menu_info item)))))
    (unless (s-blank? msg)
      (car (s-split-up-to "\n" msg 1)))))

(defun ycmd-eldoc--get-type ()
  "Get type at current position."
  (when ycmd-eldoc--cached-get-type-command
    (deferred:$
      (ycmd-eldoc--get-type-command-deferred)
      (deferred:nextc it
        (lambda (cmd)
          (when cmd
            (ycmd-with-handled-server-exceptions (ycmd--command-request cmd)
              (pcase-let ((`(,msg . ,is-type-p) (ycmd--get-message response)))
                (when is-type-p msg)))))))))

(defun ycmd-eldoc--get-type-command-deferred ()
  "Return a deferred object with the chached GetType command.
REQUEST-DATA is plist returned from `ycmd--get-request-data'."
  (if (eq ycmd-eldoc--cached-get-type-command 'none)
      (ycmd-with-handled-server-exceptions
          (ycmd--request (make-ycmd-request-data
                          :handler "defined_subcommands"))
        (setq ycmd-eldoc--cached-get-type-command
              ;; If GetTypeImprecise exists, use it in favor of GetType
              ;; because it doesn't reparse the file
              (car (-intersection '("GetTypeImprecise" "GetType")
                                  response))))
    (deferred:next nil ycmd-eldoc--cached-get-type-command)))

;;;###autoload
(defun ycmd-eldoc-setup ()
  "Setup eldoc for `ycmd-mode'."
  (interactive)
  (ycmd-eldoc-mode +1))
(make-obsolete 'ycmd-eldoc-setup 'ycmd-eldoc-mode "0.2")

(defun ycmd-eldoc--teardown ()
  "Reset `ycmd-eldoc--cache'."
  (ycmd-eldoc--cache-store nil nil)
  (setq ycmd-eldoc--cached-get-type-command 'none))

;;;###autoload
(define-minor-mode ycmd-eldoc-mode
  "Toggle ycmd eldoc mode."
  :lighter ""
  (cond
   (ycmd-eldoc-mode
    ;; For emacs < 25.1 where `eldoc-documentation-function' defaults to
    ;; nil. See also https://github.com/abingham/emacs-ycmd/issues/409
    (or eldoc-documentation-function
        (setq-local eldoc-documentation-function #'ignore))
    (add-function :before-until (local 'eldoc-documentation-function)
                  #'ycmd-eldoc--documentation-function)
    (eldoc-mode +1)
    (add-hook 'ycmd-after-teardown-hook
              #'ycmd-eldoc--teardown nil 'local))
   (t
    (eldoc-mode -1)
    (remove-function (local 'eldoc-documentation-function)
                     #'ycmd-eldoc--documentation-function)
    (remove-hook 'ycmd-after-teardown-hook
                 #'ycmd-eldoc--teardown 'local)
    (ycmd-eldoc--teardown))))

(provide 'ycmd-eldoc)

;;; ycmd-eldoc.el ends here