dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

company-yasnippet.el (7112B)


      1 ;;; company-yasnippet.el --- company-mode completion backend for Yasnippet
      2 
      3 ;; Copyright (C) 2014-2015, 2020-2022  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 <https://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 (declare-function yas-minor-mode "yasnippet")
     38 (declare-function yas--require-template-specific-condition-p "yasnippet")
     39 (declare-function yas--template-can-expand-p "yasnippet")
     40 (declare-function yas--template-condition "yasnippet")
     41 
     42 (defvar company-yasnippet-annotation-fn
     43   (lambda (name)
     44     (concat
     45      (unless company-tooltip-align-annotations " -> ")
     46      name))
     47   "Function to format completion annotation.
     48 It has to accept one argument: the snippet's name.")
     49 
     50 (defun company-yasnippet--key-prefixes ()
     51   ;; Mostly copied from `yas--templates-for-key-at-point'.
     52   (defvar yas-key-syntaxes)
     53   (save-excursion
     54     (let ((original (point))
     55           (methods yas-key-syntaxes)
     56           prefixes
     57           method)
     58       (while methods
     59         (unless (eq method (car methods))
     60           (goto-char original))
     61         (setq method (car methods))
     62         (cond ((stringp method)
     63                (skip-syntax-backward method)
     64                (setq methods (cdr methods)))
     65               ((functionp method)
     66                (unless (eq (funcall method original)
     67                            'again)
     68                  (setq methods (cdr methods))))
     69               (t
     70                (setq methods (cdr methods))
     71                (yas--warning "Invalid element `%s' in `yas-key-syntaxes'" method)))
     72         (let ((prefix (buffer-substring-no-properties (point) original)))
     73           (unless (equal prefix (car prefixes))
     74             (push prefix prefixes))))
     75       prefixes)))
     76 
     77 (defun company-yasnippet--candidates (prefix)
     78   ;; Process the prefixes in reverse: unlike Yasnippet, we look for prefix
     79   ;; matches, so the longest prefix with any matches should be the most useful.
     80   (cl-loop with tables = (yas--get-snippet-tables)
     81            for key-prefix in (company-yasnippet--key-prefixes)
     82            ;; Only consider keys at least as long as the symbol at point.
     83            when (>= (length key-prefix) (length prefix))
     84            thereis (company-yasnippet--completions-for-prefix prefix
     85                                                               key-prefix
     86                                                               tables)))
     87 
     88 (defun company-yasnippet--completions-for-prefix (prefix key-prefix tables)
     89   (cl-mapcan
     90    (lambda (table)
     91      (let ((keyhash (yas--table-hash table))
     92            (requirement (yas--require-template-specific-condition-p))
     93            res)
     94        (when keyhash
     95          (maphash
     96           (lambda (key value)
     97             (when (and (stringp key)
     98                        (string-prefix-p key-prefix key))
     99               (maphash
    100                (lambda (name template)
    101                  (when (yas--template-can-expand-p
    102                         (yas--template-condition template) requirement)
    103                    (push
    104                     (propertize key
    105                                 'yas-annotation name
    106                                 'yas-template template
    107                                 'yas-prefix-offset (- (length key-prefix)
    108                                                       (length prefix)))
    109                     res)))
    110                value)))
    111           keyhash))
    112        res))
    113    tables))
    114 
    115 (defun company-yasnippet--doc (arg)
    116   (let ((template (get-text-property 0 'yas-template arg))
    117         (mode major-mode)
    118         (file-name (buffer-file-name)))
    119     (defvar yas-prompt-functions)
    120     (with-current-buffer (company-doc-buffer)
    121       (let ((buffer-file-name file-name))
    122         (yas-minor-mode 1)
    123         (setq-local yas-prompt-functions '(yas-no-prompt))
    124         (condition-case error
    125             (yas-expand-snippet (yas--template-content template))
    126           (error
    127            (message "%s"  (error-message-string error))))
    128         (delay-mode-hooks
    129           (let ((inhibit-message t))
    130             (if (eq mode 'web-mode)
    131                 (progn
    132                   (setq mode 'html-mode)
    133                   (funcall mode))
    134               (funcall mode)))
    135           (ignore-errors (font-lock-ensure))))
    136       (current-buffer))))
    137 
    138 ;;;###autoload
    139 (defun company-yasnippet (command &optional arg &rest ignore)
    140   "`company-mode' backend for `yasnippet'.
    141 
    142 This backend should be used with care, because as long as there are
    143 snippets defined for the current major mode, this backend will always
    144 shadow backends that come after it.  Recommended usages:
    145 
    146 * In a buffer-local value of `company-backends', grouped with a backend or
    147   several that provide actual text completions.
    148 
    149   (add-hook \\='js-mode-hook
    150             (lambda ()
    151               (set (make-local-variable \\='company-backends)
    152                    \\='((company-dabbrev-code company-yasnippet)))))
    153 
    154 * After keyword `:with', grouped with other backends.
    155 
    156   (push \\='(company-semantic :with company-yasnippet) company-backends)
    157 
    158 * Not in `company-backends', just bound to a key.
    159 
    160   (global-set-key (kbd \"C-c y\") \\='company-yasnippet)
    161 "
    162   (interactive (list 'interactive))
    163   (cl-case command
    164     (interactive (company-begin-backend 'company-yasnippet))
    165     (prefix
    166      ;; Should probably use `yas--current-key', but that's bound to be slower.
    167      ;; How many trigger keys start with non-symbol characters anyway?
    168      (and (bound-and-true-p yas-minor-mode)
    169           (company-grab-symbol)))
    170     (annotation
    171      (funcall company-yasnippet-annotation-fn
    172               (get-text-property 0 'yas-annotation arg)))
    173     (candidates (company-yasnippet--candidates arg))
    174     (doc-buffer (company-yasnippet--doc arg))
    175     (no-cache t)
    176     (kind 'snippet)
    177     (post-completion
    178      (let ((template (get-text-property 0 'yas-template arg))
    179            (prefix-offset (get-text-property 0 'yas-prefix-offset arg)))
    180        (yas-expand-snippet (yas--template-content template)
    181                            (- (point) (length arg) prefix-offset)
    182                            (point)
    183                            (yas--template-expand-env template))))))
    184 
    185 (provide 'company-yasnippet)
    186 ;;; company-yasnippet.el ends here