gptel-transient: Additional directives option (#249)

* gptel.el (gptel-end-of-response, gptel-beginning-of-response,
gptel-expert-commands): Add `gptel-expert-commands` to selectively
enable experimental options in `gptel-menu`.  This should keep the
interface from overwhelming new users.  Add a command to move to
the beginning of a response.

* gptel-transient.el (gptel-menu, gptel-system-prompt,
gptel--instructions-make-overlay, gptel-option-overlaid,
transient-format-value, gptel--additional-directive,
gptel--additional-directive-get): Add a transient option to
include a (short) additional instruction/directive along with the
system message.  This makes it convenient to have an extensive
system message and specify additional, per-response tasks (such as
refactoring) on top.  Ensure that the dry run options handle this
correctly.  This option is made available when
`gptel-expert-commands` is turned on.

NOTE: WIP design.  The nomenclature for `gptel-expert-commands`
and "additional directive" is subject to change.

gptel-transient.el

@@ -116,11 +116,16 @@ which see."
   "Change parameters of prompt to send to the LLM."
   ;; :incompatible '(("-m" "-n" "-k" "-e"))
   [:description
-   (lambda () (format "Directive:  %s"
-                 (truncate-string-to-width
-                  gptel--system-message (max (- (window-width) 14) 20) nil nil t)))
-   ("h" "Set directives for chat" gptel-system-prompt :transient t)]
-  [["Session Parameters"
+   (lambda ()
+     (string-replace
+      "\n" "⮐ "
+      (truncate-string-to-width
+       gptel--system-message (max (- (window-width) 6) 14) nil nil t)))
+   [""
+    "Instructions"
+    ("h" "Set system message" gptel-system-prompt :transient t)
+    (gptel--additional-directive :if (lambda () gptel-expert-commands))]]
+  [["Model Parameters"
     (gptel--infix-provider)
     ;; (gptel--infix-model)
     (gptel--infix-max-tokens)
@@ -175,19 +180,29 @@ which see."
      :transient t)
     ("E" "Ediff previous" gptel--ediff
      :if gptel--at-response-history-p)]
-   ["Inspect"
-    ("I" "Query as Lisp"
+   ["Dry Run" :if (lambda () (or gptel-log-level gptel-expert-commands))
+    ("I" "Inspect query (Lisp)"
      (lambda ()
        "Inspect the query that will be sent as a lisp object."
        (interactive)
-       (gptel--sanitize-model)
-       (gptel--inspect-query)))
-    ("J" "Query as JSON"
+       (let* ((extra (gptel--additional-directive-get
+                      (transient-args
+                       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)
-       (gptel--inspect-query 'json)))]]
+       (let* ((extra (gptel--additional-directive-get
+                      (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))
@@ -239,15 +254,18 @@ 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
-session. Some examples of system prompts are:
+The \"system message\" establishes directives for the chat
+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"
@@ -402,6 +420,97 @@ responses."
 
 ;; ** 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))
+      (with-current-buffer transient--original-buffer
+        (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 15 nil nil "..."))
+                    'face 'transient-value)
+      (propertize
+       (concat "(" (symbol-name (oref obj display-nil)) ")")
+       'face 'transient-inactive-value))))
+
+(transient-define-infix gptel--additional-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 "Additional directive"
+  :transient t)
+
+(defun gptel--additional-directive-get (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 +544,7 @@ responses."
         (backend-name (gptel-backend-name gptel-backend))
         (buffer) (position)
         (callback) (gptel-buffer-name)
+        (system-extra (gptel--additional-directive-get args))
         ;; Input redirection: grab prompt from elsewhere?
         (prompt
          (cond
@@ -531,10 +641,18 @@ responses."
       (setq buffer (get-buffer-create gptel-buffer-name))
       (with-current-buffer buffer (setq position (point)))))
 
-    ;; Create prompt, unless doing input-redirection above
-    (unless prompt
-      (setq prompt (gptel--create-prompt (gptel--at-word-end (point)))))
+    (gptel-request
+     prompt
+     :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 +672,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)))

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))
-  (dotimes (_ (if arg (abs arg) 1))
-    (text-property-search-forward 'gptel 'response t)
-    (when (looking-at (concat "\n\\{1,2\\}"
-                              (regexp-quote
-                               (gptel-prompt-prefix-string))
-                              "?"))
-      (goto-char (match-end 0)))))
+  (interactive (list nil nil
+                     (prefix-numeric-value current-prefix-arg)))
+  (let ((search (if (> arg 0)
+                    #'text-property-search-forward
+                  #'text-property-search-backward)))
+    (dotimes (_ (abs arg))
+      (funcall search 'gptel 'response t)
+      (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."