From b68c6013693a163462ba1ff49494bfbe68d3eb6c Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 26 May 2024 14:41:03 +0200 Subject: [PATCH] Add fix suggestions to Flymake diagnostics --- lisp/progmodes/eglot.el | 81 +++++++++++++++++++++++++++++--------- lisp/progmodes/flymake.el | 54 +++++++++++++++++++++++-- lisp/progmodes/refactor.el | 1 + 3 files changed, 113 insertions(+), 23 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index bb915fb4a91..4daa1f213de 100644 --- 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 2e602658ea7..edf9e95063b 100644 --- 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 6ab2a991609..ed464790411 100644 --- 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. -- 2.39.5