emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/gptel f887dadb49 07/11: gptel-rewrite: Rewrite directive h


From: ELPA Syncer
Subject: [nongnu] elpa/gptel f887dadb49 07/11: gptel-rewrite: Rewrite directive handling changes
Date: Sat, 30 Nov 2024 07:00:05 -0500 (EST)

branch: elpa/gptel
commit f887dadb49e2c0413ed405f68fe11fe1acf227a5
Author: Karthik Chikmagalur <karthikchikmagalur@gmail.com>
Commit: Karthik Chikmagalur <karthikchikmagalur@gmail.com>

    gptel-rewrite: Rewrite directive handling changes
    
    gptel's rewrite directive handling has been inconsistent with the
    rest of the package, and poor as well.  Fix by making rewrite
    directives a first-class concept, on par with regular
    directives (i.e. system messages or templates.)
    
    Improve the UI of the rewrite menu.
    
    NOTE: For consistency, many of these function names will change in
    the following commits.
    
    * gptel-transient.el:
    (gptel--read-with-prefix-help, gptel--read-with-prefix): Function
    to read from the minibuffer while showing a prefix string.  Used
    to show the full directive (general or when rewriting) to help
    write additional instructions.
    (gptel-system-prompt--setup, gptel--setup-directive-menu):
    Function that generates the transient infixes required for
    selecting a directive.  This used to be part of
    `gptel-system-prompt--setup' but has been generalized for reuse.
    (gptel-system-prompt):  Changes for compatibility.
    (gptel--infix-add-directive):  Use the read-with-prefix helper
    function.
    (gptel--suffix-system-message, gptel--edit-directive): Extract the
    code for editing a string (the directive) in a separate buffer
    into `gptel--edit-directive'.
    
    * gptel-rewrite.el:
    (gptel--rewrite-expand-prompt): This function, used to preview a
    string when reading from the minibuffer, is more generally useful.
    Move to gptel-transient.el as `gptel--read-with-prefix'.
    (gptel-rewrite-directive): New variable serving the same function
    as `gptel--system-message'.  It is a directive (i.e. system
    message or template) used when rewriting/refactoring.  Its value
    can be set by choosing amongst `gptel-directives', and
    user-defined ones can be added.  Its default value corresponds to
    the key 'rewrite' in `gptel-directives'.
    (gptel--rewrite-directive-default): Default value of
    gptel--rewrite-directive.  Renamed from
    `gptel--rewrite-directive'.
    (gptel-rewrite-menu, gptel--rewrite-directive-menu): UI changes.
    Add a menu to select the rewrite directive.  Add the infix
    `gptel--infix-context-remove-all' to remove all context
    (gptel--infix-rewrite-prompt, gptel--infix-rewrite-extra): Rename.
    (gptel--rewrite-infix-diff:-U, gptel--infix-rewrite-diff:-U):
    Rename for consistency.
    (gptel--suffix-rewrite-directive): Suffix to edit the rewrite directive.
    (gptel--suffix-rewrite): Use `gptel--rewrite-directive' and
    `gptel--rewrite-message' to create the full rewrite prompt.
---
 gptel-rewrite.el   | 176 ++++++++++++++--------------
 gptel-transient.el | 336 +++++++++++++++++++++++++++++++++--------------------
 2 files changed, 304 insertions(+), 208 deletions(-)

diff --git a/gptel-rewrite.el b/gptel-rewrite.el
index 5cb86c03f0..7a2aebd01a 100644
--- a/gptel-rewrite.el
+++ b/gptel-rewrite.el
@@ -93,28 +93,36 @@ automatically do one of these things instead."
 (defvar-local gptel--rewrite-message nil
   "Request-specific instructions for a gptel-rewrite action.")
 
-;; ;; NOTE: Should we expose this option?  `gptel-rewrite-directives-hook'
-;; ;; already functions as a robust way to customize the system message for
-;; ;; rewriting.
-;;
-;; (defcustom gptel-rewrite-directive
-;;   #'gptel--rewrite-directive
-;;   "A gptel template (system message, a string), or function that
-;; returns a system message intended for a rewrite action."
-;;   :group 'gptel
-;;   :type '(choice
-;;           (string :tag "System message")
-;;           (function :tag "Function that returns system message")))
+;; Add the rewrite directive to `gptel-directives'
+(unless (alist-get 'rewrite gptel-directives)
+  (add-to-list 'gptel-directives `(rewrite . 
,#'gptel--rewrite-directive-default)))
+
+(defvar gptel--rewrite-directive
+  (or (alist-get 'rewrite gptel-directives)
+      #'gptel--rewrite-directive-default)
+  "Active system message for rewrite actions.
+
+This variable is for internal use only.  To customize the rewrite
+system message, set a system message (or function that generates
+the system message) as the value of the `rewrite' key in
+`gptel-directives':
+
+ (setf (alist-get \\='rewrite gptel-directives)
+       #\\='my-rewrite-message-generator)
+
+You can also customize `gptel-rewrite-directives-hook' to
+dynamically inject a rewrite-specific system message.")
 
-(defun gptel--rewrite-directive ()
-  "General gptel directive when rewriting or refactoring.
+(defun gptel--rewrite-directive-default ()
+  "Generic directive for rewriting or refactoring.
 
-This supplies the general instructions to the LLM that are not
-specific to any particular required change.
+These are instructions not specific to any particular required
+change.
 
 The returned string is interpreted as the system message for the
-rewrite request.  To substitute your own, add to
-`gptel-rewrite-directives-hook', which see."
+rewrite request.  To use your own, add a different directive to
+`gptel-directives', or add to `gptel-rewrite-directives-hook',
+which see."
   (or (save-mark-and-excursion
         (run-hook-with-args-until-success
          'gptel-rewrite-directives-hook))
@@ -154,46 +162,6 @@ Or is it the other way around?"
   (if (derived-mode-p 'prog-mode)
       "Refactor" "Rewrite"))
 
-(defun gptel--rewrite-expand-prompt ()
-  "Show the active rewrite directive in the minibuffer.
-
-The directive, in this case just the system message, is shown in
-an overlay.  Repeated calls to this command will toggle its
-visibility state."
-  (interactive)
-  (unless (minibufferp)
-    (user-error "This command is intended to be used in the minibuffer."))
-  (let ((full (with-minibuffer-selected-window
-                (gptel--rewrite-directive)))
-        (update
-         (lambda (ov s)
-           (overlay-put
-            ov 'after-string
-            (and s (concat (propertize (concat "\n" s "\n") 'face 'shadow)
-                           (make-separator-line)))))))
-    (when full
-      (unless visual-line-mode (visual-line-mode 1))
-      (goto-char (minibuffer-prompt-end))
-      (pcase-let ((`(,prop . ,ov)
-                   (get-char-property-and-overlay
-                    (point-min) 'gptel)))
-        (unless ov
-          (setq ov (make-overlay
-                    (point-min) (minibuffer-prompt-end) nil t)))
-        (pcase prop
-          ('partial
-           (if (> (length full) (window-width))
-               (progn (overlay-put ov 'gptel 'full)
-                      (funcall update ov full))
-             (overlay-put ov 'gptel 'hide)
-             (funcall update ov nil)))
-          ('full (overlay-put ov 'gptel 'hide)
-                 (funcall update ov nil))
-          (_ (overlay-put ov 'gptel 'partial)
-             (funcall update ov (truncate-string-to-width
-                                 full (window-width) nil nil
-                                 'ellipsis))))))))
-
 (defun gptel--rewrite-key-help (callback)
   "Eldoc documentation function for gptel rewrite actions.
 
@@ -359,28 +327,47 @@ BUF is the buffer to modify, defaults to the overlay 
buffer."
         (when changed (smerge-mode 1)))
       (gptel--rewrite-clear ovs))))
 
-;; * Transient Prefix for rewriting/refactoring
+;; * Transient Prefixes for rewriting/refactoring
+
+(transient-define-prefix gptel--rewrite-directive-menu ()
+  "Set the directive (system message) for rewrite actions.
+
+By default, gptel uses the directive associated with the `rewrite'
+ key in `gptel-directives'.  You can add more rewrite-specific
+ directives to `gptel-directives' and pick one from here."
+  [:description gptel-system-prompt--format
+   [(gptel--suffix-rewrite-directive)]
+   [(gptel--infix-variable-scope)]]
+   [:class transient-column
+    :setup-children
+    (lambda (_) (transient-parse-suffixes
+            'gptel--rewrite-directive-menu
+            (gptel--setup-directive-menu
+             'gptel--rewrite-directive "Rewrite directive")))
+    :pad-keys t])
 
 ;;;###autoload (autoload 'gptel-rewrite-menu "gptel-rewrite" nil t)
 (transient-define-prefix gptel-rewrite-menu ()
   "Rewrite or refactor text region using an LLM."
   [:description
    (lambda ()
-     (format "%s" (truncate-string-to-width
-                   gptel--rewrite-message
-                   (max (- (window-width) 14) 20) nil nil t)))
-   (gptel--infix-rewrite-prompt)]
+     (gptel--describe-directive
+      gptel--rewrite-directive (max (- (window-width) 14) 20) "⮐"))
+   [""
+    ("s" "Set full directive" gptel--rewrite-directive-menu)
+    (gptel--infix-rewrite-extra)]]
   ;; FIXME: We are requiring `gptel-transient' because of this suffix, perhaps
   ;; we can get find some way around that?
   [:description (lambda () (concat "Context for " 
(gptel--refactor-or-rewrite)))
    :if use-region-p
-   (gptel--suffix-context-buffer :key "C")]
+   (gptel--infix-context-remove-all :key "-d")
+   (gptel--suffix-context-buffer :key "C" :format "  %k %d")]
   [[:description "Diff Options"
     :if (lambda () gptel--rewrite-overlays)
     ("-b" "Ignore whitespace changes"      ("-b" "--ignore-space-change"))
     ("-w" "Ignore all whitespace"          ("-w" "--ignore-all-space"))
     ("-i" "Ignore case"                    ("-i" "--ignore-case"))
-    (gptel--rewrite-infix-diff:-U)]
+    (gptel--infix-rewrite-diff:-U)]
    [:description gptel--refactor-or-rewrite
     :if use-region-p
     (gptel--suffix-rewrite)]
@@ -421,33 +408,35 @@ BUF is the buffer to modify, defaults to the overlay 
buffer."
 
 ;; * Transient infixes for rewriting/refactoring
 
-(transient-define-infix gptel--infix-rewrite-prompt ()
+(transient-define-infix gptel--infix-rewrite-extra ()
   "Chat directive (system message) to use for rewriting or refactoring."
   :description (lambda () (if (derived-mode-p 'prog-mode)
-                         "Set directives for refactor"
-                       "Set directives for rewrite"))
-  :format "%k %d"
-  :class 'transient-lisp-variable
+                         "Refactor instruction"
+                       "Rewrite instruction"))
+  :class 'gptel-lisp-variable
   :variable 'gptel--rewrite-message
   :key "d"
-  :prompt (concat "Instructions ("
-                  (propertize "TAB" 'face 'help-key-binding) " to expand, "
-                  (propertize "M-n" 'face 'help-key-binding) "/"
-                  (propertize "M-p" 'face 'help-key-binding) " for 
next/previous): ")
+  :format " %k %d %v"
+  :prompt (concat "Instructions " gptel--read-with-prefix-help)
   :reader (lambda (prompt _ history)
-            (let ((minibuffer-local-map
-                   (make-composed-keymap
-                    (define-keymap "TAB" #'gptel--rewrite-expand-prompt
-                      "<tab>" #'gptel--rewrite-expand-prompt)
-                    minibuffer-local-map)))
-              (minibuffer-with-setup-hook #'gptel--rewrite-expand-prompt
+            (let* ((rewrite-directive
+                    (car-safe (gptel--parse-directive gptel--rewrite-directive
+                                                      'raw)))
+                   (cycle-prefix
+                    (lambda () (interactive)
+                      (gptel--read-with-prefix rewrite-directive)))
+                   (minibuffer-local-map
+                    (make-composed-keymap
+                     (define-keymap "TAB" cycle-prefix "<tab>" cycle-prefix)
+                     minibuffer-local-map)))
+              (minibuffer-with-setup-hook cycle-prefix
                 (read-string
                  prompt
                  (or gptel--rewrite-message
                      (concat (gptel--refactor-or-rewrite) ": "))
                  history)))))
 
-(transient-define-argument gptel--rewrite-infix-diff:-U ()
+(transient-define-argument gptel--infix-rewrite-diff:-U ()
   :description "Context lines"
   :class 'transient-option
   :argument "-U"
@@ -455,6 +444,23 @@ BUF is the buffer to modify, defaults to the overlay 
buffer."
 
 ;; * Transient suffixes for rewriting/refactoring
 
+(transient-define-suffix gptel--suffix-rewrite-directive (&optional cancel)
+  "Edit Rewrite directive.
+
+CANCEL is used to avoid touching dynamic rewrite directives,
+generated from functions."
+  :transient 'transient--do-exit
+  :description "Edit full rewrite directive"
+  :key "s"
+  (interactive
+   (list (and
+          (functionp gptel--rewrite-directive)
+          (not (y-or-n-p
+                "Rewrite directive is dynamically generated: Edit its current 
value instead?")))))
+  (if cancel (progn (message "Edit canceled")
+                    (call-interactively #'gptel-rewrite-menu))
+    (gptel--edit-directive 'gptel--rewrite-directive #'gptel-rewrite-menu)))
+
 (transient-define-suffix gptel--suffix-rewrite (&optional rewrite-message 
dry-run)
   "Rewrite or refactor region contents."
   :key "r"
@@ -468,11 +474,13 @@ BUF is the buffer to modify, defaults to the overlay 
buffer."
                        "What is the required change?"
                        (or rewrite-message gptel--rewrite-message))))
     (deactivate-mark)
-    (when nosystem (setcar prompt (concat (gptel--rewrite-directive)
-                                          "\n\n" (car prompt))))
+    (when nosystem
+      (setcar prompt (concat (car-safe (gptel--parse-directive
+                                        gptel--rewrite-directive 'raw))
+                             "\n\n" (car prompt))))
     (gptel-request prompt
       :dry-run dry-run
-      :system #'gptel--rewrite-directive
+      :system gptel--rewrite-directive
       :context
       (let ((ov (make-overlay (region-beginning) (region-end))))
         (overlay-put ov 'category 'gptel)
diff --git a/gptel-transient.el b/gptel-transient.el
index 715db77a21..81a0d398a6 100644
--- a/gptel-transient.el
+++ b/gptel-transient.el
@@ -89,6 +89,72 @@ Meant to be called when `gptel-menu' is active."
       "\n"))
     ov))
 
+(defconst gptel--read-with-prefix-help
+  (concat
+   (propertize "(" 'face 'default)
+   (propertize "TAB" 'face 'help-key-binding)
+   (propertize " to expand, " 'face 'default)
+   (propertize "M-n" 'face 'help-key-binding)
+   (propertize "/" 'face 'default)
+   (propertize "M-p" 'face 'help-key-binding)
+   (propertize " for next/previous): " 'face 'default))
+  "Help string ;TODO: ")
+
+(defun gptel--read-with-prefix (prefix)
+  "Show string PREFIX in the minibuffer after the minibuffer prompt.
+
+PREFIX is shown in an overlay.  Repeated calls to this function
+will toggle its visibility state."
+  (unless (minibufferp)
+    (user-error "This command is intended to be used in the minibuffer."))
+  (let* ((update
+         (lambda (ov s)
+           (overlay-put
+            ov 'after-string
+            (and s (concat (propertize (concat "\n" s "\n") 'face 'shadow)
+                           (make-separator-line))))))
+         (max-width (- (window-width) (minibuffer-prompt-end)))
+         (max max-mini-window-height)
+         (max-height (- (or (and (natnump max) max)
+                            (floor (* max (frame-height))))
+                        5)))
+    (when (and prefix (not (string-empty-p prefix)) (> max-height 1))
+      (unless visual-line-mode (visual-line-mode 1))
+      (goto-char (minibuffer-prompt-end))
+      (pcase-let ((`(,prop . ,ov)
+                   (get-char-property-and-overlay
+                    (point-min) 'gptel)))
+        (unless ov
+          (setq ov (make-overlay
+                    (point-min) (minibuffer-prompt-end) nil t)))
+        (pcase prop
+          ('partial
+           (if (> (length prefix) max-width)
+               (progn
+                 (overlay-put ov 'gptel 'prefix)
+                 (let ((disp-size
+                        (cl-loop for char across prefix
+                                 for idx upfrom 0
+                                 with n = 0 with max-length = (* max-height 
max-width)
+                                 if (eq char ?\n) do (cl-incf n)
+                                 if (> n max-height) return idx
+                                 if (> idx max-length)
+                                 return idx
+                                 finally return nil)))
+                   (funcall update ov
+                            (if disp-size
+                                (truncate-string-to-width
+                                 prefix disp-size  nil nil 'ellipsis)
+                              prefix))))
+             (overlay-put ov 'gptel 'hide)
+             (funcall update ov nil)))
+          ('prefix (overlay-put ov 'gptel 'hide)
+                 (funcall update ov nil))
+          (_ (overlay-put ov 'gptel 'partial)
+             (funcall update ov (truncate-string-to-width
+                                 prefix max-width nil nil
+                                 'ellipsis))))))))
+
 (defun gptel--transient-read-variable (prompt initial-input history)
   "Read value from minibuffer and interpret the result as a Lisp object.
 
@@ -402,55 +468,57 @@ Also format its value in the Transient menu."
   (transient-setup 'gptel-menu))
 
 ;; ** Prefix for setting the system prompt.
-(defun gptel-system-prompt--setup (_)
-  "Set up suffixes for system prompt."
-  (transient-parse-suffixes
-   'gptel-system-prompt
-   (cl-loop for (type . prompt) in gptel-directives
-       ;; Avoid clashes with the custom directive key
-       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))
-       do (setq unused-keys (delete key unused-keys))
-       ;; The explicit declaration ":transient transient--do-return" here
-       ;; appears to be required for Transient v0.5 and up.  Without it, these
-       ;; are treated as suffixes when invoking `gptel-system-prompt' directly,
-       ;; and infixes when going through `gptel-menu'.
-       ;; TODO: Raise an issue with Transient.
-       collect
-       (list (key-description (list key))
-             (concat (capitalize name) " "
-                     (propertize " " 'display '(space :align-to 20))
-                     (propertize
-                      (concat "(" (gptel--describe-directive prompt (- width 
30)) ")")
-                      'face 'shadow))
-             `(lambda () (interactive)
-                (message "Directive: %s"
-                 ,(gptel--describe-directive prompt 100 "⮐ "))
-                (gptel--set-with-scope 'gptel--system-message ',prompt
-                 gptel--set-buffer-locally))
-            :transient 'transient--do-return)
-       into prompt-suffixes
-       finally return
-       (nconc
-        prompt-suffixes
-        (list (list "DEL" "None"
-                    (lambda () (interactive)
-                      (message "Directive unset")
-                      (gptel--set-with-scope 'gptel--system-message nil
-                                             gptel--set-buffer-locally))
-                    :transient 'transient--do-return)
-              (list "SPC" "Pick crowdsourced prompt"
-                    'gptel--read-crowdsourced-prompt
-                   ;; NOTE: Quitting the completing read when picking a
-                   ;; crowdsourced prompt will cause the transient to exit
-                   ;; instead of returning to the system prompt menu.
-                    :transient 'transient--do-exit))))))
+
+(defun gptel--setup-directive-menu (sym msg &optional external)
+  "Return a list of transient infix definitions for setting gptel
+directives.
+
+SYM is the symbol whose value is set to the selected directive..
+MSG is the meaning of symbol, used when messaging.
+If EXTERNAL is non-nil, include external sources of directives."
+  (cl-loop for (type . prompt) in gptel-directives
+           ;; Avoid clashes with the custom directive key
+           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))
+           do (setq unused-keys (delete key unused-keys))
+           ;; The explicit declaration ":transient transient--do-return" here
+           ;; appears to be required for Transient v0.5 and up.  Without it, 
these
+           ;; are treated as suffixes when invoking `gptel-system-prompt' 
directly,
+           ;; and infixes when going through `gptel-menu'.
+           ;; TODO: Raise an issue with Transient.
+           collect
+           (list (key-description (list key))
+                 (concat (capitalize name) " "
+                         (propertize " " 'display '(space :align-to 20))
+                         (propertize
+                          (concat "(" (gptel--describe-directive prompt (- 
width 30)) ")")
+                          'face 'shadow))
+                 `(lambda () (interactive)
+                    (message "%s: %s" ,msg ,(gptel--describe-directive prompt 
100 "⮐ "))
+                    (gptel--set-with-scope ',sym ',prompt 
gptel--set-buffer-locally))
+                :transient 'transient--do-return)
+           into prompt-suffixes
+           finally return
+           (nconc
+            prompt-suffixes
+            (list (list "DEL" "None"
+                        `(lambda () (interactive)
+                           (message "%s unset" ,msg)
+                           (gptel--set-with-scope ',sym nil 
gptel--set-buffer-locally))
+                        :transient 'transient--do-return))
+            (and external
+                 (list (list "SPC" "Pick crowdsourced prompt"
+                             'gptel--read-crowdsourced-prompt
+                            ;; NOTE: Quitting the completing read when picking 
a
+                            ;; crowdsourced prompt will cause the transient to 
exit
+                            ;; instead of returning to the system prompt menu.
+                             :transient 'transient--do-exit))))))
 
 ;;;###autoload (autoload 'gptel-system-prompt "gptel-transient" nil t)
 (transient-define-prefix gptel-system-prompt ()
-  "Set the LLM system message for LLM interactions in this buffer.
+  "Set the LLM system message for LLM interactions.
 
 The \"system message\" establishes directives for the chat
 session and modifies the behavior of the LLM. Some examples of
@@ -467,7 +535,11 @@ Customize `gptel-directives' for task-specific prompts."
    [(gptel--suffix-system-message)]
    [(gptel--infix-variable-scope)]]
    [:class transient-column
-    :setup-children gptel-system-prompt--setup
+    :setup-children
+    (lambda (_) (transient-parse-suffixes
+            'gptel-system-prompt
+            (gptel--setup-directive-menu
+             'gptel--system-message "Directive" t)))
     :pad-keys t])
 
 
@@ -713,9 +785,19 @@ Or in an extended conversation:
   :display-nil 'none
   :overlay nil
   :argument ":"
-  :prompt "Instructions for next response only: "
+  :prompt (concat "Add instructions for next request only "
+                  gptel--read-with-prefix-help)
   :reader (lambda (prompt initial history)
-            (let* ((extra (read-string prompt initial history)))
+            (let* ((directive
+                    (car-safe (gptel--parse-directive gptel--system-message 
'raw)))
+                   (cycle-prefix (lambda () (interactive)
+                                   (gptel--read-with-prefix directive)))
+                   (minibuffer-local-map
+                    (make-composed-keymap
+                     (define-keymap "TAB" cycle-prefix "<tab>" cycle-prefix)
+                     minibuffer-local-map))
+                   (extra (minibuffer-with-setup-hook cycle-prefix
+                            (read-string prompt (or initial " ") history))))
               (unless (string-empty-p extra) extra)))
   :format " %k %d %v"
   :key "d"
@@ -960,89 +1042,95 @@ This uses the prompts in the variable
             (call-interactively #'gptel--suffix-system-message)))
     (message "No prompts available.")))
 
-(transient-define-suffix gptel--suffix-system-message ()
+(transient-define-suffix gptel--suffix-system-message (&optional cancel)
   "Edit LLM system message.
 
-When LOCAL is non-nil, set the system message only in the current buffer."
+CANCEL is used to avoid touching dynamic system messages,
+generated from functions."
   :transient 'transient--do-exit
   :description "Set or edit system message"
   :format " %k   %d"
   :key "s"
-  (interactive)
+  (interactive
+   (list (and (functionp gptel--system-message)
+              (not (y-or-n-p
+                    "Active directive is dynamically generated: Edit its 
current value instead?")))))
+  (if cancel (progn (message "Edit canceled")
+                    (call-interactively #'gptel-menu))
+    (gptel--edit-directive 'gptel--system-message)))
+
+;; MAYBE: Eventually can be simplified with string-edit, after we drop support
+;; for Emacs 28.2.
+(defun gptel--edit-directive (sym &optional callback-cmd)
+  "Edit a gptel directive in a dedicated buffer.
+
+Store the result in SYM, a symbol.  If CALLBACK-CMD is specified,
+it is run after exiting the edit."
   (let ((orig-buf (current-buffer))
         (msg-start (make-marker))
-        cancel
-        (directive gptel--system-message))
-    (when (functionp gptel--system-message)
-      (setq directive (funcall gptel--system-message)
-            cancel
-            (not (y-or-n-p
-                  "Active directive is a function: Edit its current value 
instead?"))))
-    (if cancel
-        (progn (message "Edit canceled")
-               (call-interactively #'gptel-menu))
-      ;; TODO: Handle editing list-of-strings directives
-      (with-current-buffer (get-buffer-create "*gptel-system*")
-        (let ((inhibit-read-only t))
-          (erase-buffer)
-          (text-mode)
-          (setq header-line-format
-                (concat
-                 "Edit your system message below and press "
-                 (propertize "C-c C-c" 'face 'help-key-binding)
-                 " when ready, or "
-                 (propertize "C-c C-k" 'face 'help-key-binding)
-                 " to abort."))
-          (insert
-           "# Example: You are a helpful assistant. Answer as concisely as 
possible.\n"
-           "# Example: Reply only with shell commands and no prose.\n"
-           "# Example: You are a poet. Reply only in verse.\n\n")
-          (add-text-properties
-           (point-min) (1- (point))
-           (list 'read-only t 'face 'font-lock-comment-face))
-          ;; TODO: make-separator-line requires Emacs 28.1+.
-          ;; (insert (propertize (make-separator-line) 'rear-nonsticky t))
-          (set-marker msg-start (point))
-          (save-excursion
-            ;; If it's a list, insert only the system message part
-            ;; MAYBE: Use `gptel--parse-directive'/`gptel--describe-directive'
-            ;; here?
-            (insert (or (car-safe directive) directive ""))
-            (push-mark nil 'nomsg))
-          (activate-mark))
-        (display-buffer (current-buffer)
-                        `((display-buffer-below-selected)
-                          (body-function . ,#'select-window)
-                          (window-height . ,#'fit-window-to-buffer)))
-        (let ((quit-to-menu
-               (lambda ()
-                 "Cancel system message update and return to `gptel-menu'"
-                 (interactive)
-                 (quit-window)
-                 (display-buffer
-                  orig-buf
-                  `((display-buffer-reuse-window
-                     display-buffer-use-some-window)
-                    (body-function . ,#'select-window)))
-                 (call-interactively #'gptel-menu))))
-          (use-local-map
-           (make-composed-keymap
-            (define-keymap
-              "C-c C-c" (lambda ()
-                          "Confirm system message and return to `gptel-menu'."
-                          (interactive)
-                          (let ((system-message
-                                 (buffer-substring-no-properties msg-start 
(point-max))))
-                            (with-current-buffer orig-buf
-                              (gptel--set-with-scope
-                               'gptel--system-message
-                               (if (cdr-safe directive) ;Handle list of strings
-                                   (prog1 directive (setcar directive 
system-message))
-                                 system-message)
-                               gptel--set-buffer-locally)))
-                          (funcall quit-to-menu))
-              "C-c C-k" quit-to-menu)
-            text-mode-map)))))))
+        (directive (symbol-value sym)))
+    (when (functionp directive)
+      (setq directive (funcall directive)))
+    ;; TODO: Handle editing list-of-strings directives
+    (with-current-buffer (get-buffer-create "*gptel-system*")
+      (let ((inhibit-read-only t))
+        (erase-buffer)
+        (text-mode)
+        (setq header-line-format
+              (concat
+               "Edit your system message below and press "
+               (propertize "C-c C-c" 'face 'help-key-binding)
+               " when ready, or "
+               (propertize "C-c C-k" 'face 'help-key-binding)
+               " to abort."))
+        (insert
+         "# Example: You are a helpful assistant. Answer as concisely as 
possible.\n"
+         "# Example: Reply only with shell commands and no prose.\n"
+         "# Example: You are a poet. Reply only in verse.\n\n")
+        (add-text-properties
+         (point-min) (1- (point))
+         (list 'read-only t 'face 'font-lock-comment-face))
+        ;; TODO: make-separator-line requires Emacs 28.1+.
+        ;; (insert (propertize (make-separator-line) 'rear-nonsticky t))
+        (set-marker msg-start (point))
+        (save-excursion
+          ;; If it's a list, insert only the system message part
+          (insert (car-safe (gptel--parse-directive directive 'raw)))
+          (push-mark nil 'nomsg))
+        (activate-mark))
+      (display-buffer (current-buffer)
+                      `((display-buffer-below-selected)
+                        (body-function . ,#'select-window)
+                        (window-height . ,#'fit-window-to-buffer)))
+      (let ((quit-to-menu
+             (lambda ()
+               "Cancel system message update and return."
+               (interactive)
+               (quit-window)
+               (display-buffer
+                orig-buf
+                `((display-buffer-reuse-window
+                   display-buffer-use-some-window)
+                  (body-function . ,#'select-window)))
+               (when (commandp callback-cmd)
+                 (call-interactively callback-cmd)))))
+        (use-local-map
+         (make-composed-keymap
+          (define-keymap
+            "C-c C-c" (lambda ()
+                        "Confirm system message and return."
+                        (interactive)
+                        (let ((system-message
+                               (buffer-substring-no-properties msg-start 
(point-max))))
+                          (with-current-buffer orig-buf
+                            (gptel--set-with-scope sym
+                                                   (if (cdr-safe directive) 
;Handle list of strings
+                                                       (prog1 directive 
(setcar directive system-message))
+                                                     system-message)
+                                                   gptel--set-buffer-locally)))
+                        (funcall quit-to-menu))
+            "C-c C-k" quit-to-menu)
+          text-mode-map))))))
 
 ;; ** Suffix for displaying and removing context
 (declare-function gptel-context--buffer-setup "gptel-context")



reply via email to

[Prev in Thread] Current Thread [Next in Thread]