Function: gptel-send--steer

gptel-send--steer is a natively compiled function defined in gptel.el.

Signature

(gptel-send--steer)

Documentation

Mark active region or text following a response as a steering message.

Source Code

;; Defined in /nix/store/q3r7g81pvghw7a523kjk2k2zih3pfk8z-emacs-packages-deps/share/emacs/site-lisp/elpa/gptel-20261002.545/gptel.el
(defun gptel-send--steer ()
  "Mark active region or text following a response as a steering message."
  (unless (gptel--fsm-live-p)
    (user-error "No active gptel request in this buffer; nothing to steer"))
  (if-let* (((eq (get-pos-property (point) 'gptel) 'steer))
            (ov (or (cdr (get-char-property-and-overlay (point) 'gptel))
                    (cdr (get-char-property-and-overlay (1- (point)) 'gptel)))))
      ;; Cancel pending steering message
      (progn (delete-overlay ov) (message "Steering message canceled"))
    (let* ((info (gptel-fsm-info gptel--fsm-last))
           (sm (plist-get info :position))
           (tracking-marker (plist-get info :tracking-marker))
           (bounds                      ;Find the bounds of the steering prompt
            (cond
             ((use-region-p) (deactivate-mark) (car-safe (region-bounds)))
             ((and tracking-marker (> (point) tracking-marker))
              (cons (save-excursion
                      (goto-char tracking-marker) (skip-chars-forward " \t\n")
                      (point))
                    (point)))
             ((and (>= (point) sm) (not (get-text-property (point) 'gptel)))
              (cons (save-excursion
                      (goto-char        ;Go to start of steering message
                       (max (previous-single-property-change ;below response
                             (point) 'gptel nil (or sm (point-min)))
                            (previous-single-property-change ;below pending tool call
                             (point) 'read-only nil (or sm (point-min)))))
                      (skip-chars-forward " \r\t\n") (point))
                    (point))))))
      (unless (and bounds (> (cdr bounds) (car bounds)))
        (user-error "No steering message at point"))
      (letrec ((steer-ov (make-overlay (car bounds) (cdr bounds) nil t t))
               (clear-steer-ov
                (lambda (req-info)
                  (plist-put req-info :post
                             (delete move-steer-msg (plist-get req-info :post)))
                  (when-let* ((obuf (overlay-buffer steer-ov))
                              (beg (overlay-start steer-ov))
                              (end (overlay-end steer-ov))
                              (msg (string-trim-right
                                    (buffer-substring-no-properties beg end))))
                    (with-current-buffer obuf
                      (delete-region beg end) (delete-overlay steer-ov))
                    (if (string-blank-p msg)
                        (message "Buffer \"%s\": steering message is blank, canceling"
                                 (buffer-name obuf))
                      (plist-put req-info :steering-message msg)))))
               (move-steer-msg (lambda (req-info)
                                 (funcall clear-steer-ov req-info)
                                 (gptel-send--steer-relocate req-info))))
        (overlay-put steer-ov 'gptel 'steer)
        (overlay-put steer-ov 'evaporate t)
        (overlay-put steer-ov 'face 'warning)
        (overlay-put
         steer-ov 'before-string
         (concat (propertize "QUEUED" 'face '(:inherit shadow :box -1))
                 (propertize ": " 'face 'shadow)))
        (plist-put info :post (cons move-steer-msg (plist-get info :post)))
        (plist-put info :post-tool
                   (cons clear-steer-ov (plist-get info :post-tool)))))))