diff --git a/gptel-gemini.el b/gptel-gemini.el index 4018b3f0..34409f23 100644 --- a/gptel-gemini.el +++ b/gptel-gemini.el @@ -230,27 +230,32 @@ See generic implementation for full documentation." (include-media (and gptel-track-media (or (gptel--model-capable-p 'media) (gptel--model-capable-p 'url))))) (if (or gptel-mode gptel-track-response) - (while (and (or (not max-entries) (>= max-entries 0)) - (goto-char (previous-single-property-change - (point) 'gptel nil (point-min))) - (not (= (point) prev-pt))) - (pcase (get-char-property (point) 'gptel) - ('response - (push (list :role "model" - :parts - (list :text (buffer-substring-no-properties (point) prev-pt))) - prompts)) - ('nil - (if include-media - (push (list :role "user" - :parts (gptel--gemini-parse-multipart - (gptel--parse-media-links major-mode (point) prev-pt))) - prompts) - (push (list :role "user" - :parts - `[(:text ,(gptel--trim-prefixes - (buffer-substring-no-properties (point) prev-pt)))]) - prompts)))) + (while (and + (or (not max-entries) (>= max-entries 0)) + (setq prop (text-property-search-backward + 'gptel 'response + (when (eq (get-char-property (max (point-min) (1- (point))) + 'gptel) + 'response) + t)))) + (if (prop-match-value prop) ;assistant role + (push (list :role "model" + :parts + (list :text (buffer-substring-no-properties (prop-match-beginning prop) + (prop-match-end prop)))) + prompts) + (if include-media + (push (list :role "user" + :parts (gptel--gemini-parse-multipart + (gptel--parse-media-links + major-mode (prop-match-beginning prop) (prop-match-end prop)))) + prompts) + (push (list :role "user" + :parts + `[(:text ,(gptel--trim-prefixes + (buffer-substring-no-properties (prop-match-beginning prop) + (prop-match-end prop))))]) + prompts))) (setq prev-pt (point)) (and max-entries (cl-decf max-entries))) (push (list :role "user" diff --git a/gptel-kagi.el b/gptel-kagi.el index 2f5c1632..759e427f 100644 --- a/gptel-kagi.el +++ b/gptel-kagi.el @@ -87,8 +87,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 9061786d..153a7db4 100644 --- a/gptel-ollama.el +++ b/gptel-ollama.el @@ -146,26 +146,31 @@ Store response metadata in state INFO." (include-media (and gptel-track-media (or (gptel--model-capable-p 'media) (gptel--model-capable-p 'url))))) (if (or gptel-mode gptel-track-response) - (while (and (or (not max-entries) (>= max-entries 0)) - (goto-char (previous-single-property-change - (point) 'gptel nil (point-min))) - (not (= (point) prev-pt))) - (pcase (get-char-property (point) 'gptel) - ('response - (push (list :role "assistant" - :content (buffer-substring-no-properties (point) prev-pt)) - prompts)) - ('nil - (if include-media - (push (append '(:role "user") - (gptel--ollama-parse-multipart - (gptel--parse-media-links major-mode (point) prev-pt))) - prompts) - (push (list :role "user" - :content - (gptel--trim-prefixes - (buffer-substring-no-properties (point) prev-pt))) - prompts)))) + (while (and + (or (not max-entries) (>= max-entries 0)) + (setq prop (text-property-search-backward + 'gptel 'response + (when (eq (get-char-property (max (point-min) (1- (point))) + 'gptel) + 'response) + t)))) + (if (prop-match-value prop) ;assistant role + (push (list :role "assistant" + :content (buffer-substring-no-properties (prop-match-beginning prop) + (prop-match-end prop))) + prompts) + (if include-media + (push (append '(:role "user") + (gptel--ollama-parse-multipart + (gptel--parse-media-links + major-mode (prop-match-beginning prop) (prop-match-end prop)))) + prompts) + (push (list :role "user" + :content + (gptel--trim-prefixes + (buffer-substring-no-properties (prop-match-beginning prop) + (prop-match-end prop)))) + prompts))) (setq prev-pt (point)) (and max-entries (cl-decf max-entries))) (push (list :role "user" diff --git a/gptel-openai.el b/gptel-openai.el index c5843596..071c5d31 100644 --- a/gptel-openai.el +++ b/gptel-openai.el @@ -324,27 +324,33 @@ Mutate state INFO with response metadata." (or (gptel--model-capable-p 'media) (gptel--model-capable-p 'url))))) (if (or gptel-mode gptel-track-response) - (while (and (or (not max-entries) (>= max-entries 0)) - (/= prev-pt (point-min)) - (goto-char (previous-single-property-change - (point) 'gptel nil (point-min)))) - (pcase (get-char-property (point) 'gptel) - ('response - (push (list :role "assistant" - :content (buffer-substring-no-properties (point) prev-pt)) - prompts)) - ('nil - (if include-media - (push (list :role "user" - :content - (gptel--openai-parse-multipart - (gptel--parse-media-links major-mode (point) prev-pt))) - prompts) - (push (list :role "user" - :content - (gptel--trim-prefixes - (buffer-substring-no-properties (point) prev-pt))) - prompts)))) + (while (and + (or (not max-entries) (>= max-entries 0)) + (setq prop (text-property-search-backward + 'gptel 'response + (when (eq (get-char-property (max (point-min) (1- (point))) + 'gptel) + 'response) + t)))) + (if (prop-match-value prop) ;assistant role + (push (list :role "assistant" + :content + (buffer-substring-no-properties (prop-match-beginning prop) + (prop-match-end prop))) + prompts) + (if include-media + (push (list :role "user" + :content + (gptel--openai-parse-multipart + (gptel--parse-media-links + major-mode (prop-match-beginning prop) (prop-match-end prop)))) + prompts) + (push (list :role "user" + :content + (gptel--trim-prefixes + (buffer-substring-no-properties (prop-match-beginning prop) + (prop-match-end prop)))) + prompts))) (setq prev-pt (point)) (and max-entries (cl-decf max-entries))) (push (list :role "user" diff --git a/gptel.el b/gptel.el index 95254751..65f5cb51 100644 --- a/gptel.el +++ b/gptel.el @@ -379,6 +379,23 @@ is only inserted in dedicated gptel buffers before the AI's response." "String inserted before responses." :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. @@ -1179,7 +1196,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 @@ -1194,6 +1237,10 @@ file." (unless (derived-mode-p 'org-mode 'markdown-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) (when (derived-mode-p 'org-mode) ;; Work around bug in `org-fontify-extend-region'. @@ -1288,12 +1335,59 @@ 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)))) (defvar gptel--fsm-last) ;Defined further below + +(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 diff --git a/test b/test index c625fea0..6ca41954 160000 --- a/test +++ b/test @@ -1 +1 @@ -Subproject commit c625fea0214d6d607d6d96ea3f62e60a8e28fefb +Subproject commit 6ca41954b94ee6c795974756ae8e870628ab71be