823 lines
29 KiB
EmacsLisp
823 lines
29 KiB
EmacsLisp
;;; irony.el --- C/C++ minor mode powered by libclang
|
||
|
||
;; Copyright (C) 2011-2014 Guillaume Papin
|
||
|
||
;; Author: Guillaume Papin <guillaume.papin@epitech.eu>
|
||
;; Version: 0.2.0-cvs4
|
||
;; URL: https://github.com/Sarcasm/irony-mode
|
||
;; Compatibility: GNU Emacs 23.x, GNU Emacs 24.x
|
||
;; Keywords: c, convenience, tools
|
||
;; Package-Requires: ((cl-lib "0.5") (json "1.2"))
|
||
|
||
;; This program is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
;;
|
||
;; This file provides `irony-mode', a minor mode for C, C++ and Objective-C.
|
||
;;
|
||
;; Usage:
|
||
;; (add-hook 'c++-mode-hook 'irony-mode)
|
||
;; (add-hook 'c-mode-hook 'irony-mode)
|
||
;; (add-hook 'objc-mode-hook 'irony-mode)
|
||
;;
|
||
;; ;; replace the `completion-at-point' and `complete-symbol' bindings in
|
||
;; ;; irony-mode's buffers by irony-mode's asynchronous function
|
||
;; (defun my-irony-mode-hook ()
|
||
;; (define-key irony-mode-map [remap completion-at-point]
|
||
;; 'irony-completion-at-point-async)
|
||
;; (define-key irony-mode-map [remap complete-symbol]
|
||
;; 'irony-completion-at-point-async))
|
||
;; (add-hook 'irony-mode-hook 'my-irony-mode-hook)
|
||
;;
|
||
;; ;; Only needed on Windows
|
||
;; (when (eq system-type 'windows-nt)
|
||
;; (setq w32-pipe-read-delay 0))
|
||
;;
|
||
;; See also:
|
||
;; - https://github.com/Sarcasm/company-irony
|
||
;; - https://github.com/Sarcasm/ac-irony
|
||
|
||
;;; Code:
|
||
|
||
(autoload 'irony-completion--enter "irony-completion")
|
||
(autoload 'irony-completion--exit "irony-completion")
|
||
|
||
(require 'cl-lib)
|
||
|
||
(autoload 'find-library-name "find-func")
|
||
(autoload 'lm-version "lisp-mnt")
|
||
|
||
|
||
;;
|
||
;; Compatibility
|
||
;;
|
||
|
||
(eval-and-compile
|
||
|
||
;; As seen in flycheck/magit
|
||
;;
|
||
;; Added in Emacs 24.3 (mirrors/emacs@b335efc3).
|
||
(unless (fboundp 'setq-local)
|
||
(defmacro setq-local (var val)
|
||
"Set variable VAR to value VAL in current buffer."
|
||
(list 'set (list 'make-local-variable (list 'quote var)) val)))
|
||
|
||
;; Added in Emacs 24.3 (mirrors/emacs@b335efc3).
|
||
(unless (fboundp 'defvar-local)
|
||
(defmacro defvar-local (var val &optional docstring)
|
||
"Define VAR as a buffer-local variable with default value VAL.
|
||
Like `defvar' but additionally marks the variable as being
|
||
automatically buffer-local wherever it is set."
|
||
(declare (debug defvar) (doc-string 3))
|
||
(list 'progn (list 'defvar var val docstring)
|
||
(list 'make-variable-buffer-local (list 'quote var)))))
|
||
|
||
) ;; eval-and-compile
|
||
|
||
|
||
;;
|
||
;; Customizable variables
|
||
;;
|
||
|
||
(defgroup irony nil
|
||
"C/C++ minor mode powered by libclang."
|
||
:group 'c)
|
||
|
||
(defcustom irony-lighter " Irony"
|
||
"Text to display in the mode line when irony mode is on."
|
||
:type 'string
|
||
:group 'irony)
|
||
|
||
(defcustom irony-user-dir (locate-user-emacs-file "irony/")
|
||
"Directory containing the Irony generated files.
|
||
|
||
The slash is expected at the end."
|
||
:type 'directory
|
||
:risky t
|
||
:group 'irony)
|
||
|
||
(defcustom irony-supported-major-modes '(c++-mode
|
||
c-mode
|
||
objc-mode)
|
||
"List of modes known to be compatible with Irony."
|
||
:type '(repeat symbol)
|
||
:group 'irony)
|
||
|
||
;;;###autoload
|
||
(defcustom irony-additional-clang-options nil
|
||
"Additional command line options to pass down to libclang.
|
||
|
||
Please, do NOT use this variable to add header search paths, only
|
||
additional warnings or compiler options.
|
||
|
||
These compiler options will be prepended to the command line, in
|
||
order to not override the value coming from a compilation
|
||
database."
|
||
:type '(repeat string)
|
||
:options '("-Wdocumentation")
|
||
:group 'irony)
|
||
|
||
(defcustom irony-lang-compile-option-alist
|
||
'((c++-mode . "c++")
|
||
(c-mode . "c")
|
||
(objc-mode . "objective-c"))
|
||
"Alist to decide the language option to used based on the `major-mode'."
|
||
:type '(alist :key-type symbol :value-type string)
|
||
:group 'irony)
|
||
|
||
(defcustom irony-cmake-executable "cmake"
|
||
"Name or path of the CMake executable."
|
||
:type 'string
|
||
:group 'irony)
|
||
|
||
(defcustom irony-server-source-dir
|
||
(expand-file-name "server" (file-name-directory (find-library-name "irony")))
|
||
"Points to the irony-server source directory.
|
||
|
||
This should point to the directory that contains the top-most
|
||
CMakeLists.txt used to build the server."
|
||
:type 'directory
|
||
:group 'irony)
|
||
|
||
(defcustom irony-server-build-dir nil
|
||
"Build directory for irony-server.
|
||
|
||
If set to nil the default is to create a build directory in
|
||
`temporary-file-directory'/build-irony-server-`(irony-version)'."
|
||
:type 'directory
|
||
:group 'irony)
|
||
|
||
(defcustom irony-server-install-prefix irony-user-dir
|
||
"Installation prefix used to install irony-server.
|
||
|
||
The irony-server executable is expected to be in
|
||
`irony-server-install-prefix'/bin/."
|
||
:type 'directory
|
||
:group 'irony)
|
||
|
||
|
||
;;
|
||
;; Public/API variables
|
||
;;
|
||
;; Non-customizable variables provided by Irony that can be useful to other
|
||
;; packages.
|
||
;;
|
||
;; Note that they shouldn't be modified directly by external packages, just
|
||
;; read.
|
||
;;
|
||
|
||
;; TODO: make this variable public when the CDB API stabilizes.
|
||
(defvar-local irony--compile-options nil
|
||
"Compile options for the current file.
|
||
|
||
The compile options used by the compiler to build the current
|
||
buffer file.")
|
||
|
||
;; TODO: make this variable public when the CDB API stabilizes.
|
||
(defvar-local irony--working-directory nil
|
||
"The working directory to pass to libclang, if any.")
|
||
|
||
|
||
;;
|
||
;; Internal variables
|
||
;;
|
||
;; The prefix `irony--' is used when something can completely change (or
|
||
;; disappear) from one release to the other.
|
||
;;
|
||
;; -- https://lists.gnu.org/archive/html/emacs-devel/2013-06/msg01129.html
|
||
|
||
(defconst irony--eot "\n;;EOT\n"
|
||
"String sent by the server to signal the end of a response.")
|
||
|
||
|
||
;;
|
||
;; Utility functions & macros
|
||
;;
|
||
|
||
(defmacro irony--aif (test if-expr &rest else-body)
|
||
(declare (indent 2))
|
||
`(let ((it ,test))
|
||
(if it
|
||
,if-expr
|
||
(progn ,@else-body))))
|
||
|
||
(defmacro irony--awhen (test &rest body)
|
||
(declare (indent 1))
|
||
`(let ((it ,test))
|
||
(when it
|
||
(progn ,@body))))
|
||
|
||
(defun irony--assoc-all (key list)
|
||
(delq nil (mapcar #'(lambda (c)
|
||
(when (equal (car c) key)
|
||
c))
|
||
list)))
|
||
|
||
(defmacro irony--without-narrowing (&rest body)
|
||
"Remove the effect of narrowing for the current buffer.
|
||
|
||
Note: If `save-excursion' is needed for BODY, it should be used
|
||
before calling this macro."
|
||
(declare (indent 0) (debug t))
|
||
`(save-restriction
|
||
(widen)
|
||
(progn ,@body)))
|
||
|
||
(defun irony--buffer-size-in-bytes ()
|
||
"Return the buffer size, in bytes."
|
||
(1- (position-bytes (point-max))))
|
||
|
||
(defun irony--read-char-choice (prompt chars)
|
||
"Wrapper around `read-char-choice', available since Emacs 24."
|
||
(setq prompt (concat prompt " [" chars "]: "))
|
||
(if (fboundp 'read-char-choice)
|
||
(read-char-choice prompt chars)
|
||
(setq prompt (propertize prompt 'face 'minibuffer-prompt))
|
||
(let ((cursor-in-echo-area t)
|
||
k)
|
||
(while (not (member k chars))
|
||
(setq k (read-char-exclusive prompt)))
|
||
k)))
|
||
|
||
(defun irony--shorten-path (path)
|
||
"Make PATH as short as possible.
|
||
|
||
The given path can be considered understandable by human but not
|
||
necessary a valid path string to use in code. Its only purpose is
|
||
to be displayed to the user."
|
||
(let ((relative (file-relative-name path))
|
||
(abbreviated (abbreviate-file-name path)))
|
||
(if (< (string-width relative) (string-width abbreviated))
|
||
relative
|
||
abbreviated)))
|
||
|
||
(defun irony--split-command-line-1 (quoted-str)
|
||
"Remove the escaped quotes and backlash from a QUOTED-STR.
|
||
|
||
Return a list of the final characters in the reverse order.
|
||
|
||
Only to be consumed by `irony--split-command-line'."
|
||
(let ((len (length quoted-str))
|
||
(i 0)
|
||
ch next-ch
|
||
result)
|
||
(while (< i len)
|
||
(setq ch (aref quoted-str i))
|
||
(when (eq ch ?\\)
|
||
(let ((next-ch (and (< (1+ i) len)
|
||
(aref quoted-str (1+ i)))))
|
||
(when (member next-ch '(?\\ ?\"))
|
||
(setq ch next-ch)
|
||
(cl-incf i))))
|
||
(push ch result)
|
||
(cl-incf i))
|
||
result))
|
||
|
||
;; TODO: rewrite the function correctly to handle things like the following:
|
||
;;
|
||
;; "/usr/bin/clang++ -Irelative -DSOMEDEF=\"With spaces, quotes and \\-es.\" <args...>"
|
||
(defun irony--split-command-line (cmd-line)
|
||
"Split CMD-LINE into a list of arguments.
|
||
|
||
Takes care of double quotes as well as backslash.
|
||
|
||
Sadly I had to write this because `split-string-and-unquote'
|
||
breaks with escaped quotes in compile_commands.json, such as in:
|
||
|
||
/usr/bin/c++ -DLLVM_VERSION_INFO=\\\\\\\"3.2svn\\\\\\\" <args>"
|
||
;; everytime I write a function like this one, it makes me feel bad
|
||
(let* ((len (length cmd-line))
|
||
(spaces (string-to-list " \f\t\n\r\v"))
|
||
(first-not-spaces-re (concat "[^" spaces "]"))
|
||
(i 0)
|
||
ch
|
||
args cur-arg)
|
||
(while (< i len)
|
||
(setq ch (aref cmd-line i))
|
||
(cond
|
||
((member ch spaces) ;spaces
|
||
(when cur-arg
|
||
(setq args (cons (apply 'string (nreverse cur-arg)) args)
|
||
cur-arg nil))
|
||
;; move to the next char
|
||
(setq i (or (string-match-p first-not-spaces-re cmd-line i)
|
||
len)))
|
||
((eq ch ?\") ;quoted string
|
||
(let ((endq (string-match-p "[^\\]\"" cmd-line i)))
|
||
(unless endq
|
||
(error "Irony: ill formed command line"))
|
||
(let ((quoted-str (substring cmd-line (1+ i) (1+ endq))))
|
||
(setq cur-arg (append (irony--split-command-line-1 quoted-str)
|
||
cur-arg)
|
||
i (+ endq 2)))))
|
||
(t ;a valid char
|
||
;; if it's an escape of: a backslash, a quote or a space push
|
||
;; only the following char.
|
||
(when (eq ch ?\\)
|
||
(let ((next-ch (and (< (1+ i) len)
|
||
(aref cmd-line (1+ i)))))
|
||
(when (or (member next-ch '(?\\ ?\"))
|
||
(member next-ch spaces))
|
||
(setq ch next-ch)
|
||
(cl-incf i))))
|
||
(push ch cur-arg)
|
||
(cl-incf i))))
|
||
(when cur-arg
|
||
(setq args (cons (apply 'string (nreverse cur-arg)) args)))
|
||
(nreverse args)))
|
||
|
||
|
||
;;
|
||
;; Mode
|
||
;;
|
||
|
||
(defvar irony-mode-map (make-sparse-keymap)
|
||
"Keymap used in `irony-mode' buffers.")
|
||
|
||
;;;###autoload
|
||
(define-minor-mode irony-mode
|
||
"Minor mode for C, C++ and Objective-C, powered by libclang."
|
||
nil
|
||
irony-lighter
|
||
irony-mode-map
|
||
:group 'irony
|
||
(if irony-mode
|
||
(irony--mode-enter)
|
||
(irony--mode-exit)))
|
||
|
||
(defun irony--mode-enter ()
|
||
;; warn the user about modes such as php-mode who inherits c-mode
|
||
(when (not (memq major-mode irony-supported-major-modes))
|
||
(display-warning 'irony "Major mode is unknown to Irony,\
|
||
see `irony-supported-major-modes'."))
|
||
;; warn the user about Windows-specific issues
|
||
(when (eq system-type 'windows-nt)
|
||
(cond
|
||
((version< emacs-version "24.4")
|
||
(display-warning 'irony "Emacs >= 24.4 expected on Windows."))
|
||
((and (boundp 'w32-pipe-read-delay) (> w32-pipe-read-delay 0))
|
||
(display-warning 'irony "Performance will be bad because a\
|
||
pipe delay is set for this platform (see variable\
|
||
`w32-pipe-read-delay')."))))
|
||
(irony-completion--enter))
|
||
|
||
(defun irony--mode-exit ()
|
||
(irony-completion--exit))
|
||
|
||
;;;###autoload
|
||
(defun irony-version (&optional show-version)
|
||
"Return the version number of the file irony.el.
|
||
|
||
If called interactively display the version in the echo area."
|
||
(interactive (list t))
|
||
;; Shamelessly stolen from `company-mode'.
|
||
(with-temp-buffer
|
||
(insert-file-contents (find-library-name "irony"))
|
||
(let ((v (lm-version)))
|
||
(when show-version
|
||
(message "irony version: %s" v))
|
||
v)))
|
||
|
||
|
||
;;
|
||
;; Compile options handling
|
||
;;
|
||
|
||
(defun irony--lang-compile-option ()
|
||
(irony--awhen (cdr-safe (assq major-mode irony-lang-compile-option-alist))
|
||
(list "-x" it)))
|
||
|
||
(defun irony--extract-working-directory-option (flags)
|
||
"Return working directory specified on the command line, if
|
||
any."
|
||
(catch 'found
|
||
(while flags
|
||
(let ((flag (car flags)))
|
||
(cond
|
||
((string= "-working-directory" flag)
|
||
(throw 'found (cadr flags)))
|
||
((string-prefix-p "-working-directory=" flag)
|
||
(throw 'found (substring flag (length "-working-directory="))))
|
||
(t
|
||
(setq flags (cdr flags))))))))
|
||
|
||
(defun irony--adjust-compile-options ()
|
||
"The compile options to send to libclang."
|
||
;; TODO: if current buffer has no associated file (will be sent as '-') but is
|
||
;; in an existing directory, we will want to add -I (directory-file-name
|
||
;; buffer-file-name) to find the relative headers
|
||
(append
|
||
(irony--lang-compile-option)
|
||
(irony--awhen irony--working-directory
|
||
(unless (irony--extract-working-directory-option irony--compile-options)
|
||
(list "-working-directory" it)))
|
||
irony-additional-clang-options
|
||
irony--compile-options))
|
||
|
||
(defun irony--extract-user-search-paths (compile-options work-dir)
|
||
"Retrieve the user search paths present in COMPILE-OPTIONS.
|
||
|
||
Relative paths are expanded to be relative to WORK-DIR.
|
||
|
||
The returned paths are returned as
|
||
directory (`file-name-as-directory').
|
||
|
||
Note: WORK-DIR is not used when the compile option
|
||
'-working-directory=<directory>' is detected in COMPILE-OPTIONS."
|
||
(setq work-dir (or (irony--extract-working-directory-option compile-options)
|
||
work-dir))
|
||
(let (include-dirs opt)
|
||
(while (setq opt (car compile-options))
|
||
(cond
|
||
((string= "-I" opt)
|
||
(add-to-list 'include-dirs (nth 1 compile-options) t)
|
||
(setq compile-options (cddr compile-options)))
|
||
((string-prefix-p "-I" opt)
|
||
(add-to-list 'include-dirs (substring opt 2) t)
|
||
(setq compile-options (cdr compile-options)))
|
||
(t
|
||
(setq compile-options (cdr compile-options)))))
|
||
(delete-dups (mapcar #'(lambda (path)
|
||
(file-name-as-directory
|
||
(expand-file-name path work-dir)))
|
||
include-dirs))))
|
||
|
||
|
||
;;
|
||
;; Irony-Server setup
|
||
;;
|
||
|
||
(defvar irony--server-install-command-history nil)
|
||
(defun irony--install-server-read-command (command)
|
||
(read-shell-command
|
||
"Install command: " command
|
||
(if (equal (car irony--server-install-command-history) command)
|
||
'(irony--server-install-command-history . 1)
|
||
'irony--server-install-command-history)))
|
||
|
||
(defun irony-install-server (command)
|
||
"Install or reinstall the Irony server.
|
||
|
||
The installation requires CMake and the libclang developpement package."
|
||
(interactive
|
||
(list (let ((command
|
||
(format
|
||
(concat "%s %s %s && %s --build . "
|
||
"--use-stderr --config Release --target install")
|
||
(shell-quote-argument irony-cmake-executable)
|
||
(shell-quote-argument (concat "-DCMAKE_INSTALL_PREFIX="
|
||
(expand-file-name
|
||
irony-server-install-prefix)))
|
||
(shell-quote-argument irony-server-source-dir)
|
||
(shell-quote-argument irony-cmake-executable))))
|
||
(irony--install-server-read-command command))))
|
||
(let ((build-dir (or irony-server-build-dir
|
||
(concat
|
||
(file-name-as-directory temporary-file-directory)
|
||
(file-name-as-directory (format "build-irony-server-%s"
|
||
(irony-version)))))))
|
||
(make-directory build-dir t)
|
||
(let ((default-directory build-dir))
|
||
;; we need to kill the process to be able to install a new one,
|
||
;; at least on Windows
|
||
(irony-server-kill)
|
||
(with-current-buffer (compilation-start command nil
|
||
#'(lambda (maj-mode)
|
||
"*irony-server build*"))
|
||
(setq-local compilation-finish-functions
|
||
'(irony--server-install-finish-function))))))
|
||
|
||
(defun irony--server-install-finish-function (buffer msg)
|
||
(if (string= "finished\n" msg)
|
||
(message "irony-server installed successfully!")
|
||
(message "Failed to build irony-server, you are on your own buddy!")))
|
||
|
||
(defun irony--locate-server-executable ()
|
||
"Check if an irony-server exists for the current buffer."
|
||
(let ((exe (expand-file-name "bin/irony-server" irony-server-install-prefix)))
|
||
(condition-case err
|
||
(let ((irony-server-version (car (process-lines exe "--version"))))
|
||
(if (and (string-match "^irony-server version " irony-server-version)
|
||
(version= (irony-version)
|
||
(substring irony-server-version
|
||
(length "irony-server version "))))
|
||
;; irony-server is working and up-to-date!
|
||
exe
|
||
(message "irony-server version mismatch: %s"
|
||
(substitute-command-keys
|
||
"type `\\[irony-install-server]' to reinstall"))
|
||
nil))
|
||
(error
|
||
(if (file-executable-p exe)
|
||
;; failed to execute due to a runtime problem, i.e: libclang.so isn't
|
||
;; in the ld paths
|
||
(message "error: irony-server is broken, good luck buddy! %s"
|
||
(error-message-string err))
|
||
;; irony-server doesn't exists, first time irony-mode is used? inform
|
||
;; the user about how to build the executable
|
||
(message "%s"
|
||
(substitute-command-keys
|
||
"Type `\\[irony-install-server]' to install irony-server")))
|
||
;; return nil on error
|
||
nil))))
|
||
|
||
|
||
;;
|
||
;; irony-server process management.
|
||
;;
|
||
|
||
(defvar irony--server-executable nil)
|
||
(defvar irony--server-process nil)
|
||
(defvar irony--server-buffer " *Irony*"
|
||
"The name of the buffer for the irony process to run in.
|
||
|
||
When using a leading space, the buffer is hidden from the buffer
|
||
list (and undo information is not kept).")
|
||
|
||
(defun irony--start-server-process ()
|
||
(when (setq irony--server-executable (or irony--server-executable
|
||
(irony--locate-server-executable)))
|
||
(let ((process-connection-type nil)
|
||
(process-adaptive-read-buffering nil)
|
||
process)
|
||
(setq process
|
||
(start-process-shell-command
|
||
"Irony" ;process name
|
||
irony--server-buffer ;buffer
|
||
(format "%s -i 2> %s" ;command
|
||
(shell-quote-argument irony--server-executable)
|
||
(expand-file-name
|
||
(format-time-string "irony.%Y-%m-%d_%Hh-%Mm-%Ss.log")
|
||
temporary-file-directory))))
|
||
(buffer-disable-undo irony--server-buffer)
|
||
(set-process-query-on-exit-flag process nil)
|
||
(set-process-sentinel process 'irony--server-process-sentinel)
|
||
(set-process-filter process 'irony--server-process-filter)
|
||
process)))
|
||
|
||
;;;###autoload
|
||
(defun irony-server-kill ()
|
||
"Kill the running irony-server process, if any."
|
||
(interactive)
|
||
(when (and irony--server-process (process-live-p irony--server-process))
|
||
(kill-process irony--server-process)
|
||
(setq irony--server-process nil)))
|
||
|
||
(defun irony--get-server-process-create ()
|
||
(if (and irony--server-process
|
||
(process-live-p irony--server-process))
|
||
irony--server-process
|
||
(setq irony--server-process (irony--start-server-process))))
|
||
|
||
(defun irony--server-process-sentinel (process event)
|
||
(unless (process-live-p process)
|
||
(setq irony--server-process nil)
|
||
(message "irony process stopped!")))
|
||
|
||
(defun irony--process-server-response (process response)
|
||
(let ((sexp (read response))
|
||
(callback (irony--server-process-pop-callback process)))
|
||
(with-demoted-errors "Warning: %S"
|
||
(apply (car callback) sexp (cdr callback)))))
|
||
|
||
(defun irony--server-process-filter (process output)
|
||
"Handle output that come from an irony-server process."
|
||
(let ((pbuf (process-buffer process))
|
||
responses)
|
||
;; append output to process buffer
|
||
(when (buffer-live-p pbuf)
|
||
(with-current-buffer pbuf
|
||
(save-excursion
|
||
(goto-char (process-mark process))
|
||
(insert output)
|
||
(set-marker (process-mark process) (point))
|
||
;; check if the message is complete based on `irony--eot'
|
||
(goto-char (point-min))
|
||
(while (search-forward irony--eot nil t)
|
||
(let ((response (buffer-substring-no-properties (point-min)
|
||
(point))))
|
||
(delete-region (point-min) (point))
|
||
(setq responses (cons response responses))))
|
||
(goto-char (process-mark process)))))
|
||
;; Handle all responses.
|
||
(mapc #'(lambda (r)
|
||
(irony--process-server-response process r))
|
||
(nreverse responses))))
|
||
|
||
(defun irony--server-process-push-callback (p cb)
|
||
(let ((callbacks (process-get p 'irony-callback-stack)))
|
||
(if callbacks
|
||
(nconc callbacks (list cb))
|
||
(process-put p 'irony-callback-stack (list cb)))))
|
||
|
||
(defun irony--server-process-pop-callback (p)
|
||
(let ((callbacks (process-get p 'irony-callback-stack)))
|
||
(process-put p 'irony-callback-stack (cdr callbacks))
|
||
(car callbacks)))
|
||
|
||
|
||
;;
|
||
;; Server commands
|
||
;;
|
||
|
||
(defun irony--get-buffer-path-for-server ()
|
||
"Get the path of the current buffer to send to irony-server.
|
||
|
||
If no such file exists on the filesystem the special file '-' is
|
||
returned instead."
|
||
(if (and buffer-file-name (file-exists-p buffer-file-name))
|
||
buffer-file-name
|
||
"-"))
|
||
|
||
(defun irony--send-request (request callback &rest args)
|
||
(let ((process (irony--get-server-process-create))
|
||
(argv (cons request args)))
|
||
(when (and process (process-live-p process))
|
||
(irony--server-process-push-callback process callback)
|
||
;; skip narrowing to compute buffer size and content
|
||
(irony--without-narrowing
|
||
(process-send-string process
|
||
(format "%s\n"
|
||
(combine-and-quote-strings argv)))))))
|
||
|
||
(defvar irony--sync-id 0 "ID of next sync request.")
|
||
(defvar irony--sync-result '(-1 . nil)
|
||
"The car stores the id of the result and the cdr stores the return value.")
|
||
|
||
(defun irony--sync-request-callback (response id)
|
||
(setq irony--sync-result (cons id response)))
|
||
|
||
(defun irony--send-request-sync (request &rest args)
|
||
"Send a request to irony-server and wait for the result."
|
||
(let* ((id irony--sync-id)
|
||
(callback (list #'irony--sync-request-callback id)))
|
||
(setq irony--sync-id (1+ irony--sync-id))
|
||
(with-local-quit
|
||
(let ((process (irony--get-server-process-create)))
|
||
(apply 'irony--send-request request callback args)
|
||
(while (not (= id (car irony--sync-result)))
|
||
(accept-process-output process))
|
||
(cdr irony--sync-result)))))
|
||
|
||
(defun irony--send-parse-request (request callback &rest args)
|
||
"Send a request that acts on the current buffer to irony-server.
|
||
|
||
This concerns mainly irony-server commands that do some work on a
|
||
translation unit for libclang, the unsaved buffer data are taken
|
||
care of."
|
||
(let ((process (irony--get-server-process-create))
|
||
(argv (append (list request
|
||
"--num-unsaved=1"
|
||
(irony--get-buffer-path-for-server))
|
||
args))
|
||
(compile-options (irony--adjust-compile-options)))
|
||
(when (and process (process-live-p process))
|
||
(irony--server-process-push-callback process callback)
|
||
;; skip narrowing to compute buffer size and content
|
||
(irony--without-narrowing
|
||
;; always make sure to finish with a newline (required by irony-server
|
||
;; to play nice with line buffering even when the file doesn't end with
|
||
;; a newline)
|
||
;;
|
||
;; it is important to send the request atomically rather than using
|
||
;; multiple process-send calls. On Windows at least, if the request is
|
||
;; not atomic, content from subsequent requests can get intermixed with
|
||
;; earlier requests. This may be because of how Emacs behaves when the
|
||
;; buffers to communicate with processes are full (see
|
||
;; http://www.gnu.org/software/emacs/manual/html_node/elisp/Input-to-Processes.html).
|
||
(process-send-string process
|
||
(format "%s\n%s\n%s\n%d\n%s\n"
|
||
(combine-and-quote-strings argv)
|
||
(combine-and-quote-strings compile-options)
|
||
buffer-file-name
|
||
(irony--buffer-size-in-bytes)
|
||
(buffer-substring (point-min) (point-max))))))))
|
||
|
||
|
||
;;
|
||
;; Buffer parsing
|
||
;;
|
||
|
||
(defvar-local irony--parse-buffer-state nil
|
||
"If non-nil, state is of the form (context . status) where:
|
||
|
||
- context is `irony--parse-buffer-context'
|
||
- status is one of the following symbol: requested, done")
|
||
|
||
(defvar-local irony--parse-buffer-callbacks nil)
|
||
(defvar-local irony--parse-buffer-last-results nil
|
||
"Holds the last parsing results.")
|
||
|
||
(defun irony--parse-buffer-context ()
|
||
;; FIXME: use the ticks of all irony's files that may influence this one?
|
||
;; FIXME: compile options should be part of the context? or settings the
|
||
;; compile options should flush the context alternatively.
|
||
(buffer-chars-modified-tick))
|
||
|
||
(defun irony--buffer-parsed-p ()
|
||
(equal irony--parse-buffer-state
|
||
(cons (irony--parse-buffer-context) 'done)))
|
||
|
||
(defun irony--buffer-parsing-in-progress-p ()
|
||
(equal irony--parse-buffer-state
|
||
(cons (irony--parse-buffer-context) 'requested)))
|
||
|
||
(defun irony--parse-request-handler (result context buffer)
|
||
(with-current-buffer buffer
|
||
(let ((callbacks irony--parse-buffer-callbacks)
|
||
(status (cond
|
||
;; context out-of-date?
|
||
((not (equal context (irony--parse-buffer-context)))
|
||
'cancelled)
|
||
(result
|
||
'success)
|
||
(t
|
||
'failed))))
|
||
(setq irony--parse-buffer-last-results (list status)
|
||
irony--parse-buffer-callbacks nil
|
||
irony--parse-buffer-state (cons context 'done))
|
||
(mapc #'(lambda (cb) (funcall cb status)) callbacks))))
|
||
|
||
;; TODO: provide a synchronous/blocking counterpart, see how
|
||
;; `url-retrieve-synchronously' does it
|
||
(defun irony--parse-buffer-async (callback &optional force)
|
||
"Parse the current buffer and call CALLACK when done.
|
||
|
||
Parsing is effectively done only if need, if the buffer hasn't
|
||
changed since the last parsing, CALLBACK is called immediately.
|
||
|
||
Use FORCE to force a re-parse unconditionally.
|
||
|
||
Callback is a function that is called with one argument, the
|
||
status of the parsing request, the value is one of the following
|
||
symbol:
|
||
|
||
- success: parsing the file was a sucess, irony-server has
|
||
up-to-date information about the buffer
|
||
|
||
- failed: parsing the file resulted in a failure (file access
|
||
rights wrong, whatever)
|
||
|
||
- cancelled: if the request for this callback was superseded by
|
||
another request or if the callback is out-of-date (but not
|
||
necessarily superseded by another request)"
|
||
(when force
|
||
(setq irony--parse-buffer-state nil))
|
||
(if (irony--buffer-parsed-p)
|
||
(apply callback irony--parse-buffer-last-results)
|
||
(let (obselete-callbacks)
|
||
(unless (irony--buffer-parsing-in-progress-p)
|
||
(let ((context (irony--parse-buffer-context)))
|
||
(setq obselete-callbacks irony--parse-buffer-callbacks
|
||
irony--parse-buffer-callbacks nil
|
||
irony--parse-buffer-state (cons context 'requested))
|
||
(irony--send-parse-request "parse"
|
||
(list 'irony--parse-request-handler context
|
||
(current-buffer)))))
|
||
(push callback irony--parse-buffer-callbacks)
|
||
;; it's safer to call this last, since the function may be called recursively
|
||
(mapc #'(lambda (cb) (funcall cb 'cancelled)) obselete-callbacks))))
|
||
|
||
(defun irony-get-type--request-handler (types)
|
||
(when types
|
||
(if (cdr types)
|
||
(if (string= (car types) (cadr types))
|
||
(message "%s" (car types))
|
||
(message "%s (aka '%s')" (car types) (cadr types)))
|
||
(message "%s" (car types)))))
|
||
|
||
;;;###autoload
|
||
(defun irony-get-type ()
|
||
"Get the type of symbol under cursor."
|
||
(interactive)
|
||
(let ((line (line-number-at-pos))
|
||
(column (1+ (- (position-bytes (point))
|
||
(position-bytes (point-at-bol))))))
|
||
(irony--parse-buffer-async
|
||
(lambda (parse-status)
|
||
(when (eq parse-status 'success)
|
||
(irony--send-request
|
||
"get-type"
|
||
(list 'irony-get-type--request-handler)
|
||
(number-to-string line)
|
||
(number-to-string column)))))))
|
||
|
||
(provide 'irony)
|
||
|
||
;; Local Variables:
|
||
;; byte-compile-warnings: (not cl-functions)
|
||
;; End:
|
||
|
||
;;; irony.el ends here
|