company-gtags.el (6276B)
1 ;;; company-gtags.el --- company-mode completion backend for GNU Global 2 3 ;; Copyright (C) 2009-2011, 2013-2021 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 (defgroup company-gtags nil 33 "Completion backend for GNU Global." 34 :group 'company) 35 36 (define-obsolete-variable-alias 37 'company-gtags-gnu-global-program-name 38 'company-gtags-executable "earlier") 39 40 (defcustom company-gtags-executable 41 (executable-find "global") 42 "Location of GNU global executable." 43 :type 'string) 44 45 (defcustom company-gtags-insert-arguments t 46 "When non-nil, insert function arguments as a template after completion." 47 :type 'boolean 48 :package-version '(company . "0.8.1")) 49 50 (defvar-local company-gtags--tags-available-p 'unknown) 51 (defvar-local company-gtags--executable 'unknown) 52 53 (defcustom company-gtags-modes '(prog-mode jde-mode) 54 "Modes that use `company-gtags'. 55 In all these modes (and their derivatives) `company-gtags' will perform 56 completion." 57 :type '(repeat (symbol :tag "Major mode")) 58 :package-version '(company . "0.8.4")) 59 60 (defun company-gtags--tags-available-p () 61 (if (eq company-gtags--tags-available-p 'unknown) 62 (setq company-gtags--tags-available-p 63 (locate-dominating-file buffer-file-name "GTAGS")) 64 company-gtags--tags-available-p)) 65 66 ;; Avoid byte-compilation warnings on Emacs < 27. 67 (declare-function with-connection-local-variables "files-x") 68 (declare-function connection-local-set-profile-variables "files-x") 69 (declare-function connection-local-set-profiles "files-x") 70 71 (defun company-gtags--executable () 72 (cond 73 ((not (eq company-gtags--executable 'unknown)) ;; the value is already cached 74 company-gtags--executable) 75 ((and (version<= "27" emacs-version) ;; can search remotely to set 76 (file-remote-p default-directory)) 77 78 (with-connection-local-variables 79 (if (boundp 'company-gtags--executable-connection) 80 (setq-local company-gtags--executable ;; use if defined as connection-local 81 company-gtags--executable-connection) 82 83 ;; Else search and set as connection local for next uses. 84 (setq-local company-gtags--executable 85 (with-no-warnings (executable-find "global" t))) 86 (let* ((host (file-remote-p default-directory 'host)) 87 (symvars (intern (concat host "-vars")))) ;; profile name 88 89 (connection-local-set-profile-variables 90 symvars 91 `((company-gtags--executable-connection . ,company-gtags--executable))) 92 93 (connection-local-set-profiles `(:machine ,host) symvars)) 94 company-gtags--executable))) 95 (t ;; use default value (searched locally) 96 company-gtags-executable))) 97 98 (defun company-gtags--fetch-tags (prefix) 99 (with-temp-buffer 100 (let (tags) 101 ;; For some reason Global v 6.6.3 is prone to returning exit status 1 102 ;; even on successful searches when '-T' is used. 103 (when (/= 3 (process-file (company-gtags--executable) nil 104 ;; "-T" goes through all the tag files listed in GTAGSLIBPATH 105 (list (current-buffer) nil) nil "-xGqT" (concat "^" prefix))) 106 (goto-char (point-min)) 107 (cl-loop while 108 (re-search-forward (concat 109 "^" 110 "\\([^ ]*\\)" ;; completion 111 "[ \t]+\\([[:digit:]]+\\)" ;; linum 112 "[ \t]+\\([^ \t]+\\)" ;; file 113 "[ \t]+\\(.*\\)" ;; definition 114 "$" 115 ) nil t) 116 collect 117 (propertize (match-string 1) 118 'meta (match-string 4) 119 'location (cons (expand-file-name (match-string 3)) 120 (string-to-number (match-string 2))) 121 )))))) 122 123 (defun company-gtags--annotation (arg) 124 (let ((meta (get-text-property 0 'meta arg))) 125 (when (string-match (concat (regexp-quote arg) " *(") meta) 126 (with-temp-buffer 127 (let ((start (match-end 0))) 128 (insert meta) 129 (goto-char start) 130 (condition-case nil 131 (forward-sexp) 132 (scan-error 133 (goto-char (point-max)))) 134 (buffer-substring-no-properties 135 start (point))))))) 136 137 ;;;###autoload 138 (defun company-gtags (command &optional arg &rest ignored) 139 "`company-mode' completion backend for GNU Global." 140 (interactive (list 'interactive)) 141 (cl-case command 142 (interactive (company-begin-backend 'company-gtags)) 143 (prefix (and (company-gtags--executable) 144 buffer-file-name 145 (apply #'derived-mode-p company-gtags-modes) 146 (not (company-in-string-or-comment)) 147 (company-gtags--tags-available-p) 148 (or (company-grab-symbol) 'stop))) 149 (candidates (company-gtags--fetch-tags arg)) 150 (sorted t) 151 (duplicates t) 152 (annotation (company-gtags--annotation arg)) 153 (meta (get-text-property 0 'meta arg)) 154 (location (get-text-property 0 'location arg)) 155 (post-completion (let ((anno (company-gtags--annotation arg))) 156 (when (and company-gtags-insert-arguments anno) 157 (insert anno) 158 (company-template-c-like-templatify anno)))))) 159 160 (provide 'company-gtags) 161 ;;; company-gtags.el ends here