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 a991cb1f785bcc916b7a6a5e306e98366c8471e0..8437d8cc8a343f80e7222cc578825d4d1311bb7e 100644 (file)
--- 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 "] ")))
 
+\f
+;; 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))))
+
 \f
 ;;; 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"))))
+
+
 \f
 ;;; Dynamic registration
 ;;;