[elpa] externals/eglot d6af4df 4/8: New command M-x eglot-code-actions

[João Távora]

branch: externals/eglot
commit d6af4df11ad962e38d0f8ab9306e7c664ff89ac5
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    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.
---
 README.md |  21 +++++++-----
 eglot.el  | 108 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 110 insertions(+), 19 deletions(-)

diff --git a/README.md b/README.md
index 07463bb..e530159 100644
--- a/README.md
+++ b/README.md
@@ -51,6 +51,11 @@ Here's a summary of available commands:
 
 - `M-x eglot-rename` asks the server to rename the symbol at point;
 
+- `M-x eglot-code-actions` asks the server for any code actions at
+  point. These may tipically be simple fixes, like deleting an unused
+  variable, or fixing an import. Left click on diagnostics to check if
+  there are any there;
+
 - `M-x eglot-help-at-point` asks the server for help for symbol at
   point. Currently this is what `eldoc-mode` displays in the echo
   area;
@@ -115,7 +120,7 @@ eglot-shutdown`.
 - [ ] workspace/configuration (3.6.0)
 - [x] workspace/didChangeWatchedFiles
 - [x] workspace/symbol
-- [ ] workspace/executeCommand
+- [x] workspace/executeCommand
 - [x] workspace/applyEdit
 
 ## Text Synchronization
@@ -140,7 +145,7 @@ eglot-shutdown`.
 - [x] textDocument/references
 - [x] textDocument/documentHighlight
 - [x] textDocument/documentSymbol
-- [ ] textDocument/codeAction
+- [x] textDocument/codeAction
 - [ ] textDocument/codeLens
 - [ ] codeLens/resolve
 - [ ] textDocument/documentLink
@@ -183,17 +188,17 @@ Under the hood:
 
 - Message parser is much simpler.
 - Defers signature requests like `textDocument/hover` until server is
-  ready. Also sends `textDocument/didChange` for groups of edits, not
+  ready.
+- Sends `textDocument/didChange` for groups of edits, not
   one per each tiny change.
 - Easier to read and maintain elisp. Yeah I know, *very subjective*,
   so judge for yourself.
-- About 1k LOC lighter.
-- Development doesn't require Cask, just Emacs.
-- Project support doesn't need `projectile.el`, uses Emacs's `project.el`
-- Requires the upcoming Emacs 26
+- Doesn't *require* anything other than Emacs 26, but will
+  automatically upgrade to work with stuff outside Emacs, like
+  `company`, `markdown-mode`, if you happen to have these installed.
 - Contained in one file
 - Has automated tests that check against actual LSP servers
-  
+
 
 [lsp]: https://microsoft.github.io/language-server-protocol/
 [rls]: https://github.com/rust-lang-nursery/rls
diff --git a/eglot.el b/eglot.el
index a991cb1..8437d8c 100644
--- a/eglot.el
+++ b/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
@@ -969,6 +974,39 @@ Uses THING, FACE, DEFS and PREPEND."
              `(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)
 ;;;
 (defun eglot-shutdown (server &optional _interactive)
@@ -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
 ;;;