gptel-rewrite.el (17633B)
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 ["Dry Run" :if (lambda () (or gptel-log-level gptel-expert-commands)) 275 ("I" "Inspect query (Lisp)" 276 (lambda () 277 "Inspect the query that will be sent as a lisp object." 278 (interactive) 279 (gptel--sanitize-model) 280 (gptel--inspect-query 281 (gptel--suffix-rewrite gptel--rewrite-message t)))) 282 ("J" "Inspect query (JSON)" 283 (lambda () 284 "Inspect the query that will be sent as a JSON object." 285 (interactive) 286 (gptel--sanitize-model) 287 (gptel--inspect-query 288 (gptel--suffix-rewrite gptel--rewrite-message t) 289 'json)))]] 290 [[:description (lambda () (concat "Diff " (gptel--refactor-or-rewrite) "s")) 291 :if (lambda () gptel--rewrite-overlays) 292 (gptel--suffix-rewrite-diff) 293 (gptel--suffix-rewrite-ediff)] 294 [:description (lambda () (concat "Continue " (gptel--refactor-or-rewrite) "s")) 295 :if (lambda () (gptel--rewrite-sanitize-overlays)) 296 (gptel--suffix-rewrite-merge) 297 (gptel--suffix-rewrite-apply)] 298 [:description (lambda () (concat "Reject " (gptel--refactor-or-rewrite) "s")) 299 :if (lambda () (gptel--rewrite-sanitize-overlays)) 300 (gptel--suffix-rewrite-clear)]] 301 (interactive) 302 (unless gptel--rewrite-message 303 (setq gptel--rewrite-message 304 (save-mark-and-excursion 305 (run-hook-with-args-until-success 306 'gptel-rewrite-directives-hook)))) 307 (transient-setup 'gptel-rewrite-menu)) 308 309 ;; * Transient infixes for rewriting/refactoring 310 311 (transient-define-infix gptel--infix-rewrite-prompt () 312 "Chat directive (system message) to use for rewriting or refactoring." 313 :description (lambda () (if (derived-mode-p 'prog-mode) 314 "Set directives for refactor" 315 "Set directives for rewrite")) 316 :format "%k %d" 317 :class 'transient-lisp-variable 318 :variable 'gptel--rewrite-message 319 :key "d" 320 :prompt "Set directive for rewrite: " 321 :reader (lambda (prompt _ history) 322 (read-string 323 prompt 324 (save-mark-and-excursion 325 (run-hook-with-args-until-success 326 'gptel-rewrite-directives-hook)) 327 history))) 328 329 (transient-define-argument gptel--rewrite-infix-diff:-U () 330 :description "Context lines" 331 :class 'transient-option 332 :argument "-U" 333 :reader #'transient-read-number-N0) 334 335 ;; * Transient suffixes for rewriting/refactoring 336 337 (transient-define-suffix gptel--suffix-rewrite (&optional rewrite-message dry-run) 338 "Rewrite or refactor region contents." 339 :key "r" 340 :description #'gptel--refactor-or-rewrite 341 (interactive (list gptel--rewrite-message)) 342 (let* ((prompt (buffer-substring-no-properties 343 (region-beginning) (region-end))) 344 (gptel--system-message (or rewrite-message gptel--rewrite-message)) 345 ;; always send context with system message 346 (gptel-use-context (and gptel-use-context 'system))) 347 (deactivate-mark) 348 (gptel-request prompt 349 :dry-run dry-run 350 :context 351 (let ((ov (make-overlay (region-beginning) (region-end)))) 352 (overlay-put ov 'category 'gptel) 353 (overlay-put ov 'evaporate t) 354 ov) 355 :callback 356 (lambda (response info) 357 (if (not response) 358 (message (concat "LLM response error: %s. Rewrite/refactor in buffer %s canceled." 359 (propertize "❌" 'face 'error)) 360 (plist-get info :status) 361 (plist-get info :buffer)) 362 ;; Store response 363 (let ((buf (plist-get info :buffer)) 364 (ov (plist-get info :context)) 365 (action-str) (hint-str)) 366 (with-current-buffer buf 367 (if (derived-mode-p 'prog-mode) 368 (progn 369 (setq action-str "refactor") 370 (when (string-match-p "^```" response) 371 (setq response (replace-regexp-in-string "^```.*$" "" response)))) 372 (setq action-str "rewrite")) 373 (setq hint-str (concat "[" (gptel-backend-name gptel-backend) 374 ":" (gptel--model-name gptel-model) "] " 375 (upcase action-str) " READY ✓\n")) 376 (add-hook 'eldoc-documentation-functions #'gptel--rewrite-key-help nil 'local) 377 (overlay-put ov 'gptel-rewrite response) 378 (overlay-put ov 'face 'gptel-rewrite-highlight-face) 379 (overlay-put ov 'keymap gptel-rewrite-actions-map) 380 (overlay-put ov 'before-string 381 (concat (propertize 382 " " 'display `(space :align-to (- right ,(1+ (length hint-str))))) 383 (propertize hint-str 'face 'success))) 384 (overlay-put 385 ov 'help-echo 386 (format "%s rewrite available: 387 - accept \\[gptel--rewrite-apply], 388 - clear \\[gptel--rewrite-clear], 389 - merge \\[gptel--accept-merge], 390 - diff \\[gptel--rewrite-diff], 391 - ediff \\[gptel--rewrite-ediff]" 392 (propertize (concat (gptel-backend-name gptel-backend) 393 ":" (gptel--model-name gptel-model))))) 394 (push ov gptel--rewrite-overlays)) 395 ;; Message user 396 (message 397 (concat 398 "LLM %s output" 399 (unless (eq (current-buffer) buf) (format " in buffer %s " buf)) 400 (substitute-command-keys " ready, \\[gptel-menu] to continue.")) 401 action-str))))))) 402 403 (transient-define-suffix gptel--suffix-rewrite-diff (&optional switches) 404 "Diff LLM output against buffer." 405 :if (lambda () gptel--rewrite-overlays) 406 :key "D" 407 :description (concat "Diff LLM " (downcase (gptel--refactor-or-rewrite)) "s") 408 (interactive (list (transient-args transient-current-command))) 409 (gptel--rewrite-diff gptel--rewrite-overlays switches)) 410 411 (transient-define-suffix gptel--suffix-rewrite-ediff () 412 "Ediff LLM output against buffer." 413 :if (lambda () gptel--rewrite-overlays) 414 :key "E" 415 :description (concat "Ediff LLM " (downcase (gptel--refactor-or-rewrite)) "s") 416 (interactive) 417 (gptel--rewrite-ediff gptel--rewrite-overlays)) 418 419 (transient-define-suffix gptel--suffix-rewrite-merge () 420 "Insert LLM output as merge conflicts" 421 :if (lambda () gptel--rewrite-overlays) 422 :key "cm" 423 :description "Accept as merge conflicts" 424 (interactive) 425 (gptel--rewrite-merge gptel--rewrite-overlays)) 426 427 (transient-define-suffix gptel--suffix-rewrite-apply () 428 "Accept pending LLM rewrites." 429 :if (lambda () gptel--rewrite-overlays) 430 :key "ca" 431 :description "Accept in-place" 432 (interactive) 433 (gptel--rewrite-apply gptel--rewrite-overlays)) 434 435 (transient-define-suffix gptel--suffix-rewrite-clear () 436 "Clear pending LLM rewrites." 437 :if (lambda () gptel--rewrite-overlays) 438 :key "ck" 439 :description (concat "Clear pending " 440 (downcase (gptel--refactor-or-rewrite)) 441 "s") 442 (interactive) 443 (gptel--rewrite-clear gptel--rewrite-overlays)) 444 445 (provide 'gptel-rewrite) 446 ;;; gptel-rewrite.el ends here 447 448 ;; Local Variables: 449 ;; outline-regexp: "^;; \\*+" 450 ;; End: