Remove superfluous hooks and start cleanup

* gptel-transient.el (gptel--get-directive,
gptel--infix-add-directive, gptel-menu): Rename the
directive-related functions to be shorter/more consistent with the
rest of the code.

gptel--additional-directive     -> gptel--infix-add-directive
gptel--additional-directive-get -> gptel--get-directive

gptel-contexter.el

@@ -0,0 +1,444 @@
+;;; gptel-contexter.el --- Context aggregator for GPTel
+
+;; Copyright (C) 2023  Karthik Chikmagalur
+
+;; Author: daedsidog <contact@daedsidog.com>
+;; Keywords: convenience, buffers
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The contexter allows you to conveniently create contexts which can be fed
+;; to GPTel.
+
+;;; Code:
+
+;;; -*- lexical-binding: t -*-
+
+(require 'cl-lib)
+
+;; We need a minor mode for a custom keymap, so that we may be able to remove
+;; contexts directly from the contexts buffer.
+(define-minor-mode gptel-context-mode
+  "A minor mode for working with context."
+  :lighter " GPTel Context"
+  :keymap (let ((map (make-sparse-keymap)))
+            (define-key map (kbd "c")
+                        'gptel-remove-context-at-point)
+            map))
+
+(defcustom gptel-context-highlight-face 'header-line
+  "Face to use to highlight selected context in the buffers."
+  :group 'gptel
+  :type 'symbol)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ------------------------------ FUNCTIONS ------------------------------- ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun gptel-add-context (&optional arg)
+  "Add context to GPTel.
+
+When called regularly, adds current buffer as context.
+When ARG is positive, prompts for buffer name to add as context.
+When ARG is negative, removes current buffer from context.
+When called in `dired-mode', adds selected files as context.
+When called with region selected, adds selected region as context."
+  (interactive)
+  (cond
+   ;; A region is selected.
+   ((use-region-p)
+    (gptel--add-region-as-context (current-buffer)
+                                  (region-beginning)
+                                  (region-end))
+    (deactivate-mark))
+   ;; No region is currently selected, so delete a context under point if there
+   ;; is one.
+   ((gptel-context-at-point)
+    (gptel-delete-context (gptel-context-at-point))
+    (message "Context under point has been deleted."))))
+  
+(defun gptel--make-context-overlay (start end)
+  "Highlight the region from START to END."
+  (let ((overlay (make-overlay start end)))
+    (overlay-put overlay 'face gptel-context-highlight-face)
+    (overlay-put overlay 'gptel-context t)
+    overlay))
+
+(cl-defun gptel--add-region-as-context (buffer start end)
+  "Add the region delimited by START and END in BUFFER as context."
+  ;; Remove existing contexts in the same region, if any.
+  (mapc #'gptel-delete-context
+        (gptel-contexts-in-region buffer start end))
+  (let ((start (make-marker))
+        (end (make-marker)))
+    (set-marker start (region-beginning) (current-buffer))
+    (set-marker end (region-end) (current-buffer))
+    ;; Trim the unnecessary parts of the context content.
+    (let* ((content (buffer-substring-no-properties start end))
+           (fat-at-end (progn
+                         (let ((match-pos
+                                (string-match-p (rx (+ (any "\t" "\n" " ")) eos)
+                                                content)))
+                           (when match-pos
+                             (- (- end start) match-pos)))))
+           (fat-at-start (progn
+                           (when (string-match (rx bos (+ (any "\t" "\n" " ")))
+                                               content)
+                             (match-end 0)))))
+      (when fat-at-start
+        (set-marker start (+ start fat-at-start)))
+      (when fat-at-end
+        (set-marker end (- end fat-at-end))))
+    (when (= start end)
+      (message "No content in selected region.")
+      (cl-return-from gptel--add-region-to-contexts nil))
+    ;; First, highlight the region.
+    (prog1 (gptel--make-context-overlay start end)
+      (message "Region added to context buffer."))))
+
+;;;###autoload
+(defun gptel-contexts-in-region (buffer start end)
+  "Return the list of context overlays in the given region, if any, in BUFFER.
+START and END signify the region delimiters."
+  (with-current-buffer buffer
+    (cl-remove-if-not #'(lambda (overlay)
+                          (overlay-get overlay 'gptel-context))
+                      (overlays-in start end))))
+
+;;;###autoload
+(defun gptel-context-at-point ()
+  "Return the context overlay at point, if any."
+  (car (overlays-in (point) (point))))
+
+;;;###autoload
+(defun gptel-delete-context (context)
+  "Remove the CONTEXT overlay from the contexts list."
+  (delete-overlay context))
+
+;;;###autoload
+(defun gptel-contexts ()
+  "Get the list of all context overlays in all active buffers."
+  (cl-remove-if-not #'(lambda (ov)
+                        (overlay-get ov 'gptel-context))
+                    (let ((all-overlays '()))
+                      (dolist (buf (buffer-list))
+                        (with-current-buffer buf
+                          (setq all-overlays
+                                (append all-overlays
+                                        (overlays-in (point-min)
+                                                     (point-max))))))
+                      all-overlays)))
+
+;;;###autoload
+(defun gptel-delete-all-contexts ()
+  "Clear all contexts."
+  (interactive)
+  (mapc #'gptel-delete-context
+        (gptel-contexts)))
+
+;;;###autoload
+(defun gptel-major-mode-md-prog-lang (mode)
+  "Get the Markdown programming language string for the given MODE."
+  (cond
+   ((eq mode 'emacs-lisp-mode) "emacs-lisp")
+   ((eq mode 'lisp-mode) "common-lisp")
+   ((eq mode 'c-mode) "c")
+   ((eq mode 'c++-mode) "c++")
+   ((eq mode 'javascript-mode) "javascript")
+   ((eq mode 'python-mode) "python")
+   ((eq mode 'ruby-mode) "ruby")
+   ((eq mode 'java-mode) "java")
+   ((eq mode 'go-mode) "go")
+   ((eq mode 'rust-mode) "rust")
+   ((eq mode 'haskell-mode) "haskell")
+   ((eq mode 'scala-mode) "scala")
+   ((eq mode 'kotlin-mode) "kotlin")
+   ((eq mode 'typescript-mode) "typescript")
+   ((eq mode 'css-mode) "css")
+   ((eq mode 'html-mode) "html")
+   ((eq mode 'xml-mode) "xml")
+   ((eq mode 'swift-mode) "swift")
+   ((eq mode 'perl-mode) "perl")
+   ((eq mode 'php-mode) "php")
+   ((eq mode 'csharp-mode) "csharp")
+   ((eq mode 'sql-mode) "sql")
+   (t "")))
+
+(cl-defun gptel--compress-code (code given-major-mode)
+  "Return a string which represents CODE with superfluous information removed.
+GIVEN-MAJOR-MODE helps determine the method of compression."
+  (with-temp-buffer
+    (insert code)
+    (goto-char (point-min))
+    (cond
+     ((member given-major-mode '(emacs-lisp-mode lisp-mode))
+      (let (form-start form-end)
+        (while (search-forward-regexp
+                (concat "\\(("
+                        (regexp-opt '("defun*" "defun" "defmacro" "cl-defun"))
+                        "[^)]+\\)")
+                nil
+                t)
+          ;; We are at the name of the form.
+          (ignore-errors (while t (backward-up-list)))
+          ;; We are at the start of the sexp.
+          (setq form-start (point))
+          ;; If error, exit function.
+          (ignore-errors (forward-sexp)
+                         (setq form-end (point)))
+          (if (null form-end) (cl-return-from gptel--compress-code code))
+          ;; We are at the end of the sexp.
+          (goto-char form-start)
+          (forward-char 1)
+          ;; Docstring should be four sexps down the line.
+          (forward-sexp)
+          (forward-sexp)
+          (forward-sexp)
+          (forward-sexp)
+          ;; If there is a docstring, we should be at its end.
+          (when (eq (char-before) ?\")
+            ;; We are, in fact, at the end of the docstring.
+            ;; Get the indendation to be used for the next line.
+            (backward-sexp)
+            (let ((indentation (current-column)))
+              (forward-sexp)
+              ;; Remove everything from this point until the end of the form.
+              (delete-region (point) form-end)
+              (insert "\n" (make-string indentation ? )))
+            (insert "...)"))))))
+    (buffer-substring (point-min) (point-max))))
+
+(defun gptel--regions-inline-p (buffer previous-region current-region)
+  "Return non-nil if CURRENT-REGION begins on the line PREVIOUS-REGION ends in.
+This check pertains only to regions in BUFFER.
+
+PREVIOUS-REGION and CURRENT-REGION should be cons cells (START . END) which
+representthe regions' boundaries within BUFFER."
+  (with-current-buffer buffer
+    (let ((prev-line-end (line-number-at-pos (cdr previous-region)))
+          (curr-line-start (line-number-at-pos (car current-region))))
+      (= prev-line-end curr-line-start))))
+
+(defun gptel--regions-continuous-p (buffer previous-region current-region)
+  "Return non-nil if CURRENT-REGION is a continuation of PREVIOUS-REGION.
+Pretains only to regions in BUFFER.
+
+A region is considered a continuation of another if it is only separated by
+newlines and whitespaces.  PREVIOUS-REGION and CURRENT-REGION should be cons
+cells (START . END) representing the boundaries of the regions within BUFFER."
+  (with-current-buffer buffer
+    (let ((gap (buffer-substring-no-properties
+                (cdr previous-region) (car current-region))))
+      (string-match-p
+       (rx bos (* (any "\t" "\n" " ")) eos)
+       gap))))
+
+(defun gptel-context-substring (buffer regions &optional compress-code)
+  "Create a context substring from the REGIONS in BUFFER.
+If COMPRESS-CODE is non-nil, try to compress code to save space.
+REGIONS is a list of pairs of (start, end) lists."
+  (with-temp-buffer
+    (let ((buffer-file
+           ;; Use file path if buffer has one, otherwise use its regular name.
+           (if (buffer-file-name buffer)
+               (format "`%s`"
+                       (buffer-file-name buffer))
+             (format "buffer `%s`"
+                     (buffer-name buffer)))))
+      (insert (format "In %s:" buffer-file)))
+    (let ((is-top-snippet t)
+          previous-region
+          buffer-point-min
+          buffer-point-max
+          prog-lang-tag)
+      (with-current-buffer buffer
+        (setq buffer-point-min (save-excursion
+                                 (goto-char (point-min))
+                                 (skip-chars-forward " \t\n\r")
+                                 (point))
+              buffer-point-max (save-excursion
+                                 (goto-char (point-max))
+                                 (skip-chars-backward " \t\n\r")
+                                 (point))
+              prog-lang-tag (gptel-major-mode-md-prog-lang
+                             major-mode)))
+      (insert "\n\n```" prog-lang-tag "\n")
+      (cl-loop for (start end) in regions do
+               (progn
+                 (let* ((region-inline
+                         ;; Does the current region start on the same line the
+                         ;; previous region ends?
+                         (when previous-region
+                           (gptel--regions-inline-p buffer
+                                                    previous-region
+                                                    (cons start end))))
+                        (region-continuous
+                         ;; Is the current region a continuation of the previous
+                         ;; region? I.e., is it only separated by newlines and
+                         ;; whitespaces?
+                         (when previous-region
+                           (gptel--regions-continuous-p buffer
+                                                        previous-region
+                                                        (cons start end)))))
+                   (unless (<= start buffer-point-min)
+                     (if region-continuous
+                         ;; If the regions are continuous, insert the
+                         ;; whitespaces that separate them.
+                         (insert-buffer-substring buffer
+                                                  (cdr previous-region)
+                                                  start)
+                       ;; Regions are not continuous. Are they on the same line?
+                       (if region-inline
+                           ;; Region is inline but not continuous, so we should
+                           ;; just insert an ellipsis.
+                           (insert " ... ")
+                         ;; Region is neither inline nor continuous, so just
+                         ;; insert an ellipsis on a new line.
+                         (unless is-top-snippet
+                           (insert "\n"))
+                         (insert "...")))
+                     (let (lineno)
+                       (with-current-buffer buffer
+                         (setq lineno (line-number-at-pos start)))
+                       ;; We do not need to insert a line number indicator on
+                       ;; inline regions.
+                       (unless (or region-inline region-continuous)
+                         (insert (format " (Line %d)\n" lineno)))))
+                   (when (and (not region-inline)
+                              (not region-continuous)
+                              (not is-top-snippet))
+                     (insert "\n"))
+                   (if is-top-snippet
+                       (setq is-top-snippet nil))
+                   (let (substring)
+                     (with-current-buffer buffer
+                       (setq substring
+                             (if compress-code
+                                 (gptel--compress-code
+                                  (buffer-substring start end)
+                                  major-mode)
+                               (buffer-substring start end))))
+                     (let (ss-start ss-end)
+                       (setq ss-start (point))
+                       (insert substring)
+                       (setq ss-end (point))
+                       ;; Save the context as a text property, so
+                       ;; that we may later be able to delete the
+                       ;; context snippet from the context buffer.
+                       (put-text-property
+                        ss-start ss-end
+                        'gptel--context
+                        (cons buffer
+                              (list
+                               (list start end)))))))
+                 (setq previous-region (cons start end))))
+      (unless (>= (cl-second (car (last regions))) buffer-point-max)
+        (insert "\n..."))
+      (insert "\n```"))
+    (buffer-substring (point-min) (point-max))))
+
+(defun gptel--refresh-context-buffer ()
+  "Write the actual context to the context buffer.
+This might require optimization later on."
+  (gptel--ensure-context-buffer-exists)
+  (setq gptel--current-highlight-region nil)
+  (with-current-buffer gptel--context-buffer
+    (with-silent-modifications
+      (erase-buffer)
+      (cl-loop for (buffer . regions) in gptel--contexts-alist do
+               (progn
+                 (unless (= (point) (point-min))
+                   (insert "\n\n"))
+                 (insert (gptel-context-substring buffer regions t)))))))
+
+;;;###autoload
+(defun gptel-remove-context-at-point-from-context-buffer ()
+  "Remove the context entry at the current point inside the context buffer.
+Does nothing if there is no entry at the current point."
+  (interactive)
+  (unless (eq (current-buffer) gptel--context-buffer)
+    (error "This function can only be used inside the context buffer"))
+  (let ((context (get-text-property (point) 'gptel--context)))
+    (gptel-remove-context context))
+  (gptel--refresh-context-buffer)
+  (when (> gptel--context-buffer-point (point-max))
+    (setq gptel--context-buffer-point (point-max)))
+  (goto-char gptel--context-buffer-point)
+  (gptel--highlight-selected-context-in-context-buffer))
+
+(defun gptel--text-property-from-point-region (property from-point)
+  "Find the region around FROM-POINT that has a specific text PROPERTY."
+  (let ((start (or from-point (point)))
+        (end (or from-point (point))))
+    ;; Search backwards for the start of the property region.
+    (while (and (> start (point-min))
+                (get-text-property (1- start) property))
+      (setq start (1- start)))
+    ;; If the exact property is not at the start, move one character forward.
+    (unless (get-text-property start property)
+      (setq start (next-single-property-change start property nil (point-max))))
+    ;; Search forwards for the end of the property region.
+    (while (and (< end (point-max))
+                (get-text-property end property))
+      (setq end (1+ end)))
+    ;; Return the region as a list.
+    (list start end)))
+
+(defun gptel--highlight-selected-context-in-context-buffer ()
+  "Highlight the selected context within the context buffer.
+In essence, just highlights the context where the point is in the buffer."
+  (unless (eq (current-buffer) gptel--context-buffer)
+    (error "This function can only be used inside the context buffer"))
+  (let* ((context (get-text-property (point) 'gptel--context))
+         (current-region (gptel--text-property-from-point-region
+                          'gptel--context
+                          (point)))
+         (start (cl-first current-region))
+         (end (cl-second current-region))
+         (current-start (cl-first gptel--current-highlight-region))
+         (current-end (cl-second gptel--current-highlight-region)))
+    (when (and gptel--current-highlight-region
+               (not (and (= start current-start)
+                         (= end current-end))))
+      ;; Current context is not the one under the point, so unhighlight it.
+      (gptel--unhighlight-region current-start current-end)
+      (setq gptel--current-highlight-region nil))
+    (when context
+      (gptel--make-context-region start end)
+      (setq gptel--current-highlight-region (list start end)))))
+
+(cl-defun gptel--monitor-context-buffer-point-change ()
+  "Monitor change in the point position within the context buffer.
+Used mainly for selecting contexts when the point has moved."
+  (unless (eq (current-buffer) gptel--context-buffer)
+    (cl-return-from gptel--monitor-context-buffer-point-change))
+  (unless (and gptel--context-buffer-point
+               (= (point) gptel--context-buffer-point))
+    (setq gptel--context-buffer-point (point))
+    (gptel--highlight-selected-context-in-context-buffer)))
+
+;;;###autoload
+(defun gptel-context-string ()
+  "Return the string of all the contexts."
+  (gptel--ensure-context-buffer-exists)
+  (with-current-buffer gptel--context-buffer
+    (buffer-substring-no-properties (point-min) (point-max))))
+
+(provide 'gptel-contexter)
+;;; gptel-contexter.el ends here.

gptel-transient.el

@@ -116,21 +116,26 @@ which see."
   "Change parameters of prompt to send to the LLM."
   ;; :incompatible '(("-m" "-n" "-k" "-e"))
   [:description
-   (lambda () (format "Directive:  %s"
+   (lambda ()
-                 (truncate-string-to-width
+     (string-replace
-                  gptel--system-message (max (- (window-width) 14) 20) nil nil t)))
+      "\n" "⮐ "
-   ("h" "Set directives for chat" gptel-system-prompt :transient t)]
+      (truncate-string-to-width
-  [["Session Parameters"
+       gptel--system-message (max (- (window-width) 6) 14) nil nil t)))
+   [""
+    "Instructions"
+    ("s" "Set system message" gptel-system-prompt :transient t)
+    (gptel--infix-add-directive :if (lambda () gptel-expert-commands))]]
+  [["Model Parameters"
     (gptel--infix-provider)
     ;; (gptel--infix-model)
     (gptel--infix-max-tokens)
     (gptel--infix-num-messages-to-send)
-    (gptel--infix-temperature)]
+    (gptel--infix-temperature :if (lambda () gptel-expert-commands))]
    ["Prompt from"
     ("p" "Minibuffer instead" "p")
     ("y" "Kill-ring instead" "y")
     ""
-    ("i" "Replace/Delete prompt" "i")]
+    ("i" "Respond in place" "i")]
     ["Response to"
     ("m" "Minibuffer instead" "m")
     ("g" "gptel session" "g"
@@ -175,19 +180,29 @@ which see."
      :transient t)
     ("E" "Ediff previous" gptel--ediff
      :if gptel--at-response-history-p)]
-   ["Inspect"
+   ["Dry Run" :if (lambda () (or gptel-log-level gptel-expert-commands))
-    ("I" "Query as Lisp"
+    ("I" "Inspect query (Lisp)"
      (lambda ()
        "Inspect the query that will be sent as a lisp object."
        (interactive)
-       (gptel--sanitize-model)
+       (let* ((extra (gptel--get-directive
-       (gptel--inspect-query)))
+                      (transient-args
-    ("J" "Query as JSON"
+                       transient-current-command)))
+              (gptel--system-message
+               (concat gptel--system-message extra)))
+         (gptel--sanitize-model)
+         (gptel--inspect-query))))
+    ("J" "Inspect query (JSON)"
      (lambda ()
        "Inspect the query that will be sent as a JSON object."
        (interactive)
-       (gptel--sanitize-model)
+       (let* ((extra (gptel--get-directive
-       (gptel--inspect-query 'json)))]]
+                      (transient-args
+                       transient-current-command)))
+              (gptel--system-message
+               (concat gptel--system-message extra)))
+         (gptel--sanitize-model)
+         (gptel--inspect-query 'json))))]]
   (interactive)
   (gptel--sanitize-model)
   (transient-setup 'gptel-menu))
@@ -199,7 +214,7 @@ which see."
    'gptel-system-prompt
    (cl-loop for (type . prompt) in gptel-directives
        ;; Avoid clashes with the custom directive key
-       with unused-keys = (delete ?h (number-sequence ?a ?z))
+       with unused-keys = (delete ?s (number-sequence ?a ?z))
        with width = (window-width)
        for name = (symbol-name type)
        for key = (seq-find (lambda (k) (member k unused-keys)) name (seq-first unused-keys))
@@ -239,20 +254,25 @@ which see."
                     :transient 'transient--do-exit))))))
 
 (transient-define-prefix gptel-system-prompt ()
-  "Change the LLM system prompt.
+  "Set the LLM system message for LLM interactions in this buffer.
 
-The \"system\" prompt establishes directives for the chat
+The \"system message\" establishes directives for the chat
-session. Some examples of system prompts are:
+session and modifies the behavior of the LLM. Some examples of
+system prompts are:
 
 You are a helpful assistant. Answer as concisely as possible.
 Reply only with shell commands and no prose.
 You are a poet. Reply only in verse.
 
+More extensive system messages can be useful for specific tasks.
+
 Customize `gptel-directives' for task-specific prompts."
   [:description
-   (lambda () (format "Current directive: %s"
+   (lambda () (format "System Message: %s"
-                 (truncate-string-to-width
+                 (string-replace
-                  gptel--system-message 100 nil nil t)))
+                  "\n" "⮐"
+                  (truncate-string-to-width
+                   gptel--system-message 100 nil nil t))))
    :class transient-column
    :setup-children gptel-system-prompt--setup
    :pad-keys t])
@@ -393,15 +413,105 @@ responses."
 
 (transient-define-infix gptel--infix-temperature ()
   "Temperature of request."
-  :description "Randomness (0 - 2.0)"
+  :description "Temperature (0 - 2.0)"
   :class 'transient-lisp-variable
   :variable 'gptel-temperature
   :key "-t"
-  :prompt "Set temperature (0.0-2.0, leave empty for default): "
+  :prompt "Temperature controls the response randomness (0.0-2.0, leave empty for default): "
   :reader 'gptel--transient-read-variable)
 
 ;; ** Infix for the refactor/rewrite system message
 
+(defun gptel--instructions-make-overlay (text &optional ov)
+  "TODO"
+  (save-excursion
+    (cond
+     ((use-region-p) (goto-char (region-beginning)))
+     ((gptel--in-response-p) (gptel-beginning-of-response))
+     (t (text-property-search-backward 'gptel 'response)))
+    (skip-chars-forward "\n \t")
+    (if (and ov (overlayp ov))
+        (move-overlay ov (point) (point) (current-buffer))
+      (setq ov (make-overlay (point) (point) nil t)))
+    (overlay-put ov 'before-string nil)
+    ;; (unless (or (bobp) (eq (char-before) "\n"))
+    ;;   (overlay-put ov 'before-string (propertize "\n" 'font-lock-face 'shadow)))
+    (overlay-put ov 'category 'gptel)
+    (overlay-put
+     ov 'after-string
+     (concat
+      (propertize (concat "GPTEL: " text)
+                  'font-lock-face '(:inherit shadow :box t))
+      "\n"))
+    ov))
+
+(defclass gptel-option-overlaid (transient-option)
+  ((display-nil :initarg :display-nil)
+   (overlay :initarg :overlay))
+  "Transient options for overlays displayed in the working buffer.")
+
+(cl-defmethod transient-format-value ((obj gptel-option-overlaid))
+  "set up the in-buffer overlay for additional directive, a string.
+
+Also format its value in the Transient menu."
+  (let ((value (oref obj value))
+        (ov    (oref obj overlay))
+        (argument (oref obj argument)))
+    ;; Making an overlay
+    (if (or (not value) (string-empty-p value))
+        (when ov (delete-overlay ov))
+      (oset obj overlay (gptel--instructions-make-overlay value ov))
+      (letrec ((ov-clear-hook
+                (lambda () (when-let* ((ov (oref obj overlay))
+                                  ((overlayp ov)))
+                        (remove-hook 'transient-exit-hook
+                                     ov-clear-hook)
+                        (delete-overlay ov)))))
+        (add-hook 'transient-exit-hook ov-clear-hook)))
+    ;; Updating transient menu display
+    (if value
+        (propertize (concat argument (truncate-string-to-width value 25 nil nil "..."))
+                    'face 'transient-value)
+      (propertize
+       (concat "(" (symbol-name (oref obj display-nil)) ")")
+       'face 'transient-inactive-value))))
+
+(transient-define-infix gptel--infix-add-directive ()
+  "Additional directive intended for the next query only.
+
+This is useful to define a quick task on top of a more extensive
+or detailed system prompt (directive).
+
+For example, with code/text selected:
+
+- Rewrite this function to do X while avoiding Y.
+- Change the tone of the following paragraph to be more direct.
+
+Or in an extended conversation:
+
+- Phrase you next response in ten words or less.
+- Pretend for now that you're an anthropologist."
+  :class 'gptel-option-overlaid
+  ;; :variable 'gptel--instructions
+  :display-nil 'none
+  :overlay nil
+  :argument ":"
+  :prompt "Instructions for next response only: "
+  :reader (lambda (prompt initial history)
+            (let* ((extra (read-string prompt initial history)))
+              (unless (string-empty-p extra) extra)))
+  :format " %k %d %v"
+  :key "d"
+  :argument ":"
+  :description "Add directive"
+  :transient t)
+
+(defun gptel--get-directive (args)
+  "Find the additional directive in the transient ARGS of this command."
+  (cl-some (lambda (s) (and (string-prefix-p ":" s)
+                       (concat "\n\n" (substring s 1))))
+                  args))
+
 (transient-define-infix gptel--infix-rewrite-prompt ()
   "Chat directive (system message) to use for rewriting or refactoring."
   :description (lambda () (if (derived-mode-p 'prog-mode)
@@ -435,6 +545,7 @@ responses."
         (backend-name (gptel-backend-name gptel-backend))
         (buffer) (position)
         (callback) (gptel-buffer-name)
+        (system-extra (gptel--get-directive args))
         ;; Input redirection: grab prompt from elsewhere?
         (prompt
          (cond
@@ -531,10 +642,18 @@ responses."
       (setq buffer (get-buffer-create gptel-buffer-name))
       (with-current-buffer buffer (setq position (point)))))
 
-    ;; Create prompt, unless doing input-redirection above
+    (gptel-request
-    (unless prompt
+     prompt
-      (setq prompt (gptel--create-prompt (gptel--at-word-end (point)))))
+     :buffer (or buffer (current-buffer))
+     :position position
+     :in-place (and in-place (not output-to-other-buffer-p))
+     :stream stream
+     :system (concat gptel--system-message system-extra)
+     :callback callback)
 
+    ;; NOTE: Possible future race condition here if Emacs ever drops the GIL.
+    ;; The HTTP request callback might modify the buffer before the in-place
+    ;; text is killed below.
     (when in-place
       ;; Kill the latest prompt
       (let ((beg
@@ -554,13 +673,6 @@ responses."
            (list (buffer-substring-no-properties beg end))))
         (kill-region beg end)))
 
-    (gptel-request
-     prompt
-     :buffer (or buffer (current-buffer))
-     :position position
-     :in-place (and in-place (not output-to-other-buffer-p))
-     :stream stream
-     :callback callback)
     (when output-to-other-buffer-p
       (message (concat "Prompt sent to buffer: "
                        (propertize gptel-buffer-name 'face 'help-key-binding)))
@@ -627,7 +739,7 @@ This uses the prompts in the variable
   "Edit LLM directives."
   :transient 'transient--do-exit
   :description "Set custom directives"
-  :key "h"
+  :key "s"
   (interactive)
   (let ((orig-buf (current-buffer))
         (msg-start (make-marker)))

gptel.el

@@ -469,6 +469,11 @@ README for examples."
           (restricted-sexp :match-alternatives (gptel-backend-p 'nil)
            :tag "Other backend")))
 
+(defvar gptel-expert-commands nil
+  "Whether experimental gptel options should be enabled.
+
+This opens up advanced options in `gptel-menu'.")
+
 (defvar-local gptel--bounds nil)
 (put 'gptel--bounds 'safe-local-variable #'always)
 
@@ -545,16 +550,32 @@ Note: This will move the cursor."
           (scroll-up-command))
       (error nil))))
 
-(defun gptel-end-of-response (_ _ &optional arg)
+(defun gptel-beginning-of-response (&optional _ _ arg)
+  "Move point to the beginning of the LLM response ARG times."
+  (interactive "p")
+  ;; FIXME: Only works for arg == 1
+  (gptel-end-of-response nil nil (- (or arg 1))))
+
+(defun gptel-end-of-response (&optional _ _ arg)
   "Move point to the end of the LLM response ARG times."
-  (interactive (list nil nil current-prefix-arg))
+  (interactive (list nil nil
-  (dotimes (_ (if arg (abs arg) 1))
+                     (prefix-numeric-value current-prefix-arg)))
-    (text-property-search-forward 'gptel 'response t)
+  (let ((search (if (> arg 0)
-    (when (looking-at (concat "\n\\{1,2\\}"
+                    #'text-property-search-forward
-                              (regexp-quote
+                  #'text-property-search-backward)))
-                               (gptel-prompt-prefix-string))
+    (dotimes (_ (abs arg))
-                              "?"))
+      (funcall search 'gptel 'response t)
-      (goto-char (match-end 0)))))
+      (if (> arg 0)
+          (when (looking-at (concat "\n\\{1,2\\}"
+                                    (regexp-quote
+                                     (gptel-prompt-prefix-string))
+                                    "?"))
+            (goto-char (match-end 0)))
+        (when (looking-back (concat (regexp-quote
+                                     (gptel-response-prefix-string))
+                                    "?")
+                            (point-min))
+          (goto-char (match-beginning 0)))))))
 
 (defmacro gptel--at-word-end (&rest body)
   "Execute BODY at end of the current word or punctuation."
@@ -1558,5 +1579,31 @@ context for the ediff session."
   (interactive "p")
   (gptel--previous-variant (- arg)))
 
+(defun gptel-clean-up-llm-code (buffer beg end)
+  "Clean up LLM response between BEG & END in BUFFER.
+
+Removes any markup formatting and indents the code within the parameters of the
+current buffer."
+  (with-current-buffer buffer
+    (save-excursion
+      (let* ((res-beg beg)
+             (res-end end)
+             (contents nil))
+        (setq contents (buffer-substring-no-properties res-beg
+                                                       res-end))
+        (setq contents (replace-regexp-in-string
+                        "^\\(```.*\n\\)\\|\n\\(```.*\\)$"
+                        ""
+                        contents))
+        (delete-region res-beg res-end)
+        (goto-char res-beg)
+        (insert contents)
+        (setq res-end (point))
+        ;; Indent the code to match the buffer indentation if it's messed up.
+        (unless (eq indent-line-function #'indent-relative)
+          (indent-region res-beg res-end))
+        (pulse-momentary-highlight-region res-beg res-end)
+        (setq res-beg (next-single-property-change res-beg 'gptel))))))
+
 (provide 'gptel)
 ;;; gptel.el ends here