Skip to content

Add response color-coding & role setting for gptel buffer #343

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 7 commits into
base: master
Choose a base branch
from
+177 −66
Open

Add response color-coding & role setting for gptel buffer #343

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
a50cf5c
test: Update test module
karthink Feb 16, 2025
beb7377
Simplify region fetching
daedsidog Jul 15, 2024
55cc58b
Make setting of custom variable immediately affect highlighting
daedsidog Jul 16, 2024
8c0a5e1
Change face to that of a much less intrusive tint
daedsidog Jul 16, 2024
cf16b35
Make role-toggling fill a role fragment when selecting region
daedsidog Jul 17, 2024
04ebdf9
Fix minor bug with role-toggling
daedsidog Jul 24, 2024
4eb6a7d
Fix out of range error when toggling roles of first message
daedsidog Aug 28, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
47 changes: 26 additions & 21 deletions gptel-gemini.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
5 changes: 3 additions & 2 deletions gptel-kagi.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
45 changes: 25 additions & 20 deletions gptel-ollama.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
48 changes: 27 additions & 21 deletions gptel-openai.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
96 changes: 95 additions & 1 deletion gptel.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.

Expand Down Expand Up @@ -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))
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I believe this should be the only point of contention.

Copy link
Contributor Author

@daedsidog daedsidog Sep 21, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

As far as the rest of this PR goes, I feel the text properties work much better as the role tagging mechanism for the chat buffer than overlays, given their downsides discussed in #321.

(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
Expand All @@ -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'.
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion test
Open in desktop
Submodule test updated 3 files
+6 −6 examples/frontend-prompt-creation.org
+2 −2 examples/openai-frontend-org.eld
+51 −0 gptel-unit-tests.el