branch: externals/ellama
commit 559f1c4590fdc79bb90a2fdfde443f889008a5e7
Merge: 3059baa169 fca903ac13
Author: Sergey Kostyaev <[email protected]>
Commit: GitHub <[email protected]>
Merge pull request #291 from s-kostyaev/refactor-ellama-stream
Refactor text insertion and handling in `ellama.el`
---
NEWS.org | 11 +++
README.org | 7 +-
ellama-blueprint.el | 16 ++--
ellama-context.el | 10 +-
ellama.el | 258 +++++++++++++++++++++++++++++++++------------------
tests/test-ellama.el | 37 +++++++-
6 files changed, 236 insertions(+), 103 deletions(-)
diff --git a/NEWS.org b/NEWS.org
index 7e5358b56b..230f57b470 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -1,3 +1,14 @@
+* Version 1.6.0
+- Refactored the text insertion and handling logic in ~ellama.el~.
+- Added new customization variables ~ellama-show-reasoning~ and
+ ~ellama-reasoning-display-action-function~ to control the display of
+ reasoning. Updated ~ellama.el~ to use these new variables when displaying
+ reasoning buffers.
+- Added ~ellama-disable-scroll~ and ~ellama-enable-scroll~ functions to control
+ auto-scroll behavior.
+- Added a new face ~ellama-key-face~ to style the context line keys in both
+ ~ellama-blueprint.el~ and ~ellama-context.el~. Updated header line formats to
+ use this new face for better visual distinction.
* Version 1.5.6
- Fix support for translating inline code from markdown to org format by
handling backticks.
diff --git a/README.org b/README.org
index 865b783f51..31dfb247d0 100644
--- a/README.org
+++ b/README.org
@@ -113,7 +113,10 @@ More sofisticated configuration example:
(setopt ellama-instant-display-action-function #'display-buffer-at-bottom)
:config
;; show ellama context in header line in all buffers
- (ellama-context-header-line-global-mode +1))
+ (ellama-context-header-line-global-mode +1)
+ ;; handle scrolling events
+ (advice-add 'pixel-scroll-precision :before #'ellama-disable-scroll)
+ (advice-add 'end-of-buffer :after #'ellama-enable-scroll))
#+END_SRC
** Commands
@@ -477,6 +480,8 @@ argument generated text string.
- ~ellama-community-prompts-file~: Path to the CSV file containing community
prompts.
This file is expected to be located inside an ~ellama~ subdirectory
within your ~user-emacs-directory~.
+- ~ellama-show-reasoning~: Show reasoning in separate buffer if enabled.
Enabled by default.
+- ~ellama-reasoning-display-action-function~: Display action function for
reasoning.
** Minor modes
diff --git a/ellama-blueprint.el b/ellama-blueprint.el
index 83d6bbfe31..10d1c58fd2 100644
--- a/ellama-blueprint.el
+++ b/ellama-blueprint.el
@@ -73,22 +73,26 @@
(setq header-line-format
(concat
(propertize
- (substitute-command-keys
- "`\\[ellama-transient-blueprint-mode-menu]' to continue")
+ (concat (propertize
+ (substitute-command-keys
+ "`\\[ellama-transient-blueprint-mode-menu]'")
+ 'face 'ellama-key-face)
+ " to continue")
'help-echo "mouse-1: show menu"
'mouse-face 'header-line-format
- 'face 'ellama-context-line-face
'keymap (let ((m (make-sparse-keymap)))
(define-key m [header-line mouse-1]
#'ellama-transient-blueprint-mode-menu)
(define-key m [mode-line mouse-1]
#'ellama-transient-blueprint-mode-menu)
m))
" "
(propertize
- (substitute-command-keys
- "`\\[ellama-kill-current-buffer]' to cancel")
+ (concat (propertize
+ (substitute-command-keys
+ "`\\[ellama-kill-current-buffer]'")
+ 'face 'ellama-key-face)
+ " to cancel")
'help-echo "mouse-1: kill buffer"
'mouse-face 'header-line-format
- 'face 'ellama-context-line-face
'keymap (let ((m (make-sparse-keymap)))
(define-key m [header-line mouse-1]
#'ellama-kill-current-buffer)
(define-key m [mode-line mouse-1]
#'ellama-kill-current-buffer)
diff --git a/ellama-context.el b/ellama-context.el
index 5d3390120e..76dc55f318 100644
--- a/ellama-context.el
+++ b/ellama-context.el
@@ -55,6 +55,10 @@
"Face for ellama context line."
:group 'ellama)
+(defface ellama-key-face '((t (:inherit help-key-binding)))
+ "Face for ellama context line."
+ :group 'ellama)
+
(defvar ellama-context-global nil
"Global context.")
@@ -242,8 +246,10 @@ the context."
:keymap ellama-context-preview-mode-map
:group 'ellama
(setq header-line-format
- (substitute-command-keys
- "`\\[ellama-kill-current-buffer]' to quit")))
+ (concat (propertize (substitute-command-keys
+ "`\\[ellama-kill-current-buffer]'")
+ 'face 'ellama-key-face)
+ " to quit")))
(defcustom ellama-context-preview-element-display-action-function nil
"Display action function for `ellama-context-preview-element'."
diff --git a/ellama.el b/ellama.el
index 653b76cd4a..4d086f31a4 100644
--- a/ellama.el
+++ b/ellama.el
@@ -5,8 +5,8 @@
;; Author: Sergey Kostyaev <[email protected]>
;; URL: http://github.com/s-kostyaev/ellama
;; Keywords: help local tools
-;; Package-Requires: ((emacs "28.1") (llm "0.22.0") (plz "0.8") (transient
"0.7") (compat "29.1"))
-;; Version: 1.5.6
+;; Package-Requires: ((emacs "28.1") (llm "0.24.0") (plz "0.8") (transient
"0.7") (compat "29.1"))
+;; Version: 1.6.0
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Created: 8th Oct 2023
@@ -502,6 +502,16 @@ It should be a function with single argument generated
text string."
:group 'ellama
:type 'function)
+(defcustom ellama-reasoning-display-action-function nil
+ "Display action function for reasoning."
+ :group 'ellama
+ :type 'function)
+
+(defcustom ellama-show-reasoning t
+ "Show reasoning in separate buffer if enabled."
+ :group 'ellama
+ :type 'boolean)
+
(define-minor-mode ellama-session-mode
"Minor mode for ellama session buffers."
:interactive nil
@@ -1159,6 +1169,120 @@ Otherwire return current active session."
(defvar ellama-global-system nil)
+(defvar-local ellama--stop-scroll nil)
+
+;;;###autoload
+(defun ellama-disable-scroll (&rest event)
+ "Disable auto scroll.
+EVENT is an argument for mweel scroll."
+ (declare-function mwheel-event-window "mwheel")
+ (with-current-buffer
+ (window-buffer
+ (if (windowp (caadar event))
+ (caadar event)
+ (mwheel-event-window event)))
+ (setq ellama--stop-scroll t)))
+
+;;;###autoload
+(defun ellama-enable-scroll (&rest _)
+ "Enable auto scroll."
+ (setq ellama--stop-scroll nil))
+
+(defun ellama-max-common-prefix (s1 s2)
+ "Return the maximum common prefix of strings S1 and S2."
+ (let ((i 0)
+ (min-length (min (length s1) (length s2))))
+ (while (and (< i min-length)
+ (eq (aref s1 i) (aref s2 i)))
+ (setq i (1+ i)))
+ (substring s1 0 i)))
+
+(defun ellama--string-without-last-line (s)
+ "Remove last line from string S."
+ (string-join
+ (reverse (cdr (reverse (string-lines
+ s))))
+ "\n"))
+
+(defun ellama--insert (buffer point filter)
+ "Insert text during streaming.
+
+Works inside BUFFER starting at POINT.
+If POINT is nil, current point will be used.
+FILTER is a function for text transformation."
+ (with-current-buffer
+ buffer
+ (let* ((end-marker (make-marker))
+ (previous-filtered-text "")
+ (safe-common-prefix ""))
+ (set-marker end-marker (or point (point)))
+ (set-marker-insertion-type end-marker t)
+ (lambda
+ (text)
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char end-marker)
+ (let* ((filtered-text
+ (funcall filter text))
+ (common-prefix (concat
+ safe-common-prefix
+ (ellama-max-common-prefix
+ (string-remove-prefix
+ safe-common-prefix
+ filtered-text)
+ (string-remove-prefix
+ safe-common-prefix
+ previous-filtered-text))))
+ (wrong-chars-cnt (- (length previous-filtered-text)
+ (length common-prefix)))
+ (delta (string-remove-prefix common-prefix filtered-text)))
+ (delete-char (- wrong-chars-cnt))
+ (insert delta)
+ (when (and
+ (not (eq major-mode 'org-mode))
+ ellama-fill-paragraphs
+ (pcase ellama-fill-paragraphs
+ ((cl-type function) (funcall ellama-fill-paragraphs))
+ ((cl-type boolean) ellama-fill-paragraphs)
+ ((cl-type list) (and (apply #'derived-mode-p
+ ellama-fill-paragraphs)))))
+ (fill-paragraph))
+ (set-marker end-marker (point))
+ (when (and ellama-auto-scroll (not ellama--stop-scroll))
+ (ellama--scroll buffer end-marker))
+ (setq safe-common-prefix (ellama--string-without-last-line
common-prefix))
+ (setq previous-filtered-text filtered-text))))))))
+
+(defun ellama--handle-partial (insert-text insert-reasoning reasoning-buffer)
+ "Handle partial llm callback.
+INSERT-TEXT is a function for text insertion.
+INSERT-REASONING is a function for reasoning insertion.
+REASONING-BUFFER is a buffer for reasoning."
+ (lambda (response)
+ (let ((text (plist-get response :text))
+ (reasoning (plist-get response :reasoning)))
+ (funcall
+ insert-text
+ (concat
+ (when reasoning
+ (if
+ (or (not ellama-output-remove-reasoning)
+ ellama--current-session)
+ (concat "<think>\n" reasoning)
+ (progn
+ (with-current-buffer reasoning-buffer
+ (funcall insert-reasoning reasoning)
+ (when ellama-show-reasoning
+ (display-buffer
+ reasoning-buffer
+ (when ellama-reasoning-display-action-function
+ `((ignore .
(,ellama-reasoning-display-action-function)))))))
+ nil)))
+ (when text
+ (if (and reasoning ellama--current-session)
+ (concat "</think>\n" (string-trim text))
+ (string-trim text))))))))
+
(defun ellama-stream (prompt &rest args)
"Query ellama for PROMPT.
ARGS contains keys for fine control.
@@ -1204,6 +1328,8 @@ failure (with BUFFER current).
(when (ellama-session-p session)
(ellama-get-session-buffer (ellama-session-id session)))
(current-buffer)))
+ (reasoning-buffer (get-buffer-create
+ (concat (make-temp-name "*ellama-reasoning-") "*")))
(point (or (plist-get args :point)
(with-current-buffer buffer (point))))
(filter (or (plist-get args :filter) #'identity))
@@ -1227,103 +1353,57 @@ failure (with BUFFER current).
(ellama-session-prompt session))
(setf (ellama-session-prompt session)
(llm-make-chat-prompt prompt-with-ctx :context
system)))
- (llm-make-chat-prompt prompt-with-ctx :context system)))
- (stop-scroll))
+ (llm-make-chat-prompt prompt-with-ctx :context system))))
+ (with-current-buffer reasoning-buffer
+ (org-mode))
(with-current-buffer buffer
(ellama-request-mode +1)
- (let* ((start (make-marker))
- (end (make-marker))
- (distance-to-end (- (point-max) (point)))
- (new-pt)
- (insert-text
- (lambda (text)
- ;; Erase and insert the new text between the marker cons.
- (with-current-buffer buffer
- ;; Manually save/restore point as save-excursion doesn't
- ;; restore the point into the middle of replaced text.
- (let* ((pt (point))
- (new-distance-to-end (- (point-max) (point))))
- (save-excursion
- (if (and (eq (window-buffer (selected-window))
- buffer)
- (not (equal distance-to-end
new-distance-to-end)))
- (setq stop-scroll t)
- (setq stop-scroll nil))
- (goto-char start)
- (delete-region start end)
- (insert (funcall filter text))
- (when (and ellama-fill-paragraphs
- (pcase ellama-fill-paragraphs
- ((cl-type function) (funcall
ellama-fill-paragraphs))
- ((cl-type boolean) ellama-fill-paragraphs)
- ((cl-type list) (and (apply #'derived-mode-p
-
ellama-fill-paragraphs)
- (not (equal major-mode
'org-mode))))))
- (fill-region start (point)))
- (setq new-pt (point)))
- (if (and ellama-auto-scroll (not stop-scroll))
- (ellama--scroll buffer new-pt)
- (goto-char pt)))
- (undo-amalgamate-change-group ellama--change-group)))))
+ (let* ((insert-text
+ (ellama--insert buffer point filter))
+ (insert-reasoning
+ (ellama--insert reasoning-buffer nil
#'ellama--translate-markdown-to-org-filter)))
(setq ellama--change-group (prepare-change-group))
(activate-change-group ellama--change-group)
- (ellama-set-markers start end point)
(when ellama-spinner-enabled
(require 'spinner)
(spinner-start ellama-spinner-type))
- (let ((request (llm-chat-streaming
- provider
- llm-prompt
- insert-text
- (lambda (text)
- (funcall insert-text
- (string-trim
- (if (and ellama-output-remove-reasoning
- (not session))
- (ellama-remove-reasoning text)
- text)))
- (with-current-buffer buffer
- (accept-change-group ellama--change-group)
- (when ellama-spinner-enabled
- (spinner-stop))
- (if (and (listp donecb)
- (functionp (car donecb)))
- (mapc (lambda (fn) (funcall fn text))
- donecb)
- (funcall donecb text))
- (when ellama-session-hide-org-quotes
- (ellama-collapse-org-quotes))
- (when (and ellama--current-session
- ellama-session-remove-reasoning)
- (mapc (lambda (interaction)
- (setf (llm-chat-prompt-interaction-content
- interaction)
- (ellama-remove-reasoning
-
(llm-chat-prompt-interaction-content
- interaction))))
- (llm-chat-prompt-interactions
- (ellama-session-prompt
- ellama--current-session))))
- (setq ellama--current-request nil)
- (ellama-request-mode -1)))
- (lambda (_ msg)
- (with-current-buffer buffer
- (cancel-change-group ellama--change-group)
- (when ellama-spinner-enabled
- (spinner-stop))
- (funcall errcb msg)
- (setq ellama--current-request nil)
- (ellama-request-mode -1))))))
+ (let* ((handler (ellama--handle-partial insert-text insert-reasoning
reasoning-buffer))
+ (request (llm-chat-streaming
+ provider
+ llm-prompt
+ handler
+ (lambda (response)
+ (let ((text (plist-get response :text))
+ (reasoning (plist-get response :reasoning)))
+ (funcall handler response)
+ (when (or ellama--current-session
+ (not reasoning))
+ (kill-buffer reasoning-buffer))
+ (with-current-buffer buffer
+ (accept-change-group ellama--change-group)
+ (when ellama-spinner-enabled
+ (spinner-stop))
+ (if (and (listp donecb)
+ (functionp (car donecb)))
+ (mapc (lambda (fn) (funcall fn text))
+ donecb)
+ (funcall donecb text))
+ (when ellama-session-hide-org-quotes
+ (ellama-collapse-org-quotes))
+ (setq ellama--current-request nil)
+ (ellama-request-mode -1))))
+ (lambda (_ msg)
+ (with-current-buffer buffer
+ (cancel-change-group ellama--change-group)
+ (when ellama-spinner-enabled
+ (spinner-stop))
+ (funcall errcb msg)
+ (setq ellama--current-request nil)
+ (ellama-request-mode -1)))
+ t)))
(with-current-buffer buffer
(setq ellama--current-request request)))))))
-(defun ellama-set-markers (start end point)
- "Set markers for START and END positions at POINT."
- (set-marker start point)
- (set-marker end point)
- (set-marker-insertion-type start nil)
- (set-marker-insertion-type end t))
-
(defun ellama-chain (initial-prompt forms &optional acc)
"Call chain of FORMS on INITIAL-PROMPT.
ACC will collect responses in reverse order (previous answer will be on top).
diff --git a/tests/test-ellama.el b/tests/test-ellama.el
index 022c0605b0..ddb1a04555 100644
--- a/tests/test-ellama.el
+++ b/tests/test-ellama.el
@@ -37,15 +37,17 @@
(ert-deftest test-ellama-code-improve ()
(let ((original "(hello)\n")
- (improved "```lisp\n(hello)\n```"))
+ (improved "```lisp\n(hello)\n```")
+ prev-lines)
(with-temp-buffer
(insert original)
(cl-letf (((symbol-function 'llm-chat-streaming)
- (lambda (_provider prompt partial-callback response-callback
_error-callback)
+ (lambda (_provider prompt partial-callback response-callback
_error-callback _multi-output)
(should (string-match original (llm-chat-prompt-to-text
prompt)))
- (cl-loop for i from 0 to (- (length improved) 1)
- do (funcall partial-callback (substring improved 0
i)))
- (funcall response-callback improved))))
+ (dolist (s (string-lines improved))
+ (funcall partial-callback `(:text ,(concat prev-lines s)))
+ (setq prev-lines (concat prev-lines s)))
+ (funcall response-callback `(:text ,improved)))))
(ellama-code-improve)
(should (equal original (buffer-string)))))))
@@ -435,6 +437,31 @@ _more italic_")))
$P_\\theta$
/more italic/"))))
+(defun ellama-test-max-common-prefix ()
+ "Test the `ellama-max-common-prefix` function."
+ (should (equal (ellama-max-common-prefix "" "") ""))
+ (should (equal (ellama-max-common-prefix "abc" "abcd") "abc"))
+ (should (equal (ellama-max-common-prefix "abcd" "abc") "abc"))
+ (should (equal (ellama-max-common-prefix "abcdef" "abcefg") "abc"))
+ (should (equal (ellama-max-common-prefix "a" "b") ""))
+ (should (equal (ellama-max-common-prefix "a" "") ""))
+ (should (equal (ellama-max-common-prefix "" "b") "")))
+
+(ert-deftest ellama-test-max-common-prefix ()
+ "Run the tests for `ellama-max-common-prefix`."
+ (ellama-test-max-common-prefix))
+
+(ert-deftest ellama--string-without-last-line-test ()
+ "Test `ellama--string-without-last-line` function."
+ (should (equal (ellama--string-without-last-line "Line1\nLine2\nLine3")
+ "Line1\nLine2"))
+ (should (equal (ellama--string-without-last-line "SingleLine")
+ ""))
+ (should (equal (ellama--string-without-last-line "")
+ ""))
+ (should (equal (ellama--string-without-last-line "Line1\nLine2")
+ "Line1")))
+
(provide 'test-ellama)
;;; test-ellama.el ends here
