From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Eshel Yaron Newsgroups: gmane.emacs.devel Subject: Adding fix suggestions to Flymake diagnostics Date: Sun, 26 May 2024 15:37:37 +0200 Message-ID: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="29502"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-devel@gnu.org To: Spencer Baugh , =?utf-8?B?Sm/Do28gVMOhdm9yYQ==?= Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Sun May 26 15:38:40 2024 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1sBE59-0007Ri-OY for ged-emacs-devel@m.gmane-mx.org; Sun, 26 May 2024 15:38:39 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sBE4N-0001f3-Oh; Sun, 26 May 2024 09:37:51 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sBE4I-0001e3-Dz for emacs-devel@gnu.org; Sun, 26 May 2024 09:37:47 -0400 Original-Received: from mail.eshelyaron.com ([107.175.124.16] helo=eshelyaron.com) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sBE4E-00073R-Cb for emacs-devel@gnu.org; Sun, 26 May 2024 09:37:46 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=eshelyaron.com; s=mail; t=1716730660; bh=2JNWlsQTc6iSrVwdnIGptOdvS+XFk+Sz96N7W0HAG8Q=; h=From:To:Cc:Subject:Date:From; b=umGTXKCkDZhSaOCUVeMziYovpRiERlTWKrdwmdkN2gtDPleW8LTYm2M0AUNfusHbV BL4GpirB1i/kqCGRHOdUiJedZs83ZzKwPyUQZpWKTLvt9ubnCfKbwpc3fZJU4g1158 h9yaWwu6g8oTCg6H2NgRkn7qyLZ+YDYV6gPZlPvrM4BU8S6PwzUcI2FlJE3zRhMJQo /ALj+Jz30yjv4T5+qSekMVR2hKaVJMJyi02iJ03VoNyVi2KZfBj21cyGTuDM0k4AtS 1aC4QPYrd4WsvczQVg+rafxQJ5tnXG74b4ur8nU3e8XFoAfJWLDWFYTiEi2afkjqRN zch3sNGToyGPA== Received-SPF: pass client-ip=107.175.124.16; envelope-from=me@eshelyaron.com; helo=eshelyaron.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:319583 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi Spencer, Jo=C3=A3o, and all, I've been playing around a bit with adding fix suggestions to Flymake. The idea is to provide backends with a standard API for associating fix suggestions with diagnostics, and to provide users with a consistent UI for applying such suggestions. Some backends already use various tricks to suggest fixes in one way or another. For example, Eglot associates LSP "quickfix" actions with some diagnostics. What do you think about standardizing this concept? I'm attaching a patch with an initial implementation that extends the Flymake API and adapts Eglot to provide fix suggestions in this manner. This lets you apply fix suggestions via context-menu-mode right-click menus, and via a new command flymake-fix that looks for a fix for the diagnostic at point. So far I tested it with clangd and gopls. Note that this patch uses the function refactor-apply-edits from my refactor.el library (attached as well) in order to apply the fix suggestions, so you'll need that too if you want to give it a spin. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Add-fix-suggestions-to-Flymake-diagnostics.patch >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 ++++++++++++++++++++++++-- 2 files changed, 112 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 @@ eglot--TextDocumentIdentifier-cache 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 @@ eglot-handle-notification 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 @@ eglot-handle-notification (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 @@ flymake-error 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 @@ flymake-make-diagnostic 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 @@ flymake-make-diagnostic 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 @@ flymake--update-eol-overlays (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 @@ flymake--highlight-line (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))))) -- 2.45.0 --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=refactor.el Content-Transfer-Encoding: quoted-printable ;;; refactor.el --- Common interface for code refactoring -*- lexical-bin= ding: t; -*- ;; Copyright (C) 2024 Eshel Yaron ;; Author: Eshel Yaron ;; Keywords: tools ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Generic refactoring UI and API. ;;; TODO ;; - Add a menu bar menu and a prefix keymap. ;; - Support custom backend operations. (Don't hardcode permitted operatio= ns.) ;;; Code: (defgroup refactor nil "Refactor code." :group 'programming) (defcustom refactor-apply-edits-function #'refactor-apply-edits-at-once "Function to use for applying edits during refactoring." :type '(choice (const :tag "Apply edits at once" refactor-apply-edits-at-= once) ;; TODO: ;; (const :tag "Query about each edit" refactor-query-appl= y-edits) (const :tag "Display edits as diff" refactor-display-edits= -as-diff) (function :tag "Custom function"))) (defcustom refactor-read-operation-function #'refactor-read-operation-multiple-choice "Function to use for reading a refactor operation." :type '(choice (const :tag "One-key selection" refactor-read-operation-mu= ltiple-choice) (const :tag "Minibuffer completion" refactor-completing-re= ad-operation) (function :tag "Custom function"))) (defcustom refactor-backend-rename-message-format "Renaming \"%o\" to \"%n\" in %s." "Message to display when renaming identifiers. This can be nil, which says not to display any message, or a string that `refactor-rename' displays when renaming. If the value is a string, it may include the following `%'-constructs: `%o' is the old identifier name, `%n' is the new identifier name, and `%s' is the scope of the renaming operation. The default value is the string \"Renaming \\\"%o\\\" to \\\"n\\\" in %s.\"" :type '(choice (string :tag "Format string") (const :tag "Disable" nil))) (defvar refactor-backend-functions nil "Special hook for choosing a refactor backend to use in the current conte= xt. Each function on this hook is called in turn with no arguments, and should return either nil to mean that it is not applicable, or a cons cell (BACKEND . OPS) where BACKEND refactor backend, a value used for dispatching the generic functions, and OPS is a list of refactoring operations that BACKEND supports.") (defun refactor-backends () "Return alist of refactor operations and backends that support them." (let ((op-be-alist nil)) (run-hook-wrapped 'refactor-backend-functions (lambda (be-fun &rest _) (pcase (funcall be-fun) (`(,be . ,ops) (dolist (op ops) (push be (alist-get op op-be-alist))))))) op-be-alist)) ;;;###autoload (defun refactor (operation backend) (interactive (let* ((op-be-alist (refactor-backends)) (op (if op-be-alist (funcall refactor-read-operation-function op-be-alist) (user-error "No refactor operations available")))) (list op (car (alist-get op op-be-alist))))) (pcase operation ('rename (refactor-rename backend)) ;; TODO: ;; ('extract (refactor-extract backend)) ;; ('inline (refactor-inline backend)) ;; ('organize (refactor-organize backend)) ;; ('simplify (refactor-simplify backend)) (_ (refactor-backend-custom-operation backend operation)))) (cl-defgeneric refactor-backend-custom-operation (backend operation) "Apply custom refactoring OPERATION provided by BACKEND.") (defun refactor-backend-for-operation (op) (car (alist-get op (refactor-backends)))) ;;;###autoload (defun refactor-rename (backend) (interactive (list (refactor-backend-for-operation 'rename))) (pcase (refactor-backend-read-scoped-identifier backend) (`(,old . ,scope) (let ((new (refactor-backend-read-replacement backend old scope))) (message (format-spec refactor-backend-rename-message-format (list (cons ?o old) (cons ?n new) (cons ?s (or scope "current scope"))))) (refactor-apply-edits (refactor-backend-rename-edits backend old new scope)))))) ;; (defun refactor-indicate-suggestions () ...) (defun refactor-read-operation-multiple-choice (operations) (intern (cadr (read-multiple-choice "Refactor operation:" (mapcar (pcase-lambda (`(,op . ,_)) (list nil (symbol-name op))) operations))))) (defun refactor-completing-read-operation (operations) (intern (completing-read "Refactor operation: " (mapcar (compose #'symbol-name #'cadr) operations) nil t))) (cl-defgeneric refactor-backend-read-scoped-identifier (_backend) "Read an identifier and its scope for refactoring using BACKEND. Return a cons cell (IDENT . SCOPE), where IDENT is the identifier to operate on and SCOPE is the scope of application. The meaning of both IDENT and SCOPE are BACKEND-specific, but SCOPE is conventionally one of `expression', `defun', `file' or `project'." (when-let ((sym (symbol-at-point))) (cons (symbol-name sym) (if (project-current) 'project 'buffer)))) (cl-defgeneric refactor-backend-invalid-replacement (_backend _old _new _sc= ope) "Check if NEW is a valid replacement for OLD in SCOPE according to BACKEN= D. If it is invalid, for example if NEW is in conflict an identifier that is already in use, return a string to display as feedback to the user. Otherwise, if the replacement is valid, return nil." nil) (cl-defgeneric refactor-backend-read-replacement (backend old scope) "Read a replacement for identifier OLD across SCOPE using BACKEND." (let ((case-fold-search nil)) (save-excursion (goto-char (point-min)) (while (search-forward old nil t) (let ((ov (make-overlay (match-beginning 0) (match-end 0)))) (overlay-put ov 'refactor-rename-old t) (overlay-put ov 'face 'lazy-highlight))))) (unwind-protect (let ((new nil) (invalid nil)) (while (not new) (setq new (read-string (format "%sRename \"%s\" across %s to: " (or invalid "") old (or scope "current scope")) nil nil old)) (when-let ((inv (refactor-backend-invalid-replacement backend old new scope))) (setq invalid (format "Invalid replacement \"%s\": %s\n" new in= v) new nil))) new) (remove-overlays (point-min) (point-max) 'refactor-rename-old t))) (cl-defgeneric refactor-backend-rename-edits (backend old new scope) "Return alist of edits for renaming OLD to NEW across SCOPE using BACKEND. Each element is a cons cell (FILE-OR-BUFFER . EDITS), where FILE-OR-BUFFER is the file name or buffer to edit, and EDITS is a list of edits to perform in FILE-OR-BUFFER. Each element of EDITS is a list (BEG END STR ID ANN), where BEG and END are buffer positions to delete and STR is the string to insert at BEG afterwards. ID is a BACKEND-specific edit identifier, and ANN is an optional annotation associated with this edit. Depending on the value of `refactor-apply-edits-function', `refactor-rename' may display ANN when applying the relevant edit.") (defun refactor--apply-edits (edits) (pcase-dolist (`(,beg ,end ,str . ,_) (sort edits :key #'cadr :reverse t)) (let ((source (current-buffer))) (with-temp-buffer (insert str) (let ((temp (current-buffer))) (with-current-buffer source (save-excursion (save-restriction (narrow-to-region beg end) (replace-buffer-contents temp))))))))) (defun refactor-apply-edits-at-once (edits) "Apply EDITS at once, without confirmation." (dolist (edit edits) (let ((file-or-buffer (car edit))) (unless (bufferp file-or-buffer) (setcar edit (find-file-noselect file-or-buffer))))) (dolist (buffer-changes edits) (with-current-buffer (car buffer-changes) (atomic-change-group (let* ((change-group (prepare-change-group))) (refactor--apply-edits (cdr buffer-changes)) (undo-amalgamate-change-group change-group)))))) (defun refactor-display-edits-as-diff (edits) "Display EDITS as a diff." (dolist (edit edits) (let ((file-or-buffer (car edit))) (when (bufferp file-or-buffer) (setcar edit (buffer-file-name file-or-buffer))))) (with-current-buffer (get-buffer-create "*Refactor Diff*") (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) (diff-mode) (let ((inhibit-read-only t) (target (current-buffer))) (erase-buffer) (pcase-dolist (`(,file . ,changes) edits) (with-temp-buffer (let* ((diff (current-buffer))) (with-temp-buffer (insert-file-contents file) (refactor--apply-edits changes) (diff-no-select file (current-buffer) nil t diff)) (with-current-buffer target (insert-buffer-substring diff)))))) (buffer-enable-undo (current-buffer)) (goto-char (point-min)) (pop-to-buffer (current-buffer)) (font-lock-ensure))) ;;;###autoload (defun refactor-apply-edits (edits) "Apply EDITS. Call the function specified by `refactor-apply-edits-function' to do the work." (funcall refactor-apply-edits-function edits)) (provide 'refactor) ;;; refactor.el ends here --=-=-=--