company-semantic.el (6817B)
1 ;;; company-semantic.el --- company-mode completion backend using Semantic 2 3 ;; Copyright (C) 2009-2011, 2013-2018 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 <https://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