X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/a73cbc5c6f456d875d18e232998a2d0767747dc0..170111814c0bd342c50ab84d3e3bf699c1bd1f1d:/packages/company/company-semantic.el diff --git a/packages/company/company-semantic.el b/packages/company/company-semantic.el index da0a5d3d8..6c020a30f 100644 --- a/packages/company/company-semantic.el +++ b/packages/company/company-semantic.el @@ -1,6 +1,6 @@ -;;; company-semantic.el --- a company-mode back-end using CEDET Semantic +;;; company-semantic.el --- company-mode completion back-end using Semantic -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009-2011, 2013 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -19,36 +19,57 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; + ;;; Code: (require 'company) -(or (require 'semantic-analyze nil t) - (require 'semantic/analyze)) -(eval-when-compile (require 'cl)) +(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") + +(defgroup company-semantic nil + "Completion back-end 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 + "The function turning a semantic tag into doc information." :type 'function) (defvar company-semantic-modes '(c-mode c++-mode jde-mode java-mode)) -(defvar company-semantic--current-tags nil - "Tags for the current context") +(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)) " -- " @@ -56,13 +77,12 @@ 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 @@ -98,28 +118,29 @@ Symbols are chained by \".\" or \"->\"." ;;;###autoload (defun company-semantic (command &optional arg &rest ignored) - "A `company-mode' completion back-end using CEDET Semantic." + "`company-mode' completion back-end using CEDET Semantic." (interactive (list 'interactive)) - (case command - ('interactive (company-begin-backend 'company-semantic)) - ('prefix (and (memq major-mode company-semantic-modes) - (semantic-active-p) - (not (company-in-string-or-comment)) - (or (company-semantic--grab) 'stop))) - ('candidates (if (and (equal arg "") - (not (looking-back "->\\|\\."))) - (company-semantic-completions-raw arg) - (company-semantic-completions arg))) - ('meta (funcall company-semantic-metadata-function - (assoc 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 "")) - ('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))))))) + (cl-case command + (interactive (company-begin-backend 'company-semantic)) + (prefix (and (featurep 'semantic) + (semantic-active-p) + (memq major-mode company-semantic-modes) + (not (company-in-string-or-comment)) + (or (company-semantic--grab) 'stop))) + (candidates (if (and (equal arg "") + (not (looking-back "->\\|\\."))) + (company-semantic-completions-raw arg) + (company-semantic-completions arg))) + (meta (funcall company-semantic-metadata-function + (assoc 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 "")) + (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))))))) (provide 'company-semantic) ;;; company-semantic.el ends here