mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-17 c4001ccd1864293b64aa37d83a9d9457eb875e70
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