(eval-and-compile (require 'gptel-request))

(require 'cl-lib)

(require 'project)

(declare-function gptel-menu "gptel-transient")

(declare-function dired-get-marked-files "dired")

(declare-function ibuffer-get-marked-buffers "ibuffer")

(declare-function ibuffer-current-buffer "ibuffer")

(declare-function image-file-name-regexp "image-file")

(declare-function create-image "image")

(defface gptel-context-highlight-face

'((((background dark) (min-colors 88)) :background "gray4" :extend t)

(((background light) (min-colors 88)) :background "alice blue" :extend t)

(t :inherit mode-line))

"Face used to highlight gptel contexts in buffers."

:group 'gptel)

(defface gptel-context-deletion-face

'((((class color) (min-colors 257) (background light))

:background "#ffeeee" :extend t)

(((class color) (min-colors 88) (background light))

:background "#ffdddd" :extend t)

(((class color) (min-colors 88) (background dark))

:background "#553333" :extend t)

(((class color)) :foreground "red" :extend t))

"Face used to highlight gptel contexts to be deleted.

:group 'gptel)

(defvar gptel-context-wrap-function nil

"Function to format the context string sent with the gptel request.")

(make-obsolete-variable

'gptel-context-wrap-function

"Custom functions for wrapping context are no longer supported by gptel.\

"0.9.9")

(defcustom gptel-context-string-function #'gptel-context--string

"Function to prepare the context string sent with the gptel request.

:group 'gptel

:type 'function)

(defcustom gptel-context-restrict-to-project-files t

"Restrict files eligible to be added to the context to project files.

:group 'gptel

:type 'boolean)

(defvar gptel-context--project-files nil

"Cached alist of project files per project.")

(defvar gptel-context--reset-cache nil

"Whether a project files cache-buster has been scheduled.")

(defun gptel-context-add-current-kill (&optional arg)

"Add current kill to gptel, accumulating if ARG is non-nil."

(interactive "P")

(let ((kill (current-kill 0)))

(with-current-buffer (get-buffer-create " *gptel-kill-ring-context*")

(if (not arg)

(kill-region (point-min) (point-max))

(goto-char (point-max))

(unless (bobp)

(insert "\n----\n")))

(insert kill)

(gptel-context--add-region (current-buffer)

(point-min) (point-max))

(message "*current-kill* has been added as context."))))

(defun gptel-context-add (&optional arg confirm)

"Add context to gptel in a DWIM fashion.

(interactive "P\np")

(cond

;; A region is selected.

((use-region-p)

(gptel-context--add-region (current-buffer)

(region-beginning)

(region-end))

(deactivate-mark)

(message "Current region added as context."))

;; If in dired

((derived-mode-p 'dired-mode)

(let* ((files (dired-get-marked-files))

(dirs (cl-remove-if-not #'file-directory-p files))

(remove-p (< (prefix-numeric-value arg) 0))

(action-fn (if remove-p

#'gptel-context-remove

#'gptel-context-add-file)))

(when (or remove-p (null dirs) (null confirm)

(y-or-n-p (format "Recursively add files from %d director%s? "

(length dirs)

(if (= (length dirs) 1) "y" "ies"))))

(mapc action-fn files))))

;; If in ibuffer

((derived-mode-p 'ibuffer-mode)

(let* ((buffers (or (ibuffer-get-marked-buffers)

(list (ibuffer-current-buffer))))

(remove-p (< (prefix-numeric-value arg) 0))

(action-fn (if remove-p

#'gptel-context-remove

#'gptel-context--add-buffer)))

(mapc action-fn buffers)))

;; If in an image buffer

((and (derived-mode-p 'image-mode)

(gptel--model-capable-p 'media)

(buffer-file-name)

(not (gptel-context--skip-p (buffer-file-name))))

(funcall (if (and arg (< (prefix-numeric-value arg) 0))

#'gptel-context-remove

#'gptel-context-add-file)

(buffer-file-name)))

;; 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: "

(current-buffer) t))

(start (with-current-buffer buffer-name (point-min)))

(end (with-current-buffer buffer-name (point-max))))

(gptel-context--add-region

(get-buffer buffer-name) start end t)

(message "Buffer '%s' added as context." buffer-name)))

;; No region is selected, and ARG is negative.

((and arg (< (prefix-numeric-value arg) 0))

(when (or (null confirm)

(y-or-n-p "Remove all contexts from this buffer? "))

(let ((removed-contexts 0))

(cl-loop for cov in

(gptel-context--in-region (current-buffer) (point-min) (point-max))

do (progn

(cl-incf removed-contexts)

(gptel-context-remove 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-context-remove

(car (gptel-context--in-region (current-buffer)

(max (point-min) (1- (point)))

(point))))

(message "Context under point has been removed."))

(gptel-context--add-buffer (current-buffer))))))

(defalias 'gptel-add #'gptel-context-add)

(defun gptel-context--add-buffer (buffer)

"Add BUFFER to context."

(with-current-buffer buffer

(gptel-context--add-region (current-buffer) (point-min) (point-max) t))

(message "Buffer \"%s\" added to context." (buffer-name buffer)))

(defun gptel-context--add-text-file (path)

"Add text file at PATH to context."

(cl-pushnew (list path) gptel-context :test #'equal)

(message "File \"%s\" added to context." path)

path)

(defun gptel-context--add-binary-file (path)

"Add binary file at PATH to context if supported.

(if-let* (((gptel--model-capable-p 'media))

(mime (mailcap-file-name-to-mime-type path))

((gptel--model-mime-capable-p mime)))

(prog1 path

(cl-pushnew (list path :mime mime)

gptel-context :test #'equal)

(message "File \"%s\" added to context." path))

(message "Ignoring unsupported binary file \"%s\"." path)

nil))

(defun gptel-context--add-directory (path action)

"Process all files in directory at PATH according to ACTION.

(dolist (file (directory-files-recursively path "."))

(pcase-exhaustive action

('add

(unless gptel-context--reset-cache

(setq gptel-context--reset-cache t)

(run-at-time

0 nil

(lambda () (setq gptel-context--reset-cache nil

gptel-context--project-files nil))))

(if (gptel-context--skip-p file)

;; Don't message about .git, as this creates thousands of messages

(unless (string-match-p "\\.git/" file)

(gptel-context--message-skipped file))

(gptel-context-add-file file)))

('remove

(setf (alist-get file gptel-context nil 'remove #'equal) nil)))))

(defun gptel-context-add-file (path)

"Add the file at PATH to the gptel context.

(interactive "fChoose file to add to context: ")

(cond ((file-directory-p path)

(gptel-context--add-directory path 'add))

((gptel--file-binary-p path)

(gptel-context--add-binary-file path))

(t (gptel-context--add-text-file path))))

(defalias 'gptel-add-file #'gptel-context-add-file)

(defun gptel-context--get-project-files (dir)

"Return a list of files in the project DIR, or nil if no project is found."

(when-let* ((project (project-current nil dir)))

(with-memoization (alist-get dir gptel-context--project-files

nil nil #'equal)

(project-files project))))

(defun gptel-context--skip-p (file)

"Return non-nil if FILE should not be added to the context."

(when (and gptel-context-restrict-to-project-files

(not (file-remote-p file)))

(and-let* ((file-dir (or (file-name-directory file) default-directory))

(project (project-current nil file-dir)))

(not (member (expand-file-name file)

(gptel-context--get-project-files (project-root project)))))))

(defun gptel-context--message-skipped (file)

"Message that FILE is skipped because it is not a project file."

(let* ((type (if (file-directory-p file) "directory" "file"))

(reminder (format "To include it, unset `%S'."

'gptel-context-restrict-to-project-files)))

(if-let* ((root (cl-some (lambda (dir) (and (file-in-directory-p file dir) dir))

(map-keys gptel-context--project-files)))

(rel-file (file-relative-name file root)))

(message "Skipping %s \"%s\" in project \"%s\". %s"

type rel-file root reminder)

(message "Skipping %s \"%s\". %s" type file reminder))))

(defun gptel-context-remove (&optional context)

"Remove the CONTEXT overlay from the contexts list.

(cond

((overlayp context) ;Overlay in buffer

(when-let* ((buf (overlay-buffer context)))

(delete-overlay context)

;; FIXME: Quadratic cost when clearing a bunch of contexts at once

(unless

(cl-loop

for ov in

(plist-get (alist-get buf gptel-context) :overlays)

thereis (overlay-start ov))

(setf (alist-get buf gptel-context nil 'remove) nil))))

((bufferp context) ;Full buffer

(setf (alist-get context gptel-context nil 'remove) nil)

(when (buffer-live-p context)

(with-current-buffer context

(without-restriction

(remove-overlays nil nil 'gptel-context t)))))

((stringp context) ;file or directory

(if (file-directory-p context)

(gptel-context--add-directory context 'remove)

(setf (alist-get context gptel-context nil 'remove #'equal) nil)

(message "File \"%s\" removed from context." context)))

((region-active-p) ;Overlays in region

(when-let* ((contexts (gptel-context--in-region (current-buffer)

(region-beginning)

(region-end))))

(cl-loop for ctx in contexts do (delete-overlay ctx))))

(t ;Anything at point

(when-let* ((ctx (gptel-context--at-point)))

(delete-overlay ctx)))))

(defun gptel-context-remove-all (&optional verbose)

"Remove all gptel context.

(interactive (list t))

(if (null gptel-context)

(when verbose (message "No gptel context sources to remove."))

(when (or (not verbose) (y-or-n-p "Remove all context? "))

(cl-loop

for context in gptel-context

for (source . spec) = (ensure-list context)

if (bufferp source) do ;Buffers and buffer regions

(mapc #'gptel-context-remove (plist-get spec :overlays))

else do (gptel-context-remove source) ;files or other types

finally do (setq gptel-context nil))

(when verbose (message "Removed all gptel context sources.")))))

(defun gptel-context--make-overlay (start end &optional advance)

"Highlight the region from START to END.

(let ((overlay (make-overlay start end nil (not advance) advance))

(buf-entry (alist-get (current-buffer) gptel-context)))

(overlay-put overlay 'evaporate t)

(overlay-put overlay 'face 'gptel-context-highlight-face)

(overlay-put overlay 'gptel-context t)

(setf (alist-get (current-buffer) gptel-context)

(plist-put buf-entry :overlays

(cons overlay (plist-get buf-entry :overlays))))

overlay))

(defun gptel-context--wrap (callback data-buf)

"Add request context to DATA-BUF and run CALLBACK.

(if (= (car (func-arity gptel-context-string-function)) 2)

(funcall gptel-context-string-function

(lambda (c) (with-current-buffer data-buf

(gptel-context--wrap-in-buffer c))

(funcall callback))

(gptel-context--collect))

(with-current-buffer data-buf

(thread-last (gptel-context--collect)

(funcall gptel-context-string-function)

(gptel-context--wrap-in-buffer)))

(funcall callback)))

(defun gptel-context--wrap-in-buffer (context-string &optional method)

"Inject CONTEXT-STRING to current buffer using METHOD.

(when (length> context-string 0)

(pcase (or method gptel-use-context)

('system

(if (gptel--model-capable-p 'nosystem)

(gptel-context--wrap-in-buffer context-string 'user)

(if gptel-system-prompt

(cl-etypecase gptel-system-prompt

(string

(setq gptel-system-prompt

(concat context-string "\n\n" gptel-system-prompt)))

(function

;; FIXME: This parses the directive in the prompt construction

;; buffer, which is wrong. Wrap in a function instead.

(setq gptel-system-prompt

(gptel--parse-directive gptel-system-prompt 'raw))

(gptel-context--wrap-in-buffer context-string))

(list

(setq gptel-system-prompt ;cons a new list to avoid mutation

(cons (concat context-string "\n\n" (car gptel-system-prompt))

(cdr gptel-system-prompt)))))

(setq gptel-system-prompt context-string))))

('user

(goto-char (point-max))

(text-property-search-backward 'gptel nil t)

(and gptel-mode

(looking-at

(concat "[\n[:blank:]]*"

(and-let* ((prefix (gptel-prompt-prefix-string))

((not (string-empty-p prefix))))

(concat "\\(?:" (regexp-quote prefix) "\\)?"))))

(delete-region (match-beginning 0) (match-end 0)))

(insert "\n" context-string "\n\n")))))

(defun gptel-context--collect-media (&optional contexts)

"Collect media CONTEXTS.

(cl-loop for context in (or contexts gptel-context)

for (path . props) = (ensure-list context)

when (and (stringp path) (plist-get props :mime))

collect (cons :media context)))

(cl-defun gptel-context--add-region (buffer region-beginning region-end &optional advance)

"Add region delimited by REGION-BEGINNING, REGION-END in BUFFER as context.

;; Remove existing contexts in the same region, if any.

(mapc #'gptel-context-remove

(gptel-context--in-region buffer region-beginning region-end))

(prog1 (with-current-buffer buffer

(gptel-context--make-overlay region-beginning region-end advance))

(message "Region added to context buffer.")))

(defun gptel-context--in-region (buffer start end)

"Return the list of context overlays in the given region, if any, in BUFFER.

(with-current-buffer buffer

(cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-context))

(overlays-in start end))))

(defun gptel-context--at-point ()

"Return the context overlay at point, if any."

(cl-find-if (lambda (ov) (overlay-get ov 'gptel-context))

(overlays-at (point))))

(defun gptel-context--collect (&optional context-alist)

"Get the list of all active context sources from CONTEXT-ALIST.

;; Get only the non-degenerate overlays, collect them, and update the overlays variable.

(let ((res))

(dolist (entry (or context-alist gptel-context))

(pcase entry ;Context entry is:

(`(,buf . ,data)

(cond

((buffer-live-p buf)

;; (<buf> :overlays ... :lines ... :bounds ...)

(when-let* ((ovs (plist-get data :overlays))) ;Clear dead overlays

(plist-put data :overlays (cl-remove-if-not #'overlay-start ovs)))

(push (cons buf data) res))

((and (stringp buf) (file-readable-p buf))

;; ("/file/path" :mime ... :bounds ... :line ...)

(push (cons buf data) res))))

((and (pred stringp) (pred file-readable-p)) ;Just a file, figure out mimetype

(if (file-directory-p entry)

(progn

(unless gptel-context--reset-cache

(setq gptel-context--reset-cache t)

(run-at-time

0 nil

(lambda () (setq gptel-context--reset-cache nil

gptel-context--project-files nil))))

(dolist (f (directory-files-recursively entry "."))

(unless (gptel-context--skip-p f)

(push `(,f ,@(and (gptel--file-binary-p f)

(list :mime (mailcap-file-name-to-mime-type entry))))

res))))

(push `(,entry ,@(and (gptel--file-binary-p entry)

(list :mime (mailcap-file-name-to-mime-type entry))))

res)))

((pred buffer-live-p) (push (list entry) res)))) ;Just a buffer

res))

(defun gptel-context--collect-regions (buffer context-data)

"Collect BUFFER regions from CONTEXT-DATA specification.

(let ((regions ; Collect bounds (already in position format)

(when-let* ((bounds (plist-get context-data :bounds)))

(if (consp (car bounds)) bounds (list bounds)))))

(with-current-buffer buffer

(without-restriction

;; Collect overlays

(dolist (ov (plist-get context-data :overlays))

(when (overlay-start ov)

(push (cons (overlay-start ov) (overlay-end ov))

regions))) ;(start1 . end1)

;; Collect lines (convert line numbers to positions)

(when-let* ((line-bounds (plist-get context-data :lines)))

(dolist (pair (if (consp (car line-bounds)) ;Handle single (BEG . END)

line-bounds (list line-bounds)))

(push (cons (progn (goto-char (point-min))

(forward-line (1- (car pair)))

(point))

(progn (goto-char (point-min))

(forward-line (cdr pair))

(point)))

regions)))))

;; TODO: Update sort for Emacs 28+ calling convention

;; Sort by start position.

;; NOTE: This can modify `:bounds' of `context-data' by side-effect!

(sort regions #'car-less-than-car)))

(defun gptel-context--insert-buffer-string (buffer context-data &optional header)

"Insert at point a context string from CONTEXT-DATA in BUFFER.

(let ((is-top-snippet t)

(previous-line 1)

(regions (gptel-context--collect-regions buffer context-data)))

;; Insert header

(insert (or header (format "In buffer `%s`:\n\n```"(buffer-name buffer)))

(gptel--strip-mode-suffix (buffer-local-value

'major-mode buffer))

"\n")

(if (not regions)

(insert-buffer-substring-no-properties buffer)

(dolist (region regions)

(let ((start (car region)) (end (cdr region)))

(let (lineno column)

(with-current-buffer buffer

(without-restriction

(setq lineno (line-number-at-pos start t)

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)

(unless is-top-snippet (insert "\n"))

(insert (format "... (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"))))

(insert-buffer-substring-no-properties buffer start end)))

(unless (>= (cdr (car (last regions))) (point-max))

(insert "\n...")))

(insert "\n```")))

(defun gptel-context--insert-file-string (path &optional spec)

"Insert at point the contents of file at PATH as context.

(if (not (and spec (or (plist-member spec :lines)

(plist-member spec :bounds))))

;; Insert whole file

(gptel--insert-file-string path)

;; Insert only regions from lines and/or bounds

(let* ((visiting-buf (find-buffer-visiting ;Reuse buffer

path (lambda (b) (not (buffer-modified-p b)))))

(file-buf (or visiting-buf ;temp buf to dump file contents

(gptel--temp-buffer " *gptel-file-context*"))))

(unless visiting-buf

(with-current-buffer file-buf (insert-file-contents path)))

(gptel-context--insert-buffer-string

file-buf spec (format "In file `%s`:\n\n```\n"

(abbreviate-file-name path)))

(unless visiting-buf (kill-buffer file-buf)))))

(defun gptel-context--string (context-alist)

"Format the aggregated gptel context as annotated markdown fragments.

(with-temp-buffer

(cl-loop for entry in context-alist

for (source . spec) = (ensure-list entry)

if (bufferp source)

do (gptel-context--insert-buffer-string source spec)

else if (or (not (plist-get spec :mime))

(string-match-p "^text/" (plist-get spec :mime)))

do (gptel-context--insert-file-string source spec) end

do (insert "\n\n")

finally do

(skip-chars-backward "\n\t\r ")

(delete-region (point) (point-max))

(unless (bobp)

(goto-char (point-min))

(insert "Request context:\n\n"))

finally return

(and (> (buffer-size) 0)

(buffer-string)))))

(defvar-keymap gptel-context-buffer-mode-map

"C-c C-c" #'gptel-context-confirm

"C-c C-k" #'gptel-context-quit

"RET" #'gptel-context-visit

"n" #'gptel-context-next

"p" #'gptel-context-previous

"d" #'gptel-context-flag-deletion)

(define-derived-mode gptel-context-buffer-mode special-mode "gptel-context"

"Major-mode for inspecting context used by gptel."

:group 'gptel

(add-hook 'post-command-hook #'gptel-context--post-command

nil t)

(setq-local revert-buffer-function #'gptel-context--buffer-setup))

(defun gptel-context--buffer-setup (&optional _ignore-auto _noconfirm context-alist)

"Set up the gptel context buffer.

(with-current-buffer (get-buffer-create "*gptel-context*")

(gptel-context-buffer-mode)

(let ((inhibit-read-only t))

(erase-buffer)

(setq header-line-format

(substitute-command-keys

(concat

"\\[gptel-context-flag-deletion]: Mark/unmark deletion, "

"\\[gptel-context-next]/\\[gptel-context-previous]: next/previous, "

"\\[gptel-context-visit]: visit, "

"\\[gptel-context-confirm]: apply, "

"\\[gptel-context-quit]: cancel, "

"\\[quit-window]: quit")))

(save-excursion

(let ((contexts (gptel-context--collect context-alist)))

(if (length= contexts 0)

(insert "There are no active gptel contexts.")

(let (beg ov l1 l2)

(pcase-dolist (`(,buf . ,spec) contexts)

(cond

((bufferp buf)

(if (not spec) ;BUF is a full buffer, not specific ranges

(progn

(insert (propertize (format "In buffer %s:\n\n"

(buffer-name buf))

'face 'bold))

(setq beg (point))

(insert-buffer-substring buf)

(insert "\n")

(setq ov (make-overlay beg (point))))

(dolist (source-ov (plist-get spec :overlays)) ;BUF is a buffer with some overlay(s)

(with-current-buffer buf

(setq l1 (line-number-at-pos (overlay-start source-ov))

l2 (line-number-at-pos (overlay-end source-ov))))

(insert (propertize (format "In buffer %s (lines %d-%d):\n\n"

(buffer-name buf) l1 l2)

'face 'bold))

(setq beg (point))

(insert-buffer-substring

buf (overlay-start source-ov) (overlay-end source-ov))

(insert "\n")

(setq ov (make-overlay beg (point)))

(overlay-put ov 'gptel-context source-ov)

(overlay-put ov 'gptel-overlay t)

(overlay-put ov 'evaporate t)))

(insert "\n" (make-separator-line) "\n"))

(t ;BUF is a file path, not a buffer

(insert (propertize (format "In file %s:\n\n" (file-name-nondirectory buf))

'face 'bold))

(setq beg (point))

(if-let* ((mime (plist-get spec :mime))

((not (string-match-p "^text/" mime)))) ;BUF is a binary file

(if-let* (((string-match-p (image-file-name-regexp) buf))

(img (create-image buf)))

(insert-image img "*") ; Can be displayed

(insert

buf " " (propertize "(No preview for binary file)"

'face '(:inherit shadow :slant italic))))

(insert-file-contents buf))

(goto-char (point-max))

(insert "\n")

(setq ov (make-overlay beg (point)))

(overlay-put ov 'gptel-context buf)

(overlay-put ov 'gptel-overlay t)

(overlay-put ov 'evaporate t)

(insert "\n" (make-separator-line) "\n"))))

(goto-char (point-min)))))))

(display-buffer (current-buffer)

`((display-buffer-reuse-window

display-buffer-reuse-mode-window

display-buffer-below-selected)

(body-function . ,#'select-window)

(window-height . ,#'fit-window-to-buffer)))))

(defvar gptel-context--buffer-reverse nil

"Last direction of cursor movement in gptel context buffer.

If non-nil, indicates backward movement.")

(defalias 'gptel-context--post-command

(let ((highlight-overlay))

(lambda ()

;; Only update if point moved outside the current region.

(unless (memq highlight-overlay (overlays-at (point)))

(let ((context-overlay

(cl-loop for ov in (overlays-at (point))

thereis (and (overlay-get ov 'gptel-overlay) ov))))

(when highlight-overlay

(overlay-put highlight-overlay 'face nil))

(when context-overlay

(overlay-put context-overlay 'face 'highlight))

(setq highlight-overlay context-overlay))))))

(defun gptel-context-visit ()

"Display the location of this gptel context chunk in its original buffer."

(interactive)

(let ((ov-here (car (overlays-at (point)))))

(if-let* ((source (overlay-get ov-here 'gptel-context))

(buf (if (overlayp source)

(overlay-buffer source)

(find-file-noselect source)))

(offset (- (point) (overlay-start ov-here))))

(with-selected-window (display-buffer buf)

(goto-char (if (overlayp source)

(overlay-start source)

(point-min)))

(forward-char offset)

(recenter))

(message "No source location for this gptel context chunk."))))

(defun gptel-context-next ()

"Move to next gptel context chunk."

(interactive)

(let ((ov-here (car (overlays-at (point))))

(next-start (next-overlay-change (point))))

(when (and (/= (point-max) next-start) ov-here)

;; 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 gptel-context--buffer-reverse nil)

(goto-char next-start)

(recenter (floor (window-height) 4)))))

(defun gptel-context-previous ()

"Move to previous gptel context chunk."

(interactive)

(let ((ov-here (car (overlays-at (point)))))

(when ov-here (goto-char (overlay-start ov-here)))

(let ((previous-context-pos (previous-overlay-change

(previous-overlay-change (point)))))

;; Prevent point from jumping to the start of the buffer.

(unless (= previous-context-pos (point-min))

(goto-char previous-context-pos)

(recenter (floor (window-height) 4))

(setq gptel-context--buffer-reverse t)))))

(defun gptel-context-flag-deletion ()

"Mark gptel context chunk at point for removal."

(interactive)

(let* ((overlays (if (use-region-p)

(overlays-in (region-beginning) (region-end))

(overlays-at (point))))

(deletion-ov)

(marked-ovs (cl-remove-if-not (lambda (ov) (overlay-get ov 'gptel-context-deletion-mark))

overlays)))

(if marked-ovs

(mapc #'delete-overlay marked-ovs)

(save-excursion

(dolist (ov overlays)

(when (overlay-get ov 'gptel-context)

(goto-char (overlay-start ov))

(setq deletion-ov (make-overlay (overlay-start ov) (overlay-end ov)))

(overlay-put deletion-ov 'gptel-context (overlay-get ov 'gptel-context))

(overlay-put deletion-ov 'priority -80)

(overlay-put deletion-ov 'face 'gptel-context-deletion-face)

(overlay-put deletion-ov 'gptel-context-deletion-mark t)))))

(if (use-region-p)

(deactivate-mark)

(if gptel-context--buffer-reverse

(gptel-context-previous)

(gptel-context-next)))))

(defun gptel-context-quit ()

"Cancel pending operations and return to gptel's menu."

(interactive)

(quit-window)

(call-interactively #'gptel-menu))

(defun gptel-context-confirm ()

"Confirm pending operations and return to gptel's menu."

(interactive)

;; Delete all the context overlays that have been marked for deletion.

(when-let* ((deletion-marks

(delq nil (mapcar

(lambda (ov)

(and

(overlay-get ov 'gptel-context-deletion-mark)

(overlay-get ov 'gptel-context)))

(overlays-in (point-min) (point-max))))))

(mapc #'gptel-context-remove deletion-marks)

(revert-buffer))

;; FIXME(context): This should run in the buffer from which the context

;; inspection buffer was visited.

;; Update contexts and revert buffer (#482)

(setq gptel-context (nreverse (gptel-context--collect)))

(gptel-context-quit))

(provide 'gptel-context)