[nongnu] elpa/gptel 8e0de5dd25 13/14: gptel: overhaul bounds, support more text property types

[ELPA Syncer]

branch: elpa/gptel
commit 8e0de5dd25b85122e35da9e2e3a7d09e2e46ece8
Author: Psionik K <73710933+psionic-k@users.noreply.github.com>
Commit: Karthik Chikmagalur <karthikchikmagalur@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