From: João Távora Date: Tue, 5 Jun 2018 18:13:46 +0000 (+0100) Subject: Merge master into jsonrpc-refactor (using imerge) X-Git-Tag: emacs-29.0.90~1616^2~524^2~4^2~489^2~9 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=41d646a830cac5b346de3fc015bbd8509c02c90b;p=emacs.git Merge master into jsonrpc-refactor (using imerge) --- 41d646a830cac5b346de3fc015bbd8509c02c90b diff --cc lisp/progmodes/eglot.el index 3f82c893fd6,950cf6ada89..d5498f95334 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@@ -86,15 -85,15 +86,15 @@@ mode symbol. SPEC i PROGRAM is called with ARGS and is expected to serve LSP requests over the standard input/output channels. --* A list (HOST PORT [ARGS...]) where HOST is a string and PORT is a --positive integer number for connecting to a server via TCP. ++* A list (HOST PORT [ARGS...]) where HOST is a string and PORT is ++a positive integer number for connecting to a server via TCP. Remaining ARGS are passed to `open-network-stream' for upgrading --the connection with encryption, etc... ++the connection with encryption or other capabilities. * A function of no arguments returning a connected process. * A cons (CLASS-NAME . SPEC) where CLASS-NAME is a symbol --designating a subclass of `eglot-lsp-server', for ++designating a subclass of symbol `eglot-lsp-server', for representing experimental LSP servers. In this case SPEC is interpreted as described above this point.") @@@ -120,13 -123,13 +120,6 @@@ lasted more than that many seconds. (let ((b (cl-gensym))) `(let ((,b ,buf)) (if (buffer-live-p ,b) (with-current-buffer ,b ,@body))))) --(cl-defmacro eglot--lambda (cl-lambda-list &body body) -- "Make a unary function of ARG, a plist-like JSON object. --CL-LAMBDA-LIST destructures ARGS before running BODY." -- (declare (indent 1) (debug (sexp &rest form))) -- (let ((e (gensym "eglot--lambda-elem"))) -- `(lambda (,e) (apply (cl-function (lambda ,cl-lambda-list ,@body)) ,e)))) -- (cl-defmacro eglot--widening (&rest body) "Save excursion and restriction. Widen. Then run BODY." (declare (debug t)) `(save-excursion (save-restriction (widen) ,@body))) @@@ -197,60 -234,43 +192,60 @@@ :documentation "Represents a server. Wraps a process for LSP communication.") -(cl-defmethod cl-print-object ((obj eglot-lsp-server) stream) - (princ (format "#<%s: %s>" (eieio-object-class obj) (eglot--name obj)) stream)) + +;;; Process management +(defvar eglot--servers-by-project (make-hash-table :test #'equal) + "Keys are projects. Values are lists of processes.") -(defun eglot--current-server () - "The current logical EGLOT process." - (let* ((probe (or (project-current) `(transient . ,default-directory)))) - (cl-find major-mode (gethash probe eglot--servers-by-project) - :key #'eglot--major-mode))) +;; HACK: Do something to fix this in the jsonrpc API or here, but in +;; the meantime concentrate the hack here. +(defalias 'eglot--process 'jsonrpc--process + "An abuse of `jsonrpc--process', a jsonrpc.el internal.") -(defun eglot--current-server-or-lose () - "Return the current EGLOT process or error." - (or (eglot--current-server) (eglot--error "No current EGLOT process"))) - -(defun eglot--make-process (name contact) - "Make a process object from CONTACT. -NAME is used to name the the started process or connection. -CONTACT is in `eglot'. Returns a process object." - (let* ((stdout (format "*%s stdout*" name)) stderr - (proc (cond - ((processp contact) contact) - ((integerp (cadr contact)) - (apply #'open-network-stream name stdout contact)) - (t (make-process - :name name :command contact :buffer stdout - :coding 'no-conversion :connection-type 'pipe - :stderr (setq stderr (format "*%s stderr*" name))))))) - (process-put proc 'eglot-stderr stderr) - (set-process-buffer proc (get-buffer-create stdout)) - (set-marker (process-mark proc) (with-current-buffer stdout (point-min))) - (set-process-filter proc #'eglot--process-filter) - (set-process-sentinel proc #'eglot--process-sentinel) - (with-current-buffer stdout - (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t))) - proc)) +(defun eglot-shutdown (server &optional _interactive) + "Politely ask SERVER to quit. +Forcefully quit it if it doesn't respond. Don't leave this +function with the server still running." + (interactive (list (jsonrpc-current-connection-or-lose) t)) + (eglot--message "Asking %s politely to terminate" (jsonrpc-name server)) + (unwind-protect + (progn + (setf (eglot--shutdown-requested server) t) + (jsonrpc-request server :shutdown nil :timeout 3) + ;; this one is supposed to always fail, hence ignore-errors + (ignore-errors (jsonrpc-request server :exit nil :timeout 1))) + ;; Turn off `eglot--managed-mode' where appropriate. + (dolist (buffer (eglot--managed-buffers server)) + (with-current-buffer buffer (eglot--managed-mode-onoff server -1))) + (while (progn (accept-process-output nil 0.1) + (not (eq (eglot--shutdown-requested server) :sentinel-done))) + (eglot--warn "Sentinel for %s still hasn't run, brutally deleting it!" + (eglot--process server)) + (delete-process (eglot--process server))))) + +(defun eglot--on-shutdown (server) + "Called by jsonrpc.el when SERVER is already dead." + ;; Turn off `eglot--managed-mode' where appropriate. + (dolist (buffer (eglot--managed-buffers server)) + (with-current-buffer buffer (eglot--managed-mode-onoff server -1))) + ;; Kill any expensive watches + (maphash (lambda (_id watches) + (mapcar #'file-notify-rm-watch watches)) + (eglot--file-watches server)) + ;; Sever the project/server relationship for `server' + (setf (gethash (eglot--project server) eglot--servers-by-project) + (delq server + (gethash (eglot--project server) eglot--servers-by-project))) + (cond ((eglot--shutdown-requested server) + (setf (eglot--shutdown-requested server) :sentinel-done)) + ((not (eglot--inhibit-autoreconnect server)) + (eglot--warn "Reconnecting after unexpected server exit.") + (eglot-reconnect server)) + ((timerp (eglot--inhibit-autoreconnect server)) + (eglot--warn "Not auto-reconnecting, last one didn't last long.")))) (defun eglot--all-major-modes () - "Return all know major modes." + "Return all known major modes." (let ((retval)) (mapatoms (lambda (sym) (when (plist-member (symbol-plist sym) 'derived-mode-parent) @@@ -501,16 -816,26 +496,26 @@@ If optional MARKER, return a marker ins (ignore-errors (funcall mode)) (insert string) (font-lock-ensure) (buffer-string)))) + (defcustom eglot-ignored-server-capabilites (list) + "LSP server capabilities that Eglot could use, but won't. + You could add, for instance, the symbol + `:documentHighlightProvider' to prevent automatic highlighting + under cursor." + :type '(repeat symbol)) + (defun eglot--server-capable (&rest feats) "Determine if current server is capable of FEATS." - (cl-loop for caps = (eglot--capabilities (jsonrpc-current-connection-or-lose)) - then (cadr probe) - for feat in feats - for probe = (plist-member caps feat) - if (not probe) do (cl-return nil) - if (eq (cadr probe) t) do (cl-return t) - if (eq (cadr probe) :json-false) do (cl-return nil) - finally (cl-return (or probe t)))) + (unless (cl-some (lambda (feat) + (memq feat eglot-ignored-server-capabilites)) + feats) - (cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose)) ++ (cl-loop for caps = (eglot--capabilities (jsonrpc-current-connection-or-lose)) + then (cadr probe) + for feat in feats + for probe = (plist-member caps feat) + if (not probe) do (cl-return nil) + if (eq (cadr probe) t) do (cl-return t) + if (eq (cadr probe) :json-false) do (cl-return nil) + finally (cl-return (or probe t))))) (defun eglot--range-region (range &optional markers) "Return region (BEG . END) that represents LSP RANGE. @@@ -607,9 -924,11 +612,12 @@@ that case, also signal textDocument/did "Make an interactive lambda for calling WHAT from mode-line." (lambda (event) (interactive "e") - (with-selected-window (posn-window (event-start event)) - (call-interactively what) - (force-mode-line-update t)))) + (let ((start (event-start event))) (with-selected-window (posn-window start) + (save-excursion + (goto-char (or (posn-point start) + (point))) - (call-interactively what)))))) ++ (call-interactively what) ++ (force-mode-line-update t)))))) (defun eglot--mode-line-props (thing face defs &optional prepend) "Helper for function `eglot--mode-line-format'. @@@ -1010,15 -1354,17 +1033,17 @@@ DUMMY is ignored. (or (cdr bounds) (point)) (completion-table-with-cache (lambda (_ignored) - (let* ((resp (eglot--request server - :textDocument/completion - (eglot--TextDocumentPositionParams) - :textDocument/completion)) + (let* ((resp (jsonrpc-request server + :textDocument/completion + (eglot--TextDocumentPositionParams) + :deferred :textDocument/completion)) (items (if (vectorp resp) resp (plist-get resp :items)))) (mapcar - (eglot--lambda (&rest all &key label insertText &allow-other-keys) + (jsonrpc-lambda (&rest all &key label insertText &allow-other-keys) (let ((insert (or insertText label))) - (add-text-properties 0 1 all insert) insert)) + (add-text-properties 0 1 all insert) + (put-text-property 0 1 'eglot--lsp-completion all insert) + insert)) items)))) :annotation-function (lambda (obj) @@@ -1037,13 -1383,15 +1062,15 @@@ (or (get-text-property 0 :sortText b) ""))))) :company-doc-buffer (lambda (obj) - (let ((documentation - (or (get-text-property 0 :documentation obj) - (and (eglot--server-capable :completionProvider - :resolveProvider) - (plist-get (jsonrpc-request server :completionItem/resolve - (text-properties-at 0 obj)) - :documentation))))) + (let* ((documentation + (or (get-text-property 0 :documentation obj) + (and (eglot--server-capable :completionProvider + :resolveProvider) + (plist-get - (eglot--request server :completionItem/resolve - (get-text-property - 0 'eglot--lsp-completion obj)) ++ (jsonrpc-request server :completionItem/resolve ++ (get-text-property ++ 0 'eglot--lsp-completion obj)) + :documentation))))) (when documentation (with-current-buffer (get-buffer-create " *eglot doc*") (insert (eglot--format-markup documentation)) @@@ -1214,11 -1557,55 +1242,55 @@@ If SKIP-SIGNATURE, don't try to send te (unless (eglot--server-capable :renameProvider) (eglot--error "Server can't rename!")) (eglot--apply-workspace-edit - (eglot--request (eglot--current-server-or-lose) - :textDocument/rename `(,@(eglot--TextDocumentPositionParams) - :newName ,newname)) + (jsonrpc-request (jsonrpc-current-connection-or-lose) + :textDocument/rename `(,@(eglot--TextDocumentPositionParams) + :newName ,newname)) current-prefix-arg)) + + (defun eglot-code-actions (&optional beg end) + "Get and offer to execute code actions between BEG and END." + (interactive + (let (diags) + (cond ((region-active-p) (list (region-beginning) (region-end))) + ((setq diags (flymake-diagnostics (point))) + (list (cl-reduce #'min (mapcar #'flymake-diagnostic-beg diags)) + (cl-reduce #'max (mapcar #'flymake-diagnostic-end diags)))) + (t (list (point-min) (point-max)))))) + (unless (eglot--server-capable :codeActionProvider) + (eglot--error "Server can't execute code actions!")) - (let* ((server (eglot--current-server-or-lose)) - (actions (eglot--request ++ (let* ((server (jsonrpc-current-connection-or-lose)) ++ (actions (jsonrpc-request + server + :textDocument/codeAction + (list :textDocument (eglot--TextDocumentIdentifier) + :range (list :start (eglot--pos-to-lsp-position beg) + :end (eglot--pos-to-lsp-position end)) + :context + `(:diagnostics + [,@(mapcar (lambda (diag) + (cdr (assoc 'eglot-lsp-diag + (eglot--diag-data diag)))) + (flymake-diagnostics beg end))])))) - (menu-items (mapcar (eglot--lambda (&key title command arguments) ++ (menu-items (mapcar (jsonrpc-lambda (&key title command arguments) + `(,title . (:command ,command :arguments ,arguments))) + actions)) + (menu (and menu-items `("Eglot code actions:" ("dummy" ,@menu-items)))) + (command-and-args + (and menu + (if (listp last-nonmenu-event) + (x-popup-menu last-nonmenu-event menu) + (let ((never-mind (gensym)) retval) + (setcdr (cadr menu) + (cons `("never mind..." . ,never-mind) (cdadr menu))) + (if (eq (setq retval (tmm-prompt menu)) never-mind) + (keyboard-quit) + retval)))))) + (if command-and-args - (eglot--request server :workspace/executeCommand command-and-args) ++ (jsonrpc-request server :workspace/executeCommand command-and-args) + (eglot--message "No code actions here")))) + + ;;; Dynamic registration ;;;