Add GitHub CI workflow, for running ERT

.github/workflows/commits.yml

@@ -0,0 +1,14 @@
+name: Lint Commit Messages
+on: [pull_request]
+jobs:
+  lint:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+
+      - name: Check commit messages
+        run: |
+          for sha in $(git rev-list origin/main..HEAD); do
+            msg=$(git log --format=%B -n 1 $sha)
+            echo "$msg" | grep -E "^(feat|fix|docs|chore): .{10,}$" || exit 1
+          done

.github/workflows/ert.yml

@@ -0,0 +1,37 @@
+name: Emacs ERT Tests
+
+on: [push, pull_request]
+
+jobs:
+  test:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: purcell/setup-emacs@master
+        with:
+          version: '30.1'
+
+      - name: Run ERT tests
+        run: |
+          git submodule update --init --recursive
+          cd test
+          emacs -Q -L .. -L . \
+            --eval "(progn
+                      (require 'package)
+                      (add-to-list 'package-archives '(\"melpa\" . \"https://melpa.org/packages/\") t)
+                      (add-to-list 'package-archives '(\"gnu\" . \"https://elpa.gnu.org/packages/\") t)
+                      (package-initialize)
+                      (setq package-install-upgrade-built-in t)
+                      (package-refresh-contents)
+                      (package-install 'transient)
+                      ;; Verify version
+                      (require 'transient)
+                      (message \"Transient version: %s\" (package-desc-version (package-get-descriptor 'transient)))
+                      (require 'compat)
+                      (message \"Compat version: %s\" (package-desc-version (package-get-descriptor 'compat))))" \
+            $(find .. -mindepth 1 -maxdepth 1 \
+              \( -name '.*.el' -prune -o -name '*.el' -type f -printf ' -l %p' \)) \
+            $(find . -mindepth 1 -maxdepth 1 \
+              \( -name '.*.el' -prune -o -name '*.el' -type f -printf ' -l %p' \)) \
+            -l ert --batch -f ert-run-tests-batch-and-exit

gptel-context.el

@@ -56,18 +56,25 @@
 This is used in gptel context buffers."
   :group 'gptel)
 
-(defcustom gptel-context-wrap-function #'gptel-context--wrap-default
-  "Function to format the context string sent with the gptel request.
+(defvar gptel-context-wrap-function nil
+  "Function to format the context string sent with the gptel request.")
+(make-obsolete-variable
+ 'gptel-context-wrap-function
+ "Custom functions for wrapping context are no longer supported by gptel.\
+  See `gptel-context--wrap-in-buffer' for details."
+ "0.9.9")
 
-This function receives two argument, the message to wrap with the
-context, and an alist of contexts organized by buffer.  It should
-return a string containing the message and the context, formatted as
-necessary.
+(defcustom gptel-context-string-function #'gptel-context--string
+  "Function to prepare the context string sent with the gptel request.
 
-The message is either the system message or the last user prompt,
-as configured by `gptel-use-context'.
+This function can be synchronous or asynchronous, and receives one or
+two arguments respectively.
 
-The alist of contexts is structured as follows:
+Synchronous: An alist of contexts with buffers or files (the context
+alist).
+Asynchronous: A callback to call with the result, and the context alist.
+
+The context alist is structured as follows:
 
  ((buffer1 . (overlay1 overlay2)
   (\"path/to/file\")
@@ -286,25 +293,57 @@ ADVANCE controls the overlay boundary behavior."
     overlay))
 
 ;;;###autoload
-(defun gptel-context--wrap (message)
-  "Wrap MESSAGE with context string."
-  (funcall gptel-context-wrap-function
-           message (gptel-context--collect)))
-
-(defun gptel-context--wrap-default (message contexts)
-  "Add CONTEXTS to MESSAGE.
-
-MESSAGE is usually either the system message or the user prompt.
-The accumulated context from CONTEXTS is appended or prepended to
-it, respectively."
-  ;; Append context before/after system message.
-  (let ((context-string (gptel-context--string contexts)))
-    (if (> (length context-string) 0)
-        (pcase-exhaustive gptel-use-context
-          ('system (concat message "\n\n" context-string))
-          ('user   (concat context-string "\n\n" message))
-          ('nil    message))
-      message)))
+(defun gptel-context--wrap (callback data-buf)
+  "Add request context to DATA-BUF and run CALLBACK.
+
+DATA-BUF is the buffer where the request prompt is constructed."
+  (if (= (car (func-arity gptel-context-string-function)) 2)
+      (funcall gptel-context-string-function
+               (lambda (c) (with-current-buffer data-buf
+                        (gptel-context--wrap-in-buffer c))
+                 (funcall callback))
+               (gptel-context--collect))
+    (with-current-buffer data-buf
+      (thread-last (gptel-context--collect)
+                   (funcall gptel-context-string-function)
+                   (gptel-context--wrap-in-buffer)))
+    (funcall callback)))
+
+(defun gptel-context--wrap-in-buffer (context-string &optional method)
+  "Inject CONTEXT-STRING to current buffer using METHOD.
+
+METHOD is either system or user, and defaults to `gptel-use-context'.
+This modifies the buffer."
+  (when (length> context-string 0)
+    (pcase (or method gptel-use-context)
+      ('system
+       (if (gptel--model-capable-p 'nosystem)
+           (gptel-context--wrap-in-buffer context-string 'user)
+         (if gptel--system-message
+             (cl-etypecase gptel--system-message
+               (string
+                (setq gptel--system-message
+                      (concat gptel--system-message "\n\n" context-string)))
+               (function
+                (setq gptel--system-message
+                      (gptel--parse-directive gptel--system-message 'raw))
+                (gptel-context--wrap-in-buffer context-string))
+               (list
+                (setq gptel--system-message ;cons a new list to avoid mutation
+                      (cons (concat (car gptel--system-message) "\n\n" context-string)
+                            (cdr gptel--system-message)))))
+           (setq gptel--system-message context-string))))
+      ('user
+       (goto-char (point-max))
+       (text-property-search-backward 'gptel nil t)
+       (and gptel-mode
+            (looking-at
+             (concat "[\n[:blank:]]*"
+                     (and-let* ((prefix (gptel-prompt-prefix-string))
+                                ((not (string-empty-p prefix))))
+                       (concat "\\(?:" (regexp-quote prefix) "\\)?"))))
+            (delete-region (match-beginning 0) (match-end 0)))
+       (insert "\n" context-string "\n\n")))))
 
 (defun gptel-context--collect-media (&optional contexts)
   "Collect media CONTEXTS.

gptel-curl.el

@@ -165,7 +165,13 @@ the response is inserted into the current buffer after point."
           (progn (set-process-sentinel process #'gptel-curl--stream-cleanup)
                  (set-process-filter process #'gptel-curl--stream-filter))
         (set-process-sentinel process #'gptel-curl--sentinel))
-      (setf (alist-get process gptel--request-alist) fsm))))
+      (setf (alist-get process gptel--request-alist)
+            (cons fsm
+                  #'(lambda ()
+                      ;; Clean up Curl process
+                      (set-process-sentinel process #'ignore)
+                      (delete-process process)
+                      (kill-buffer (process-buffer process))))))))
 
 ;; ;; Ahead-Of-Time dispatch code for the parsers
 ;; :parser ; FIXME `cl--generic-*' are internal functions
@@ -211,7 +217,7 @@ PROC-INFO is the plist containing process metadata."
 
 PROCESS and _STATUS are process parameters."
   (let ((proc-buf (process-buffer process)))
-    (let* ((fsm (alist-get process gptel--request-alist))
+    (let* ((fsm (car (alist-get process gptel--request-alist)))
            (info (gptel-fsm-info fsm))
            (http-status (plist-get info :http-status)))
       (when gptel-log-level (gptel-curl--log-response proc-buf info)) ;logging
@@ -283,7 +289,7 @@ Optional RAW disables text properties and transformation."
      (gptel--display-tool-results tool-results info))))
 
 (defun gptel-curl--stream-filter (process output)
-  (let* ((fsm (alist-get process gptel--request-alist))
+  (let* ((fsm (car (alist-get process gptel--request-alist)))
          (proc-info (gptel-fsm-info fsm))
          (callback (or (plist-get proc-info :callback)
                        #'gptel-curl--stream-insert-response)))
@@ -386,7 +392,7 @@ See `gptel-curl--get-response' for its contents.")
 PROCESS and _STATUS are process parameters."
   (let ((proc-buf (process-buffer process)))
     (when-let* (((eq (process-status process) 'exit))
-                (fsm (alist-get process gptel--request-alist))
+                (fsm (car (alist-get process gptel--request-alist)))
                 (proc-info (gptel-fsm-info fsm))
                 (proc-callback (plist-get proc-info :callback)))
       (when gptel-log-level (gptel-curl--log-response proc-buf proc-info)) ;logging

gptel-org.el

@@ -188,26 +188,22 @@ current heading and the cursor position."
                                  50))))))
   (when (stringp topic) (org-set-property "GPTEL_TOPIC" topic)))
 
-;; NOTE: This can be converted to a cl-defmethod for `gptel--parse-buffer'
-;; (conceptually cleaner), but will cause load-order issues in gptel.el and
-;; might be harder to debug.
-(defun gptel-org--create-prompt (&optional prompt-end)
-  "Return a full conversation prompt from the contents of this Org buffer.
-
-If `gptel--num-messages-to-send' is set, limit to that many
-recent exchanges.
-
-The prompt is constructed from the contents of the buffer up to
-point, or PROMPT-END if provided.  Its contents depend on the
-value of `gptel-org-branching-context', which see."
+;; NOTE: This can be converted to a cl-defmethod for
+;; `gptel--create-prompt-buffer' (conceptually cleaner), but will cause
+;; load-order issues in gptel.el and might be harder to debug.
+(defun gptel-org--create-prompt-buffer (&optional prompt-end)
+  "Return a buffer with the conversation prompt to be sent.
+
+If the region is active limit the prompt text to the region contents.
+Otherwise the prompt text is constructed from the contents of the
+current buffer up to point, or PROMPT-END if provided.  Its contents
+depend on the value of `gptel-org-branching-context', which see."
   (when (use-region-p)
     (narrow-to-region (region-beginning) (region-end)))
   (if prompt-end
       (goto-char prompt-end)
     (setq prompt-end (point)))
-  (let ((max-entries (and gptel--num-messages-to-send
-                          (* 2 gptel--num-messages-to-send)))
-        (topic-start (gptel-org--get-topic-start)))
+  (let ((topic-start (gptel-org--get-topic-start)))
     (when topic-start
       ;; narrow to GPTEL_TOPIC property scope
       (narrow-to-region topic-start prompt-end))
@@ -251,17 +247,15 @@ value of `gptel-org-branching-context', which see."
               (gptel-org--unescape-tool-results)
               (gptel-org--strip-block-headers)
               (when gptel-org-ignore-elements (gptel-org--strip-elements))
-              (save-excursion (run-hooks 'gptel-prompt-filter-hook))
-              (gptel--parse-buffer gptel-backend max-entries))))
+              (current-buffer))))
       ;; Create prompt the usual way
       (let ((org-buf (current-buffer))
             (beg (point-min)))
         (gptel--with-buffer-copy org-buf beg prompt-end
           (gptel-org--unescape-tool-results)
           (gptel-org--strip-block-headers)
           (when gptel-org-ignore-elements (gptel-org--strip-elements))
-          (save-excursion (run-hooks 'gptel-prompt-filter-hook))
-          (gptel--parse-buffer gptel-backend max-entries))))))
+          (current-buffer))))))
 
 (defun gptel-org--strip-elements ()
   "Remove all elements in `gptel-org-ignore-elements' from the

gptel-rewrite.el

@@ -642,6 +642,7 @@ generated from functions."
                (overlay-put ov 'evaporate t)
                ;; NOTE: Switch to `generate-new-buffer' after we drop Emacs 27.1 (#724)
                (cons ov (gptel--temp-buffer " *gptel-rewrite*")))
+             :transforms gptel-prompt-transform-functions
              :callback #'gptel--rewrite-callback)
       ;; Move back so that the cursor is on the overlay when done.
       (unless (get-char-property (point) 'gptel-rewrite)

gptel-transient.el

@@ -1482,6 +1482,7 @@ This sets the variable `gptel-include-tool-results', which see."
                  (gptel--merge-additional-directive system-extra)
                gptel--system-message)
              :callback callback
+             :transforms gptel-prompt-transform-functions
              :fsm (gptel-make-fsm :handlers gptel-send--handlers)
              :dry-run dry-run)