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