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 (defun company--capf-data ()
  29   (let ((data (run-hook-wrapped 'completion-at-point-functions
  30                                 ;; Ignore misbehaving functions.
  31                                 #'completion--capf-wrapper 'optimist)))
  32     (when (consp data) data)))
  33
  34 (defun company-capf (command &optional arg &rest _args)
  35   "`company-mode' back-end using `completion-at-point-functions'.
  36 Requires Emacs 24.1 or newer."
  37   (interactive (list 'interactive))
  38   (pcase command
  39     (`interactive (company-begin-backend 'company-capf))
  40     (`prefix
  41      (let ((res (company--capf-data)))
  42        (when res
  43          (if (> (nth 2 res) (point))
  44              'stop
  45            (buffer-substring-no-properties (nth 1 res) (point))))))
  46     (`candidates
  47      (let ((res (company--capf-data)))
  48        (when res
  49          (let* ((table (nth 3 res))
  50                 (pred (plist-get (nthcdr 4 res) :predicate))
  51                 (meta (completion-metadata
  52                       (buffer-substring (nth 1 res) (nth 2 res))
  53                       table pred))
  54                 (sortfun (cdr (assq 'display-sort-function meta)))
  55                 (boundaries (completion-boundaries arg table pred ""))
  56                 (candidates (all-completions arg table pred)))
  57            (unless (zerop (car boundaries))
  58              (let ((before (substring arg 0 (car boundaries))))
  59                (setq candidates
  60                      (mapcar (lambda (candidate)
  61                                (concat before candidate))
  62                              candidates))))
  63            (if sortfun (funcall sortfun candidates) candidates)))))
  64     (`sorted
  65      (let ((res (company--capf-data)))
  66        (when res
  67          (let ((meta (completion-metadata
  68                       (buffer-substring (nth 1 res) (nth 2 res))
  69                       (nth 3 res) (plist-get (nthcdr 4 res) :predicate))))
  70            (cdr (assq 'display-sort-function meta))))))
  71     (`duplicates nil) ;Don't bother.
  72     (`no-cache t)     ;FIXME: Improve!
  73     (`meta
  74      (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-docsig)))
  75        (when f (funcall f arg))))
  76     (`doc-buffer
  77      (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-doc-buffer)))
  78        (when f (funcall f arg))))
  79     (`location
  80      (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location)))
  81        (when f (funcall f arg))))
  82     (`require-match
  83      (plist-get (nthcdr 4 (company--capf-data)) :company-require-match))
  84     (`init nil)      ;Don't bother: plenty of other ways to initialize the code.
  85     (`post-completion
  86      (let* ((res (company--capf-data))
  87             (exit-function (plist-get (nthcdr 4 res) :exit-function)))
  88        (if exit-function
  89            (funcall exit-function arg 'finished))))
  90     ))
  91
  92 (provide 'company-capf)
  93
  94 ;;; company-capf.el ends here