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

   1 ;;; company-capf.el --- company-mode completion-at-point-functions back-end -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2013  Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
   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 (eval-when-compile (require 'cl))
  29
  30 (defun company--capf-data ()
  31   ;; Ignore tags-completion-at-point-function because it subverts company-etags
  32   ;; in the default value of company-backends, where the latter comes later.
  33   (letf* (((default-value 'completion-at-point-functions) nil)
  34           (data (run-hook-wrapped 'completion-at-point-functions
  35                                   ;; Ignore misbehaving functions.
  36                                   #'completion--capf-wrapper 'optimist)))
  37     (when (consp data) data)))
  38
  39 (defun company-capf (command &optional arg &rest _args)
  40   "`company-mode' back-end using `completion-at-point-functions'.
  41 Requires Emacs 24.1 or newer."
  42   (interactive (list 'interactive))
  43   (pcase command
  44     (`interactive (company-begin-backend 'company-capf))
  45     (`prefix
  46      (let ((res (company--capf-data)))
  47        (when res
  48          (if (> (nth 2 res) (point))
  49              'stop
  50            (buffer-substring-no-properties (nth 1 res) (point))))))
  51     (`candidates
  52      (let ((res (company--capf-data)))
  53        (when res
  54          (let* ((table (nth 3 res))
  55                 (pred (plist-get (nthcdr 4 res) :predicate))
  56                 (meta (completion-metadata
  57                       (buffer-substring (nth 1 res) (nth 2 res))
  58                       table pred))
  59                 (sortfun (cdr (assq 'display-sort-function meta)))
  60                 (boundaries (completion-boundaries arg table pred ""))
  61                 (candidates (completion-all-completions arg table pred (length arg)))
  62                 (last (last candidates 1)))
  63            (when (numberp (cdr last))
  64              (setcdr last nil))
  65            (when sortfun
  66              (setq candidates (funcall sortfun candidates)))
  67            (if (not (zerop (car boundaries)))
  68                (let ((before (substring arg 0 (car boundaries))))
  69                  (mapcar (lambda (candidate)
  70                            (concat before candidate))
  71                          candidates))
  72              candidates)))))
  73     (`sorted
  74      (let ((res (company--capf-data)))
  75        (when res
  76          (let ((meta (completion-metadata
  77                       (buffer-substring (nth 1 res) (nth 2 res))
  78                       (nth 3 res) (plist-get (nthcdr 4 res) :predicate))))
  79            (cdr (assq 'display-sort-function meta))))))
  80     (`duplicates nil) ;Don't bother.
  81     (`no-cache t)     ;FIXME: Improve!
  82     (`meta
  83      (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-docsig)))
  84        (when f (funcall f arg))))
  85     (`doc-buffer
  86      (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-doc-buffer)))
  87        (when f (funcall f arg))))
  88     (`location
  89      (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location)))
  90        (when f (funcall f arg))))
  91     (`require-match
  92      (plist-get (nthcdr 4 (company--capf-data)) :company-require-match))
  93     (`init nil)      ;Don't bother: plenty of other ways to initialize the code.
  94     (`post-completion
  95      (let* ((res (company--capf-data))
  96             (exit-function (plist-get (nthcdr 4 res) :exit-function)))
  97        (if exit-function
  98            (funcall exit-function arg 'finished))))
  99     ))
 100
 101 (provide 'company-capf)
 102
 103 ;;; company-capf.el ends here