branch: elpa/gptel
commit b10cd98e075a8314b93cab93faa6144341f87478
Author: daedsidog <[email protected]>
Commit: karthink <[email protected]>
gptel-context: Implement DWIM features
gptel-contexter.el: General fixes to context management
features.
gptel-transient.el: Ditto.
---
gptel-contexter.el | 277 ++++++++++++-----------
gptel-openai.el | 19 +-
gptel-transient.el | 638 ++++++++++++++++++++++++-----------------------------
gptel.el | 43 ++--
4 files changed, 460 insertions(+), 517 deletions(-)
diff --git a/gptel-contexter.el b/gptel-contexter.el
index 43cb8b55bd..95a6563805 100644
--- a/gptel-contexter.el
+++ b/gptel-contexter.el
@@ -38,7 +38,8 @@
:type 'symbol)
(defcustom gptel-use-context-in-chat nil
- "Determines if context should be injected when using the dedicated chat
buffer."
+ "Determines if context should be injected when using the dedicated chat
buffer.
+If non-nil, then the model will use the context in the chat buffer."
:group 'gptel
:type 'symbol)
@@ -53,6 +54,18 @@
:group 'gptel
:type 'symbol)
+(defcustom gptel-context-preamble "Request context:"
+ "A string to be prepended to the context."
+ :group 'gptel
+ :type 'string)
+
+(defcustom gptel-context-postamble ""
+ "A string to be appended to the context."
+ :group 'gptel
+ :type 'string)
+
+(defvar gptel--context-overlays '())
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ------------------------------ FUNCTIONS -------------------------------
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -61,11 +74,13 @@
(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)
+When called without a prefix argument, adds the current buffer as context.
+When ARG is positive, prompts for a buffer name and adds it as context.
+When ARG is negative, removes all contexts from the current buffer.
+When called with a region selected, adds the selected region as context.
+
+If there is a context under point, it is removed when called without a prefix."
+ (interactive "P")
(cond
;; A region is selected.
((use-region-p)
@@ -74,55 +89,79 @@ When called with region selected, adds selected region as
context."
(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."))))
+ ;; No region is selected, and ARG is positive.
+ ((and arg (> (prefix-numeric-value arg) 0))
+ (let ((buffer-name (read-buffer "Choose buffer to add as context: " nil
t)))
+ (gptel--add-region-as-context (get-buffer buffer-name) (point-min)
(point-max))
+ (message "Buffer '%s' added as context." buffer-name)))
+ ;; No region is selected, and ARG is negative.
+ ((and arg (< (prefix-numeric-value arg) 0))
+ (when (y-or-n-p "Remove all contexts from this buffer? ")
+ (let ((removed-contexts 0))
+ (cl-loop for cov in
+ (gptel-contexts-in-region (current-buffer) (point-min)
(point-max))
+ do (progn
+ (cl-incf removed-contexts)
+ (gptel-remove-context cov)))
+ (message (format "%d context%s removed from current buffer."
+ removed-contexts
+ (if (= removed-contexts 1) "" "s"))))))
+ (t ; Default behavior
+ (if (gptel-context-at-point)
+ (progn
+ (gptel-remove-context (car (gptel-contexts-in-region (current-buffer)
+ (max
(point-min) (1- (point)))
+ (point))))
+ (message "Context under point has been removed."))
+ (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 'evaporate t)
(overlay-put overlay 'face gptel-context-highlight-face)
(overlay-put overlay 'gptel-context t)
+ (push overlay gptel--context-overlays)
overlay))
+(defun gptel--wrap-in-context (message)
+ "Wrap MESSAGE with context.
+The message is usually either a system message or user prompt."
+ ;; Append context before/after system message.
+ (if (and (bound-and-true-p gptel-mode)
+ (not gptel-use-context-in-chat))
+ ;; If we are in the dedicated chat buffer, we would like to consult
+ ;; `gptel-use-context-in-chat' to see if context should be used inside.
+ message
+ (let ((context (gptel-context-string)))
+ (if (> (length context) 0)
+ (if (memq gptel-context-injection-destination
+ '(:before-system-message
+ :before-user-prompt))
+ (concat gptel-context-preamble
+ (when (not (zerop (length gptel-context-preamble)))
"\n\n")
+ context
+ "\n\n"
+ gptel-context-postamble
+ (when (not (zerop (length gptel-context-postamble)))
"\n\n")
+ message)
+ (concat message
+ "\n\n"
+ gptel-context-preamble
+ (when (not (zerop (length gptel-context-preamble))) "\n\n")
+ context
+ (when (not (zerop (length gptel-context-postamble)))
"\n\n")
+ gptel-context-postamble))
+ message))))
+
(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."))))
+ (prog1 (gptel--make-context-overlay region-beginning region-end)
+ (message "Region added to context buffer.")))
;;;###autoload
(defun gptel-contexts-in-region (buffer start end)
@@ -136,8 +175,10 @@ START and END signify the region delimiters."
;;;###autoload
(defun gptel-context-at-point ()
"Return the context overlay at point, if any."
- (car (overlays-in (point) (point))))
-
+ (car (cl-remove-if-not #'(lambda (ov)
+ (overlay-get ov 'gptel-context))
+ (overlays-at (point)))))
+
;;;###autoload
(defun gptel-remove-context (&optional context)
"Remove the CONTEXT overlay from the contexts list.
@@ -160,17 +201,13 @@ If selection is active, removes all contexts within
selection."
;;;###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)))
+ "Get the list of all active context overlays."
+ ;; Get only the non-degenerate overlays, collect them, and update the
overlays variable.
+ (let ((overlays (cl-loop for ov in gptel--context-overlays
+ when (overlay-start ov)
+ collect ov)))
+ (setq gptel--context-overlays overlays)
+ overlays))
;;;###autoload
(defun gptel-contexts-in-buffer (buffer)
@@ -232,39 +269,16 @@ representthe regions' boundaries within BUFFER."
(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."
+(defun gptel-buffer-context-string (buffer &optional depropertize)
+ "Create a context string from all contexts in BUFFER.
+If DEPROPERTIZE is non-nil, remove the properties from the final substring."
(let ((is-top-snippet t)
buffer-file
- previous-region
- buffer-point-min
- buffer-point-max
+ (previous-line 1)
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
+ (setq 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.
@@ -279,55 +293,26 @@ cells (START . END) representing the boundaries of the
regions within BUFFER."
(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))
+ (end (overlay-end context)))
+ (let (lineno column)
+ (with-current-buffer buffer
+ (setq lineno (line-number-at-pos start t))
+ (setq column (save-excursion
+ (goto-char start)
+ (current-column))))
+ ;; We do not need to insert a line number indicator if
we have two regions
+ ;; on the same line, because the previous region should
have already put the
+ ;; indicator.
+ (unless (= previous-line lineno)
+ (unless (= lineno 1)
+ (insert (format "\n... (Line %d)\n" lineno))))
+ (setq previous-line lineno)
+ (unless (zerop column)
+ (insert " ..."))
+ (if is-top-snippet
+ (setq is-top-snippet nil)
+ (unless (= previous-line lineno)
+ (insert "\n"))))
(let (substring)
(with-current-buffer buffer
(setq substring (buffer-substring-no-properties
@@ -337,20 +322,28 @@ cells (START . END) representing the boundaries of the
regions within BUFFER."
(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 substring)))))
+ (unless (>= (overlay-end (car (last contexts))) (point-max))
(insert "\n..."))
(insert "\n```")
- (buffer-substring (point-min) (point-max)))))
+ (let ((context-snippet (buffer-substring (point-min) (point-max))))
+ (when depropertize
+ (set-text-properties 0 (length context-snippet) nil
context-snippet))
+ context-snippet))))
;;;###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"))))
+(defun gptel-context-string (&optional propertize)
+ "Return the context string of all aggregated contexts.
+If PROPERTIZE is non-nil, keep the text properties."
+ (without-restriction
+ (let ((context (string-trim-right
+ (cl-loop for buffer in
+ (delete-dups (mapcar #'overlay-buffer
(gptel-contexts)))
+ concat (concat (gptel-buffer-context-string
buffer) "\n\n")))))
+ (if propertize
+ context
+ (set-text-properties 0 (length context) nil context)
+ context))))
(provide 'gptel-contexter)
;;; gptel-contexter.el ends here.
diff --git a/gptel-openai.el b/gptel-openai.el
index 9b8f375eea..b89d3e747a 100644
--- a/gptel-openai.el
+++ b/gptel-openai.el
@@ -26,6 +26,7 @@
(eval-when-compile
(require 'cl-lib))
(require 'map)
+(require 'gptel-contexter)
(defvar gptel-model)
(defvar gptel-stream)
@@ -143,8 +144,22 @@ with differing settings.")
(push (list :role "user"
:content
(string-trim
- (buffer-substring-no-properties (point-min) (point-max))))
- prompts))
+ (buffer-substring-no-properties (prop-match-beginning prop)
+ (prop-match-end prop))
+ (format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*"
+ (regexp-quote (gptel-prompt-prefix-string)))
+ (format "[\t\r\n ]*\\(?:%s\\)?[\t\r\n ]*"
+ (regexp-quote (gptel-response-prefix-string)))))
+ prompts)
+ (and max-entries (cl-decf max-entries)))
+ (when (and (memq gptel-context-injection-destination '(:before-user-prompt
:after-user-prompt))
+ (> (length prompts) 0))
+ ;; Add context to final user prompt.
+ (let* ((last-prompt (last prompts))
+ (last-plist (car last-prompt)))
+ (setf (car last-prompt) (plist-put last-plist :content
+ (gptel--wrap-in-context (plist-get
(car last-prompt)
+
:content))))))
(cons (list :role "system"
:content gptel--system-message)
prompts)))
diff --git a/gptel-transient.el b/gptel-transient.el
index 30db75950d..d59f0a07c6 100644
--- a/gptel-transient.el
+++ b/gptel-transient.el
@@ -236,6 +236,32 @@ This is used only for setting this variable via
`gptel-menu'.")
(oset obj model-value model-value)
gptel--set-buffer-locally)))
+(defclass gptel-context-destination-variable (transient-lisp-variable)
+ ((display-value :initarg :display-value
+ :initform (lambda (value)
+ (pcase value
+ (: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"))))))
+
+(cl-defmethod transient-format-value ((obj gptel-context-destination-variable))
+ (propertize (funcall (oref obj display-value)
+ (buffer-local-value (oref obj variable)
transient--original-buffer))
+ 'face 'transient-value))
+
+(cl-defmethod transient-infix-set ((obj gptel-context-destination-variable)
value)
+ (funcall (oref obj set-value)
+ (oref obj variable)
+ (pcase value
+ ("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))
+ gptel--set-buffer-locally))
+
(defclass gptel-option-overlaid (transient-option)
((display-nil :initarg :display-nil)
(overlay :initarg :overlay))
@@ -288,6 +314,10 @@ Also format its value in the Transient menu."
"Instructions"
("s" "Set system message" gptel-system-prompt :transient t)
(gptel--infix-add-directive)]]
+ [["Context" :if (lambda () gptel-expert-commands)
+ (gptel--suffix-context-buffer)
+ (gptel--infix-context-destination)
+ (gptel--infix-use-context-in-chat :if (lambda () gptel-mode))]]
[["Model Parameters"
:pad-keys t
(gptel--infix-variable-scope)
@@ -470,73 +500,27 @@ Customize `gptel-directives' for task-specific prompts."
;; ** 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
+ :class 'gptel-context-destination-variable
:variable 'gptel-context-injection-destination
+ :set-value #'gptel--set-with-scope
: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))
+ (completing-read prompt '("Nowhere" "Before system message" "After
system message"
+ "Before user prompt" "After user prompt")
+ nil t)))
(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
+ :class 'gptel--switches
:variable 'gptel-use-context-in-chat
- :key "-xc"
- :reader 'gptel--boolean-reader)
+ :set-value #'gptel--set-with-scope
+ :display-if-true "Yes"
+ :display-if-false "No"
+ :key "-xc")
;; ** Infixes for model parameters
@@ -954,296 +938,260 @@ When LOCAL is non-nil, set the system message only in
the current buffer."
;; ** 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
+(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 "
+ (format
+ (propertize "(%s)" 'face 'transient-delimiter)
+ (propertize (format "%d context%s in %d buffer%s"
+ (length contexts)
+ (if (/= (length contexts) 1)
"s" "")
+ buffer-count
+ (if (/= buffer-count 1) "s"
""))
+ 'face (if (zerop (length contexts))
+ 'transient-inactive-value
+ 'transient-value))))))
+ (interactive)
+ (let ((orig-buf (current-buffer))
+ (highlight-overlay nil)
+ (moved-backwards nil)) ; This is used for some deletion navigation QoL.
+ (with-current-buffer (get-buffer-create "*gptel-context*")
+ (read-only-mode 1)
+ (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)
+ (progn
+ (insert (gptel-context-string t))
+ ;; Mark the inserted context chunks with an overlay to
simplify bookkeeping.
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((beg (next-single-property-change (point)
'gptel-context-overlay))
+ (end (when beg
+ (next-single-property-change beg
'gptel-context-overlay))))
+ (if end
+ (progn
+ (when (get-text-property beg
'gptel-context-overlay)
+ (let ((ov (make-overlay beg end)))
+ ;; We want to make the highlighting overlay a
higher priority than
+ ;; the deletion overlay. We superimpose both
overlays to have an
+ ;; effect that allows for both highlighting
and deletion overlays
+ ;; to exist simutaniously for the same context
chunk.
+ (overlay-put ov 'priority 1)
+ (overlay-put ov 'gptel-context-highlight t)))
+ (goto-char end))
+ (goto-char (point-max))))))
+ (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 (member highlight-overlay (overlays-at (point)))
+ (let ((context-overlay (car (cl-loop
+ for ov in (overlays-at (point))
+ when (overlay-get ov
'gptel-context-highlight)
+ collect ov))))
+ (when highlight-overlay
+ (overlay-put highlight-overlay 'face nil))
+ (when context-overlay
+ (overlay-put context-overlay 'face 'highlight))
+ (setq highlight-overlay context-overlay))))
+ 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)))
+ ;; Function used to detect whether or not we are at the edges of
an overlay. This is
+ ;; used to know how many overlay changes we should jump over in
order to reach the
+ ;; start or end of overlays. Refers to inner edge.
+ (at-overlay-edge-p #'(lambda (pos left-edge)
+ ;; Obviously, if we have no overlay at the
point, we cannot be
+ ;; at an edge.
+ (when (overlays-at (point))
+ (not (if left-edge
+ (overlays-at (max (1- pos)
(point-min)))
+ (not (overlays-at (min (1+ pos)
(point-max)))))))))
+ (move-forward
+ #'(lambda ()
+ (interactive)
+ (let ((point-is-inside-overlay (overlays-at (point)))
+ (next-start (next-overlay-change (point))))
+ (when (and (/= (point-max) next-start)
point-is-inside-overlay)
+ ;; We were inside the overlay, so we want the next
overlay change, which
+ ;; would be the start of the next overlay.
+ (setq next-start (next-overlay-change next-start)))
+ (when (/= next-start (point-max))
+ (setq moved-backwards nil)
+ (goto-char next-start)))))
+ (move-backward
+ #'(lambda ()
+ (interactive)
+ (let ((point-is-inside-overlay (overlays-at (point)))
+ (previous-end (previous-overlay-change (point))))
+ (when (and (/= (point-min) previous-end)
point-is-inside-overlay
+ ;; Handele the edge case where the caret is
located right at the
+ ;; beginning of an overlay.
+ (overlays-at (max (1- (point)) (point-min))))
+ ;; We were inside an overlay, so are currently at the
start of the current
+ ;; overlay.
+ (setq previous-end (previous-overlay-change
previous-end)))
+ (when (/= (point-min) previous-end)
+ (setq moved-backwards t)
+ (goto-char (1- previous-end)))))))
+ (local-set-key (kbd "n") move-forward)
+ (local-set-key (kbd "p") move-backward)
+ (local-set-key
+ (kbd "d") ; Marking overlays for deletion
#'(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))))))
+ (interactive)
+ (if (not (region-active-p)) ; Separate functionality 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 move-backward)
+ (when (eq point (point))
+ ;; We haven't moved. Disregard previous
movement and just go
+ ;; forwards.
+ (setq moved-backwards nil)
+ (funcall move-forward))))
+ (funcall move-forward)))))
+ ;; 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'.
+ (let ((ov (car (cl-loop for ov in (overlays-at
(point))
+ when (overlay-get ov
'gptel-context-highlight)
+ collect ov))))
+ (cons (overlay-start ov) (overlay-end ov)))))
+ (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 move-forward)))
+ 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
+ ;; The text property from the context
string points to the
+ ;; actual context overlay located in
the buffers.
+ (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
diff --git a/gptel.el b/gptel.el
index e72db51ccf..335d9e5e99 100644
--- a/gptel.el
+++ b/gptel.el
@@ -154,6 +154,7 @@
(require 'text-property-search)
(require 'cl-generic)
(require 'gptel-openai)
+(require 'gptel-contexter)
(with-eval-after-load 'org
(require 'gptel-org))
@@ -902,11 +903,22 @@ Model parameters can be let-bound around calls to this
function."
(set-marker (make-marker) position buffer))))
(full-prompt
(cond
- ((null prompt) (gptel--create-prompt start-marker))
+ ((null prompt)
+ (let ((gptel--system-message (if (memq
gptel-context-injection-destination
+ '(:before-system-message
+ :after-system-message))
+ (gptel--wrap-in-context system)
+ system)))
+ (gptel--create-prompt start-marker)))
((stringp prompt)
;; FIXME Dear reader, welcome to Jank City:
(with-temp-buffer
- (let ((gptel-model (buffer-local-value 'gptel-model buffer))
+ (let ((gptel--system-message (if (memq
gptel-context-injection-destination
+ '(:before-system-message
+ :after-system-message))
+ (gptel--wrap-in-context system)
+ system))
+ (gptel-model (buffer-local-value 'gptel-model buffer))
(gptel-backend (buffer-local-value 'gptel-backend buffer)))
(insert prompt)
(gptel--create-prompt))))
@@ -915,6 +927,7 @@ Model parameters can be let-bound around calls to this
function."
(info (list :data request-data
:buffer buffer
:position start-marker)))
+ ;; This context should not be confused with the context aggregation
context!
(when context (plist-put info :context context))
(when in-place (plist-put info :in-place in-place))
(unless dry-run
@@ -1378,32 +1391,6 @@ 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
