Re: [jabber.el] [PATCH UPDATED] Add jabber-chat-print-image to body-printers, move jb-print-url too

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

If a jabber:x:oob message is received with a URL that looks like an
image, the image is fetched and displayed. If it can't be displayed,
Image: url is shown instead.

I'm not quite sure about moving jabber-char-print-url to
jabber-body-printers, but I don't think it makes sense to show it if
displaying the image succeeds.

However, if there is a URL, that can't be displayed, maybe the body
should be shown? Hm.

In the examples I've seen, the message looks like:

  <message from="vi...@ko.../pidgin" to="as...@ko..." type="chat" id="purple4fb6fb94">
    <archived by="koldfront.dk" xmlns="urn:xmpp:mam:tmp" id="1555194815542627"/>
    <stanza-id by="koldfront.dk" xmlns="urn:xmpp:sid:0" id="1555194815542627"/>
    <body>https://koldfront.dk/xmpp/virgil/8ze1C6CGD1hvWQhbl4cYNzDYrAb19wjbFX7IkXZ3/x-face.png</body>
    <x xmlns="jabber:x:oob">
      <url>https://koldfront.dk/xmpp/virgil/8ze1C6CGD1hvWQhbl4cYNzDYrAb19wjbFX7IkXZ3/x-face.png</url>
    </x>
  </message>

So the body is redundant when the jabber:x:oob url is handled.
---
I have updated the patch to handle errors when fetching/creating the
image, it will now properly display Image: url, and I have added the
max-width and max-height as customizable values. Also, webp is now in
the regex.

 jabber-chat.el | 60 ++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 58 insertions(+), 2 deletions(-)

diff --git a/jabber-chat.el b/jabber-chat.el
index e2fd607..60e91f7 100644
--- a/jabber-chat.el
+++ b/jabber-chat.el
@@ -139,6 +139,16 @@ These fields are available:
   :type 'string
   :group 'jabber-chat)
 
+(defcustom jabber-chat-image-max-width 800
+  "The maximum width of images shown in chats."
+  :type 'integer
+  :group 'jabber-chat)
+
+(defcustom jabber-chat-image-max-height 400
+  "The maximum height of images shown in chats."
+  :type 'integer
+  :group 'jabber-chat)
+
 (defface jabber-chat-prompt-local
   '((t (:foreground "blue" :weight bold)))
   "face for displaying the chat prompt for what you type in"
@@ -177,7 +187,6 @@ These fields are available:
 
 (defvar jabber-chat-printers '(jabber-chat-print-subject
 			       jabber-chat-print-body
-			       jabber-chat-print-url
 			       jabber-chat-goto-address)
   "List of functions that may be able to print part of a message.
 Each function receives these arguments:
@@ -187,7 +196,9 @@ WHO        :local or :foreign, for sent or received stanza, respectively
 MODE       :insert or :printp.  For :insert, insert text at point.
            For :printp, return non-nil if function would insert text.")
 
-(defvar jabber-body-printers '(jabber-chat-normal-body)
+(defvar jabber-body-printers '(jabber-chat-print-image
+			       jabber-chat-print-url
+                               jabber-chat-normal-body)
   "List of functions that may be able to print a body for a message.
 Each function receives these arguments:
 
@@ -630,6 +641,51 @@ If DONT-PRINT-NICK-P is true, don't include nickname."
                     (format "%s <%s>" desc url))))))
     foundp))
 
+(defun jabber-chat-download-image (url)
+  "Download image from URL and return as image"
+  ;;; Maybe do a HEAD request and check Content-Type: instead?
+  (when (string-match "^https?://.*\\.\\(png\\|jpg\\|jpeg\\|gif\\|webp\\)$" url)
+    (condition-case nil
+        (let ((image-buffer (url-retrieve-synchronously url)))
+          (when image-buffer
+            (with-current-buffer image-buffer
+              (goto-char (point-min))
+              (re-search-forward "^$" nil 'move)
+              (forward-char)
+              (delete-region (point-min) (point))
+              (let ((image (create-image (buffer-string) nil t :max-width jabber-chat-image-max-width :max-height jabber-chat-image-max-height)))
+                                        ; I can't figure out how to use max-width and max-height,
+                                        ; as width and height are set, and overrides them:
+                (let ((width (image-property image :width))
+                      (height (image-property image :height)))
+                  (setf (image-property image :width) nil)
+                  (setf (image-property image width) nil)
+                  (setf (image-property image :height) nil)
+                  (setf (image-property image height) nil))
+                image))))
+      (error nil))))
+
+(defun jabber-chat-print-image (xml-data who mode)
+  "Print images provided in jabber:x:oob namespace."
+  (let ((foundp nil))
+    (dolist (x (jabber-xml-node-children xml-data))
+      (when (and (listp x) (eq (jabber-xml-node-name x) 'x)
+		 (string= (jabber-xml-get-attribute x 'xmlns) "jabber:x:oob"))
+	(setq foundp t)
+
+	(when (eql mode :insert)
+	  (let ((url (car (jabber-xml-node-children
+			   (car (jabber-xml-get-children x 'url))))))
+            (let ((image (jabber-chat-download-image url)))
+              (if image
+                  (progn
+                    (insert-image image url)
+                    (insert "\n"))
+                (insert (jabber-propertize
+		         "Image: " 'face 'jabber-chat-prompt-system)
+                        url)))))))
+    foundp))
+
 (defun jabber-chat-goto-address (xml-data who mode)
   "Call `goto-address' on the newly written text."
   (when (eq mode :insert)
-- 
2.20.1



-- 
 "Everything needs to change.                                 Adam Sjøgren
  And it has to start today."                            as...@ko...



