From 03be20dd7e689967bc45633179567df142ef5ba4 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 7 Apr 2024 18:32:35 +0200 Subject: [PATCH] Add refactor.el --- lisp/progmodes/eglot.el | 35 +++++ lisp/progmodes/prog-mode.el | 5 +- lisp/progmodes/refactor-simple.el | 67 ++++++++++ lisp/progmodes/refactor.el | 205 ++++++++++++++++++++++++++++++ 4 files changed, 310 insertions(+), 2 deletions(-) create mode 100644 lisp/progmodes/refactor-simple.el create mode 100644 lisp/progmodes/refactor.el diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b8946a8762e..0c108b30246 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1970,6 +1970,7 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (add-hook 'after-save-hook #'eglot--signal-textDocument/didSave nil t) (unless (eglot--stay-out-of-p 'xref) (add-hook 'xref-backend-functions #'eglot-xref-backend nil t)) + (add-hook 'refactor-backend-functions #'eglot-refactor-backend nil t) (add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t) (add-hook 'completion-in-region-mode-hook #'eglot--capf-session-flush nil t) (add-hook 'company-after-completion-hook #'eglot--capf-session-flush nil t) @@ -3640,6 +3641,40 @@ edit proposed by the server." :newName ,newname)) this-command)) +(require 'refactor) + +(defun eglot-refactor-backend () '(eglot rename)) + +(cl-defmethod refactor-backend-read-scoped-identifier ((_backend (eql eglot))) + (when-let ((sym (symbol-at-point))) (list (symbol-name sym)))) + +(cl-defmethod refactor-backend-rename-edits ((_backend (eql eglot)) _old new _scope) + (eglot--dbind + ((WorkspaceEdit) changes documentChanges) + (eglot--request (eglot--current-server-or-lose) + :textDocument/rename `(,@(eglot--TextDocumentPositionParams) + :newName ,new)) + (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))) + (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 nil nil)))) + edits)))) + prepared)))) + (defun eglot--code-action-bounds () "Calculate appropriate bounds depending on region and point." (let (diags boftap) diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index d4e0514a6c3..b13318c59ae 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -109,8 +109,9 @@ (defvar-keymap prog-mode-map :doc "Keymap used for programming modes." - "C-M-q" #'prog-indent-sexp - "M-q" #'prog-fill-reindent-defun) + "C-M-q" #'prog-indent-sexp + "M-q" #'prog-fill-reindent-defun + "M-s M-r" #'refactor) (defvar prog-indentation-context nil "When non-nil, provides context for indenting embedded code chunks. diff --git a/lisp/progmodes/refactor-simple.el b/lisp/progmodes/refactor-simple.el new file mode 100644 index 00000000000..2ee70fbb717 --- /dev/null +++ b/lisp/progmodes/refactor-simple.el @@ -0,0 +1,67 @@ +;;; refactor-simple.el --- A simple refactor backend -*- lexical-binding: 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: + +;; + +;;; Code: + +(require 'project) +(require 'refactor) + +(defun refactor-simple-backend () '(simple rename)) + +(defun refactor-simple-rename-edits-in-buffer (old new &optional buf) + (with-current-buffer (or buf (current-buffer)) + (let ((edits nil) + (case-fold-search nil)) + (save-excursion + (without-restriction + (goto-char (point-min)) + (while (search-forward old nil t) + (push (list (match-beginning 0) (match-end 0) new nil nil) edits)))) + (cons (current-buffer) edits)))) + +(cl-defmethod refactor-backend-rename-edits ((_backend (eql simple)) old new + (_scope (eql buffer))) + (list (refactor-simple-rename-edits-in-buffer old new))) + +(cl-defmethod refactor-backend-rename-edits ((_backend (eql simple)) old new + (_scope (eql project))) + (mapcar (apply-partially #'refactor-simple-rename-edits-in-buffer old new) + (seq-filter (let ((mm major-mode)) + (lambda (buf) + (with-current-buffer buf + (derived-mode-p mm)))) + (project-buffers (project-current))))) + +;;;###autoload +(define-minor-mode refactor-simple-mode + "Use the dummy backend for refactoring operations." + :group 'refactor + :global t + (if refactor-simple-mode + (add-hook 'refactor-backend-functions #'refactor-simple-backend) + (remove-hook 'refactor-backend-functions #'refactor-simple-backend))) + + +(provide 'refactor-simple) +;;; refactor-simple.el ends here diff --git a/lisp/progmodes/refactor.el b/lisp/progmodes/refactor.el new file mode 100644 index 00000000000..d02675b8e1d --- /dev/null +++ b/lisp/progmodes/refactor.el @@ -0,0 +1,205 @@ +;;; refactor.el --- Common interface for code refactoring -*- lexical-binding: 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 operations.) + + +;;; 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 "Display edits as diff" refactor-display-edits-as-diff) + ;; (const :tag "Query about each edit" refactor-query-apply-edits) + (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-multiple-choice) + (const :tag "Minibuffer completion" refactor-completing-read-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 context. + +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 ((act-be-alist nil)) + (pcase-dolist (`(,be . ,acts) + (seq-keep #'funcall refactor-backend-functions)) + (dolist (act acts) + (push be (alist-get act act-be-alist)))) + act-be-alist)) + +;;;###autoload +(defun refactor (operation backend) + (interactive + (let* ((op-be-alist (refactor-backends)) + (op (funcall refactor-read-operation-function op-be-alist))) + (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 act 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-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 + (read-string (format "Rename \"%s\" across %s to: " + old (or scope "current scope")) + nil nil old) + (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-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))) + (dolist (change (sort (cdr buffer-changes) :key #'cadr :reverse t)) + (pcase change + (`(,beg ,end ,str . ,_) + (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))))))) + ;; TODO - temporarly highlight replacement text. + ))) + (undo-amalgamate-change-group change-group)))))) + +(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 -- 2.39.5