branch: elpa/gptel
commit ef9684206a5c1a6a940f3df01bf51b82e93467e8
Author: daedsidog <[email protected]>
Commit: karthink <[email protected]>
gptel-context: Add contexter
gptel-contexter.el: New file for managing gptel's context for LLM
queries.
gptel-transient.el: Corresponding menu changes for context
management.
---
gptel-contexter.el | 356 +++++++++++++++++++++++++++++++++++++++++++++++++++
gptel-transient.el | 364 +++++++++++++++++++++++++++++++++++++++++++++++++++++
gptel.el | 26 ++++
3 files changed, 746 insertions(+)
diff --git a/gptel-contexter.el b/gptel-contexter.el
new file mode 100644
index 0000000000..43cb8b55bd
--- /dev/null
+++ b/gptel-contexter.el
@@ -0,0 +1,356 @@
+
+;;; gptel-contexter.el --- Context aggregator for GPTel
+
+;; Copyright (C) 2023 Karthik Chikmagalur
+
+;; Author: daedsidog <[email protected]>
+;; Keywords: convenience, buffers
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The contexter allows you to conveniently create contexts which can be fed
+;; to GPTel.
+
+;;; Code:
+
+;;; -*- lexical-binding: t -*-
+
+(require 'cl-lib)
+
+(defcustom gptel-context-highlight-face 'header-line
+ "Face to use to highlight selected context in the buffers."
+ :group 'gptel
+ :type 'symbol)
+
+(defcustom gptel-use-context-in-chat nil
+ "Determines if context should be injected when using the dedicated chat
buffer."
+ :group 'gptel
+ :type 'symbol)
+
+(defcustom gptel-context-injection-destination :nowhere
+ "Where to inject the context. Currently supported options are:
+
+ :nowhere - Do not use the context at all.
+ :before-system-message - Inject the context right before the system
message.
+ :after-system-message - Inject the context right after the system emssage.
+ :before-user-prompt - Inject the context right before the user prompt.
+ :after-user-prompt - Inject the context right after the user prompt."
+ :group 'gptel
+ :type 'symbol)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ------------------------------ FUNCTIONS -------------------------------
;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun gptel-add-context (&optional arg)
+ "Add context to GPTel.
+
+When called regularly, adds current buffer as context.
+When ARG is positive, prompts for buffer name to add as context.
+When ARG is negative, removes current buffer from context.
+When called with region selected, adds selected region as context."
+ (interactive)
+ (cond
+ ;; A region is selected.
+ ((use-region-p)
+ (gptel--add-region-as-context (current-buffer)
+ (region-beginning)
+ (region-end))
+ (deactivate-mark)
+ (message "Current region added as context."))
+ ;; No region is currently selected, so delete a context under point if there
+ ;; is one.
+ ((gptel-context-at-point)
+ (gptel-remove-context (gptel-context-at-point))
+ (message "Context under point has been removed."))
+ ;; No region is selected and no context is under point. The default
behavior
+ ;; is to add the entire buffer as context.
+ (t
+ (gptel--add-region-as-context (current-buffer) (point-min) (point-max))
+ (message "Current buffer added as context."))))
+
+(defun gptel--make-context-overlay (start end)
+ "Highlight the region from START to END."
+ (let ((overlay (make-overlay start end)))
+ (overlay-put overlay 'face gptel-context-highlight-face)
+ (overlay-put overlay 'gptel-context t)
+ overlay))
+
+(cl-defun gptel--add-region-as-context (buffer region-beginning region-end)
+ "Add region delimited by REGION-BEGINNING, REGION-END in BUFFER as context."
+ ;; Remove existing contexts in the same region, if any.
+ (mapc #'gptel-remove-context
+ (gptel-contexts-in-region buffer region-beginning region-end))
+ (let ((start (make-marker))
+ (end (make-marker)))
+ (set-marker start region-beginning (current-buffer))
+ (set-marker end region-end (current-buffer))
+ ;; Trim the unnecessary parts of the context content.
+ (let* ((content (buffer-substring-no-properties start end))
+ (fat-at-end (progn
+ (let ((match-pos
+ (string-match-p (rx (+ (any "\t" "\n" " "))
eos)
+ content)))
+ (when match-pos
+ (- (- end start) match-pos)))))
+ (fat-at-start (progn
+ (when (string-match (rx bos (+ (any "\t" "\n" " ")))
+ content)
+ (match-end 0)))))
+ (when fat-at-start
+ (set-marker start (+ start fat-at-start)))
+ (when fat-at-end
+ (set-marker end (- end fat-at-end))))
+ (when (= start end)
+ (message "No content in selected region.")
+ (cl-return-from gptel--add-region-to-contexts nil))
+ ;; First, highlight the region.
+ (prog1 (gptel--make-context-overlay start end)
+ (message "Region added to context buffer."))))
+
+;;;###autoload
+(defun gptel-contexts-in-region (buffer start end)
+ "Return the list of context overlays in the given region, if any, in BUFFER.
+START and END signify the region delimiters."
+ (with-current-buffer buffer
+ (cl-remove-if-not #'(lambda (overlay)
+ (overlay-get overlay 'gptel-context))
+ (overlays-in start end))))
+
+;;;###autoload
+(defun gptel-context-at-point ()
+ "Return the context overlay at point, if any."
+ (car (overlays-in (point) (point))))
+
+;;;###autoload
+(defun gptel-remove-context (&optional context)
+ "Remove the CONTEXT overlay from the contexts list.
+If CONTEXT is nil, removes the context at point.
+If selection is active, removes all contexts within selection."
+ (interactive)
+ (cond
+ ((overlayp context)
+ (delete-overlay context))
+ ((region-active-p)
+ (let ((contexts (gptel-contexts-in-region (current-buffer)
+ (region-beginning)
+ (region-end))))
+ (when contexts
+ (cl-loop for ctx in contexts do (delete-overlay ctx)))))
+ (t
+ (let ((ctx (gptel-context-at-point)))
+ (when ctx
+ (delete-overlay ctx))))))
+
+;;;###autoload
+(defun gptel-contexts ()
+ "Get the list of all context overlays in all active buffers."
+ (cl-remove-if-not #'(lambda (ov)
+ (overlay-get ov 'gptel-context))
+ (let ((all-overlays '()))
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (setq all-overlays
+ (append all-overlays
+ (overlays-in (point-min)
+ (point-max))))))
+ all-overlays)))
+
+;;;###autoload
+(defun gptel-contexts-in-buffer (buffer)
+ "Get the list of all context overlays in BUFFER."
+ (cl-remove-if-not
+ #'(lambda (ov)
+ (overlay-get ov 'gptel-context))
+ (let ((all-overlays '()))
+ (with-current-buffer buffer
+ (setq all-overlays
+ (append all-overlays
+ (overlays-in (point-min)
+ (point-max)))))
+ all-overlays)))
+
+;;;###autoload
+(defun gptel-remove-all-contexts ()
+ "Clear all contexts."
+ (interactive)
+ (mapc #'gptel-remove-context
+ (gptel-contexts)))
+
+;;;###autoload
+(defun gptel-major-mode-md-prog-lang (mode)
+ "Get the Markdown programming language string for the given MODE."
+ (cond
+ ((eq mode 'emacs-lisp-mode) "emacs-lisp")
+ ((eq mode 'lisp-mode) "common-lisp")
+ ((eq mode 'c-mode) "c")
+ ((eq mode 'c++-mode) "c++")
+ ((eq mode 'javascript-mode) "javascript")
+ ((eq mode 'python-mode) "python")
+ ((eq mode 'ruby-mode) "ruby")
+ ((eq mode 'java-mode) "java")
+ ((eq mode 'go-mode) "go")
+ ((eq mode 'rust-mode) "rust")
+ ((eq mode 'haskell-mode) "haskell")
+ ((eq mode 'scala-mode) "scala")
+ ((eq mode 'kotlin-mode) "kotlin")
+ ((eq mode 'typescript-mode) "typescript")
+ ((eq mode 'css-mode) "css")
+ ((eq mode 'html-mode) "html")
+ ((eq mode 'xml-mode) "xml")
+ ((eq mode 'swift-mode) "swift")
+ ((eq mode 'perl-mode) "perl")
+ ((eq mode 'php-mode) "php")
+ ((eq mode 'csharp-mode) "csharp")
+ ((eq mode 'sql-mode) "sql")
+ (t "")))
+
+(defun gptel--region-inline-p (buffer previous-region current-region)
+ "Return non-nil if CURRENT-REGION begins on the line PREVIOUS-REGION ends in.
+This check pertains only to regions in BUFFER.
+
+PREVIOUS-REGION and CURRENT-REGION should be cons cells (START . END) which
+representthe regions' boundaries within BUFFER."
+ (with-current-buffer buffer
+ (let ((prev-line-end (line-number-at-pos (cdr previous-region)))
+ (curr-line-start (line-number-at-pos (car current-region))))
+ (= prev-line-end curr-line-start))))
+
+(defun gptel--regions-continuous-p (buffer previous-region current-region)
+ "Return non-nil if CURRENT-REGION is a continuation of PREVIOUS-REGION.
+Pretains only to regions in BUFFER.
+
+A region is considered a continuation of another if it is only separated by
+newlines and whitespaces. PREVIOUS-REGION and CURRENT-REGION should be cons
+cells (START . END) representing the boundaries of the regions within BUFFER."
+ (with-current-buffer buffer
+ (let ((gap (buffer-substring-no-properties
+ (cdr previous-region) (car current-region))))
+ (string-match-p
+ (rx bos (* (any "\t" "\n" " ")) eos)
+ gap))))
+
+(defun gptel-buffer-context-string (buffer)
+ "Create a context string from all contexts in BUFFER."
+ (let ((is-top-snippet t)
+ buffer-file
+ previous-region
+ buffer-point-min
+ buffer-point-max
+ prog-lang-tag
+ (contexts (gptel-contexts-in-buffer buffer)))
+ (with-current-buffer buffer
+ (setq buffer-point-min (save-excursion
+ (goto-char (point-min))
+ (skip-chars-forward " \t\n\r")
+ (point))
+ buffer-point-max (save-excursion
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n\r")
+ (point))
+ prog-lang-tag (gptel-major-mode-md-prog-lang
+ major-mode)))
+ (setq buffer-file
+ ;; Use file path if buffer has one, otherwise use its regular name.
+ (if (buffer-file-name buffer)
+ (format "`%s`"
+ (buffer-file-name buffer))
+ (format "buffer `%s`"
+ (buffer-name buffer))))
+ (with-temp-buffer
+ (insert (format "In %s:" buffer-file))
+ (insert "\n\n```" prog-lang-tag "\n")
+ (cl-loop for context in contexts do
+ (progn
+ (let* ((start (overlay-start context))
+ (end (overlay-end context))
+ (region-inline
+ ;; Does the current region start on the same line
the
+ ;; previous region ends?
+ (when previous-region
+ (gptel--region-inline-p buffer
+ previous-region
+ (cons start end))))
+ (region-continuous
+ ;; Is the current region a continuation of the
+ ;; previous region? I.e., is it only separated by
+ ;; newlines and whitespaces?
+ (when previous-region
+ (gptel--regions-continuous-p buffer
+ previous-region
+ (cons start end)))))
+ (unless (<= start buffer-point-min)
+ (if region-continuous
+ ;; If the regions are continuous, insert the
+ ;; whitespaces that separate them.
+ (insert-buffer-substring-no-properties
+ buffer
+ (cdr previous-region)
+ start)
+ ;; Regions are not continuous. Are they on the same
+ ;; line?
+ (if region-inline
+ ;; Region is inline but not continuous, so we
+ ;; should just insert an ellipsis.
+ (insert " ... ")
+ ;; Region is neither inline nor continuous, so just
+ ;; insert an ellipsis on a new line.
+ (unless is-top-snippet
+ (insert "\n"))
+ (insert "...")))
+ (let (lineno)
+ (with-current-buffer buffer
+ (setq lineno (line-number-at-pos start)))
+ ;; We do not need to insert a line number indicator on
+ ;; inline regions.
+ (unless (or region-inline region-continuous)
+ (insert (format " (Line %d)" lineno)))))
+ (when (or (and (not region-inline)
+ (not region-continuous)
+ (not is-top-snippet))
+ is-top-snippet)
+ (insert "\n"))
+ (if is-top-snippet
+ (setq is-top-snippet nil))
+ (let (substring)
+ (with-current-buffer buffer
+ (setq substring (buffer-substring-no-properties
+ start end)))
+ ;; This text property will allow us to know what overlay
+ ;; is associated to which context.
+ (put-text-property 0 (length substring)
+ 'gptel-context-overlay
+ context substring)
+ (insert substring))
+ (setq previous-region (cons start end)))))
+ (unless (>= (overlay-end (car (last contexts))) buffer-point-max)
+ (insert "\n..."))
+ (insert "\n```")
+ (buffer-substring (point-min) (point-max)))))
+
+;;;###autoload
+(defun gptel-context-string ()
+ "Return the context string of all aggregated contexts."
+ (string-trim-right
+ (cl-loop for buffer in
+ (delete-dups (mapcar #'overlay-buffer (gptel-contexts)))
+ concat (concat (gptel-buffer-context-string buffer) "\n\n"))))
+
+(provide 'gptel-contexter)
+;;; gptel-contexter.el ends here.
diff --git a/gptel-transient.el b/gptel-transient.el
index ec723904f5..30db75950d 100644
--- a/gptel-transient.el
+++ b/gptel-transient.el
@@ -28,6 +28,7 @@
(require 'cl-lib)
(require 'gptel)
(require 'transient)
+(require 'gptel-contexter)
(declare-function ediff-regions-internal "ediff")
(declare-function ediff-make-cloned-buffer "ediff-utils")
@@ -467,6 +468,76 @@ Customize `gptel-directives' for task-specific prompts."
;; * Transient Infixes
+;; ** Infixes for context aggregation
+
+(defclass gptel-keyword-variable (transient-lisp-variable)
+ ((choices :initarg :choices)
+ (always-read :initform t)
+ (set-value :initarg :set-value :initform #'set))
+ "Class for handling variables with keyword choices.")
+
+(cl-defmethod transient-format-value ((obj gptel-keyword-variable))
+ (let ((keyword-value (oref obj value))
+ (choices (oref obj choices)))
+ (propertize (cdr (assoc keyword-value choices)) 'face 'transient-value)))
+
+(cl-defmethod transient-infix-set ((obj gptel-keyword-variable) value)
+ (let ((keyword (car (rassoc value (oref obj choices)))))
+ (funcall (oref obj set-value)
+ (oref obj variable)
+ (oset obj value keyword))))
+
+(defun gptel--keyword-reader (prompt choices)
+ (let* ((display-choices (mapcar #'cdr choices))
+ (selected-string (completing-read prompt display-choices nil t)))
+ selected-string))
+
+(transient-define-infix gptel--infix-context-destination ()
+ "Describe target destination for context injection."
+ :description "Context destination"
+ :class 'gptel-keyword-variable
+ :variable 'gptel-context-injection-destination
+ :key "-xd"
+ :choices '((:nowhere . "nowhere")
+ (:before-system-message . "before system message")
+ (:after-system-message . "after system message")
+ (:before-user-prompt . "before user prompt")
+ (:after-user-prompt . "after user prompt"))
+ :reader (lambda (prompt &rest _)
+ (gptel--keyword-reader
+ prompt
+ '((:nowhere . "nowhere")
+ (:before-system-message . "before system message")
+ (:after-system-message . "after system message")
+ (:before-user-prompt . "before user prompt")
+ (:after-user-prompt . "after user prompt")))))
+
+(defclass gptel-boolean-variable (transient-lisp-variable)
+ ((always-read :initform t)
+ (set-value :initarg :set-value :initform #'set))
+ "Class for handling boolean variables.")
+
+(cl-defmethod transient-format-value ((obj gptel-boolean-variable))
+ (let ((value (oref obj value)))
+ (propertize (if value "yes" "no") 'face 'transient-value)))
+
+(cl-defmethod transient-infix-set ((obj gptel-boolean-variable) value)
+ (funcall (oref obj set-value)
+ (oref obj variable)
+ (oset obj value (equal value "yes"))))
+
+(defun gptel--boolean-reader (prompt _ history)
+ (let* ((choice (completing-read prompt '("yes" "no") nil t nil history)))
+ choice))
+
+(transient-define-infix gptel--infix-use-context-in-chat ()
+ "Determine if context should be passed to the LLM during the chat."
+ :description "Use in chat"
+ :class 'gptel-boolean-variable
+ :variable 'gptel-use-context-in-chat
+ :key "-xc"
+ :reader 'gptel--boolean-reader)
+
;; ** Infixes for model parameters
(transient-define-infix gptel--infix-variable-scope ()
@@ -881,6 +952,299 @@ When LOCAL is non-nil, set the system message only in the
current buffer."
(funcall quit-to-menu)))
(local-set-key (kbd "C-c C-k") quit-to-menu)))))
+;; ** Suffix for displaying and removing context
+
+(defun gptel--context-edge-point (edge-type direction &optional inclusive)
+ "Find context edge point of EDGE-TYPE from current point.
+EDGE-TYPE is either :start or :end.
+DIRECTION is either :next or :previous.
+If INCLUSIVE is non-nil, return the current point if it is on an edge."
+ (let* ((point nil)
+ (get-edge-point #'(lambda (direction)
+ (if (and inclusive
+ (when (get-text-property (point)
'gptel-context-overlay)
+ (if (eq edge-type :start)
+ (when (and (/= (point) (point-min))
+ (not (get-text-property
+ (1- (point))
+
'gptel-context-overlay)))
+ t)
+ (when (and (/= (point) (point-max))
+ (not (get-text-property
+ (1+ (point))
+
'gptel-context-overlay)))
+ t))))
+ (point)
+ (if (eq direction :next)
+ (setq point (next-single-property-change
+ (point)
+ 'gptel-context-overlay nil
nil))
+ (setq point (previous-single-property-change
+ (point)
+ 'gptel-context-overlay nil
nil)))))))
+ (save-excursion
+ (if (eq edge-type :end)
+ (progn
+ (funcall get-edge-point direction)
+ (when point
+ (goto-char point)
+ (if (get-text-property (1+ point) 'gptel-context-overlay)
+ ;; This is actually a starting edge, not an ending edge.
+ (funcall get-edge-point direction)
+ point)))
+ (funcall get-edge-point direction)
+ (when point
+ (goto-char point)
+ (if (get-text-property (1- point) 'gptel-context-overlay)
+ ;; This is actually an ending edge, not a starting edge.
+ (funcall get-edge-point direction)))))
+ ;; Handle some edge cases (pun unintended).
+ (unless point
+ (if (eq edge-type :end)
+ (when (get-text-property (max (point-min) (1- (point)))
'gptel-context-overlay)
+ (setq point (point)))
+ (when (get-text-property (min (point-max) (1+ (point)))
'gptel-context-overlay)
+ (setq point (point)))))
+ point))
+
+(let* ((highlight-start nil)
+ (highlight-end nil)
+ (highlight-overlay nil)
+ (moved-backwards nil)) ; This is used for some deletion navigation QoL.
+
+ (transient-define-suffix gptel--suffix-context-buffer ()
+ "Display all contexts from all buffers & files."
+ :transient 'transient--do-exit
+ :key "-xb"
+ :description (lambda ()
+ (let* ((contexts (gptel-contexts))
+ (buffer-count (length (delete-dups (mapcar
#'overlay-buffer contexts)))))
+ (concat "Display context buffer "
+ (propertize
+ (format "%d context%s in %d buffer%s"
+ (length contexts)
+ (if (/= (length contexts) 1) "s" "")
+ buffer-count
+ (if (/= buffer-count 1) "s" ""))
+ 'face 'transient-value))))
+ (interactive)
+ (let ((orig-buf (current-buffer)))
+ (with-current-buffer (get-buffer-create "*gptel-context*")
+ (read-only-mode 1)
+ (setq highlight-start nil
+ highlight-end nil
+ highlight-overlay nil)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (setq header-line-format
+ (concat
+ "Mark/unmark deletion with "
+ (propertize "d" 'face 'help-key-binding)
+ ", jump to next/previous with "
+ (propertize "n" 'face 'help-key-binding)
+ "/"
+ (propertize "p" 'face 'help-key-binding)
+ ", respectively. "
+ (propertize "C-c C-c" 'face 'help-key-binding)
+ " to apply, or "
+ (propertize "C-c C-k" 'face 'help-key-binding)
+ " to abort."))
+ (save-excursion
+ (let ((contexts (gptel-contexts)))
+ (if (> (length contexts) 0)
+ (insert (gptel-context-string))
+ (insert "There are no active contexts in any buffer.")))))
+ (display-buffer (current-buffer)
+ `((display-buffer-below-selected)
+ (body-function . ,#'select-window)
+ (window-height . ,#'fit-window-to-buffer)))
+ ;; Add hook to change the highlight whenever the point has moved beyond
+ ;; that of the current highlight.
+ (add-hook
+ 'post-command-hook
+ #'(lambda ()
+ ;; Only update if point moved outside the current region.
+ (unless (and highlight-start highlight-end
+ (>= (point) highlight-start)
+ (<= (point) highlight-end))
+ ;; Remove the old region.
+ (when highlight-overlay (delete-overlay highlight-overlay))
+ (setq highlight-end nil
+ highlight-start nil)
+ ;; Find new region to highlight.
+ (let* ((point-is-within-context
+ (get-text-property (point) 'gptel-context-overlay))
+ (start (previous-single-property-change
+ (point)
+ 'gptel-context-overlay
+ nil
+ nil))
+ (end (next-single-property-change
+ (point)
+ 'gptel-context-overlay
+ nil
+ nil)))
+ ;; Handle the edge cases where the point is located at the
ends
+ ;; of the context.
+ (when (or (not start)
+ (not (get-text-property (1+ start)
+ 'gptel-context-overlay)))
+ (setq start (point)))
+ (when (and start end (<= start (point) end)
+ point-is-within-context)
+ (setq highlight-start start)
+ (setq highlight-end (1- end))
+ ;; Create new overlay for highlighting.
+ (setq highlight-overlay (make-overlay start end))
+ (overlay-put highlight-overlay 'face 'highlight)
+ (overlay-put highlight-overlay 'priority 1)
+ (overlay-put highlight-overlay 'gptel-context-highlight
t)))))
+ nil t)
+ (let ((quit-to-menu
+ (lambda ()
+ (interactive)
+ (local-unset-key (kbd "d"))
+ (local-unset-key (kbd "n"))
+ (local-unset-key (kbd "p"))
+ (local-unset-key (kbd "C-c C-c"))
+ (local-unset-key (kbd "C-c C-k"))
+ (quit-window)
+ (display-buffer
+ orig-buf
+ `((display-buffer-reuse-window
+ display-buffer-use-some-window)
+ (body-function . ,#'select-window)))
+ (call-interactively #'gptel-menu)))
+ (forward-movement-func
+ #'(lambda ()
+ (interactive)
+ (let ((next-start (gptel--context-edge-point :start :next)))
+ (when next-start
+ (setq moved-backwards nil)
+ (goto-char next-start)))))
+ (backward-movement-func
+ #'(lambda ()
+ (interactive)
+ (let ((previous-end (gptel--context-edge-point :end
:previous)))
+ (when (and previous-end (/= previous-end (point)))
+ (setq moved-backwards t)
+ (goto-char (1- previous-end)))))))
+ (local-set-key (kbd "n") forward-movement-func)
+ (local-set-key (kbd "p") backward-movement-func)
+ (local-set-key
+ (kbd "d") ; Marking overlays for deletion
+ #'(lambda ()
+ (interactive)
+ (if (not (region-active-p)) ; Separate functiaonlity with just
points vs. regions.
+ (progn
+ (let ((overlays (overlays-at (point)))
+ (deletion-overlay-found nil)
+ (highlighting-overlay nil)
+ (something-marked-or-unmarked nil))
+ ;; Loop through all overlays at point to check for
deletion mark or
+ ;; highlight.
+ (dolist (overlay overlays)
+ (cond
+ ((overlay-get overlay 'gptel-context-deletion-mark)
+ ;; If deletion mark is found, delete the overlay
and set flag to true.
+ (delete-overlay overlay)
+ (setq something-marked-or-unmarked t)
+ (setq deletion-overlay-found t))
+ ((overlay-get overlay 'gptel-context-highlight)
+ (setq highlighting-overlay overlay))))
+ (when (and highlighting-overlay
+ (not deletion-overlay-found)
+ (overlay-get highlighting-overlay
'gptel-context-highlight))
+ (let* ((start (overlay-start highlighting-overlay))
+ (end (overlay-end highlighting-overlay))
+ (new-overlay (make-overlay start end)))
+ ;; We want to have 0 priority so that the
highlighting overlay takes
+ ;; precedence.
+ (setq something-marked-or-unmarked t)
+ (overlay-put new-overlay 'priority 0)
+ (overlay-put new-overlay 'face
'diff-indicator-removed)
+ (overlay-put new-overlay
'gptel-context-deletion-mark t)))
+ (when something-marked-or-unmarked
+ (if moved-backwards
+ (progn
+ (let ((point (point)))
+ (funcall backward-movement-func)
+ (when (eq point (point))
+ ;; We haven't moved. Disregard previous
movement and just go
+ ;; forwards.
+ (setq moved-backwards nil)
+ (funcall forward-movement-func))))
+ (funcall forward-movement-func)))))
+ ;; We have a region selected, so we must iterate all the
overlays in it to do the
+ ;; same as we have done above.
+ (let ((marking-action :mark-all) ; :mark-all, :unmark-all
+ (context-region-and-mark '())
+ (start (region-beginning))
+ (end (region-end))
+ (unmarked-context-found nil)
+ (highlight-overlay-region-at-point
+ #'(lambda ()
+ ;; We can't get the overlay, because the hook
isn't triggered, so the
+ ;; highlighting overlay won't work when we use
`goto-char'.
+ (when (get-text-property (point)
'gptel-context-overlay)
+ (cons (gptel--context-edge-point :start
:previous t)
+ (gptel--context-edge-point :end :next
t)))))
+ (deletion-overlay-at-point
+ #'(lambda ()
+ (car (cl-loop
+ for ov in (overlays-at (point))
+ when (overlay-get ov
'gptel-context-deletion-mark)
+ collect ov)))))
+ (deactivate-mark)
+ ;; We want to collect the context regions and see if they
have deletion marks to
+ ;; determine what we want to do.
+ (save-excursion
+ (goto-char start)
+ (cl-loop for previous-point = start then (point)
+ do (progn
+ (let ((hov-region (funcall
highlight-overlay-region-at-point))
+ (deletion-ov nil))
+ (when hov-region
+ (setq deletion-ov (funcall
deletion-overlay-at-point))
+ (push (cons hov-region
+ deletion-ov)
+ context-region-and-mark)
+ (unless deletion-ov
+ (setq unmarked-context-found t)))
+ (funcall forward-movement-func)))
+ until (or (= previous-point (point))
+ (> (point) end))))
+ (unless unmarked-context-found
+ (setq marking-action :unmark-all))
+ (cl-loop for (hov-region . dov) in context-region-and-mark
do
+ (if (eq marking-action :mark-all)
+ (unless dov ; Do not make a duplicate deletion
overlay.
+ (let* ((start (car hov-region))
+ (end (cdr hov-region))
+ (new-overlay (make-overlay start
end)))
+ (overlay-put new-overlay 'priority 0)
+ (overlay-put new-overlay 'face
'diff-indicator-removed)
+ (overlay-put new-overlay
'gptel-context-deletion-mark t)))
+ ;; marking-action is :unmark-all.
+ (delete-overlay dov)))))))
+ (local-set-key (kbd "C-c C-c")
+ #'(lambda ()
+ (interactive)
+ ;; Delete all the context overlays that have been
marked for deletion.
+ (cl-loop for dov in
+ (cl-loop for ov in (overlays-in
(point-min) (point-max))
+ when
+ (and (overlay-get ov
'gptel-context-deletion-mark)
+ ;; Ignore zero-length
overlays. Not sure why
+ ;; these appear at the
start of the buffer.
+ (/= (overlay-start ov)
(overlay-end ov)))
+ collect ov)
+ do (delete-overlay
+ (get-text-property (overlay-start
dov)
+
'gptel-context-overlay)))
+ (funcall quit-to-menu)))
+ (local-set-key (kbd "C-c C-k") quit-to-menu))))))
+
;; ** Suffixes for rewriting/refactoring
(transient-define-suffix gptel--suffix-rewrite ()
diff --git a/gptel.el b/gptel.el
index 5f217e0abc..e72db51ccf 100644
--- a/gptel.el
+++ b/gptel.el
@@ -1378,6 +1378,32 @@ context for the ediff session."
(interactive "p")
(gptel--previous-variant (- arg)))
+(defun gptel-clean-up-llm-code (buffer beg end)
+ "Clean up LLM response between BEG & END in BUFFER.
+
+Removes any markup formatting and indents the code within the parameters of the
+current buffer."
+ (with-current-buffer buffer
+ (save-excursion
+ (let* ((res-beg beg)
+ (res-end end)
+ (contents nil))
+ (setq contents (buffer-substring-no-properties res-beg
+ res-end))
+ (setq contents (replace-regexp-in-string
+ "^\\(```.*\n\\)\\|\n\\(```.*\\)$"
+ ""
+ contents))
+ (delete-region res-beg res-end)
+ (goto-char res-beg)
+ (insert contents)
+ (setq res-end (point))
+ ;; Indent the code to match the buffer indentation if it's messed up.
+ (unless (eq indent-line-function #'indent-relative)
+ (indent-region res-beg res-end))
+ (pulse-momentary-highlight-region res-beg res-end)
+ (setq res-beg (next-single-property-change res-beg 'gptel))))))
+
(provide 'gptel)
;;; gptel.el ends here
