From 706ad703db40945457b678314faa7d081f1a201b Mon Sep 17 00:00:00 2001
From: Karthik Chikmagalur <karthikchikmagalur@gmail.com>
Date: Fri, 19 May 2023 21:01:01 -0700
Subject: [PATCH] gptel-transient: Allow arbitrary system prompts/directives

* gptel.el (gptel-directives): Bump required transient version to
0.4.0.  Remove placeholder about hard-coded directives from
the docstring for `gptel-directives'.

* gptel-transient.el (gptel-system-prompt,
gptel-system-prompt--setup): Dynamically generate the system
prompt menu in `gptel-menu'.  Delete helper functions that
hard-coded the list of system prompts/directives before.
---
 gptel-transient.el | 79 +++++++++++++++-------------------------------
 gptel.el           |  8 ++---
 2 files changed, 28 insertions(+), 59 deletions(-)

diff --git a/gptel-transient.el b/gptel-transient.el
index 79e177b..c895513 100644
--- a/gptel-transient.el
+++ b/gptel-transient.el
@@ -103,25 +103,28 @@ Or is it the other way around?"
 
 
 ;; ** Prefix for setting the system prompt.
-
-;; These helper functions are a temporary workaround to fix #45. Once dynamic
-;; transients are supported, we can do away with all this jank.
-(defun gptel--system-prompt-programming ()
-  (interactive)
-  (setq gptel--system-message
-        (alist-get 'programming gptel-directives)))
-(defun gptel--system-prompt-default ()
-  (interactive)
-  (setq gptel--system-message
-        (alist-get 'chat gptel-directives)))
-(defun gptel--system-prompt-writing ()
-  (interactive)
-  (setq gptel--system-message
-        (alist-get 'writing gptel-directives)))
-(defun gptel--system-prompt-chat ()
-  (interactive)
-  (setq gptel--system-message
-        (alist-get 'default gptel-directives)))
+(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
+       with taken
+       for name = (symbol-name type)
+       for key =
+       (let ((idx 0) pos)
+         (while (or (not pos) (member pos taken))
+           (setq pos (substring name idx (1+ idx)))
+           (cl-incf idx))
+         (push pos taken)
+         pos)
+       collect (list (key-description key) (capitalize name)
+                `(lambda () (interactive)
+                  (message "Directive: %s" ,prompt)
+                  (setq gptel--system-message ,prompt))
+                :transient t)
+       into prompt-suffixes
+       finally return (cons (list 'gptel--suffix-system-message)
+                            prompt-suffixes))))
 
 (transient-define-prefix gptel-system-prompt ()
   "Change the system prompt to send ChatGPT.
@@ -135,17 +138,12 @@ You are a poet. Reply only in verse.
 
 Customize `gptel-directives' for task-specific prompts."
   [:description
-   (lambda () (format "Directive: %s"
+   (lambda () (format "Current directive: %s"
                  (truncate-string-to-width
-                  gptel--system-message
-                  (max (- (window-width) 14) 20) nil nil t)))
+                  gptel--system-message 100 nil nil t)))
    :class transient-column
-   :pad-keys t
-   (gptel--suffix-system-message)
-   ("p" "Programming" gptel--system-prompt-programming :transient t)
-   ("d" "Default" gptel--system-prompt-default :transient t)
-   ("w" "Writing" gptel--system-prompt-writing :transient t)
-   ("c" "Chat" gptel--system-prompt-chat :transient t)])
+   :setup-children gptel-system-prompt--setup
+   :pad-keys t])
 
 ;; ** Prefix for rewriting/refactoring
 
@@ -171,31 +169,6 @@ Customize `gptel-directives' for task-specific prompts."
     (setq gptel--rewrite-message (gptel--rewrite-message)))
   (transient-setup 'gptel-rewrite-menu))
 
-;; TODO: Switch to dynamic Transient menus (below) once there's a new Transient release
-;; (transient-define-prefix gptel-system-prompt ()
-;;   "Change the system prompt to send ChatGPT."
-;;   [:description (lambda () (format "Current directive: %s"
-;;                                 (truncate-string-to-width gptel--system-message 100 nil nil t)))
-;;    :class transient-column
-;;    :setup-children gptel-system-prompt--setup
-;;    :pad-keys t])
-
-;; (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
-;;        for name = (symbol-name type)
-;;        for key = (substring name 0 1)
-;;        collect (list (key-description key) (capitalize name)
-;;                 `(lambda () (interactive)
-;;                   (message "Directive: %s" ,prompt)
-;;                   (setq gptel--system-message ,prompt))
-;;                 :transient t)
-;;        into prompt-suffixes
-;;        finally return (cons (list 'gptel--suffix-system-message)
-;;                             prompt-suffixes))))
-
 ;; * Transient Infixes
 
 ;; ** Infixes for model parameters
diff --git a/gptel.el b/gptel.el
index f9635b7..269a7bc 100644
--- a/gptel.el
+++ b/gptel.el
@@ -4,7 +4,7 @@
 
 ;; Author: Karthik Chikmagalur
 ;; Version: 0.3.5
-;; Package-Requires: ((emacs "27.1") (transient "0.3.7"))
+;; Package-Requires: ((emacs "27.1") (transient "0.4.0"))
 ;; Keywords: convenience
 ;; URL: https://github.com/karthink/gptel
 
@@ -158,11 +158,7 @@ request to ChatGPT.
 
 Each entry in this alist maps a symbol naming the directive to
 the string that is sent. To set the directive for a chat session
-interactively call `gptel-send' with a prefix argument.
-
-Note: Currently the names (default, programming, writing and
-chat) are hard-coded and only their values may be customized.
-This will be fixed in an upcoming release."
+interactively call `gptel-send' with a prefix argument."
   :group 'gptel
   :type '(alist :key-type symbol :value-type string))