dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

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