branch: elpa/gptel
commit 8e0de5dd25b85122e35da9e2e3a7d09e2e46ece8
Author: Psionik K <73710933+psioni...@users.noreply.github.com>
Commit: Karthik Chikmagalur <karthikchikmaga...@gmail.com>
gptel: overhaul bounds, support more text property types
Store the chat buffer's gptel bounds in an alist for compactness.
Each entry maps a text designation type (`response', `tool',
`ignore' etc) to a list of bounds. Each bound is a
list (previously a cons) of the form (BEG END) or (BEG END VAL).
VAL is used for text properties like tool calls that can store an
ID.
The previous variant of gptel's bounds (as a list of conses)
will continue to be supported.
* gptel-org.el (gptel-org--restore-state, gptel-org--save-state):
Update for new bounds data type.
* gptel.el (gptel--in-response-p, gptel--restore-props,
gptel--restore-state): New function 'gptel--restore-props' to
restore the gptel text-property from either of the supported
bounds types. Other modifications are to handle the fact that
the `gptel' text-property can have many valid values now.
---
gptel-org.el | 9 ++++-----
gptel.el | 58 +++++++++++++++++++++++++++++++++++++++++++++++-----------
2 files changed, 51 insertions(+), 16 deletions(-)
diff --git a/gptel-org.el b/gptel-org.el
index 6550425310..ace590e5cd 100644
--- a/gptel-org.el
+++ b/gptel-org.el
@@ -50,6 +50,7 @@
(declare-function gptel-backend-name "gptel")
(declare-function gptel--parse-buffer "gptel")
(declare-function gptel--parse-directive "gptel")
+(declare-function gptel--restore-props "gptel")
(declare-function org-entry-get "org")
(declare-function org-entry-put "org")
(declare-function org-with-wide-buffer "org-macs")
@@ -408,10 +409,7 @@ ARGS are the original function call arguments."
(condition-case status
(progn
(when-let* ((bounds (org-entry-get (point-min) "GPTEL_BOUNDS")))
- (mapc (pcase-lambda (`(,beg . ,end))
- (add-text-properties
- beg end '(gptel response front-sticky (gptel))))
- (read bounds)))
+ (gptel--restore-props (read bounds)))
(pcase-let ((`(,system ,backend ,model ,temperature ,tokens ,num)
(gptel-org--entry-properties (point-min))))
(when system (setq-local gptel--system-message system))
@@ -470,7 +468,8 @@ non-nil (default), display a message afterwards."
(letrec ((write-bounds
(lambda (attempts)
(let* ((bounds (gptel--get-buffer-bounds))
- (offset (caar bounds))
+ ;; first value of ((prop . ((beg end val)...))...)
+ (offset (caadar bounds))
(offset-marker (set-marker (make-marker) offset)))
(org-entry-put (point-min) "GPTEL_BOUNDS"
(prin1-to-string (gptel--get-buffer-bounds)))
diff --git a/gptel.el b/gptel.el
index bf90a0f91c..52810fd9ff 100644
--- a/gptel.el
+++ b/gptel.el
@@ -998,12 +998,18 @@ FILE is assumed to exist and be a regular file."
(save-restriction
(widen)
(goto-char (point-max))
- (let ((prop) (bounds))
- (while (setq prop (text-property-search-backward
- 'gptel 'response t))
- (push (cons (prop-match-beginning prop)
- (prop-match-end prop))
- bounds))
+ (let ((bounds) (prev-pt (point)))
+ (while (and (/= prev-pt (point-min))
+ (goto-char (previous-single-property-change
+ (point) 'gptel nil (point-min))))
+ (when-let* ((prop (get-char-property (point) 'gptel)))
+ (let* ((prop-name (if (symbolp prop) prop (car prop)))
+ (val (when (consp prop) (cdr prop)))
+ (bound (if val
+ (list (point) prev-pt val)
+ (list (point) prev-pt))))
+ (push bound (alist-get prop-name bounds))))
+ (setq prev-pt (point)))
bounds))))
(define-obsolete-function-alias
@@ -1022,7 +1028,7 @@ FILE is assumed to exist and be a regular file."
(defun gptel--in-response-p (&optional pt)
"Check if position PT is inside a gptel response."
- (get-char-property (or pt (point)) 'gptel))
+ (eq (get-char-property (or pt (point)) 'gptel) 'response))
(defun gptel--at-response-history-p (&optional pt)
"Check if gptel response at position PT has variants."
@@ -1139,6 +1145,39 @@ Valid JSON unless NO-JSON is t."
;;; Saving and restoring state
+(defun gptel--restore-props (bounds-alist)
+ "Restore text properties from BOUNDS-ALIST.
+BOUNDS-ALIST is (PROP . BOUNDS). BOUNDS is a list of BOUND. Each BOUND
+is either (BEG END VAL) or (BEG END).
+
+For (BEG END VAL) forms, even if VAL is nil, the gptel property will be
+set to (PROP . VAL). For (BEG END) forms, except when PROP is response,
+the gptel property is set to just PROP.
+
+The legacy structure, a list of (BEG . END) is also supported and will be
+applied before being re-persisted in the new structure."
+ (if (symbolp (caar bounds-alist))
+ (mapc
+ (lambda (bounds)
+ (let* ((prop (pop bounds)))
+ (mapc
+ (lambda (bound)
+ (let ((prop-has-val (> (length bound) 2)))
+ (add-text-properties
+ (pop bound) (pop bound)
+ (if (eq prop 'response)
+ '(gptel response front-sticky (gptel))
+ (list 'gptel
+ (if prop-has-val
+ (cons prop (pop bound))
+ prop))))))
+ bounds)))
+ bounds-alist)
+ (mapc (lambda (bound)
+ (add-text-properties
+ (car bound) (cdr bound) '(gptel response front-sticky (gptel))))
+ bounds-alist)))
+
(defun gptel--restore-state ()
"Restore gptel state when turning on `gptel-mode'."
(when (buffer-file-name)
@@ -1147,10 +1186,7 @@ Valid JSON unless NO-JSON is t."
(require 'gptel-org)
(gptel-org--restore-state))
(when gptel--bounds
- (mapc (pcase-lambda (`(,beg . ,end))
- (add-text-properties
- beg end '(gptel response front-sticky (gptel))))
- gptel--bounds)
+ (gptel--restore-props gptel--bounds)
(message "gptel chat restored."))
(when gptel--backend-name
(if-let* ((backend (alist-get
