From a50cf5ce99eab2b96de2942d6287e073b7b5b5e2 Mon Sep 17 00:00:00 2001 From: Karthik Chikmagalur Date: Sun, 16 Feb 2025 07:07:31 -0800 Subject: [PATCH 1/7] test: Update test module --- gptel.el | 73 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ test | 2 +- 2 files changed, 74 insertions(+), 1 deletion(-) diff --git a/gptel.el b/gptel.el index 95254751..4e334a82 100644 --- a/gptel.el +++ b/gptel.el @@ -379,6 +379,12 @@ 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) + (defcustom gptel-use-header-line t "Whether `gptel-mode' should use header-line for status information. @@ -1181,6 +1187,31 @@ file." ;; NOTE: It's not clear that this is the best strategy: (add-to-list 'text-property-default-nonsticky '(gptel . t)) +(defface gptel-response-highlight-face + '((((class color) (min-colors 257) (background light)) + :foreground "#0066cc") + (((class color) (min-colors 88) (background light)) + :foreground "#0066cc") + (((class color) (min-colors 88) (background dark)) + :foreground "light sky blue") + (((class color)) :foreground "blue")) + "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 "Minor mode for interacting with LLMs." @@ -1194,6 +1225,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 +1323,50 @@ 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." + (let* ((pos (point)) + (start pos) + (end pos)) + (cl-flet ((responsep (point) + (member 'gptel (text-properties-at point)))) + (while (and (/= start (point-min)) + (responsep start)) + (setq start (or (previous-property-change start) (point-min)))) + (while (and (/= end (point-max)) + (responsep end)) + (setq end (or (next-property-change end) (point-max)))) + (setq start (if (responsep start) start (1+ start))) + (cons start end)))) + +(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) + (setf start (region-beginning) + end (region-end)) + (let ((response-region (gptel--response-region-at-point))) + (setf start (car response-region) + end (cdr response-region)))) + (let ((type (get-text-property start 'gptel))) + (if (eq type 'response) + (put-text-property start end 'gptel nil) + (put-text-property start end 'gptel 'response))))) + (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 From beb73778b2c360e3154d07278391776754de8723 Mon Sep 17 00:00:00 2001 From: daedsidog <41439659+daedsidog@users.noreply.github.com> Date: Tue, 16 Jul 2024 02:58:20 +0300 Subject: [PATCH 2/7] Simplify region fetching --- gptel.el | 42 ++++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/gptel.el b/gptel.el index 4e334a82..d0719bd2 100644 --- a/gptel.el +++ b/gptel.el @@ -1334,20 +1334,21 @@ file." (defvar gptel--fsm-last) ;Defined further below (defun gptel--response-region-at-point () - "Return cons of response start and end points." - (let* ((pos (point)) - (start pos) - (end pos)) - (cl-flet ((responsep (point) - (member 'gptel (text-properties-at point)))) - (while (and (/= start (point-min)) - (responsep start)) - (setq start (or (previous-property-change start) (point-min)))) - (while (and (/= end (point-max)) - (responsep end)) - (setq end (or (next-property-change end) (point-max)))) - (setq start (if (responsep start) start (1+ start))) - (cons start end)))) + "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 0 + 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. @@ -1357,15 +1358,16 @@ If a region is selected, modifies the region. Otherwise, modifies at the point. (user-error "This command is only usable in the dedicated gptel chat buffer")) (let (start end) (if (region-active-p) - (setf start (region-beginning) + (setq start (region-beginning) end (region-end)) (let ((response-region (gptel--response-region-at-point))) - (setf start (car response-region) + (setq start (car response-region) end (cdr response-region)))) - (let ((type (get-text-property start 'gptel))) - (if (eq type 'response) - (put-text-property start end 'gptel nil) - (put-text-property start end 'gptel 'response))))) + (when (and start end) + (let ((type (get-text-property start 'gptel))) + (if (eq type 'response) + (put-text-property start end 'gptel nil) + (put-text-property start end 'gptel 'response)))))) (defun gptel--update-status (&optional msg face) "Update status MSG in FACE." From 55cc58b5536856709c65796ac16550bfc4eed62b Mon Sep 17 00:00:00 2001 From: daedsidog <41439659+daedsidog@users.noreply.github.com> Date: Tue, 16 Jul 2024 03:23:24 +0300 Subject: [PATCH 3/7] Make setting of custom variable immediately affect highlighting --- gptel.el | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/gptel.el b/gptel.el index d0719bd2..949410f3 100644 --- a/gptel.el +++ b/gptel.el @@ -383,7 +383,18 @@ is only inserted in dedicated gptel buffers before the AI's response." "Whether or not the assistant responses should be highlighted. Applies only to the dedicated gptel chat buffer." - :type 'boolean) + :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. From 8c0a5e14e025cfa190242edb6fa08d90ed35719f Mon Sep 17 00:00:00 2001 From: daedsidog <41439659+daedsidog@users.noreply.github.com> Date: Tue, 16 Jul 2024 05:52:03 +0300 Subject: [PATCH 4/7] Change face to that of a much less intrusive tint --- gptel.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/gptel.el b/gptel.el index 949410f3..cdd4bfba 100644 --- a/gptel.el +++ b/gptel.el @@ -1200,12 +1200,13 @@ file." (defface gptel-response-highlight-face '((((class color) (min-colors 257) (background light)) - :foreground "#0066cc") + :background "#e6f2ff" :extend t) (((class color) (min-colors 88) (background light)) - :foreground "#0066cc") + :background "#cce7ff" :extend t) (((class color) (min-colors 88) (background dark)) - :foreground "light sky blue") - (((class color)) :foreground "blue")) + :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) From cf16b352a24df69e8f25e9b9c65e3505e638c471 Mon Sep 17 00:00:00 2001 From: daedsidog <41439659+daedsidog@users.noreply.github.com> Date: Wed, 17 Jul 2024 06:00:20 +0300 Subject: [PATCH 5/7] Make role-toggling fill a role fragment when selecting region --- gptel.el | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/gptel.el b/gptel.el index cdd4bfba..88a951cc 100644 --- a/gptel.el +++ b/gptel.el @@ -1376,10 +1376,16 @@ If a region is selected, modifies the region. Otherwise, modifies at the point. (setq start (car response-region) end (cdr response-region)))) (when (and start end) - (let ((type (get-text-property start 'gptel))) - (if (eq type 'response) - (put-text-property start end 'gptel nil) - (put-text-property start end 'gptel 'response)))))) + (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)) + type) + finally (cl-return (if (eq type 'response) + nil + 'response))))) + (put-text-property start end 'gptel dst-type))))) (defun gptel--update-status (&optional msg face) "Update status MSG in FACE." From 04ebdf943a1bba4a7ef0da1a96fbe98e184f6def Mon Sep 17 00:00:00 2001 From: daedsidog <41439659+daedsidog@users.noreply.github.com> Date: Wed, 24 Jul 2024 05:22:16 +0300 Subject: [PATCH 6/7] Fix minor bug with role-toggling --- gptel.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/gptel.el b/gptel.el index 88a951cc..3a77c7a2 100644 --- a/gptel.el +++ b/gptel.el @@ -1196,7 +1196,7 @@ 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)) @@ -1381,11 +1381,13 @@ If a region is selected, modifies the region. Otherwise, modifies at the point. ;; 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)) - type) + (unless type + 'query)) finally (cl-return (if (eq type 'response) - nil + 'query 'response))))) - (put-text-property start end 'gptel dst-type))))) + (setq dst-type (if (eq dst-type 'query-placeholder) nil dst-type)) + (put-text-property start end 'gptel dst-type))))) (defun gptel--update-status (&optional msg face) "Update status MSG in FACE." From 4eb6a7d8eba303d0f5866db58468d85a310c0818 Mon Sep 17 00:00:00 2001 From: daedsidog <41439659+daedsidog@users.noreply.github.com> Date: Wed, 28 Aug 2024 19:43:56 +0300 Subject: [PATCH 7/7] Fix out of range error when toggling roles of first message --- gptel-gemini.el | 47 ++++++++++++++++++++++++++--------------------- gptel-kagi.el | 5 +++-- gptel-ollama.el | 45 +++++++++++++++++++++++++-------------------- gptel-openai.el | 48 +++++++++++++++++++++++++++--------------------- gptel.el | 3 +-- 5 files changed, 82 insertions(+), 66 deletions(-) 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 3a77c7a2..65f5cb51 100644 --- a/gptel.el +++ b/gptel.el @@ -1354,7 +1354,7 @@ Returns nil if no response is found at the 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 0 + (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) @@ -1386,7 +1386,6 @@ If a region is selected, modifies the region. Otherwise, modifies at the point. finally (cl-return (if (eq type 'response) 'query 'response))))) - (setq dst-type (if (eq dst-type 'query-placeholder) nil dst-type)) (put-text-property start end 'gptel dst-type))))) (defun gptel--update-status (&optional msg face)