Remove superfluous hooks and start cleanup
This commit is contained in:
daedsidog
parent
329a2776b3
commit
192a4ba9de
1 changed files with 77 additions and 195 deletions
|
|
@ -31,23 +31,17 @@
|
||||||
|
|
||||||
(require 'cl-lib)
|
(require 'cl-lib)
|
||||||
|
|
||||||
(defvar gptel--context-buffer nil)
|
|
||||||
(defvar gptel--contexts-alist nil
|
|
||||||
"An association list from buffers to a list of regions.")
|
|
||||||
(defvar gptel--current-highlight-region nil)
|
|
||||||
(defvar gptel--context-buffer-point nil)
|
|
||||||
|
|
||||||
;; We need a minor mode for a custom keymap, so that we may be able to remove
|
;; We need a minor mode for a custom keymap, so that we may be able to remove
|
||||||
;; contexts directly from the contexts buffer.
|
;; contexts directly from the contexts buffer.
|
||||||
(define-minor-mode context-mode
|
(define-minor-mode gptel-context-mode
|
||||||
"A minor mode for working with context."
|
"A minor mode for working with context."
|
||||||
:lighter " Context"
|
:lighter " GPTel Context"
|
||||||
:keymap (let ((map (make-sparse-keymap)))
|
:keymap (let ((map (make-sparse-keymap)))
|
||||||
(define-key map (kbd "c")
|
(define-key map (kbd "c")
|
||||||
'gptel-remove-context-at-point-from-context-buffer)
|
'gptel-remove-context-at-point)
|
||||||
map))
|
map))
|
||||||
|
|
||||||
(defcustom gptel-contexter-selection-face 'secondary-selection
|
(defcustom gptel-context-highlight-face 'header-line
|
||||||
"Face to use to highlight selected context in the buffers."
|
"Face to use to highlight selected context in the buffers."
|
||||||
:group 'gptel
|
:group 'gptel
|
||||||
:type 'symbol)
|
:type 'symbol)
|
||||||
|
|
@ -56,24 +50,41 @@
|
||||||
;;; ------------------------------ FUNCTIONS ------------------------------- ;;;
|
;;; ------------------------------ FUNCTIONS ------------------------------- ;;;
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defun gptel--highlight-region (start end)
|
;;;###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 in `dired-mode', adds selected files as 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))
|
||||||
|
;; No region is currently selected, so delete a context under point if there
|
||||||
|
;; is one.
|
||||||
|
((gptel-context-at-point)
|
||||||
|
(gptel-delete-context (gptel-context-at-point))
|
||||||
|
(message "Context under point has been deleted."))))
|
||||||
|
|
||||||
|
(defun gptel--make-context-overlay (start end)
|
||||||
"Highlight the region from START to END."
|
"Highlight the region from START to END."
|
||||||
(let ((overlay (make-overlay start end)))
|
(let ((overlay (make-overlay start end)))
|
||||||
(overlay-put overlay 'face gptel-contexter-selection-face)
|
(overlay-put overlay 'face gptel-context-highlight-face)
|
||||||
(overlay-put overlay 'contexter t)))
|
(overlay-put overlay 'gptel-context t)
|
||||||
|
overlay))
|
||||||
|
|
||||||
(defun gptel--unhighlight-region (start end)
|
(cl-defun gptel--add-region-as-context (buffer start end)
|
||||||
"Remove highlighting from the region between START and END."
|
"Add the region delimited by START and END in BUFFER as context."
|
||||||
(dolist (overlay (overlays-in start end))
|
;; Remove existing contexts in the same region, if any.
|
||||||
(when (and (overlay-get overlay 'contexter)
|
(mapc #'gptel-delete-context
|
||||||
(overlay-get overlay 'face))
|
(gptel-contexts-in-region buffer start end))
|
||||||
(delete-overlay overlay))))
|
|
||||||
|
|
||||||
(cl-defun gptel--add-region-to-contexts ()
|
|
||||||
"Add the selected region to te contexts.
|
|
||||||
Order of the contexts in a buffer is determined by their order in the buffer."
|
|
||||||
(unless (use-region-p)
|
|
||||||
(error "No region selected"))
|
|
||||||
(let ((start (make-marker))
|
(let ((start (make-marker))
|
||||||
(end (make-marker)))
|
(end (make-marker)))
|
||||||
(set-marker start (region-beginning) (current-buffer))
|
(set-marker start (region-beginning) (current-buffer))
|
||||||
|
|
@ -98,163 +109,51 @@ Order of the contexts in a buffer is determined by their order in the buffer."
|
||||||
(message "No content in selected region.")
|
(message "No content in selected region.")
|
||||||
(cl-return-from gptel--add-region-to-contexts nil))
|
(cl-return-from gptel--add-region-to-contexts nil))
|
||||||
;; First, highlight the region.
|
;; First, highlight the region.
|
||||||
(gptel--highlight-region start end)
|
(prog1 (gptel--make-context-overlay start end)
|
||||||
;; Then, add the region to `gptel--contexts-alist', associating it with
|
(message "Region added to context buffer."))))
|
||||||
;; the current buffer.
|
|
||||||
(let ((existing-entry (assoc (current-buffer) gptel--contexts-alist)))
|
|
||||||
(if (not existing-entry)
|
|
||||||
(add-to-list 'gptel--contexts-alist
|
|
||||||
(cons (current-buffer) (list (list start end))))
|
|
||||||
(let ((regions (cdr existing-entry))
|
|
||||||
(new-region (list (list start end))))
|
|
||||||
(setcdr existing-entry
|
|
||||||
(cl-sort (append regions new-region)
|
|
||||||
(lambda (a b)
|
|
||||||
(or (<= (car a) (car b)))))))))
|
|
||||||
(message "Region added to context buffer.")
|
|
||||||
t))
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun gptel-context-in-region (buffer start end)
|
(defun gptel-contexts-in-region (buffer start end)
|
||||||
"Return the context in the given region, if any, in BUFFER.
|
"Return the list of context overlays in the given region, if any, in BUFFER.
|
||||||
START and END signify the region delimiters.
|
START and END signify the region delimiters."
|
||||||
A context in this function is a cons cell with the buffer as the CAR and the
|
(with-current-buffer buffer
|
||||||
region tuple as the CDR. The tuple is a list, not a cons cell."
|
(cl-remove-if-not #'(lambda (overlay)
|
||||||
(interactive)
|
(overlay-get overlay 'gptel-context))
|
||||||
(let (context regions)
|
(overlays-in start end))))
|
||||||
(setq context (assoc buffer gptel--contexts-alist))
|
|
||||||
(when context
|
|
||||||
(cl-loop for (ctx-start ctx-end) in (cdr context)
|
|
||||||
;; If the current context range overlaps with the argument range.
|
|
||||||
when (or (<= ctx-start start end ctx-end)
|
|
||||||
(<= ctx-start start ctx-end end)
|
|
||||||
(<= start ctx-start end ctx-end)
|
|
||||||
(<= start ctx-start ctx-end end))
|
|
||||||
do (push (list ctx-start ctx-end) regions)))
|
|
||||||
(if (not (zerop (length regions)))
|
|
||||||
(setq context (cons buffer regions))
|
|
||||||
(setq context nil))
|
|
||||||
context))
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun gptel-context-at-point ()
|
(defun gptel-context-at-point ()
|
||||||
"Return the context at point, if any.
|
"Return the context overlay at point, if any."
|
||||||
A context in this function is a cons cell with the buffer as the CAR and the
|
(car (overlays-in (point) (point))))
|
||||||
region tuple as the CDR. The tuple is a list, not a cons cell."
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun gptel-delete-context (context)
|
||||||
|
"Remove the CONTEXT overlay from the contexts list."
|
||||||
|
(delete-overlay context))
|
||||||
|
|
||||||
|
;;;###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-delete-all-contexts ()
|
||||||
|
"Clear all contexts."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let ((point (point))
|
(mapc #'gptel-delete-context
|
||||||
(buffer (current-buffer))
|
(gptel-contexts)))
|
||||||
context
|
|
||||||
regions '())
|
|
||||||
(setq context (assoc buffer gptel--contexts-alist))
|
|
||||||
(when context
|
|
||||||
(cl-loop for (start end) in (cdr context)
|
|
||||||
when (and (>= point start) (<= point end))
|
|
||||||
do (push (list start end) regions)))
|
|
||||||
(if (not (zerop (length regions)))
|
|
||||||
(setq context (cons buffer regions))
|
|
||||||
nil)))
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun gptel-remove-context (context &optional refresh-context-buffer)
|
(defun gptel-major-mode-md-prog-lang (mode)
|
||||||
"Remove the CONTEXT snippet and unhighlight its region.
|
|
||||||
If REFRESH-CONTEXT-BUFFER is set to t, then also refresh the context buffer."
|
|
||||||
(let* ((buffer (car context))
|
|
||||||
(regions (cdr context)))
|
|
||||||
;; Unhighlight each region.
|
|
||||||
(with-current-buffer buffer
|
|
||||||
(cl-loop for (start end) in regions
|
|
||||||
do (gptel--unhighlight-region start end)))
|
|
||||||
;; Remove regions from the list and clean up if empty.
|
|
||||||
(setq gptel--contexts-alist
|
|
||||||
(delq nil
|
|
||||||
(mapcar (lambda (item)
|
|
||||||
(if (eq (car item) buffer)
|
|
||||||
(let ((new-value
|
|
||||||
(seq-difference (cdr item) regions)))
|
|
||||||
(unless (seq-empty-p new-value)
|
|
||||||
(cons (car item) new-value)))
|
|
||||||
item))
|
|
||||||
gptel--contexts-alist))))
|
|
||||||
(when refresh-context-buffer
|
|
||||||
(gptel--refresh-context-buffer)))
|
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(cl-defun gptel-pop-or-push-context ()
|
|
||||||
"Pop or push text into the context buffer depending on selection state.
|
|
||||||
|
|
||||||
If a region is selected, push the region as context.
|
|
||||||
If no region is selected, try to pop the context at the point.
|
|
||||||
If a region is selected but it contains contexts, pop all contexts within it and
|
|
||||||
add the region as a single context..
|
|
||||||
|
|
||||||
Popping context has no other meaning other than erasing it from the context
|
|
||||||
buffer."
|
|
||||||
(interactive)
|
|
||||||
(let ((context
|
|
||||||
(if (use-region-p)
|
|
||||||
(gptel-context-in-region (current-buffer)
|
|
||||||
(region-beginning)
|
|
||||||
(region-end))
|
|
||||||
(gptel-context-at-point))))
|
|
||||||
(when context
|
|
||||||
(gptel-remove-context context))
|
|
||||||
(when (use-region-p)
|
|
||||||
(unless (gptel--add-region-to-contexts)
|
|
||||||
(cl-return-from gptel-pop-or-push-context))
|
|
||||||
(deactivate-mark)))
|
|
||||||
(gptel--refresh-context-buffer))
|
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(defun gptel-remove-all-contexts ()
|
|
||||||
"Clear all saved context regions."
|
|
||||||
(interactive)
|
|
||||||
(mapc #'gptel-remove-context gptel--contexts-alist)
|
|
||||||
(gptel--refresh-context-buffer))
|
|
||||||
|
|
||||||
(defun gptel--cleanup-killed-buffer ()
|
|
||||||
"Remove contexts if their buffer was killed."
|
|
||||||
(let ((context (assoc (current-buffer) gptel--contexts-alist)))
|
|
||||||
(when context
|
|
||||||
(setq gptel--contexts-alist (assoc-delete-all (current-buffer)
|
|
||||||
gptel--contexts-alist))
|
|
||||||
(gptel--refresh-context-buffer))))
|
|
||||||
|
|
||||||
;; We don't care about the hook parameters.
|
|
||||||
(defun gptel--cleanup-degenerate-contexts (_ _ _)
|
|
||||||
"Clean up contexts by degenerate regions."
|
|
||||||
(let ((context (assoc (current-buffer) gptel--contexts-alist)))
|
|
||||||
(when context
|
|
||||||
(setcdr context
|
|
||||||
(cl-remove-if (lambda (region)
|
|
||||||
(= (cl-first region) (cl-second region)))
|
|
||||||
(cdr context)))
|
|
||||||
(when (zerop (length (cdr context))) ; All regions were removed!
|
|
||||||
(setq gptel--contexts-alist
|
|
||||||
(assoc-delete-all (current-buffer) gptel--contexts-alist)))
|
|
||||||
(gptel--refresh-context-buffer))))
|
|
||||||
|
|
||||||
(defun gptel--sync-context-buffer (start end _)
|
|
||||||
"See if the markers in the buffer have been changed between START and END.
|
|
||||||
If they have, update the context buffer."
|
|
||||||
(when (gptel-context-in-region (current-buffer) start end)
|
|
||||||
(gptel--refresh-context-buffer)))
|
|
||||||
|
|
||||||
(defun gptel--ensure-context-buffer-exists ()
|
|
||||||
"Make sure the context buffer exists. Create it if it does not."
|
|
||||||
(with-current-buffer (get-buffer-create "*Context*") ; Create, if nonexistant.
|
|
||||||
(setq gptel--context-buffer (current-buffer))
|
|
||||||
;; Ensure the minor mode context-mode is enabled in this buffer.
|
|
||||||
(unless (bound-and-true-p context-mode)
|
|
||||||
(context-mode 1))
|
|
||||||
(read-only-mode 1))) ; Set read-only mode.
|
|
||||||
|
|
||||||
(defun gptel--sort-pairs-by-ascending-order (regions)
|
|
||||||
"Sort the pairs in REGIONS by ascending order."
|
|
||||||
(sort regions (lambda (a b) (< (car a) (car b)))))
|
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(defun gptel--major-mode-md-prog-lang (mode)
|
|
||||||
"Get the Markdown programming language string for the given MODE."
|
"Get the Markdown programming language string for the given MODE."
|
||||||
(cond
|
(cond
|
||||||
((eq mode 'emacs-lisp-mode) "emacs-lisp")
|
((eq mode 'emacs-lisp-mode) "emacs-lisp")
|
||||||
|
|
@ -377,7 +276,7 @@ REGIONS is a list of pairs of (start, end) lists."
|
||||||
(goto-char (point-max))
|
(goto-char (point-max))
|
||||||
(skip-chars-backward " \t\n\r")
|
(skip-chars-backward " \t\n\r")
|
||||||
(point))
|
(point))
|
||||||
prog-lang-tag (gptel--major-mode-md-prog-lang
|
prog-lang-tag (gptel-major-mode-md-prog-lang
|
||||||
major-mode)))
|
major-mode)))
|
||||||
(insert "\n\n```" prog-lang-tag "\n")
|
(insert "\n\n```" prog-lang-tag "\n")
|
||||||
(cl-loop for (start end) in regions do
|
(cl-loop for (start end) in regions do
|
||||||
|
|
@ -521,7 +420,7 @@ In essence, just highlights the context where the point is in the buffer."
|
||||||
(gptel--unhighlight-region current-start current-end)
|
(gptel--unhighlight-region current-start current-end)
|
||||||
(setq gptel--current-highlight-region nil))
|
(setq gptel--current-highlight-region nil))
|
||||||
(when context
|
(when context
|
||||||
(gptel--highlight-region start end)
|
(gptel--make-context-region start end)
|
||||||
(setq gptel--current-highlight-region (list start end)))))
|
(setq gptel--current-highlight-region (list start end)))))
|
||||||
|
|
||||||
(cl-defun gptel--monitor-context-buffer-point-change ()
|
(cl-defun gptel--monitor-context-buffer-point-change ()
|
||||||
|
|
@ -536,27 +435,10 @@ Used mainly for selecting contexts when the point has moved."
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun gptel-context-string ()
|
(defun gptel-context-string ()
|
||||||
"Return the contents of the context buffer."
|
"Return the string of all the contexts."
|
||||||
(gptel--ensure-context-buffer-exists)
|
(gptel--ensure-context-buffer-exists)
|
||||||
(with-current-buffer gptel--context-buffer
|
(with-current-buffer gptel--context-buffer
|
||||||
(buffer-substring-no-properties (point-min) (point-max))))
|
(buffer-substring-no-properties (point-min) (point-max))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
(provide 'gptel-contexter)
|
||||||
;;; -------------------------------- HOOKS --------------------------------- ;;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(add-hook 'kill-buffer-hook #'gptel--cleanup-killed-buffer)
|
|
||||||
(add-hook 'after-change-functions
|
|
||||||
#'gptel--cleanup-degenerate-contexts
|
|
||||||
#'gptel--sync-context-buffer)
|
|
||||||
(add-hook 'post-command-hook #'gptel--monitor-context-buffer-point-change)
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; ---------------------------- INITIALIZATION ---------------------------- ;;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
;; Just make sure an empty buffer exists.
|
|
||||||
(gptel--refresh-context-buffer)
|
|
||||||
|
|
||||||
(provide 'contexter)
|
|
||||||
;;; gptel-contexter.el ends here.
|
;;; gptel-contexter.el ends here.
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue