X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/8b7d5ff1768dc573b9d2e64d1fc8a5973de163b9..ada2ede3ec75235ef0a6721e526b2fc94284093e:/company-semantic.el diff --git a/company-semantic.el b/company-semantic.el index 1495059af..8b13b72c6 100644 --- a/company-semantic.el +++ b/company-semantic.el @@ -1,6 +1,6 @@ -;;; company-semantic.el --- A company-mode back-end using CEDET Semantic +;;; company-semantic.el --- company-mode completion backend using Semantic -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. +;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -26,33 +26,66 @@ ;;; Code: (require 'company) -(or (require 'semantic-analyze nil t) - (require 'semantic/analyze)) -(eval-when-compile (require 'cl)) +(require 'company-template) +(require 'cl-lib) + +(defvar semantic-idle-summary-function) +(declare-function semantic-documentation-for-tag "semantic/doc" ) +(declare-function semantic-analyze-current-context "semantic/analyze") +(declare-function semantic-analyze-possible-completions "semantic/complete") +(declare-function semantic-analyze-find-tags-by-prefix "semantic/analyze/fcn") +(declare-function semantic-tag-class "semantic/tag") +(declare-function semantic-tag-name "semantic/tag") +(declare-function semantic-tag-start "semantic/tag") +(declare-function semantic-tag-buffer "semantic/tag") +(declare-function semantic-active-p "semantic") +(declare-function semantic-format-tag-prototype "semantic/format") + +(defgroup company-semantic nil + "Completion backend using Semantic." + :group 'company) (defcustom company-semantic-metadata-function 'company-semantic-summary-and-doc "The function turning a semantic tag into doc information." - :group 'company :type 'function) +(defcustom company-semantic-begin-after-member-access t + "When non-nil, automatic completion will start whenever the current +symbol is preceded by \".\", \"->\" or \"::\", ignoring +`company-minimum-prefix-length'. + +If `company-begin-commands' is a list, it should include `c-electric-lt-gt' +and `c-electric-colon', for automatic completion right after \">\" and +\":\".") + +(defcustom company-semantic-insert-arguments t + "When non-nil, insert function arguments as a template after completion." + :type 'boolean + :package-version '(company . "0.9.0")) + (defvar company-semantic-modes '(c-mode c++-mode jde-mode java-mode)) -(defvar company-semantic--current-tags nil +(defvar-local company-semantic--current-tags nil "Tags for the current context.") +(defun company-semantic-documentation-for-tag (tag) + (when (semantic-tag-buffer tag) + ;; When TAG's buffer is unknown, the function below raises an error. + (semantic-documentation-for-tag tag))) + (defun company-semantic-doc-or-summary (tag) - (or (semantic-documentation-for-tag tag) + (or (company-semantic-documentation-for-tag tag) (and (require 'semantic-idle nil t) (require 'semantic/idle nil t) (funcall semantic-idle-summary-function tag nil t)))) (defun company-semantic-summary-and-doc (tag) - (let ((doc (semantic-documentation-for-tag tag)) + (let ((doc (company-semantic-documentation-for-tag tag)) (summary (funcall semantic-idle-summary-function tag nil t))) (and (stringp doc) (string-match "\n*\\(.*\\)$" doc) (setq doc (match-string 1 doc))) - (concat (funcall semantic-idle-summary-function tag nil t) + (concat summary (when doc (if (< (+ (length doc) (length summary) 4) (window-width)) " -- " @@ -60,20 +93,19 @@ doc))) (defun company-semantic-doc-buffer (tag) - (let ((doc (semantic-documentation-for-tag tag))) + (let ((doc (company-semantic-documentation-for-tag tag))) (when doc - (with-current-buffer (company-doc-buffer) - (insert (funcall semantic-idle-summary-function tag nil t) - "\n" - doc) - (current-buffer))))) + (company-doc-buffer + (concat (funcall semantic-idle-summary-function tag nil t) + "\n" + doc))))) (defsubst company-semantic-completions (prefix) (ignore-errors (let ((completion-ignore-case nil) (context (semantic-analyze-current-context))) (setq company-semantic--current-tags - (semantic-analyze-possible-completions context)) + (semantic-analyze-possible-completions context 'no-unique)) (all-completions prefix company-semantic--current-tags)))) (defun company-semantic-completions-raw (prefix) @@ -83,47 +115,53 @@ (push tag company-semantic--current-tags))) (delete "" (mapcar 'semantic-tag-name company-semantic--current-tags))) -(defun company-semantic--pre-prefix-length (prefix-length) - "Sum up the length of all chained symbols before POS. -Symbols are chained by \".\" or \"->\"." - (save-excursion - (let ((pos (point))) - (goto-char (- (point) prefix-length)) - (while (looking-back "->\\|\\.") - (goto-char (match-beginning 0)) - (skip-syntax-backward "w_")) - (- pos (point))))) - -(defun company-semantic--grab () - "Grab the semantic prefix, but return everything before -> or . as length." - (let ((symbol (company-grab-symbol))) - (when symbol - (cons symbol (company-semantic--pre-prefix-length (length symbol)))))) +(defun company-semantic-annotation (argument tags) + (let* ((tag (assq argument tags)) + (kind (when tag (elt tag 1)))) + (cl-case kind + (function (let* ((prototype (semantic-format-tag-prototype tag nil nil)) + (par-pos (string-match "(" prototype))) + (when par-pos (substring prototype par-pos))))))) + +(defun company-semantic--prefix () + (if company-semantic-begin-after-member-access + (company-grab-symbol-cons "\\.\\|->\\|::" 2) + (company-grab-symbol))) ;;;###autoload (defun company-semantic (command &optional arg &rest ignored) - "A `company-mode' completion back-end using CEDET Semantic." + "`company-mode' completion backend using CEDET Semantic." (interactive (list 'interactive)) - (case command + (cl-case command (interactive (company-begin-backend 'company-semantic)) - (prefix (and (memq major-mode company-semantic-modes) + (prefix (and (featurep 'semantic) (semantic-active-p) + (memq major-mode company-semantic-modes) (not (company-in-string-or-comment)) - (or (company-semantic--grab) 'stop))) + (or (company-semantic--prefix) 'stop))) (candidates (if (and (equal arg "") - (not (looking-back "->\\|\\."))) + (not (looking-back "->\\|\\." (- (point) 2)))) (company-semantic-completions-raw arg) (company-semantic-completions arg))) (meta (funcall company-semantic-metadata-function (assoc arg company-semantic--current-tags))) + (annotation (company-semantic-annotation arg + company-semantic--current-tags)) (doc-buffer (company-semantic-doc-buffer (assoc arg company-semantic--current-tags))) ;; Because "" is an empty context and doesn't return local variables. (no-cache (equal arg "")) + (duplicates t) (location (let ((tag (assoc arg company-semantic--current-tags))) (when (buffer-live-p (semantic-tag-buffer tag)) (cons (semantic-tag-buffer tag) - (semantic-tag-start tag))))))) + (semantic-tag-start tag))))) + (post-completion (let ((anno (company-semantic-annotation + arg company-semantic--current-tags))) + (when (and company-semantic-insert-arguments anno) + (insert anno) + (company-template-c-like-templatify (concat arg anno))) + )))) (provide 'company-semantic) ;;; company-semantic.el ends here