gptel-rewrite.el (17010B)
1 ;;; gptel-rewrite.el --- Refactoring functions for gptel -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2024 Karthik Chikmagalur 4 5 ;; Author: Karthik Chikmagalur <karthikchikmagalur@gmail.com> 6 ;; Keywords: hypermedia, convenience, tools 7 8 ;; This program is free software; you can redistribute it and/or modify 9 ;; it under the terms of the GNU General Public License as published by 10 ;; the Free Software Foundation, either version 3 of the License, or 11 ;; (at your option) any later version. 12 13 ;; This program is distributed in the hope that it will be useful, 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; GNU General Public License for more details. 17 18 ;; You should have received a copy of the GNU General Public License 19 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 20 21 ;;; Commentary: 22 23 ;; 24 25 ;;; Code: 26 (require 'gptel-transient) 27 (require 'cl-lib) 28 29 (defvar eldoc-documentation-functions) 30 (defvar diff-entire-buffers) 31 32 (declare-function diff-no-select "diff") 33 34 ;; * User options 35 36 (defcustom gptel-rewrite-directives-hook (list #'gptel--rewrite-message) 37 "Hook run to generate gptel's default rewrite directives. 38 39 Each function in this hook is called with no arguments until one 40 returns a non-nil value, the base string to use as the 41 rewrite/refactor instruction. 42 43 Use this hook to tailor context-specific refactoring directives. 44 For example, you can specialize the default refactor directive 45 for a particular major-mode." 46 :group 'gptel 47 :type 'hook) 48 49 (defface gptel-rewrite-highlight-face 50 '((((class color) (min-colors 88) (background dark)) 51 :background "#041714" :extend t) 52 (((class color) (min-colors 88) (background light)) 53 :background "light goldenrod yellow" :extend t) 54 (t :inherit secondary-selection)) 55 "Face for highlighting regions with pending rewrites." 56 :group 'gptel) 57 58 ;; * Variables 59 60 (defvar-keymap gptel-rewrite-actions-map 61 :doc "Keymap for gptel rewrite actions at point." 62 "C-c C-k" #'gptel--rewrite-clear 63 "C-c C-a" #'gptel--rewrite-apply 64 "C-c C-d" #'gptel--rewrite-diff 65 "C-c C-e" #'gptel--rewrite-ediff 66 "C-c C-n" #'gptel--rewrite-next 67 "C-c C-p" #'gptel--rewrite-previous 68 "C-c C-m" #'gptel--rewrite-merge) 69 70 (defvar-local gptel--rewrite-overlays nil 71 "List of active rewrite overlays in the buffer.") 72 73 (defvar-local gptel--rewrite-message nil) 74 75 ;; * Helper functions 76 77 (defun gptel--rewrite-sanitize-overlays () 78 "Ensure gptel's rewrite overlays in buffer are consistent." 79 (setq gptel--rewrite-overlays 80 (cl-delete-if-not #'overlay-buffer 81 gptel--rewrite-overlays))) 82 83 (defsubst gptel--refactor-or-rewrite () 84 "Rewrite should be refactored into refactor. 85 86 Or is it the other way around?" 87 (if (derived-mode-p 'prog-mode) 88 "Refactor" "Rewrite")) 89 90 (defun gptel--rewrite-message () 91 "Set a generic refactor/rewrite message for the buffer." 92 (if (derived-mode-p 'prog-mode) 93 (format "You are a %s programmer. Generate only code, no explanation, no code fences. Refactor the following code." 94 (gptel--strip-mode-suffix major-mode)) 95 (format "You are a prose editor. Rewrite the following text to be more professional."))) 96 97 (defun gptel--rewrite-key-help (callback) 98 "Eldoc documentation function for gptel rewrite actions. 99 100 CALLBACK is supplied by Eldoc, see 101 `eldoc-documentation-functions'." 102 (when (and gptel--rewrite-overlays 103 (get-char-property (point) 'gptel-rewrite)) 104 (funcall callback 105 (format (substitute-command-keys "%s rewrite available: accept \\[gptel--rewrite-apply], clear \\[gptel--rewrite-clear], merge \\[gptel--rewrite-merge], diff \\[gptel--rewrite-diff] or ediff \\[gptel--rewrite-ediff]") 106 (propertize (concat (gptel-backend-name gptel-backend) 107 ":" (gptel--model-name gptel-model)) 108 'face 'mode-line-emphasis))))) 109 110 (defun gptel--rewrite-move (search-func) 111 "Move directionally to a gptel rewrite location using SEARCH-FUNC." 112 (let* ((ov (cdr (get-char-property-and-overlay (point) 'gptel-rewrite))) 113 (pt (save-excursion 114 (if ov 115 (goto-char 116 (funcall search-func (overlay-start ov) 'gptel-rewrite)) 117 (goto-char 118 (max (1- (funcall search-func (point) 'gptel-rewrite)) 119 (point-min)))) 120 (funcall search-func (point) 'gptel-rewrite)))) 121 (if (get-char-property pt 'gptel-rewrite) 122 (goto-char pt) 123 (user-error "No further rewrite regions!")))) 124 125 (defun gptel--rewrite-next () 126 "Go to next pending LLM rewrite in buffer, if one exists." 127 (interactive) 128 (gptel--rewrite-move #'next-single-char-property-change)) 129 130 (defun gptel--rewrite-previous () 131 "Go to previous pending LLM rewrite in buffer, if one exists." 132 (interactive) 133 (gptel--rewrite-move #'previous-single-char-property-change)) 134 135 (defun gptel--rewrite-overlay-at (&optional pt) 136 "Check for a gptel rewrite overlay at PT and return it. 137 138 If no suitable overlay is found, raise an error." 139 (pcase-let ((`(,response . ,ov) 140 (get-char-property-and-overlay (or pt (point)) 'gptel-rewrite)) 141 (diff-entire-buffers nil)) 142 (unless ov (user-error "Could not find region being rewritten.")) 143 (unless response (user-error "No LLM output available for this rewrite.")) 144 ov)) 145 146 (defun gptel--rewrite-prepare-buffer (ovs &optional buf) 147 "Prepare new buffer with LLM changes applied and return it. 148 149 This is used for (e)diff purposes. 150 151 RESPONSE is the LLM response. OVS are the overlays specifying 152 the changed regions. BUF is the (current) buffer." 153 (setq buf (or buf (current-buffer))) 154 (with-current-buffer buf 155 (let ((pmin (point-min)) 156 (pmax (point-max)) 157 (pt (point)) 158 ;; (mode major-mode) 159 (newbuf (get-buffer-create "*gptel-diff*")) 160 (inhibit-read-only t) 161 (inhibit-message t)) 162 (save-restriction 163 (widen) 164 (with-current-buffer newbuf 165 (erase-buffer) 166 (insert-buffer-substring buf))) 167 (with-current-buffer newbuf 168 (narrow-to-region pmin pmax) 169 (goto-char pt) 170 ;; We mostly just want font-locking 171 ;; (delay-mode-hooks (funcall mode)) 172 ;; Apply the changes to the new buffer 173 (save-excursion 174 (gptel--rewrite-apply ovs))) 175 newbuf))) 176 177 ;; * Refactor action functions 178 179 (defun gptel--rewrite-clear (&optional ovs) 180 "Clear pending LLM responses in OVS or at point." 181 (interactive (list (gptel--rewrite-overlay-at))) 182 (dolist (ov (ensure-list ovs)) 183 (setq gptel--rewrite-overlays (delq ov gptel--rewrite-overlays)) 184 (delete-overlay ov)) 185 (unless gptel--rewrite-overlays 186 (remove-hook 'eldoc-documentation-functions 'gptel--rewrite-key-help 'local)) 187 (message "Cleared pending LLM response(s).")) 188 189 (defun gptel--rewrite-apply (&optional ovs) 190 "Apply pending LLM responses in OVS or at point." 191 (interactive (list (gptel--rewrite-overlay-at))) 192 (cl-loop for ov in (ensure-list ovs) 193 for ov-beg = (overlay-start ov) 194 for ov-end = (overlay-end ov) 195 for response = (overlay-get ov 'gptel-rewrite) 196 do (overlay-put ov 'before-string nil) 197 (goto-char ov-beg) 198 (delete-region ov-beg ov-end) 199 (insert response)) 200 (message "Replaced region(s) with LLM output.")) 201 202 (defun gptel--rewrite-diff (&optional ovs switches) 203 "Diff pending LLM responses in OVS or at point." 204 (interactive (list (gptel--rewrite-overlay-at))) 205 (let* ((buf (current-buffer)) 206 (newbuf (gptel--rewrite-prepare-buffer ovs)) 207 (diff-buf (diff-no-select 208 (if-let ((buf-file (buffer-file-name buf))) 209 (expand-file-name buf-file) buf) 210 newbuf switches))) 211 (with-current-buffer diff-buf 212 (setq-local diff-jump-to-old-file t)) 213 (display-buffer diff-buf))) 214 215 (defun gptel--rewrite-ediff (&optional ovs) 216 "Ediff pending LLM responses in OVS or at point." 217 (interactive (list (gptel--rewrite-overlay-at))) 218 (letrec ((newbuf (gptel--rewrite-prepare-buffer ovs)) 219 (cwc (current-window-configuration)) 220 (gptel--ediff-restore 221 (lambda () 222 (when (window-configuration-p cwc) 223 (set-window-configuration cwc)) 224 (remove-hook 'ediff-quit-hook gptel--ediff-restore)))) 225 (add-hook 'ediff-quit-hook gptel--ediff-restore) 226 (ediff-buffers (current-buffer) newbuf))) 227 228 (defun gptel--rewrite-merge (&optional ovs) 229 "Insert pending LLM responses in OVS as merge conflicts." 230 (interactive (list (gptel--rewrite-overlay-at))) 231 (let ((changed)) 232 (dolist (ov (ensure-list ovs)) 233 (save-excursion 234 (when-let (new-str (overlay-get ov 'gptel-rewrite)) 235 ;; Insert merge 236 (goto-char (overlay-start ov)) 237 (unless (bolp) (insert "\n")) 238 (insert-before-markers "<<<<<<< original\n") 239 (goto-char (overlay-end ov)) 240 (unless (bolp) (insert "\n")) 241 (insert 242 "=======\n" new-str 243 "\n>>>>>>> " (gptel-backend-name gptel-backend) "\n") 244 (setq changed t)))) 245 (when changed (smerge-mode 1))) 246 (gptel--rewrite-clear ovs)) 247 248 ;; * Transient Prefix for rewriting/refactoring 249 250 ;;;###autoload (autoload 'gptel-rewrite-menu "gptel-rewrite" nil t) 251 (transient-define-prefix gptel-rewrite-menu () 252 "Rewrite or refactor text region using an LLM." 253 [:description 254 (lambda () 255 (format "Directive: %s" 256 (truncate-string-to-width 257 gptel--rewrite-message 258 (max (- (window-width) 14) 20) nil nil t))) 259 (gptel--infix-rewrite-prompt)] 260 ;; FIXME: We are requiring `gptel-transient' because of this suffix, perhaps 261 ;; we can get find some way around that? 262 [:description (lambda () (concat "Context for " (gptel--refactor-or-rewrite))) 263 :if use-region-p 264 (gptel--suffix-context-buffer :key "C")] 265 [[:description "Diff Options" 266 :if (lambda () gptel--rewrite-overlays) 267 ("-b" "Ignore whitespace changes" ("-b" "--ignore-space-change")) 268 ("-w" "Ignore all whitespace" ("-w" "--ignore-all-space")) 269 ("-i" "Ignore case" ("-i" "--ignore-case")) 270 (gptel--rewrite-infix-diff:-U)] 271 [:description gptel--refactor-or-rewrite 272 :if use-region-p 273 (gptel--suffix-rewrite)]] 274 [[:description (lambda () (concat "Diff " (gptel--refactor-or-rewrite) "s")) 275 :if (lambda () gptel--rewrite-overlays) 276 (gptel--suffix-rewrite-diff) 277 (gptel--suffix-rewrite-ediff)] 278 [:description (lambda () (concat "Continue " (gptel--refactor-or-rewrite) "s")) 279 :if (lambda () (gptel--rewrite-sanitize-overlays)) 280 (gptel--suffix-rewrite-merge) 281 (gptel--suffix-rewrite-apply)] 282 [:description (lambda () (concat "Reject " (gptel--refactor-or-rewrite) "s")) 283 :if (lambda () (gptel--rewrite-sanitize-overlays)) 284 (gptel--suffix-rewrite-clear)]] 285 (interactive) 286 (unless gptel--rewrite-message 287 (setq gptel--rewrite-message 288 (save-mark-and-excursion 289 (run-hook-with-args-until-success 290 'gptel-rewrite-directives-hook)))) 291 (transient-setup 'gptel-rewrite-menu)) 292 293 ;; * Transient infixes for rewriting/refactoring 294 295 (transient-define-infix gptel--infix-rewrite-prompt () 296 "Chat directive (system message) to use for rewriting or refactoring." 297 :description (lambda () (if (derived-mode-p 'prog-mode) 298 "Set directives for refactor" 299 "Set directives for rewrite")) 300 :format "%k %d" 301 :class 'transient-lisp-variable 302 :variable 'gptel--rewrite-message 303 :key "d" 304 :prompt "Set directive for rewrite: " 305 :reader (lambda (prompt _ history) 306 (read-string 307 prompt 308 (save-mark-and-excursion 309 (run-hook-with-args-until-success 310 'gptel-rewrite-directives-hook)) 311 history))) 312 313 (transient-define-argument gptel--rewrite-infix-diff:-U () 314 :description "Context lines" 315 :class 'transient-option 316 :argument "-U" 317 :reader #'transient-read-number-N0) 318 319 ;; * Transient suffixes for rewriting/refactoring 320 321 (transient-define-suffix gptel--suffix-rewrite (&optional rewrite-message) 322 "Rewrite or refactor region contents." 323 :key "r" 324 :description #'gptel--refactor-or-rewrite 325 (interactive (list gptel--rewrite-message)) 326 (let* ((prompt (buffer-substring-no-properties 327 (region-beginning) (region-end))) 328 (gptel--system-message (or rewrite-message gptel--rewrite-message)) 329 ;; always send context with system message 330 (gptel-use-context (and gptel-use-context 'system))) 331 (deactivate-mark) 332 (gptel-request prompt 333 :context 334 (let ((ov (make-overlay (region-beginning) (region-end)))) 335 (overlay-put ov 'category 'gptel) 336 (overlay-put ov 'evaporate t) 337 ov) 338 :callback 339 (lambda (response info) 340 (if (not response) 341 (message (concat "LLM response error: %s. Rewrite/refactor in buffer %s canceled." 342 (propertize "❌" 'face 'error)) 343 (plist-get info :status) 344 (plist-get info :buffer)) 345 ;; Store response 346 (let ((buf (plist-get info :buffer)) 347 (ov (plist-get info :context)) 348 (action-str) (hint-str)) 349 (with-current-buffer buf 350 (if (derived-mode-p 'prog-mode) 351 (progn 352 (setq action-str "refactor") 353 (when (string-match-p "^```" response) 354 (setq response (replace-regexp-in-string "^```.*$" "" response)))) 355 (setq action-str "rewrite")) 356 (setq hint-str (concat "[" (gptel-backend-name gptel-backend) 357 ":" (gptel--model-name gptel-model) "] " 358 (upcase action-str) " READY ✓\n")) 359 (add-hook 'eldoc-documentation-functions #'gptel--rewrite-key-help nil 'local) 360 (overlay-put ov 'gptel-rewrite response) 361 (overlay-put ov 'face 'gptel-rewrite-highlight-face) 362 (overlay-put ov 'keymap gptel-rewrite-actions-map) 363 (overlay-put ov 'before-string 364 (concat (propertize 365 " " 'display `(space :align-to (- right ,(1+ (length hint-str))))) 366 (propertize hint-str 'face 'success))) 367 (overlay-put 368 ov 'help-echo 369 (format "%s rewrite available: 370 - accept \\[gptel--rewrite-apply], 371 - clear \\[gptel--rewrite-clear], 372 - merge \\[gptel--accept-merge], 373 - diff \\[gptel--rewrite-diff], 374 - ediff \\[gptel--rewrite-ediff]" 375 (propertize (concat (gptel-backend-name gptel-backend) 376 ":" (gptel--model-name gptel-model))))) 377 (push ov gptel--rewrite-overlays)) 378 ;; Message user 379 (message 380 (concat 381 "LLM %s output" 382 (unless (eq (current-buffer) buf) (format " in buffer %s " buf)) 383 (substitute-command-keys " ready, \\[gptel-menu] to continue.")) 384 action-str))))))) 385 386 (transient-define-suffix gptel--suffix-rewrite-diff (&optional switches) 387 "Diff LLM output against buffer." 388 :if (lambda () gptel--rewrite-overlays) 389 :key "D" 390 :description (concat "Diff LLM " (downcase (gptel--refactor-or-rewrite)) "s") 391 (interactive (list (transient-args transient-current-command))) 392 (gptel--rewrite-diff gptel--rewrite-overlays switches)) 393 394 (transient-define-suffix gptel--suffix-rewrite-ediff () 395 "Ediff LLM output against buffer." 396 :if (lambda () gptel--rewrite-overlays) 397 :key "E" 398 :description (concat "Ediff LLM " (downcase (gptel--refactor-or-rewrite)) "s") 399 (interactive) 400 (gptel--rewrite-ediff gptel--rewrite-overlays)) 401 402 (transient-define-suffix gptel--suffix-rewrite-merge () 403 "Insert LLM output as merge conflicts" 404 :if (lambda () gptel--rewrite-overlays) 405 :key "cm" 406 :description "Accept as merge conflicts" 407 (interactive) 408 (gptel--rewrite-merge gptel--rewrite-overlays)) 409 410 (transient-define-suffix gptel--suffix-rewrite-apply () 411 "Accept pending LLM rewrites." 412 :if (lambda () gptel--rewrite-overlays) 413 :key "ca" 414 :description "Accept in-place" 415 (interactive) 416 (gptel--rewrite-apply gptel--rewrite-overlays)) 417 418 (transient-define-suffix gptel--suffix-rewrite-clear () 419 "Clear pending LLM rewrites." 420 :if (lambda () gptel--rewrite-overlays) 421 :key "ck" 422 :description (concat "Clear pending " 423 (downcase (gptel--refactor-or-rewrite)) 424 "s") 425 (interactive) 426 (gptel--rewrite-clear gptel--rewrite-overlays)) 427 428 (provide 'gptel-rewrite) 429 ;;; gptel-rewrite.el ends here 430 431 ;; Local Variables: 432 ;; outline-regexp: "^;; \\*+" 433 ;; End: