You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
419 lines
16 KiB
419 lines
16 KiB
;;; company-meghanada.el --- Company support for meganada -*- coding: utf-8; lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2017 - 2020 Yutaka Matsubara
|
|
;; License: http://www.gnu.org/licenses/gpl.html
|
|
|
|
;; 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:
|
|
;;
|
|
;; The `company-meghanada' is a `company' backend that
|
|
;; will serve completion candidates asynchronously.
|
|
;;
|
|
|
|
;;; Code:
|
|
|
|
(eval-when-compile
|
|
(require 'cl-lib)
|
|
(require 'pcase))
|
|
|
|
(require 'company)
|
|
(require 'company-template)
|
|
(require 'thingatpt)
|
|
(require 'meghanada)
|
|
(require 'yasnippet)
|
|
|
|
(defgroup company-meghanada nil
|
|
"Company-mode completion backend for Meghanada."
|
|
:group 'meghanada)
|
|
|
|
(defcustom company-meghanada-show-annotation t
|
|
"Show an annotation inline with the candidate."
|
|
:group 'company-meghanada
|
|
:type 'boolean)
|
|
|
|
(defcustom company-meghanada-auto-import t
|
|
"Add new package class autoimport."
|
|
:group 'company-meghanada
|
|
:type 'boolean)
|
|
|
|
(defcustom company-meghanada-prefix-length nil
|
|
"Start completion prefix-length."
|
|
:group 'company-meghanada
|
|
:type 'integer)
|
|
|
|
(defcustom company-meghanada-insert-args nil
|
|
"Insert method argument information when you select a completion candidate.
|
|
If t is set, it will be inserted. The default is nil."
|
|
:group 'company-meghanada
|
|
:type 'boolean)
|
|
|
|
(defconst company-meghanada--trigger "^package \\|^import \\w\\{%d,\\}\\|new \\w\\{%d,\\}\\|@\\w\\{%d,\\}\\|(.*)\\.\\w*\\|[A-Za-z0-9]+\\.\\w*\\|\\.\\w*")
|
|
|
|
(defvar company-meghanada-trigger-regex nil)
|
|
|
|
;;;###autoload
|
|
(defun meghanada-company-enable ()
|
|
"Enable auto completion with company."
|
|
(company-mode t)
|
|
(if company-meghanada-prefix-length
|
|
(set (make-local-variable 'company-minimum-prefix-length) company-meghanada-prefix-length)
|
|
(set (make-local-variable 'company-meghanada-prefix-length) company-minimum-prefix-length))
|
|
(setq company-meghanada-trigger-regex (format company-meghanada--trigger
|
|
company-meghanada-prefix-length
|
|
company-meghanada-prefix-length
|
|
company-meghanada-prefix-length
|
|
company-meghanada-prefix-length))
|
|
(set (make-local-variable 'company-backends) '((company-meghanada :separate company-dabbrev-code)))
|
|
(yas-minor-mode t)
|
|
(make-local-variable 'yas-minor-mode-map)
|
|
(advice-add #' company--insert-candidate :override #'meghanada--insert-candidate))
|
|
|
|
(defun make-icon-hash (type)
|
|
(let ((kind-val (pcase type
|
|
("VARIABLE" 6)
|
|
("METHOD" 2)
|
|
("CONSTRUCTOR" 2)
|
|
("FIELD" 5)
|
|
("CLASS" 22)
|
|
("IMPORT" 10)
|
|
("PACKAGE" 10)))
|
|
(ht (make-hash-table :test 'equal)))
|
|
(puthash "kind" kind-val ht)
|
|
ht))
|
|
|
|
(defun company-meghanada--to-candidate (result)
|
|
(mapcar (lambda (candidate)
|
|
(propertize (nth 1 candidate)
|
|
'desc
|
|
(nth 2 candidate)
|
|
'meta
|
|
(nth 3 candidate)
|
|
'type
|
|
(nth 0 candidate)
|
|
'return-type
|
|
(nth 4 candidate)
|
|
'extra
|
|
(nth 5 candidate)
|
|
'lsp-completion-item
|
|
(make-icon-hash (nth 0 candidate)))) result))
|
|
|
|
(defun company-meghanada--to-candidates (output)
|
|
(when (> (length output) 0)
|
|
(company-meghanada--to-candidate output)))
|
|
|
|
(defun company-meghanada--autocomplete-callback (output &rest args)
|
|
(let ((callback (car args)))
|
|
(funcall callback (company-meghanada--to-candidates output))))
|
|
|
|
(defvar meghanada--sp-prefix nil)
|
|
|
|
(defun company-meghanada--candidates (prefix)
|
|
(let ((prefix (if meghanada--sp-prefix
|
|
meghanada--sp-prefix
|
|
prefix)))
|
|
(when prefix
|
|
(cons :async
|
|
#'(lambda (callback)
|
|
(meghanada-autocomplete-prefix-async
|
|
prefix
|
|
(list #'company-meghanada--autocomplete-callback callback)))))))
|
|
|
|
(defun meghanada--search-method-caller ()
|
|
(save-excursion
|
|
(backward-list)
|
|
(forward-char -1)
|
|
(get-text-property (point) 'return-type)))
|
|
|
|
(defun meghanada--search-access-caller ()
|
|
(save-excursion
|
|
(search-backward "." nil t)
|
|
(backward-word)
|
|
(if (= (meghanada--what-word) "this")
|
|
"this"
|
|
(get-text-property (point) 'return-type))))
|
|
|
|
(defun meghanada--last-is-paren ()
|
|
(save-excursion
|
|
(search-backward "." nil t)
|
|
(forward-char -1)
|
|
(while (or
|
|
(string= (char-to-string (char-after)) " ")
|
|
(string= (char-to-string (char-after)) "\n"))
|
|
(forward-char -1))
|
|
(string= (char-to-string (char-after)) ")")))
|
|
|
|
(defun meghanada--last-statement-position ()
|
|
;; Get position of nearest ";" and "{" character before current line, And
|
|
;; assume this is the last statement position
|
|
(max (save-excursion (or (search-backward ";" nil t) 0)
|
|
(save-excursion (or (search-backward "{" nil t) 0)))))
|
|
|
|
(defun meghanada--last-is-assignment (lap)
|
|
;; Whether is in an assignment statement, if in assignment statement, variable
|
|
;; type or name need to be send to backend to do smart completion
|
|
(save-excursion
|
|
(search-backward "=" lap t) 0))
|
|
|
|
(defun meghanada--variable-type-or-name (lap)
|
|
;; Get assignment statement variable type or variable name, then send it to
|
|
;; backend for smart completion
|
|
(save-excursion
|
|
(search-backward "=" lap t) (backward-word 2)
|
|
(if (< (point) lap)
|
|
(forward-word 2))
|
|
(meghanada--what-word)))
|
|
|
|
(defun meghanada--grab-symbol-cons ()
|
|
(let ((symbol (company-grab-symbol))
|
|
(re company-meghanada-trigger-regex))
|
|
|
|
(setq meghanada--sp-prefix nil)
|
|
(when symbol
|
|
(save-excursion
|
|
(if (looking-back re (line-beginning-position) t)
|
|
(let* ((match (match-string 0))
|
|
(keyword
|
|
(cond
|
|
((string-prefix-p "package" match) "*package")
|
|
|
|
((string-prefix-p "import " match)
|
|
(concat "*" (replace-regexp-in-string " " ":" match)))
|
|
|
|
((string-prefix-p "new" match)
|
|
(concat "*" (replace-regexp-in-string " " ":" match)))
|
|
|
|
((string-match "\)\\.\\(\\w*\\)$" match)
|
|
(let ((prefix (match-string 1 match))
|
|
(rt (meghanada--search-method-caller)))
|
|
(if rt
|
|
(concat "*method:" rt "#" prefix)
|
|
(concat "*method#" prefix))))
|
|
|
|
((string-match "\\.\\(\\w*\\)$" match)
|
|
(let* ((prefix (match-string 1 match))
|
|
(paren (meghanada--last-is-paren))
|
|
(lap (meghanada--last-statement-position))
|
|
(assign (meghanada--last-is-assignment lap))
|
|
(vt (if assign
|
|
(ignore-errors (meghanada--variable-type-or-name lap))))
|
|
(rt (if paren
|
|
(ignore-errors (meghanada--search-method-caller))
|
|
(ignore-errors (meghanada--search-access-caller))))
|
|
(sym (if paren
|
|
(save-excursion
|
|
(backward-list)
|
|
(forward-char -1)
|
|
(meghanada--what-word))
|
|
(save-excursion
|
|
(search-backward "." nil t)
|
|
(backward-word)
|
|
(meghanada--what-word)))))
|
|
(if assign
|
|
(if rt (concat "*method:" rt "*" vt "#" prefix)
|
|
(concat "*" sym "*" vt "#" prefix))
|
|
(if rt (concat "*method:" rt "#" prefix)
|
|
(concat "*" sym "#" prefix))
|
|
)))
|
|
|
|
((string-match "\\(.*\\)\\.\\(\\w*\\)$" match)
|
|
(let* ((var (match-string 1 match))
|
|
(prefix (match-string 2 match)))
|
|
(concat "*" var "#" prefix)))
|
|
(t match))))
|
|
|
|
(setq meghanada--sp-prefix keyword)
|
|
(cons symbol t))
|
|
symbol)))))
|
|
|
|
;; (defun company-meghanada--prefix ()
|
|
;; (company-grab-symbol-cons "\\(package \\)\\|\\(news \\)\\|[A-Za-z0-9)]+\\."))
|
|
|
|
(defun company-meghanada--prefix ()
|
|
(meghanada--grab-symbol-cons))
|
|
|
|
(defun company-meghanada--in-num-literal-p ()
|
|
"Returns t if point is in a numeric literal."
|
|
(let ((word (company-grab-word)))
|
|
(when word
|
|
(string-match-p "^0x\\|^[0-9]+" word))))
|
|
|
|
(defun company-meghanada--annotation (arg)
|
|
(let ((meta (get-text-property 0 'meta arg)))
|
|
(when (string-match "\\(([^-]*\\)" meta)
|
|
(substring meta (match-beginning 1) (match-end 1)))))
|
|
|
|
(defun company-meghanada--typep-annotation (arg)
|
|
(let ((desc (get-text-property 0 'desc arg)))
|
|
(when (string-match "\\(<[^-]*\\)" desc)
|
|
(substring desc (match-beginning 1) (match-end 1)))))
|
|
|
|
(defun company-meghanada--post-class (arg)
|
|
(let ((meta (get-text-property 0 'meta arg))
|
|
(anno (company-meghanada--typep-annotation arg))
|
|
(return-t (get-text-property 0 'return-type arg)))
|
|
(unless (meghanada--import-exists-p meta)
|
|
(if company-meghanada-auto-import
|
|
(meghanada--add-import meta (current-buffer))
|
|
(when (y-or-n-p (format "Add import %s ? " (meghanada--import-name meta)))
|
|
(meghanada--add-import meta (current-buffer)))))
|
|
|
|
(save-excursion
|
|
(forward-char -1)
|
|
(set-text-properties
|
|
(beginning-of-thing 'symbol)
|
|
(end-of-thing 'symbol)
|
|
(list 'class t 'return-type return-t 'meta meta 'type 'class)))
|
|
|
|
(if (and meghanada--sp-prefix
|
|
(or (string-prefix-p "*new" meghanada--sp-prefix)
|
|
(string-prefix-p "@" meghanada--sp-prefix)))
|
|
(if anno
|
|
;; complete diamond op. like a new HashMap<>()
|
|
(progn
|
|
(insert "<>()")
|
|
(backward-char 3))
|
|
(progn
|
|
(insert "()")
|
|
(backward-char 1)))
|
|
(when anno
|
|
(insert anno)
|
|
(when company-meghanada-insert-args
|
|
(company-template-c-like-templatify anno))))))
|
|
|
|
(defun company-meghanada--post-method (arg)
|
|
(let* ((meta (get-text-property 0 'meta arg))
|
|
(desc (get-text-property 0 'desc arg))
|
|
(anno (company-meghanada--annotation arg))
|
|
(return-t (get-text-property 0 'return-type arg))
|
|
(extra (split-string (get-text-property 0 'extra arg))))
|
|
(when return-t
|
|
(save-excursion
|
|
(forward-char -1)
|
|
(set-text-properties
|
|
(beginning-of-thing 'symbol)
|
|
(end-of-thing 'symbol)
|
|
(list 'return-type return-t 'meta meta 'type 'method))))
|
|
(when anno
|
|
(when company-meghanada-insert-args
|
|
(company-template-c-like-templatify anno))
|
|
(when (and
|
|
(> (length extra) 1)
|
|
(string= "static-import" (car extra)))
|
|
(let* ((class (nth 1 extra))
|
|
(imp (format "%s#%s" class arg)))
|
|
(if company-meghanada-auto-import
|
|
(meghanada--add-import imp (current-buffer))
|
|
(when (y-or-n-p
|
|
(format "Add import %s ? " (meghanada--import-name class)))
|
|
(meghanada--add-import imp (current-buffer)))))))))
|
|
|
|
(defun company-meghanada--post-field (arg)
|
|
(let ((meta (get-text-property 0 'meta arg))
|
|
(anno (company-meghanada--annotation arg))
|
|
(return-t (get-text-property 0 'return-type arg))
|
|
(extra (split-string (get-text-property 0 'extra arg))))
|
|
(when return-t
|
|
(save-excursion
|
|
(forward-char -1)
|
|
(set-text-properties
|
|
(beginning-of-thing 'symbol)
|
|
(end-of-thing 'symbol)
|
|
(list 'return-type return-t 'meta meta 'type 'field)))
|
|
(when (and
|
|
(> (length extra) 1)
|
|
(string= "static-import" (car extra)))
|
|
(let* ((class (nth 1 extra))
|
|
(imp (format "%s#%s" class arg)))
|
|
(if company-meghanada-auto-import
|
|
(meghanada--add-import imp (current-buffer))
|
|
(when (y-or-n-p
|
|
(format "Add import %s ? " (meghanada--import-name class)))
|
|
(meghanada--add-import imp (current-buffer)))))))))
|
|
|
|
(defun company-meghanada--post-var (arg)
|
|
(let ((meta (get-text-property 0 'meta arg))
|
|
(anno (company-meghanada--annotation arg))
|
|
(return-t (get-text-property 0 'return-type arg)))
|
|
(when return-t
|
|
(save-excursion
|
|
(forward-char -1)
|
|
(set-text-properties
|
|
(beginning-of-thing 'symbol)
|
|
(end-of-thing 'symbol)
|
|
(list 'return-type return-t 'meta meta 'type 'var))))))
|
|
|
|
(defun company-meghanada--post-completion (arg)
|
|
(let ((type (intern (get-text-property 0 'type arg)))
|
|
(meta (get-text-property 0 'meta arg))
|
|
(desc (get-text-property 0 'desc arg))
|
|
(anno (company-meghanada--annotation arg)))
|
|
(meghanada-autocomplete-resolve-async type arg desc #'identity)
|
|
(pcase type
|
|
;; completion class
|
|
(`CLASS (company-meghanada--post-class arg))
|
|
;; completion field
|
|
(`FIELD (company-meghanada--post-field arg))
|
|
;; completion method
|
|
(`METHOD (company-meghanada--post-method arg))
|
|
;; completion var
|
|
(`VAR (company-meghanada--post-var arg))
|
|
;; completion const
|
|
(`CONSTRUCTOR (progn (insert "()") (backward-char 1)))
|
|
;; completion const
|
|
(`IMPORT (progn
|
|
(backward-word)
|
|
(insert meta)
|
|
(insert ";")
|
|
(delete-region (point) (+ (point) (length arg))))))))
|
|
|
|
(defun substring--candidate (candidate)
|
|
(if (and (meghanada-alive-p) (not company-meghanada-insert-args))
|
|
(if (string-match "\\(([^-]*\\)" candidate)
|
|
(substring candidate 0 (match-beginning 1))
|
|
candidate)
|
|
candidate))
|
|
|
|
(defun meghanada--insert-candidate (candidate)
|
|
(when (> (length candidate) 0)
|
|
(setq candidate (substring-no-properties candidate))
|
|
(if (eq (company-call-backend 'ignore-case) 'keep-prefix)
|
|
(insert (substring--candidate (company-strip-prefix candidate)))
|
|
(unless (equal company-prefix candidate)
|
|
(delete-region (- (point) (length company-prefix)) (point))
|
|
(insert (substring--candidate candidate))))))
|
|
|
|
(defun company-meghanada (command &optional arg &rest ignored)
|
|
(cl-case command
|
|
(prefix (and (meghanada-alive-p)
|
|
(not (company-in-string-or-comment))
|
|
(not (company-meghanada--in-num-literal-p))
|
|
(or (company-meghanada--prefix) 'stop)))
|
|
(candidates (company-meghanada--candidates arg))
|
|
(meta (get-text-property 0 'meta arg))
|
|
(annotation (when company-meghanada-show-annotation
|
|
(concat " " (get-text-property 0 'desc arg))))
|
|
(ignore-case t)
|
|
(sorted t)
|
|
(no-cache
|
|
(unless (and (string= "prefix" meghanada-completion-matcher) (string= "prefix" meghanada-class-completion-matcher))
|
|
t))
|
|
(require-match 'never)
|
|
(post-completion
|
|
(company-meghanada--post-completion arg))))
|
|
|
|
(provide 'company-meghanada)
|
|
|
|
;;; company-meghanada.el ends here
|