code.delx.au - gnu-emacs-elpa/blob - company-clang.el

   1 ;;; company-clang.el --- company-mode completion back-end for Clang
   2
   3 ;; Copyright (C) 2009, 2011, 2013  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 (eval-when-compile (require 'cl))
  31
  32 (defgroup company-clang nil
  33   "Completion back-end for Clang."
  34   :group 'company)
  35
  36 (defcustom company-clang-executable
  37   (executable-find "clang")
  38   "Location of clang executable."
  39   :type 'file)
  40
  41 (defcustom company-clang-begin-after-member-access t
  42   "When non-nil, automatic completion will start whenever the current
  43 symbol is preceded by \".\", \"->\" or \"::\", ignoring
  44 `company-minimum-prefix-length'.
  45
  46 If `company-begin-commands' is a list, it should include `c-electric-lt-gt'
  47 and `c-electric-colon', for automatic completion right after \">\" and
  48 \":\".")
  49
  50 (defcustom company-clang-arguments nil
  51   "Additional arguments to pass to clang when completing.
  52 Prefix files (-include ...) can be selected with `company-clang-set-prefix'
  53 or automatically through a custom `company-clang-prefix-guesser'."
  54   :type '(repeat (string :tag "Argument" nil)))
  55
  56 (defcustom company-clang-prefix-guesser 'company-clang-guess-prefix
  57   "A function to determine the prefix file for the current buffer."
  58   :type '(function :tag "Guesser function" nil))
  59
  60 (defvar company-clang-modes '(c-mode c++-mode objc-mode)
  61   "Major modes which clang may complete.")
  62
  63 ;; prefix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  64
  65 (defvar company-clang--prefix nil)
  66
  67 (defsubst company-clang--guess-pch-file (file)
  68   (let ((dir (directory-file-name (file-name-directory file))))
  69     (when (equal (file-name-nondirectory dir) "Classes")
  70       (setq dir (file-name-directory dir)))
  71     (car (directory-files dir t "\\([^.]h\\|[^h]\\).pch\\'" t))))
  72
  73 (defsubst company-clang--file-substring (file beg end)
  74   (with-temp-buffer
  75     (insert-file-contents-literally file nil beg end)
  76     (buffer-string)))
  77
  78 (defun company-clang-guess-prefix ()
  79   "Try to guess the prefix file for the current buffer."
  80   ;; Prefixes seem to be called .pch.  Pre-compiled headers do, too.
  81   ;; So we look at the magic number to rule them out.
  82   (let* ((file (company-clang--guess-pch-file buffer-file-name))
  83          (magic-number (and file (company-clang--file-substring file 0 4))))
  84     (unless (member magic-number '("CPCH" "gpch"))
  85       file)))
  86
  87 (defun company-clang-set-prefix (&optional prefix)
  88   "Use PREFIX as a prefix (-include ...) file for clang completion."
  89   (interactive (let ((def (funcall company-clang-prefix-guesser)))
  90      (unless (stringp def)
  91        (setq def default-directory))
  92      (list (read-file-name "Prefix file: "
  93                            (when def (file-name-directory def))
  94                            def t (when def (file-name-nondirectory def))))))
  95   ;; TODO: pre-compile?
  96   (setq company-clang--prefix (and (stringp prefix)
  97                                    (file-regular-p prefix)
  98                                    prefix)))
  99
 100 ;; Clean-up on exit.
 101 (add-hook 'kill-emacs-hook 'company-clang-set-prefix)
 102
 103 ;; parsing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 104
 105 ;; TODO: Handle Pattern (syntactic hints would be neat).
 106 ;; Do we ever see OVERLOAD (or OVERRIDE)?
 107 (defconst company-clang--completion-pattern
 108   "^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:]*\\)\\(?: : \\(.*\\)$\\)?$")
 109
 110 (defconst company-clang--error-buffer-name "*clang error*")
 111
 112 (defun company-clang--lang-option ()
 113      (if (eq major-mode 'objc-mode)
 114          (if (string= "m" (file-name-extension buffer-file-name))
 115              "objective-c" "objective-c++")
 116        (substring (symbol-name major-mode) 0 -5)))
 117
 118 (defun company-clang--parse-output (prefix objc)
 119   (goto-char (point-min))
 120   (let ((pattern (format company-clang--completion-pattern
 121                          (regexp-quote prefix)))
 122         (case-fold-search nil)
 123         lines match)
 124     (while (re-search-forward pattern nil t)
 125       (setq match (match-string-no-properties 1))
 126       (unless (equal match "Pattern")
 127         (save-match-data
 128           (when (string-match ":" match)
 129             (setq match (substring match 0 (match-beginning 0)))))
 130         (let ((meta (match-string-no-properties 2)))
 131           (when (and meta (not (string= match meta)))
 132             (put-text-property 0 1 'meta
 133                                (company-clang--strip-formatting meta)
 134                                match)))
 135         (push match lines)))
 136     lines))
 137
 138 (defun company-clang--meta (candidate)
 139   (get-text-property 0 'meta candidate))
 140
 141 (defun company-clang--annotation (candidate)
 142   (let ((meta (company-clang--meta candidate)))
 143     (cond
 144      ((null meta) nil)
 145      ((string-match ":" meta)
 146       (substring meta (match-beginning 0)))
 147      ((string-match "\\((.*)\\'\\)" meta)
 148       (match-string 1 meta)))))
 149
 150 (defun company-clang--strip-formatting (text)
 151   (replace-regexp-in-string
 152    "#]" " "
 153    (replace-regexp-in-string "[<{[]#\\|#[>}]" "" text t)
 154    t))
 155
 156 (defun company-clang--handle-error (res args)
 157   (goto-char (point-min))
 158   (let* ((buf (get-buffer-create company-clang--error-buffer-name))
 159          (cmd (concat company-clang-executable " " (mapconcat 'identity args " ")))
 160          (pattern (format company-clang--completion-pattern ""))
 161          (err (if (re-search-forward pattern nil t)
 162                   (buffer-substring-no-properties (point-min)
 163                                                   (1- (match-beginning 0)))
 164                 ;; Warn the user more aggressively if no match was found.
 165                 (message "clang failed with error %d:\n%s" res cmd)
 166                 (buffer-string))))
 167
 168     (with-current-buffer buf
 169       (let ((inhibit-read-only t))
 170         (erase-buffer)
 171         (insert (current-time-string)
 172                 (format "\nclang failed with error %d:\n" res)
 173                 cmd "\n\n")
 174         (insert err)
 175         (setq buffer-read-only t)
 176         (goto-char (point-min))))))
 177
 178 (defun company-clang--call-process (prefix &rest args)
 179   (let ((objc (derived-mode-p 'objc-mode))
 180         (buf (get-buffer-create "*clang-output*"))
 181         res)
 182     (with-current-buffer buf (erase-buffer))
 183     (setq res (if (company-clang--auto-save-p)
 184                   (apply 'call-process company-clang-executable nil buf nil args)
 185                 (apply 'call-process-region (point-min) (point-max)
 186                        company-clang-executable nil buf nil args)))
 187     (with-current-buffer buf
 188       (unless (eq 0 res)
 189         (company-clang--handle-error res args))
 190       ;; Still try to get any useful input.
 191       (company-clang--parse-output prefix objc))))
 192
 193 (defsubst company-clang--build-location (pos)
 194   (save-excursion
 195     (goto-char pos)
 196     (format "%s:%d:%d"
 197             (if (company-clang--auto-save-p) buffer-file-name "-")
 198             (line-number-at-pos)
 199             (1+ (length
 200                  (encode-coding-region
 201                   (line-beginning-position)
 202                   (point)
 203                   'utf-8
 204                   t))))))
 205
 206 (defsubst company-clang--build-complete-args (pos)
 207   (append '("-cc1" "-fsyntax-only" "-code-completion-macros")
 208           (unless (company-clang--auto-save-p)
 209             (list "-x" (company-clang--lang-option)))
 210           company-clang-arguments
 211           (when (stringp company-clang--prefix)
 212             (list "-include" (expand-file-name company-clang--prefix)))
 213           '("-code-completion-at")
 214           (list (company-clang--build-location pos))
 215           (list (if (company-clang--auto-save-p) buffer-file-name "-"))))
 216
 217 (defun company-clang--candidates (prefix)
 218   (and (company-clang--auto-save-p)
 219        (buffer-modified-p)
 220        (basic-save-buffer))
 221   (when (null company-clang--prefix)
 222     (company-clang-set-prefix (or (funcall company-clang-prefix-guesser)
 223                                   'none)))
 224   (apply 'company-clang--call-process
 225          prefix
 226          (company-clang--build-complete-args (- (point) (length prefix)))))
 227
 228 (defun company-clang--prefix ()
 229   (let ((symbol (company-grab-symbol)))
 230     (if symbol
 231         (if (and company-clang-begin-after-member-access
 232                  (save-excursion
 233                    (forward-char (- (length symbol)))
 234                    (looking-back "\\.\\|->\\|::" (- (point) 2))))
 235             (cons symbol t)
 236           symbol)
 237       'stop)))
 238
 239 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 240
 241 (defconst company-clang-required-version 1.1)
 242
 243 (defvar company-clang--version nil)
 244
 245 (defun company-clang--auto-save-p ()
 246   (< company-clang--version 2.9))
 247
 248 (defsubst company-clang-version ()
 249   "Return the version of `company-clang-executable'."
 250   (with-temp-buffer
 251     (call-process company-clang-executable nil t nil "--version")
 252     (goto-char (point-min))
 253     (if (re-search-forward "clang\\(?: version \\|-\\)\\([0-9.]+\\)" nil t)
 254         (let ((ver (string-to-number (match-string-no-properties 1))))
 255           (if (> ver 100)
 256               (/ ver 100)
 257             ver))
 258       0)))
 259
 260 (defun company-clang-objc-templatify (selector)
 261   (let* ((end (point-marker))
 262          (beg (- (point) (length selector) 1))
 263          (templ (company-template-declare-template beg end))
 264          (cnt 0))
 265     (save-excursion
 266       (goto-char beg)
 267       (catch 'stop
 268         (while (search-forward ":" end t)
 269           (when (looking-at "([^)]*) ?")
 270             (delete-region (match-beginning 0) (match-end 0)))
 271           (company-template-add-field templ (point) (format "arg%d" cnt))
 272           (if (< (point) end)
 273               (insert " ")
 274             (throw 'stop t))
 275           (incf cnt))))
 276     (company-template-move-to-first templ)))
 277
 278 (defun company-clang (command &optional arg &rest ignored)
 279   "`company-mode' completion back-end for Clang.
 280 Clang is a parser for C and ObjC.  Clang version 1.1 or newer is required.
 281
 282 Additional command line arguments can be specified in
 283 `company-clang-arguments'.  Prefix files (-include ...) can be selected
 284 with `company-clang-set-prefix' or automatically through a custom
 285 `company-clang-prefix-guesser'.
 286
 287 With Clang versions before 2.9, we have to save the buffer before
 288 performing completion.  With Clang 2.9 and later, buffer contents are
 289 passed via standard input."
 290   (interactive (list 'interactive))
 291   (case command
 292     (interactive (company-begin-backend 'company-clang))
 293     (init (when (memq major-mode company-clang-modes)
 294             (unless company-clang-executable
 295               (error "Company found no clang executable"))
 296             (setq company-clang--version (company-clang-version))
 297             (when (< company-clang--version company-clang-required-version)
 298               (error "Company requires clang version 1.1"))))
 299     (prefix (and (memq major-mode company-clang-modes)
 300                  buffer-file-name
 301                  company-clang-executable
 302                  (not (company-in-string-or-comment))
 303                  (company-clang--prefix)))
 304     (candidates (company-clang--candidates arg))
 305     (meta       (company-clang--meta arg))
 306     (annotation (company-clang--annotation arg))
 307     (post-completion (let ((anno (company-clang--annotation arg)))
 308                        (when anno
 309                          (insert anno)
 310                          (if (string-match ":" anno)
 311                              (company-clang-objc-templatify anno)
 312                           (company-template-c-like-templatify anno)))))))
 313
 314 (provide 'company-clang)
 315 ;;; company-clang.el ends here