lisp/company-irony.el

   1 ;;; company-irony.el --- company-mode completion back-end for irony-mode  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014  Guillaume Papin
   4
   5 ;; Author: Guillaume Papin <guillaume.papin@epitech.eu>
   6 ;; Keywords: convenience
   7 ;; Version: 1.1.0
   8 ;; URL: https://github.com/Sarcasm/company-irony/
   9 ;; Package-Requires: ((emacs "24.1") (company "0.8.0") (irony "1.1.0") (cl-lib "0.5"))
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Usage:
  27 ;;
  28 ;;     (eval-after-load 'company
  29 ;;       '(add-to-list 'company-backends 'company-irony))
  30
  31 ;;; Code:
  32
  33 (require 'irony-completion)
  34
  35 (require 'company)
  36 (require 'company-template)
  37
  38 (require 'cl-lib)
  39
  40 (defgroup company-irony nil
  41   "Company-mode completion back-end for Irony."
  42   :group 'company
  43   :group 'irony)
  44
  45 (defcustom company-irony-ignore-case nil
  46   "If t, ignore case when collecting completion candidates.
  47 If this value is `smart', ignore case only when there is no
  48 uppercase letters."
  49   :type '(choice (const :tag "off" nil)
  50                  (const smart)
  51                  (other :tag "on" t)))
  52
  53 (defsubst company-irony--irony-candidate (candidate)
  54   (get-text-property 0 'company-irony candidate))
  55
  56 (defun company-irony-prefix ()
  57   (pcase-let ((`(,symbol-start . ,symbol-end) (irony-completion-symbol-bounds)))
  58     (if (and symbol-end (> symbol-end (point)))
  59         'stop
  60       (when symbol-start
  61         (let ((prefix (buffer-substring-no-properties symbol-start (point))))
  62           (save-excursion
  63             (goto-char symbol-start)
  64             (if (irony-completion-at-trigger-point-p)
  65                 (cons prefix t)
  66               prefix)))))))
  67
  68 (defun company-irony--make-candidates (candidates)
  69   (cl-loop for candidate in candidates
  70            collect (propertize (car candidate) 'company-irony candidate)))
  71
  72 (defun company-irony--get-matching-style ()
  73   (cl-case company-irony-ignore-case
  74     (smart 'smart-case)
  75     (nil 'exact)
  76     (t 'case-insensitive)))
  77
  78 (defun company-irony--candidates (prefix)
  79   (cons :async
  80         (lambda (callback)
  81           (irony-completion-candidates-async
  82            (lambda (candidates) ;; closure, lexically bound
  83              (funcall callback
  84                       (company-irony--make-candidates candidates)))
  85            prefix
  86            (company-irony--get-matching-style)))))
  87
  88 (defun company-irony--annotation (candidate)
  89   (concat
  90    (irony-completion-annotation candidate)
  91    (let ((type (irony-completion-type candidate)))
  92      (when (not (zerop (length type)))
  93        (concat " -> " type)))))
  94
  95 (defun company-irony--post-completion (candidate)
  96   ;; This check is necessary because Company triggers a 'post-completion even if
  97   ;; the candidate has just been typed without relying on the completion, but it
  98   ;; doesn't provide the full candidate information.
  99   (when candidate
 100     (let ((point-before-post-complete (point)))
 101       (if (irony-snippet-available-p)
 102           (irony-completion-post-complete candidate)
 103         (let ((str (irony-completion-post-comp-str candidate)))
 104           (insert str)
 105           (company-template-c-like-templatify str)))
 106       ;; Here we set this-command to a `self-insert-command' so that company may
 107       ;; retrigger idle completion after the snippet expansion
 108       ;; (~`company-post-command'). This is a bit of a hack and maybe that will
 109       ;; change in the future. This is useful for example when the completed
 110       ;; candidate is a namespace and the annotation text (inserted snippet) is
 111       ;; the scope operator.
 112       ;;
 113       ;; std| -> std::   (=> idle completion desired here)
 114       ;;         stderr
 115       ;;         ...
 116       ;;
 117       ;; See https://github.com/company-mode/company-mode/issues/143
 118       (unless (eq (point) point-before-post-complete)
 119         (setq this-command 'self-insert-command)))))
 120
 121 ;;;###autoload
 122 (defun company-irony (command &optional arg &rest ignored)
 123   (interactive (list 'interactive))
 124   (cl-case command
 125     (interactive (company-begin-backend 'company-irony))
 126     (prefix (and irony-mode (company-irony-prefix)))
 127     (candidates (company-irony--candidates arg))
 128     (annotation (company-irony--annotation
 129                  (company-irony--irony-candidate arg)))
 130     (meta (irony-completion-brief
 131            (company-irony--irony-candidate arg)))
 132     (post-completion (company-irony--post-completion
 133                       (company-irony--irony-candidate arg)))
 134     (ignore-case (eq company-irony-ignore-case t))
 135     (no-cache (eq company-irony-ignore-case 'smart))
 136     (sorted t)))
 137
 138 ;;;###autoload
 139 (defun company-irony-setup-begin-commands ()
 140   "Include irony trigger commands to `company-begin-commands'.
 141
 142 This allow completion to be automatically triggered after member
 143 accesses (obj.|, obj->|, ...).
 144
 145 This may be useful to company < `0.8.4', newer version of company
 146 include these commands by default."
 147   (if (listp company-begin-commands)
 148       (set (make-local-variable 'company-begin-commands)
 149            (delete-dups
 150             (append company-begin-commands irony-completion-trigger-commands)))
 151     (display-warning 'company-irony
 152                      "`company-irony-setup-begin-commands' expects \
 153 `company-begin-commands' to be a list!")))
 154
 155 (provide 'company-irony)
 156 ;;; company-irony.el ends here