Add fix suggestions to Flymake diagnostics

diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index bb915fb4a91be3f5ebd8a92a369af81caa14d1bf..4daa1f213de1196677253ea361d3616d623ee690 100644 (file)
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -2382,6 +2382,65 @@ Value is (TRUENAME . (:uri STR)), where STR is what is sent to the
 server on textDocument/didOpen and similar calls.  TRUENAME is the
 expensive cached value of `file-truename'.")
 
+(defun eglot--flymake-fix (data)
+  "Return fix suggestions for Flymake diagnostic with DATA."
+  (eglot--dbind ((Diagnostic) range) (alist-get 'eglot-lsp-diag data)
+    (pcase-let ((`(,beg . ,end) (eglot--diag-range-region range)))
+      (let ((actions (eglot-code-actions beg end "quickfix")))
+        (seq-keep
+         (eglot--lambda ((CodeAction) title edit)
+           (eglot--dbind
+               ((WorkspaceEdit) changes documentChanges)
+               edit
+             (let ((prepared
+                    (mapcar
+                     (eglot--lambda ((TextDocumentEdit) textDocument edits)
+                       (eglot--dbind ((VersionedTextDocumentIdentifier)
+                                      uri version)
+                           textDocument
+                         (list (eglot-uri-to-path uri) edits version)))
+                     documentChanges)))
+               (unless (and changes documentChanges)
+                 (cl-loop for (uri edits) on changes by #'cddr
+                          do (push (list (eglot-uri-to-path uri) edits)
+                                   prepared)))
+               (when prepared
+                 (list title
+                       (mapcar
+                        (pcase-lambda (`(,file ,edits . ,_))
+                          (let ((buf (find-file-noselect file)))
+                            (cons buf
+                                  (seq-map (eglot--lambda ((TextEdit)
+                                                           range newText)
+                                             (pcase (with-current-buffer buf
+                                                      (eglot-range-region range))
+                                               (`(,beg . ,end)
+                                                (list beg end newText))))
+                                           edits))))
+                        prepared))))))
+         actions)))))
+
+(defun eglot--diag-range-region (range)
+  (pcase-let ((`(,beg . ,end) (eglot-range-region range)))
+    ;; Fallback to `flymake-diag-region' if server
+    ;; botched the range
+    (when (= beg end)
+      (if-let* ((st (plist-get range :start))
+                (diag-region
+                 (flymake-diag-region
+                  (current-buffer) (1+ (plist-get st :line))
+                  (plist-get st :character))))
+          (setq beg (car diag-region) end (cdr diag-region))
+        (eglot--widening
+         (goto-char (point-min))
+         (setq beg
+               (eglot--bol
+                (1+ (plist-get (plist-get range :start) :line))))
+         (setq end
+               (line-end-position
+                (1+ (plist-get (plist-get range :end) :line)))))))
+    (cons beg end)))
+
 (cl-defmethod eglot-handle-notification
   (server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics
            &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode'
@@ -2413,24 +2472,7 @@ expensive cached value of `file-truename'.")
                        diag-spec
                      (setq message (mess source code message))
                      (pcase-let
-                         ((`(,beg . ,end) (eglot-range-region range)))
-                       ;; Fallback to `flymake-diag-region' if server
-                       ;; botched the range
-                       (when (= beg end)
-                         (if-let* ((st (plist-get range :start))
-                                   (diag-region
-                                    (flymake-diag-region
-                                     (current-buffer) (1+ (plist-get st :line))
-                                     (plist-get st :character))))
-                             (setq beg (car diag-region) end (cdr diag-region))
-                           (eglot--widening
-                            (goto-char (point-min))
-                            (setq beg
-                                  (eglot--bol
-                                   (1+ (plist-get (plist-get range :start) :line))))
-                            (setq end
-                                  (line-end-position
-                                   (1+ (plist-get (plist-get range :end) :line)))))))
+                         ((`(,beg . ,end) (eglot--diag-range-region range)))
                        (eglot--make-diag
                         (current-buffer) beg end
                         (eglot--diag-type severity)
@@ -2439,7 +2481,8 @@ expensive cached value of `file-truename'.")
                                     (cl-loop for tag across tags
                                              when (alist-get tag eglot--tag-faces)
                                              collect it)))
-                          `((face . ,faces))))))
+                          `((face . ,faces)))
+                        #'eglot--flymake-fix)))
            into diags
            finally (cond ((and
                            ;; only add to current report if Flymake

diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 2e602658ea7e30e56e18eed5fd38307610ea176a..edf9e95063bb827b484d52f01b9f19dec4062281 100644 (file)
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -368,7 +368,7 @@ generated it."
   locus beg end type text backend data overlay-properties overlay
   ;; FIXME: See usage of these two in `flymake--highlight-line'.
   ;; Ideally they wouldn't be needed.
-  orig-beg orig-end)
+  orig-beg orig-end fix-function)
 
 ;;;###autoload
 (defun flymake-make-diagnostic (locus
@@ -377,7 +377,8 @@ generated it."
                                 type
                                 text
                                 &optional data
-                                overlay-properties)
+                                overlay-properties
+                                fix-function)
   "Make a Flymake diagnostic for LOCUS's region from BEG to END.
 LOCUS is a buffer object or a string designating a file name.
 
@@ -396,14 +397,24 @@ actual buffer.
 OVERLAY-PROPERTIES is an alist of properties attached to the
 created diagnostic, overriding the default properties and any
 properties listed in the `flymake-overlay-control' property of
-the diagnostic's type symbol."
+the diagnostic's type symbol.
+
+FIX-FUNCTION, if non-nil, is a function that takes DATA and returns a
+list of fix suggestions for this diagnostic.  Each fix suggestion is a
+list (TITLE EDITS), where TITLE is a string describing the fix and EDITS
+is a list of (FILE-OR-BUFFER . CHANGES) cons cells, where FILE-OR-BUFFER
+is the file name or buffer to edit, and CHANGES is a list of changes to
+perform in FILE-OR-BUFFER.  Each element of CHANGES is in turn a
+list (BEG END STR), where BEG and END are buffer positions to delete and
+STR is the string to insert at BEG afterwards."
   (when (stringp locus)
     (setq locus (expand-file-name locus)))
   (flymake--diag-make :locus locus :beg beg :end end
                       :type type :text text :data data
                       :overlay-properties overlay-properties
                       :orig-beg beg
-                      :orig-end end))
+                      :orig-end end
+                      :fix-function fix-function))
 
 ;;;###autoload
 (defun flymake-diagnostics (&optional beg end)
@@ -849,6 +860,40 @@ Return to original margin width if ORIG-WIDTH is non-nil."
             (overlay-put o 'before-string (flymake--eol-overlay-summary src-ovs))
           (delete-overlay o))))))
 
+(defun flymake-diagnostic-context-menu (menu click)
+  "Extend MENU with fix suggestions for diagnostic at CLICK."
+  (when-let ((diag (mouse-posn-property (event-start click)
+                                        'flymake-diagnostic))
+             (fix-fun (flymake--diag-fix-function diag))
+             (fixes (funcall fix-fun (flymake--diag-data diag)))
+             (i 1))
+    (dolist (fix fixes)
+      (define-key menu (vector (intern (format "flymake-fix-%d" i)))
+                  `(menu-item ,(format "Fix: %s" (car fix))
+                              ,(lambda ()
+                                 (interactive)
+                                 (refactor-apply-edits (cadr fix)))
+                              ,@(cddr fix)))
+      (cl-incf i)))
+  menu)
+
+(defun flymake-fix (pos)
+  "Fix Flymake diagnostic at POS."
+  (interactive "d")
+  ;; TODO - fix _all_ diagnostics at point.
+  (if-let ((diag (car (flymake-diagnostics pos))))
+      (if-let ((fix-fun (flymake--diag-fix-function diag))
+               (fixes (funcall fix-fun (flymake--diag-data diag))))
+          (refactor-apply-edits
+           (car (if (cdr fixes)
+                    (alist-get
+                     (completing-read (format-prompt "Fix" (caar fixes))
+                                      fixes nil t nil nil (caar fixes))
+                     fixes nil nil #'string=)
+                  (cdar fixes))))
+        (message "No fix available for this diagnostic"))
+    (user-error "No diagnostic at this position")))
+
 (cl-defun flymake--highlight-line (diagnostic &optional foreign)
   "Attempt to overlay DIAGNOSTIC in current buffer.
 
@@ -956,6 +1001,7 @@ Return nil or the overlay created."
              (flymake-diagnostics pos)
              "\n"))))
       (default-maybe 'severity (warning-numeric-level :error))
+      (default-maybe 'context-menu-functions '(flymake-diagnostic-context-menu))
       ;; Use (PRIMARY . SECONDARY) priority, to avoid clashing with
       ;; `region' face, for example (bug#34022).
       (default-maybe 'priority (cons nil (+ 40 (overlay-get ov 'severity)))))

diff --git a/lisp/progmodes/refactor.el b/lisp/progmodes/refactor.el
index 6ab2a9916096963326b8b753b6054f6a617cb8ca..ed464790411ca5ad19a1aa6ce43b5414ee199bd1 100644 (file)
--- a/lisp/progmodes/refactor.el
+++ b/lisp/progmodes/refactor.el
@@ -240,6 +240,7 @@ applying the relevant edit.")
     (pop-to-buffer (current-buffer))
     (font-lock-ensure)))
 
+;;;###autoload
 (defun refactor-apply-edits (edits)
   "Apply EDITS.