From: João Távora Date: Fri, 1 Jun 2018 15:59:00 +0000 (+0100) Subject: New command m-x eglot-code-actions X-Git-Tag: emacs-29.0.90~1616^2~524^2~4^2~520 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0e3d15f51c0a06751441c9392db0676a25ddf968;p=emacs.git New command m-x eglot-code-actions Also available when left-clicking diagnostics. * README.md: Mention eglot-code-actions. Slightly rewrite differences to lsp-mode. * eglot.el (eglot-code-actions): New command. (eglot-handle-notification :textDocument/publishDiagnostics): Use eglot--make-diag and eglot--overlay-diag-props. (eglot--mode-line-props): Use eglot--mouse-call. (eglot--mouse-call): Renamed from eglot--mode-line-call. (eglot-client-capabilities): List :executeCommand and :codeAction as capabilities. (eglot--diag, advice-add flymake--highlight-line): Horrible hack. (eglot--overlay-diag-props): Horrible hack. --- diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index a991cb1f785..8437d8cc8a3 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -155,6 +155,8 @@ deferred to the future.") (list :workspace (list :applyEdit t + :executeCommand `(:dynamicRegistration :json-false) + :codeAction `(:dynamicRegistration :json-false) :workspaceEdit `(:documentChanges :json-false) :didChangeWatchesFiles `(:dynamicRegistration t) :symbol `(:dynamicRegistration :json-false)) @@ -908,12 +910,15 @@ that case, also signal textDocument/didOpen." (put 'eglot--mode-line-format 'risky-local-variable t) -(defun eglot--mode-line-call (what) +(defun eglot--mouse-call (what) "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)))) + (let ((start (event-start event))) (with-selected-window (posn-window start) + (save-excursion + (goto-char (or (posn-point start) + (point))) + (call-interactively what)))))) (defun eglot--mode-line-props (thing face defs &optional prepend) "Helper for function `eglot--mode-line-format'. @@ -921,7 +926,7 @@ Uses THING, FACE, DEFS and PREPEND." (cl-loop with map = (make-sparse-keymap) for (elem . rest) on defs for (key def help) = elem - do (define-key map `[mode-line ,key] (eglot--mode-line-call def)) + do (define-key map `[mode-line ,key] (eglot--mouse-call def)) concat (format "%s: %s" key help) into blurb when rest concat "\n" into blurb finally (return `(:propertize ,thing @@ -968,6 +973,39 @@ Uses THING, FACE, DEFS and PREPEND." (add-to-list 'mode-line-misc-info `(eglot--managed-mode (" [" eglot--mode-line-format "] "))) + +;; FIXME: A horrible hack of Flymake's insufficient API that must go +;; into Emacs master, or better, 26.2 +(cl-defstruct (eglot--diag (:include flymake--diag) + (:constructor eglot--make-diag + (buffer beg end type text props))) + props) + +(advice-add 'flymake--highlight-line :after + (lambda (diag) + (when (cl-typep diag 'eglot--diag) + (let ((ov (cl-find diag + (overlays-at (flymake-diagnostic-beg diag)) + :key (lambda (ov) + (overlay-get ov 'flymake-diagnostic))))) + (cl-loop for (key . value) in (eglot--diag-props diag) + do (overlay-put ov key value))))) + '((name . eglot-hacking-in-some-per-diag-overlay-properties))) + + +(defun eglot--overlay-diag-props () + `((mouse-face . highlight) + (help-echo . (lambda (window _ov pos) + (with-selected-window window + (mapconcat + #'flymake-diagnostic-text + (flymake-diagnostics pos) + "\n")))) + (keymap . ,(let ((map (make-sparse-keymap))) + (define-key map [mouse-1] + (eglot--mouse-call 'eglot-code-actions)) + map)))) + ;;; Protocol implementation (Requests, notifications, etc) ;;; @@ -1037,16 +1075,18 @@ function with the server still running." (with-current-buffer buffer (cl-loop for diag-spec across diagnostics - collect (cl-destructuring-bind (&key range severity _group + collect (cl-destructuring-bind (&key range ((:severity sev)) _group _code source message) diag-spec + (setq message (concat source ": " message)) (pcase-let ((`(,beg . ,end) (eglot--range-region range))) - (flymake-make-diagnostic (current-buffer) - beg end - (cond ((<= severity 1) :error) - ((= severity 2) :warning) - (t :note)) - (concat source ": " message)))) + (eglot--make-diag (current-buffer) beg end + (cond ((<= sev 1) ':error) + ((= sev 2) ':warning) + (t ':note)) + message (cons + `(eglot-lsp-diag . ,diag-spec) + (eglot--overlay-diag-props))))) into diags finally (cond (eglot--current-flymake-report-fn (funcall eglot--current-flymake-report-fn diags) @@ -1528,6 +1568,52 @@ If SKIP-SIGNATURE, don't try to send textDocument/signatureHelp." :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 + 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-props diag)))) + (cl-remove-if-not + (lambda (diag) (cl-typep diag 'eglot--diag)) + (flymake-diagnostics beg end)))])))) + (menu-items (mapcar (eglot--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) + (eglot--message "No code actions here")))) + + ;;; Dynamic registration ;;;