| commit | author | age | ||
| 5cb5f7 | 1 | ;;; company-semantic.el --- company-mode completion backend using Semantic |
| C | 2 | |
| 3 | ;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc. | |
| 4 | ||
| 5 | ;; Author: Nikolaj Schumacher | |
| 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 'company-template) | |
| 30 | (require 'cl-lib) | |
| 31 | ||
| 32 | (defvar semantic-idle-summary-function) | |
| 33 | (declare-function semantic-documentation-for-tag "semantic/doc" ) | |
| 34 | (declare-function semantic-analyze-current-context "semantic/analyze") | |
| 35 | (declare-function semantic-analyze-possible-completions "semantic/complete") | |
| 36 | (declare-function semantic-analyze-find-tags-by-prefix "semantic/analyze/fcn") | |
| 37 | (declare-function semantic-tag-class "semantic/tag") | |
| 38 | (declare-function semantic-tag-name "semantic/tag") | |
| 39 | (declare-function semantic-tag-start "semantic/tag") | |
| 40 | (declare-function semantic-tag-buffer "semantic/tag") | |
| 41 | (declare-function semantic-active-p "semantic") | |
| 42 | (declare-function semantic-format-tag-prototype "semantic/format") | |
| 43 | ||
| 44 | (defgroup company-semantic nil | |
| 45 | "Completion backend using Semantic." | |
| 46 | :group 'company) | |
| 47 | ||
| 48 | (defcustom company-semantic-metadata-function 'company-semantic-summary-and-doc | |
| 49 | "The function turning a semantic tag into doc information." | |
| 50 | :type 'function) | |
| 51 | ||
| 52 | (defcustom company-semantic-begin-after-member-access t | |
| 53 | "When non-nil, automatic completion will start whenever the current | |
| 54 | symbol is preceded by \".\", \"->\" or \"::\", ignoring | |
| 55 | `company-minimum-prefix-length'. | |
| 56 | ||
| 57 | If `company-begin-commands' is a list, it should include `c-electric-lt-gt' | |
| 58 | and `c-electric-colon', for automatic completion right after \">\" and | |
| 59 | \":\"." | |
| 60 | :type 'boolean) | |
| 61 | ||
| 62 | (defcustom company-semantic-insert-arguments t | |
| 63 | "When non-nil, insert function arguments as a template after completion." | |
| 64 | :type 'boolean | |
| 65 | :package-version '(company . "0.9.0")) | |
| 66 | ||
| 67 | (defvar company-semantic-modes '(c-mode c++-mode jde-mode java-mode)) | |
| 68 | ||
| 69 | (defvar-local company-semantic--current-tags nil | |
| 70 | "Tags for the current context.") | |
| 71 | ||
| 72 | (defun company-semantic-documentation-for-tag (tag) | |
| 73 | (when (semantic-tag-buffer tag) | |
| 74 | ;; When TAG's buffer is unknown, the function below raises an error. | |
| 75 | (semantic-documentation-for-tag tag))) | |
| 76 | ||
| 77 | (defun company-semantic-doc-or-summary (tag) | |
| 78 | (or (company-semantic-documentation-for-tag tag) | |
| 79 | (and (require 'semantic-idle nil t) | |
| 80 | (require 'semantic/idle nil t) | |
| 81 | (funcall semantic-idle-summary-function tag nil t)))) | |
| 82 | ||
| 83 | (defun company-semantic-summary-and-doc (tag) | |
| 84 | (let ((doc (company-semantic-documentation-for-tag tag)) | |
| 85 | (summary (funcall semantic-idle-summary-function tag nil t))) | |
| 86 | (and (stringp doc) | |
| 87 | (string-match "\n*\\(.*\\)$" doc) | |
| 88 | (setq doc (match-string 1 doc))) | |
| 89 | (concat summary | |
| 90 | (when doc | |
| 91 | (if (< (+ (length doc) (length summary) 4) (window-width)) | |
| 92 | " -- " | |
| 93 | "\n")) | |
| 94 | doc))) | |
| 95 | ||
| 96 | (defun company-semantic-doc-buffer (tag) | |
| 97 | (let ((doc (company-semantic-documentation-for-tag tag))) | |
| 98 | (when doc | |
| 99 | (company-doc-buffer | |
| 100 | (concat (funcall semantic-idle-summary-function tag nil t) | |
| 101 | "\n" | |
| 102 | doc))))) | |
| 103 | ||
| 104 | (defsubst company-semantic-completions (prefix) | |
| 105 | (ignore-errors | |
| 106 | (let ((completion-ignore-case nil) | |
| 107 | (context (semantic-analyze-current-context))) | |
| 108 | (setq company-semantic--current-tags | |
| 109 | (semantic-analyze-possible-completions context 'no-unique)) | |
| 110 | (all-completions prefix company-semantic--current-tags)))) | |
| 111 | ||
| 112 | (defun company-semantic-completions-raw (prefix) | |
| 113 | (setq company-semantic--current-tags nil) | |
| 114 | (dolist (tag (semantic-analyze-find-tags-by-prefix prefix)) | |
| 115 | (unless (eq (semantic-tag-class tag) 'include) | |
| 116 | (push tag company-semantic--current-tags))) | |
| 117 | (delete "" (mapcar 'semantic-tag-name company-semantic--current-tags))) | |
| 118 | ||
| 119 | (defun company-semantic-annotation (argument tags) | |
| 120 | (let* ((tag (assq argument tags)) | |
| 121 | (kind (when tag (elt tag 1)))) | |
| 122 | (cl-case kind | |
| 123 | (function (let* ((prototype (semantic-format-tag-prototype tag nil nil)) | |
| 124 | (par-pos (string-match "(" prototype))) | |
| 125 | (when par-pos (substring prototype par-pos))))))) | |
| 126 | ||
| 127 | (defun company-semantic--prefix () | |
| 128 | (if company-semantic-begin-after-member-access | |
| 129 | (company-grab-symbol-cons "\\.\\|->\\|::" 2) | |
| 130 | (company-grab-symbol))) | |
| 131 | ||
| 132 | ;;;###autoload | |
| 133 | (defun company-semantic (command &optional arg &rest ignored) | |
| 134 | "`company-mode' completion backend using CEDET Semantic." | |
| 135 | (interactive (list 'interactive)) | |
| 136 | (cl-case command | |
| 137 | (interactive (company-begin-backend 'company-semantic)) | |
| 138 | (prefix (and (featurep 'semantic) | |
| 139 | (semantic-active-p) | |
| 140 | (memq major-mode company-semantic-modes) | |
| 141 | (not (company-in-string-or-comment)) | |
| 142 | (or (company-semantic--prefix) 'stop))) | |
| 143 | (candidates (if (and (equal arg "") | |
| 144 | (not (looking-back "->\\|\\.\\|::" (- (point) 2)))) | |
| 145 | (company-semantic-completions-raw arg) | |
| 146 | (company-semantic-completions arg))) | |
| 147 | (meta (funcall company-semantic-metadata-function | |
| 148 | (assoc arg company-semantic--current-tags))) | |
| 149 | (annotation (company-semantic-annotation arg | |
| 150 | company-semantic--current-tags)) | |
| 151 | (doc-buffer (company-semantic-doc-buffer | |
| 152 | (assoc arg company-semantic--current-tags))) | |
| 153 | ;; Because "" is an empty context and doesn't return local variables. | |
| 154 | (no-cache (equal arg "")) | |
| 155 | (duplicates t) | |
| 156 | (location (let ((tag (assoc arg company-semantic--current-tags))) | |
| 157 | (when (buffer-live-p (semantic-tag-buffer tag)) | |
| 158 | (cons (semantic-tag-buffer tag) | |
| 159 | (semantic-tag-start tag))))) | |
| 160 | (post-completion (let ((anno (company-semantic-annotation | |
| 161 | arg company-semantic--current-tags))) | |
| 162 | (when (and company-semantic-insert-arguments anno) | |
| 163 | (insert anno) | |
| 164 | (company-template-c-like-templatify (concat arg anno))) | |
| 165 | )))) | |
| 166 | ||
| 167 | (provide 'company-semantic) | |
| 168 | ;;; company-semantic.el ends here | |
