diff --git a/gptel-gemini.el b/gptel-gemini.el index 1d663001..979ef501 100644 --- a/gptel-gemini.el +++ b/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" diff --git a/gptel-kagi.el b/gptel-kagi.el index 7e0304f7..0c80925f 100644 --- a/gptel-kagi.el +++ b/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) diff --git a/gptel-ollama.el b/gptel-ollama.el index 0ec6c27a..e64a5b3f 100644 --- a/gptel-ollama.el +++ b/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" diff --git a/gptel-openai.el b/gptel-openai.el index 23ac3ac4..61339b3e 100644 --- a/gptel-openai.el +++ b/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" diff --git a/gptel.el b/gptel.el index 2e9e3809..695aa866 100644 --- a/gptel.el +++ b/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