X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/da32a6a4e9fd28006e4a53e99250e80587cb50bf..212c8fc3101781a2f1c55ca61772eb75a2046e87:/company-clang.el

diff --git a/company-clang.el b/company-clang.el
index 6b80ef02f..54d4b9b9c 100644
--- a/company-clang.el
+++ b/company-clang.el
@@ -1,6 +1,6 @@
-;;; company-clang.el --- A company-mode completion back-end for clang
+;;; company-clang.el --- company-mode completion backend for Clang  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2009, 2011, 2013  Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011, 2013-2016  Free Software Foundation, Inc.
 
 ;; Author: Nikolaj Schumacher
 
@@ -26,37 +26,45 @@
 ;;; Code:
 
 (require 'company)
-(eval-when-compile (require 'cl))
+(require 'company-template)
+(require 'cl-lib)
+
+(defgroup company-clang nil
+  "Completion backend for Clang."
+  :group 'company)
 
 (defcustom company-clang-executable
   (executable-find "clang")
   "Location of clang executable."
-  :group 'company-clang
   :type 'file)
 
-(defcustom company-clang-auto-save t
-  "Determines whether to save the buffer when retrieving completions.
-clang can only complete correctly when the buffer has been saved."
-  :group 'company-clang
-  :type '(choice (const :tag "Off" nil)
-                 (const :tag "On" t)))
+(defcustom company-clang-begin-after-member-access t
+  "When non-nil, automatic completion will start whenever the current
+symbol is preceded by \".\", \"->\" or \"::\", ignoring
+`company-minimum-prefix-length'.
+
+If `company-begin-commands' is a list, it should include `c-electric-lt-gt'
+and `c-electric-colon', for automatic completion right after \">\" and
+\":\".")
 
 (defcustom company-clang-arguments nil
   "Additional arguments to pass to clang when completing.
-Prefix files (-include ...) can be selected with
-`company-clang-set-prefix' or automatically through a custom
-`company-clang-prefix-guesser'."
-  :group 'company-clang
-  :type '(repeat (string :tag "Argument" nil)))
+Prefix files (-include ...) can be selected with `company-clang-set-prefix'
+or automatically through a custom `company-clang-prefix-guesser'."
+  :type '(repeat (string :tag "Argument")))
 
 (defcustom company-clang-prefix-guesser 'company-clang-guess-prefix
   "A function to determine the prefix file for the current buffer."
-  :group 'company-clang
   :type '(function :tag "Guesser function" nil))
 
-(defvar company-clang-modes '(c-mode objc-mode)
+(defvar company-clang-modes '(c-mode c++-mode objc-mode)
   "Major modes which clang may complete.")
 
+(defcustom company-clang-insert-arguments t
+  "When non-nil, insert function arguments as a template after completion."
+  :type 'boolean
+  :package-version '(company . "0.8.0"))
+
 ;; prefix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defvar company-clang--prefix nil)
@@ -99,39 +107,84 @@ Prefix files (-include ...) can be selected with
 
 ;; parsing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; TODO: How to handle OVERLOAD and Pattern?
+;; TODO: Handle Pattern (syntactic hints would be neat).
+;; Do we ever see OVERLOAD (or OVERRIDE)?
 (defconst company-clang--completion-pattern
-  "^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:]*\\)\\(?: : \\(.*\\)$\\)?")
+  "^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:]*\\)\\(?: : \\(.*\\)$\\)?$")
 
-(defconst company-clang--error-buffer-name "*clang error*")
+(defconst company-clang--error-buffer-name "*clang-error*")
 
-(defvar company-clang--meta-cache nil)
+(defun company-clang--lang-option ()
+     (if (eq major-mode 'objc-mode)
+         (if (string= "m" (file-name-extension buffer-file-name))
+             "objective-c" "objective-c++")
+       (substring (symbol-name major-mode) 0 -5)))
 
-(defun company-clang--parse-output (prefix)
+(defun company-clang--parse-output (prefix _objc)
   (goto-char (point-min))
   (let ((pattern (format company-clang--completion-pattern
                          (regexp-quote prefix)))
         (case-fold-search nil)
         lines match)
-    (setq company-clang--meta-cache (make-hash-table :test 'equal))
     (while (re-search-forward pattern nil t)
       (setq match (match-string-no-properties 1))
-      (let ((meta (match-string-no-properties 2)))
-        (when (and meta (not (string= match meta)))
-          (puthash match meta company-clang--meta-cache)))
       (unless (equal match "Pattern")
+        (save-match-data
+          (when (string-match ":" match)
+            (setq match (substring match 0 (match-beginning 0)))))
+        (let ((meta (match-string-no-properties 2)))
+          (when (and meta (not (string= match meta)))
+            (put-text-property 0 1 'meta
+                               (company-clang--strip-formatting meta)
+                               match)))
         (push match lines)))
     lines))
 
+(defun company-clang--meta (candidate)
+  (get-text-property 0 'meta candidate))
+
+(defun company-clang--annotation (candidate)
+  (let ((ann (company-clang--annotation-1 candidate)))
+    (if (not (and ann (string-prefix-p "(*)" ann)))
+        ann
+      (with-temp-buffer
+        (insert ann)
+        (search-backward ")")
+        (let ((pt (1+ (point))))
+          (re-search-forward ".\\_>" nil t)
+          (delete-region pt (point)))
+        (buffer-string)))))
+
+(defun company-clang--annotation-1 (candidate)
+  (let ((meta (company-clang--meta candidate)))
+    (cond
+     ((null meta) nil)
+     ((string-match "[^:]:[^:]" meta)
+      (substring meta (1+ (match-beginning 0))))
+     ((string-match "\\((.*)[ a-z]*\\'\\)" meta)
+      (let ((paren (match-beginning 1)))
+        (if (not (eq (aref meta (1- paren)) ?>))
+            (match-string 1 meta)
+          (with-temp-buffer
+            (insert meta)
+            (goto-char paren)
+            (substring meta (1- (search-backward "<"))))))))))
+
+(defun company-clang--strip-formatting (text)
+  (replace-regexp-in-string
+   "#]" " "
+   (replace-regexp-in-string "[<{[]#\\|#[>}]" "" text t)
+   t))
+
 (defun company-clang--handle-error (res args)
   (goto-char (point-min))
   (let* ((buf (get-buffer-create company-clang--error-buffer-name))
-         (cmd (concat company-clang-executable (mapconcat 'identity args " ")))
+         (cmd (concat company-clang-executable " " (mapconcat 'identity args " ")))
          (pattern (format company-clang--completion-pattern ""))
          (err (if (re-search-forward pattern nil t)
                   (buffer-substring-no-properties (point-min)
                                                   (1- (match-beginning 0)))
-                ;; Warn the user more agressively if no match was found.
+                ;; Warn the user more aggressively if no match was found.
                 (message "clang failed with error %d:\n%s" res cmd)
                 (buffer-string))))
 
@@ -145,44 +198,85 @@ Prefix files (-include ...) can be selected with
         (setq buffer-read-only t)
         (goto-char (point-min))))))
 
-(defun company-clang--call-process (prefix &rest args)
-  (with-temp-buffer
-    (let ((res (apply 'call-process company-clang-executable nil t nil args)))
-      (unless (eq 0 res)
-        (company-clang--handle-error res args))
-      ;; Still try to get any useful input.
-      (company-clang--parse-output prefix))))
+(defun company-clang--start-process (prefix callback &rest args)
+  (let ((objc (derived-mode-p 'objc-mode))
+        (buf (get-buffer-create "*clang-output*"))
+        ;; Looks unnecessary in Emacs 25.1 and later.
+        (process-adaptive-read-buffering nil))
+    (if (get-buffer-process buf)
+        (funcall callback nil)
+      (with-current-buffer buf
+        (erase-buffer)
+        (setq buffer-undo-list t))
+      (let ((process (apply #'start-process "company-clang" buf
+                            company-clang-executable args)))
+        (set-process-sentinel
+         process
+         (lambda (proc status)
+           (unless (string-match-p "hangup" status)
+             (funcall
+              callback
+              (let ((res (process-exit-status proc)))
+                (with-current-buffer buf
+                  (unless (eq 0 res)
+                    (company-clang--handle-error res args))
+                  ;; Still try to get any useful input.
+                  (company-clang--parse-output prefix objc)))))))
+        (unless (company-clang--auto-save-p)
+          (send-region process (point-min) (point-max))
+          (send-string process "\n")
+          (process-send-eof process))))))
 
 (defsubst company-clang--build-location (pos)
   (save-excursion
     (goto-char pos)
-    (format "%s:%d:%d" buffer-file-name (line-number-at-pos)
-            (1+ (current-column)))))
+    (format "%s:%d:%d"
+            (if (company-clang--auto-save-p) buffer-file-name "-")
+            (line-number-at-pos)
+            (1+ (length
+                 (encode-coding-region
+                  (line-beginning-position)
+                  (point)
+                  'utf-8
+                  t))))))
 
 (defsubst company-clang--build-complete-args (pos)
-  (append '("-cc1" "-fsyntax-only" "-code-completion-macros")
+  (append '("-fsyntax-only" "-Xclang" "-code-completion-macros")
+          (unless (company-clang--auto-save-p)
+            (list "-x" (company-clang--lang-option)))
           company-clang-arguments
           (when (stringp company-clang--prefix)
             (list "-include" (expand-file-name company-clang--prefix)))
-          '("-code-completion-at")
-          (list (company-clang--build-location pos))
-          (list buffer-file-name)))
+          (list "-Xclang" (format "-code-completion-at=%s"
+                                  (company-clang--build-location pos)))
+          (list (if (company-clang--auto-save-p) buffer-file-name "-"))))
 
-(defun company-clang--candidates (prefix)
-  (and company-clang-auto-save
+(defun company-clang--candidates (prefix callback)
+  (and (company-clang--auto-save-p)
        (buffer-modified-p)
        (basic-save-buffer))
   (when (null company-clang--prefix)
     (company-clang-set-prefix (or (funcall company-clang-prefix-guesser)
                                   'none)))
-  (apply 'company-clang--call-process
+  (apply 'company-clang--start-process
          prefix
+         callback
          (company-clang--build-complete-args (- (point) (length prefix)))))
 
+(defun company-clang--prefix ()
+  (if company-clang-begin-after-member-access
+      (company-grab-symbol-cons "\\.\\|->\\|::" 2)
+    (company-grab-symbol)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defconst company-clang-required-version 1.1)
 
+(defvar company-clang--version nil)
+
+(defun company-clang--auto-save-p ()
+  (< company-clang--version 2.9))
+
 (defsubst company-clang-version ()
   "Return the version of `company-clang-executable'."
   (with-temp-buffer
@@ -195,21 +289,8 @@ Prefix files (-include ...) can be selected with
             ver))
       0)))
 
-(defun company-clang-objc-templatify (selector)
-  (let* ((end (point))
-         (beg (- (point) (length selector)))
-         (templ (company-template-declare-template beg end)))
-    (save-excursion
-      (goto-char beg)
-      (while (search-forward ":" end t)
-        (replace-match ":  ")
-        (incf end 2)
-        (company-template-add-field templ (1- (match-end 0)) "<arg>"))
-      (delete-char -1))
-    (company-template-move-to-first templ)))
-
 (defun company-clang (command &optional arg &rest ignored)
-  "A `company-mode' completion back-end for clang.
+  "`company-mode' completion backend for Clang.
 Clang is a parser for C and ObjC.  Clang version 1.1 or newer is required.
 
 Additional command line arguments can be specified in
@@ -217,31 +298,34 @@ Additional command line arguments can be specified in
 with `company-clang-set-prefix' or automatically through a custom
 `company-clang-prefix-guesser'.
 
-Completions only work correctly when the buffer has been saved.
-`company-clang-auto-save' determines whether to do this automatically."
+With Clang versions before 2.9, we have to save the buffer before
+performing completion.  With Clang 2.9 and later, buffer contents are
+passed via standard input."
   (interactive (list 'interactive))
-  (case command
+  (cl-case command
     (interactive (company-begin-backend 'company-clang))
     (init (when (memq major-mode company-clang-modes)
             (unless company-clang-executable
               (error "Company found no clang executable"))
-            (when (< (company-clang-version) company-clang-required-version)
+            (setq company-clang--version (company-clang-version))
+            (when (< company-clang--version company-clang-required-version)
               (error "Company requires clang version 1.1"))))
     (prefix (and (memq major-mode company-clang-modes)
                  buffer-file-name
                  company-clang-executable
                  (not (company-in-string-or-comment))
-                 (or (company-grab-symbol) 'stop)))
-    (candidates (company-clang--candidates arg))
-    (meta (let ((meta (gethash arg company-clang--meta-cache)))
-            (when meta
-              (replace-regexp-in-string
-               "#]" " "
-               (replace-regexp-in-string "[<{[]#\\|#[>}]" "" meta t)
-               t))))
-    (post-completion (and (derived-mode-p 'objc-mode)
-                          (string-match ":" arg)
-                          (company-clang-objc-templatify arg)))))
+                 (or (company-clang--prefix) 'stop)))
+    (candidates (cons :async
+                      (lambda (cb) (company-clang--candidates arg cb))))
+    (meta       (company-clang--meta arg))
+    (annotation (company-clang--annotation arg))
+    (post-completion (let ((anno (company-clang--annotation arg)))
+                       (when (and company-clang-insert-arguments anno)
+                         (insert anno)
+                         (if (string-match "\\`:[^:]" anno)
+                             (company-template-objc-templatify anno)
+                           (company-template-c-like-templatify
+                            (concat arg anno))))))))
 
 (provide 'company-clang)
 ;;; company-clang.el ends here