Add response color-coding & role setting for gptel buffer

gptel-gemini.el

@@ -99,8 +99,9 @@
                 (or (not max-entries) (>= max-entries 0))
                 (setq prop (text-property-search-backward
                             'gptel 'response
-                            (when (get-char-property (max (point-min) (1- (point)))
-                                                     'gptel)
+                            (when (eq (get-char-property (max (point-min) (1- (point)))
+                                                         'gptel)
+                                      'response)
                               t))))
           (if (prop-match-value prop)   ;assistant role
               (push (list :role "model"

gptel-kagi.el

@@ -84,8 +84,9 @@
         ;; (filename (thing-at-point 'existing-filename)) ;no file upload support yet
         (prop (text-property-search-backward
                'gptel 'response
-               (when (get-char-property (max (point-min) (1- (point)))
-                                        'gptel)
+               (when (eq (get-char-property (max (point-min) (1- (point)))
+                                            'gptel)
+                         'response)
                  t))))
     (if (and url (string-prefix-p "summarize" (gptel--model-name gptel-model)))
         (list :url url)

gptel-ollama.el

@@ -104,8 +104,9 @@ Intended for internal use only.")
                 (or (not max-entries) (>= max-entries 0))
                 (setq prop (text-property-search-backward
                             'gptel 'response
-                            (when (get-char-property (max (point-min) (1- (point)))
-                                                     'gptel)
+                            (when (eq (get-char-property (max (point-min) (1- (point)))
+                                                         'gptel)
+                                      'response)
                               t))))
           (if (prop-match-value prop)   ;assistant role
               (push (list :role "assistant"

gptel-openai.el

@@ -153,8 +153,9 @@ with differing settings.")
                 (or (not max-entries) (>= max-entries 0))
                 (setq prop (text-property-search-backward
                             'gptel 'response
-                            (when (get-char-property (max (point-min) (1- (point)))
-                                                     'gptel)
+                            (when (eq (get-char-property (max (point-min) (1- (point)))
+                                                         'gptel)
+                                      'response)
                               t))))
           (if (prop-match-value prop)   ;assistant role
               (push (list :role "assistant"

gptel.el

@@ -361,6 +361,23 @@ This is an alist mapping major modes to the reply prefix strings.  This
 is only inserted in dedicated gptel buffers before the AI's response."
   :type '(alist :key-type symbol :value-type string))
 
+(defcustom gptel-highlight-assistant-responses nil
+  "Whether or not the assistant responses should be highlighted.
+
+Applies only to the dedicated gptel chat buffer."
+  :type 'boolean
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (when (bound-and-true-p gptel-mode)
+           (if value
+               (progn
+                 (font-lock-add-keywords
+                  nil '((gptel--response-text-search 0 'gptel-response-highlight-face prepend)) t)
+                 (font-lock-flush))
+             (font-lock-remove-keywords
+              nil '((gptel--response-text-search 0 'gptel-response-highlight-face prepend)))
+             (font-lock-flush)))))
+
 (defcustom gptel-use-header-line t
   "Whether `gptel-mode' should use header-line for status information.
 
@@ -1023,7 +1040,33 @@ file."
 ;;; Minor mode and UI
 
 ;; NOTE: It's not clear that this is the best strategy:
-(add-to-list 'text-property-default-nonsticky '(gptel . t))
+(add-to-list 'text-property-default-nonsticky '(gptel . nil))
+
+(defface gptel-response-highlight-face
+  '((((class color) (min-colors 257) (background light))
+     :background "#e6f2ff" :extend t)
+    (((class color) (min-colors 88) (background light))
+     :background "#cce7ff" :extend t)
+    (((class color) (min-colors 88) (background dark))
+     :background "#202030" :extend t)
+    (((class color) (background dark))
+     :background "#202030" :extend t))
+  "Face used to highlight gptel responses in the dedicated chat buffer."
+  :group 'gptel)
+
+(defun gptel--response-text-search (bound)
+  "Search for text with the `gptel' property set to `response' up to BOUND."
+  (let ((pos (point)))
+    (while (and (< pos bound)
+                (not (eq (get-text-property pos 'gptel) 'response)))
+      (setq pos (next-single-property-change pos 'gptel nil bound)))
+    (if (and (< pos bound) (eq (get-text-property pos 'gptel) 'response))
+        (let ((end (next-single-property-change pos 'gptel nil bound)))
+          (set-match-data (list pos end))
+          (goto-char end)
+          t)
+      (goto-char bound)
+      nil)))
 
 ;;;###autoload
 (define-minor-mode gptel-mode
@@ -1039,6 +1082,10 @@ file."
                     (eq major-mode 'text-mode))
           (gptel-mode -1)
           (user-error (format "`gptel-mode' is not supported in `%s'." major-mode)))
+        (when gptel-highlight-assistant-responses
+          (font-lock-add-keywords
+           nil '((gptel--response-text-search 0 'gptel-response-highlight-face prepend)) t)
+          (font-lock-flush))
         (add-hook 'before-save-hook #'gptel--save-state nil t)
         (gptel--restore-state)
         (if gptel-use-header-line
@@ -1118,11 +1165,57 @@ file."
                          (buttonize (gptel--model-name gptel-model)
                             (lambda (&rest _) (gptel-menu))))))))
     (remove-hook 'before-save-hook #'gptel--save-state t)
+    (font-lock-remove-keywords
+     nil '((gptel--response-text-search 0 'gptel-response-highlight-face prepend)))
+    (font-lock-flush)
     (if gptel-use-header-line
         (setq header-line-format gptel--old-header-line
               gptel--old-header-line nil)
       (setq mode-line-process nil))))
 
+(defun gptel--response-region-at-point ()
+  "Return cons of response start and end points.
+
+Returns nil if no response is found at the point."
+  (cl-flet ((responsep (point type)
+              (let ((prop (member 'gptel (text-properties-at point))))
+                (and prop (eq (cadr prop) type)))))
+    (let ((type (get-text-property (point) 'gptel)))
+      (if (responsep (point) type)
+          (cons (cl-loop for i from (point) downto (point-min)
+                         while (responsep i type)
+                         finally (cl-return (1+ i)))
+                (cl-loop for i from (point) to (point-max)
+                         while (responsep i type)
+                         finally (cl-return i)))
+        nil))))
+
+(defun gptel-toggle-response-role ()
+  "Toggle the role of the text between the user and the assistant.
+If a region is selected, modifies the region.  Otherwise, modifies at the point."
+  (interactive)
+  (unless gptel-mode
+    (user-error "This command is only usable in the dedicated gptel chat buffer"))
+  (let (start end)
+    (if (region-active-p)
+        (setq start (region-beginning)
+              end (region-end))
+      (let ((response-region (gptel--response-region-at-point)))
+        (setq start (car response-region)
+              end (cdr response-region))))
+    (when (and start end)
+      (let* ((type (get-text-property start 'gptel))
+             ;; If a region has a fragmented role that opposes the current one at the start, we make
+             ;; sure to fill it with the role at the start of the region.
+             (dst-type (cl-loop for i from start while (< i end)
+                                thereis (unless (eq type (get-text-property i 'gptel))
+                                          (unless type
+                                            'query))
+                                finally (cl-return (if (eq type 'response)
+                                                       'query
+                                                     'response)))))
+        (put-text-property start end 'gptel dst-type)))))
+
 (defun gptel--update-status (&optional msg face)
   "Update status MSG in FACE."
   (when gptel-mode