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                 (candidates (completion-all-completions arg table pred (length arg)))
  61                 (last (last candidates))
  62                 (base-size (and (numberp (cdr last)) (cdr last))))
  63            (when base-size
  64              (setcdr last nil))
  65            (when sortfun
  66              (setq candidates (funcall sortfun candidates)))
  67            (if (not (zerop (or base-size 0)))
  68                (let ((before (substring arg 0 base-size)))
  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     (`common-part
  81      ;; Can't just use 0 when base-size (see above) is non-zero.
  82      (let ((start (if (get-text-property 0 'face arg)
  83                       0
  84                     (next-single-property-change 0 'face arg))))
  85        (when start
  86          ;; completions-common-part comes first, but we can't just look for this
  87          ;; value because it can be in a list.
  88          (or
  89           (let ((value (get-text-property start 'face arg)))
  90             (text-property-not-all start (length arg)
  91                                    'face value arg))
  92           (length arg)))))
  93     (`duplicates nil) ;Don't bother.
  94     (`no-cache t)     ;FIXME: Improve!
  95     (`meta
  96      (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-docsig)))
  97        (when f (funcall f arg))))
  98     (`doc-buffer
  99      (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-doc-buffer)))
 100        (when f (funcall f arg))))
 101     (`location
 102      (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location)))
 103        (when f (funcall f arg))))
 104     (`require-match
 105      (plist-get (nthcdr 4 (company--capf-data)) :company-require-match))
 106     (`init nil)      ;Don't bother: plenty of other ways to initialize the code.
 107     (`post-completion
 108      (let* ((res (company--capf-data))
 109             (exit-function (plist-get (nthcdr 4 res) :exit-function)))
 110        (if exit-function
 111            (funcall exit-function arg 'finished))))
 112     ))
 113
 114 (provide 'company-capf)
 115
 116 ;;; company-capf.el ends here