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

    gptel: Send links pointing to plaintext files (#475, #481)
    
    When `gptel-track-media' is enabled, follow links in gptel
    buffers (Org or Markdown) that point to plaintext files.
    
    The file text is included in place of the link when sending
    requests.  This provides an easy way to provide buffer-local
    context in chat buffers.
    
    Previously, this option only controlled whether links to binary
    files (images/documents) of supported mime-types were included
    with the request.
    
    NOTE: `gptel-track-media' will be renamed to reflect this
    expansion in scope next.
    
    * gptel.el (gptel--file-binary-p, gptel--insert-file-string): Move
    helper functions from gptel-context, as they are needed for
    inserting linked files.
    
    (gptel--parse-media-links): Update Markdown implementation to
    handle links to plaintext files.
    
    * gptel-org.el (gptel--parse-media-links): Update Org mode
    implementation to handle links to plaintext files.
    
    * gptel-context.el (gptel--file-binary-p)
    (gptel-context--insert-file-string): Move to gptel.el and rename.
    (gptel-context--string): Adjust for renaming.
    
    * gptel-anthropic.el (gptel--anthropic-parse-multipart): Update
    to insert the contents of plaintext files.
    * gptel-gemini.el (gptel--gemini-parse-multipart): Ditto.
    * gptel-ollama.el (gptel--ollama-parse-multipart): Ditto.
    * gptel-openai.el (gptel--openai-parse-multipart): Ditto.
---
 gptel-anthropic.el |  6 ++++++
 gptel-context.el   | 18 +-----------------
 gptel-gemini.el    |  6 ++++++
 gptel-ollama.el    |  8 +++++++-
 gptel-openai.el    |  9 +++++++--
 gptel-org.el       | 43 +++++++++++++++++++++++++------------------
 gptel.el           | 47 +++++++++++++++++++++++++++++++++--------------
 7 files changed, 85 insertions(+), 52 deletions(-)

diff --git a/gptel-anthropic.el b/gptel-anthropic.el
index 81472d72c8..82fb08c5a9 100644
--- a/gptel-anthropic.el
+++ b/gptel-anthropic.el
@@ -459,6 +459,12 @@ format."
      ,@(and (gptel--model-capable-p 'cache)
         '(:cache_control (:type "ephemeral"))))
    into parts-array
+   else if (plist-get part :textfile) collect
+   `(:type "text"
+     :text ,(with-temp-buffer
+              (gptel--insert-file-string (plist-get part :textfile))
+              (buffer-string)))
+   into parts-array
    finally return (vconcat parts-array)))
 
 (cl-defmethod gptel--wrap-user-prompt ((_backend gptel-anthropic) prompts
diff --git a/gptel-context.el b/gptel-context.el
index fd832019b1..9d64dc1cb6 100644
--- a/gptel-context.el
+++ b/gptel-context.el
@@ -183,14 +183,6 @@ context chunk.  This is accessible as, for example:
 ;;;###autoload (autoload 'gptel-add "gptel-context" "Add/remove regions or 
buffers from gptel's context." t)
 (defalias 'gptel-add #'gptel-context-add)
 
-(defun gptel--file-binary-p (path)
-  "Check if file at PATH is readable and binary."
-  (condition-case nil
-      (with-temp-buffer
-        (insert-file-contents path nil 1 512 'replace)
-        (eq buffer-file-coding-system 'no-conversion))
-    (file-missing (message "File \"%s\" is not readable." path))))
-
 (defun gptel-context--add-text-file (path)
   "Add text file at PATH to context."
   (cl-pushnew (list path) gptel-context--alist :test #'equal)
@@ -408,14 +400,6 @@ START and END signify the region delimiters."
         (insert "\n..."))
       (insert "\n```")))
 
-(defun gptel-context--insert-file-string (path)
-  "Insert at point the contents of the file at PATH as context."
-  (insert (format "In file `%s`:" (file-name-nondirectory path))
-          "\n\n```\n")
-  (insert-file-contents path)
-  (goto-char (point-max))
-  (insert "\n```\n"))
-
 (defun gptel-context--string (context-alist)
   "Format the aggregated gptel context as annotated markdown fragments.
 
@@ -426,7 +410,7 @@ context overlays, see `gptel-context--alist'."
              if (bufferp buf)
              do (gptel-context--insert-buffer-string buf ovs)
              else if (not (plist-get ovs :mime))
-             do (gptel-context--insert-file-string buf) end
+             do (gptel--insert-file-string buf) end
              do (insert "\n\n")
              finally do
              (skip-chars-backward "\n\t\r ")
diff --git a/gptel-gemini.el b/gptel-gemini.el
index e9d1728715..dbff3416a7 100644
--- a/gptel-gemini.el
+++ b/gptel-gemini.el
@@ -332,6 +332,12 @@ format."
      (:mime_type ,(plist-get part :mime)
       :data ,(gptel--base64-encode media)))
    into parts-array
+   else if (plist-get part :textfile)
+   collect
+   (list :text (with-temp-buffer
+                 (gptel--insert-file-string (plist-get part :textfile))
+                 (buffer-string)))
+   into parts-array
    finally return (vconcat parts-array)))
 
 (cl-defmethod gptel--wrap-user-prompt ((_backend gptel-gemini) prompts
diff --git a/gptel-ollama.el b/gptel-ollama.el
index a866688097..3aad77aae4 100644
--- a/gptel-ollama.el
+++ b/gptel-ollama.el
@@ -230,7 +230,13 @@ format."
    if text
    collect text into text-array end
    else if media
-   collect (gptel--base64-encode media) into media-array end
+   collect (gptel--base64-encode media) into media-array
+   else if (plist-get part :textfile)
+   collect
+   (with-temp-buffer
+     (gptel--insert-file-string (plist-get part :textfile))
+     (buffer-string))
+   into text-array
    finally return
    `(,@(and text-array  (list :content (mapconcat #'identity text-array " ")))
      ,@(and media-array (list :images  (vconcat media-array))))))
diff --git a/gptel-openai.el b/gptel-openai.el
index 8d16119399..cb49e5c523 100644
--- a/gptel-openai.el
+++ b/gptel-openai.el
@@ -456,11 +456,16 @@ format."
    (and (or (= n 1) (= n last)) (setq text (gptel--trim-prefixes text)))
    and if text
    collect `(:type "text" :text ,text) into parts-array end
-   else if media
-   collect
+   else if media collect
    `(:type "image_url"
      :image_url (:url ,(concat "data:" (plist-get part :mime)
                         ";base64," (gptel--base64-encode media))))
+   into parts-array
+   else if (plist-get part :textfile) collect
+   `(:type "text"
+     :text ,(with-temp-buffer
+              (gptel--insert-file-string (plist-get part :textfile))
+              (buffer-string)))
    into parts-array end and
    if (plist-get part :url)
    collect
diff --git a/gptel-org.el b/gptel-org.el
index eba8ef6d85..87eecec95b 100644
--- a/gptel-org.el
+++ b/gptel-org.el
@@ -53,6 +53,7 @@
 (declare-function gptel--parse-directive "gptel")
 (declare-function gptel--restore-props "gptel")
 (declare-function gptel--with-buffer-copy "gptel")
+(declare-function gptel--file-binary-p "gptel")
 (declare-function org-entry-get "org")
 (declare-function org-entry-put "org")
 (declare-function org-with-wide-buffer "org-macs")
@@ -346,12 +347,13 @@ Return a list of the form
   (:text \"More text\"))
 for inclusion into the user prompt for the gptel request."
   (require 'mailcap)                    ;FIXME Avoid this somehow
-  (let ((parts) (from-pt)
+  (let ((parts) (from-pt) (mime)
         (link-regex (concat "\\(?:" org-link-bracket-re "\\|"
                             org-link-angle-re "\\)")))
     (save-excursion
       (setq from-pt (goto-char beg))
       (while (re-search-forward link-regex end t)
+        (setq mime nil)
         (when-let* ((link (org-element-context))
                     ((gptel-org--link-standalone-p link))
                     (raw-link (org-element-property :raw-link link))
@@ -360,25 +362,30 @@ for inclusion into the user prompt for the gptel request."
                     ;; FIXME This is not a good place to check for url 
capability!
                     ((member type `("attachment" "file"
                                     ,@(and (gptel--model-capable-p 'url)
-                                       '("http" "https" "ftp")))))
-                    (mime (mailcap-file-name-to-mime-type path))
-                    ((gptel--model-mime-capable-p mime)))
+                                       '("http" "https" "ftp"))))))
           (cond
            ((member type '("file" "attachment"))
-            (when (file-readable-p path)
-              ;; Collect text up to this image, and
-              ;; Collect this image
-              (when-let* ((text (string-trim (buffer-substring-no-properties
-                                              from-pt 
(gptel-org--element-begin link)))))
-                (unless (string-empty-p text) (push (list :text text) parts)))
-              (push (list :media path :mime mime) parts)
-              (setq from-pt (point))))
-           ((member type '("http" "https" "ftp"))
-            ;; Collect text up to this image, and
-            ;; Collect this image url
-            (when-let* ((text (string-trim (buffer-substring-no-properties
-                                            from-pt (gptel-org--element-begin 
link)))))
-              (unless (string-empty-p text) (push (list :text text) parts)))
+            (if (file-readable-p path)
+              (if (or (not (gptel--file-binary-p path))
+                      (and (setq mime (mailcap-file-name-to-mime-type path))
+                           (gptel--model-mime-capable-p mime)))
+                  (progn                ; text file or supported binary file
+                    ;; collect text up to link
+                    (when-let* ((text (buffer-substring-no-properties
+                                       from-pt (gptel-org--element-begin 
link))))
+                      (unless (string-blank-p text) (push (list :text text) 
parts)))
+                    ;; collect link
+                    (push (if mime (list :media path :mime mime) (list 
:textfile path)) parts)
+                    (setq from-pt (point)))
+                (message "Ignoring unsupported binary file \"%s\"." path))
+              (message "Ignoring inaccessible file \"%s\"." path)))
+           ((and (member type '("http" "https" "ftp"))
+                 (setq mime (mailcap-file-name-to-mime-type path))
+                 (gptel--model-capable-p mime))
+            ;; Collect text up to this image, and collect this image url
+            (when-let* ((text (buffer-substring-no-properties
+                               from-pt (gptel-org--element-begin link))))
+              (unless (string-blank-p text) (push (list :text text) parts)))
             (push (list :url raw-link :mime mime) parts)
             (setq from-pt (point))))))
       (unless (= from-pt end)
diff --git a/gptel.el b/gptel.el
index 45c84614c4..15872e32f0 100644
--- a/gptel.el
+++ b/gptel.el
@@ -931,6 +931,22 @@ Later plists in the sequence take precedence over earlier 
ones."
         (setq rtn (plist-put rtn p v))))
     rtn))
 
+(defun gptel--file-binary-p (path)
+  "Check if file at PATH is readable and binary."
+  (condition-case nil
+      (with-temp-buffer
+        (insert-file-contents path nil 1 512 'replace)
+        (eq buffer-file-coding-system 'no-conversion))
+    (file-missing (message "File \"%s\" is not readable." path)
+                  nil)))
+
+(defun gptel--insert-file-string (path)
+  "Insert at point the contents of the file at PATH as context."
+  (insert (format "In file `%s`:" (file-name-nondirectory path))
+          "\n\n```\n")
+  (insert-file-contents path)
+  (insert "\n```\n"))
+
 (defvar url-http-end-of-headers)
 (defvar url-http-response-status)
 (cl-defun gptel--url-retrieve (url &key method data headers)
@@ -2729,36 +2745,39 @@ Return a list of the form
   (:text \"More text\"))
 for inclusion into the user prompt for the gptel request."
   (require 'mailcap)                    ;FIXME Avoid this somehow
-  (let ((parts) (from-pt))
+  (let ((parts) (from-pt) (mime))
     (save-excursion
       (setq from-pt (goto-char beg))
       (while (re-search-forward
               (concat "\\(?:" markdown-regex-link-inline "\\|"
                       markdown-regex-angle-uri "\\)")
               end t)
+        (setq mime nil)
         (when-let* ((link-at-pt (markdown-link-at-pos (point)))
                     ((gptel--link-standalone-p
                       (car link-at-pt) (cadr link-at-pt)))
                     (path (nth 3 link-at-pt))
-                    (path (string-remove-prefix "file://" path))
-                    (mime (mailcap-file-name-to-mime-type path))
-                    ((gptel--model-mime-capable-p mime)))
+                    (path (string-remove-prefix "file://" path)))
           (cond
            ((seq-some (lambda (p) (string-prefix-p p path))
                       '("https:" "http:" "ftp:"))
             ;; Collect text up to this image, and collect this image url
             (when (gptel--model-capable-p 'url) ; FIXME This is not a good 
place
-                                                ; to check for url capability!
-              (push (list :text (buffer-substring-no-properties from-pt (car 
link-at-pt)))
-                    parts)
-              (push (list :url path :mime mime) parts)
-              (setq from-pt (cadr link-at-pt))))
+                                        ; to check for url capability!
+              (let ((text (buffer-substring-no-properties from-pt (car 
link-at-pt))))
+                (unless (string-blank-p text) (push (list :text text) parts))
+                (push (list :url path :mime mime) parts)
+                (setq from-pt (cadr link-at-pt)))))
            ((file-readable-p path)
-            ;; Collect text up to this image, and collect this image
-            (push (list :text (buffer-substring-no-properties from-pt (car 
link-at-pt)))
-                  parts)
-            (push (list :media path :mime mime) parts)
-            (setq from-pt (cadr link-at-pt)))))))
+            (if (or (not (gptel--file-binary-p path))
+                    (and (setq mime (mailcap-file-name-to-mime-type path))
+                         (gptel--model-mime-capable-p mime)))
+                ;; Collect text up to this image, and collect this image
+                (let ((text (buffer-substring-no-properties from-pt (car 
link-at-pt))))
+                  (unless (string-blank-p text) (push (list :text text) parts))
+                  (push (if mime (list :media path :mime mime) (list :textfile 
path)) parts)
+                  (setq from-pt (cadr link-at-pt)))
+              (message "Ignoring unsupported binary file \"%s\"." path)))))))
     (unless (= from-pt end)
       (push (list :text (buffer-substring-no-properties from-pt end)) parts))
     (nreverse parts)))

Reply via email to