code.delx.au - gnu-emacs-elpa/blob - company-yasnippet.el

   1 ;;; company-yasnippet.el --- company-mode completion backend for Yasnippet
   2
   3 ;; Copyright (C) 2014  Free Software Foundation, Inc.
   4
   5 ;; Author: Dmitry Gutov
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22
  23 ;;; Commentary:
  24 ;;
  25
  26 ;;; Code:
  27
  28 (require 'company)
  29 (require 'cl-lib)
  30
  31 (declare-function yas--table-hash "yasnippet")
  32 (declare-function yas--get-snippet-tables "yasnippet")
  33 (declare-function yas-expand-snippet "yasnippet")
  34 (declare-function yas--template-content "yasnippet")
  35 (declare-function yas--template-expand-env "yasnippet")
  36 (declare-function yas--warning "yasnippet")
  37
  38 (defun company-yasnippet--key-prefixes ()
  39   ;; Mostly copied from `yas--templates-for-key-at-point'.
  40   (defvar yas-key-syntaxes)
  41   (save-excursion
  42     (let ((original (point))
  43           (methods yas-key-syntaxes)
  44           prefixes
  45           method)
  46       (while methods
  47         (unless (eq method (car methods))
  48           (goto-char original))
  49         (setq method (car methods))
  50         (cond ((stringp method)
  51                (skip-syntax-backward method)
  52                (setq methods (cdr methods)))
  53               ((functionp method)
  54                (unless (eq (funcall method original)
  55                            'again)
  56                  (setq methods (cdr methods))))
  57               (t
  58                (setq methods (cdr methods))
  59                (yas--warning "Invalid element `%s' in `yas-key-syntaxes'" method)))
  60         (let ((prefix (buffer-substring-no-properties (point) original)))
  61           (unless (equal prefix (car prefixes))
  62             (push prefix prefixes))))
  63       prefixes)))
  64
  65 (defun company-yasnippet--candidates (prefix)
  66   ;; Process the prefixes in reverse: unlike Yasnippet, we look for prefix
  67   ;; matches, so the longest prefix with any matches should be the most useful.
  68   (cl-loop with tables = (yas--get-snippet-tables)
  69            for key-prefix in (company-yasnippet--key-prefixes)
  70            thereis (company-yasnippet--completions-for-prefix prefix
  71                                                               key-prefix
  72                                                               tables)))
  73
  74 (defun company-yasnippet--completions-for-prefix (prefix key-prefix tables)
  75   (cl-mapcan
  76    (lambda (table)
  77      (let ((keyhash (yas--table-hash table))
  78            res)
  79        (when keyhash
  80          (maphash
  81           (lambda (key value)
  82             (when (and (stringp key)
  83                        (string-prefix-p key-prefix key))
  84               (maphash
  85                (lambda (name template)
  86                  (push
  87                   (propertize (company-yasnippet--adjust-key key prefix key-prefix)
  88                               'yas-annotation name
  89                               'yas-template template
  90                               'yas-prefix-offset (- (length key-prefix)
  91                                                     (length prefix)))
  92                   res))
  93                value)))
  94           keyhash))
  95        res))
  96    tables))
  97
  98 (defun company-yasnippet--adjust-key (key prefix key-prefix)
  99   (let ((pl (length prefix))
 100         (kpl (length key-prefix)))
 101     (cond
 102      ((= pl kpl)
 103       key)
 104      ((> pl kpl)
 105       (concat (substring prefix 0 (- pl kpl)) key))
 106      (t
 107       (substring key (- kpl pl))))))
 108
 109 ;;;###autoload
 110 (defun company-yasnippet (command &optional arg &rest ignore)
 111   "`company-mode' backend for `yasnippet'.
 112
 113 This backend should be used with care, because as long as there are
 114 snippets defined for the current major mode, this backend will always
 115 shadow backends that come after it.  Recommended usages:
 116
 117 * In a buffer-local value of `company-backends', grouped with a backend or
 118   several that provide actual text completions.
 119
 120   (add-hook 'js-mode-hook
 121             (lambda ()
 122               (set (make-local-variable 'company-backends)
 123                    '((company-dabbrev-code company-yasnippet)))))
 124
 125 * After keyword `:with', grouped with other backends.
 126
 127   (push '(company-semantic :with company-yasnippet) company-backends)
 128
 129 * Not in `company-backends', just bound to a key.
 130
 131   (global-set-key (kbd \"C-c y\") 'company-yasnippet)
 132 "
 133   (interactive (list 'interactive))
 134   (cl-case command
 135     (interactive (company-begin-backend 'company-yasnippet))
 136     (prefix
 137      ;; Should probably use `yas--current-key', but that's bound to be slower.
 138      ;; How many trigger keys start with non-symbol characters anyway?
 139      (and (bound-and-true-p yas-minor-mode)
 140           (company-grab-symbol)))
 141     (annotation
 142      (concat
 143       (unless company-tooltip-align-annotations " -> ")
 144       (get-text-property 0 'yas-annotation arg)))
 145     (candidates (company-yasnippet--candidates arg))
 146     (post-completion
 147      (let ((template (get-text-property 0 'yas-template arg))
 148            (prefix-offset (get-text-property 0 'yas-prefix-offset arg)))
 149        (yas-expand-snippet (yas--template-content template)
 150                            (- (point) (length arg) prefix-offset)
 151                            (point)
 152                            (yas--template-expand-env template))))))
 153
 154 (provide 'company-yasnippet)
 155 ;;; company-yasnippet.el ends here