branch: externals/ement
commit 8c962ccd7c4650b4292cde862770628e6d948044
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Add: Authenticated media support for browse-url
---
ement-lib.el | 21 +++++++++++++++++++++
ement-room.el | 53 +++++++++++++++++++++++++++++------------------------
2 files changed, 50 insertions(+), 24 deletions(-)
diff --git a/ement-lib.el b/ement-lib.el
index 723498c98f..4dfc8363aa 100644
--- a/ement-lib.el
+++ b/ement-lib.el
@@ -1802,6 +1802,27 @@ seconds, etc."
choices)))
(read-multiple-choice prompt choices (format help-format help-choices))))
+(cl-defun ement--media-request
+ (mxc session &key queue (then #'ignore) (else #'ement-api-error)
+ (as 'binary) (authenticatedp t))
+ "Request media from MXC URL on SESSION.
+If AUTHENTICATEDP, send authenticated request. Arguments THEN,
+ELSE, and AS are passed to `ement-api' for authenticated media
+requests, or to `plz' for unauthenticated ones, each which see.
+If QUEUE, send request on it."
+ (declare (indent defun))
+ (if authenticatedp
+ (ement-api session (ement--mxc-to-endpoint mxc) :version "v1"
+ :json-read-fn as :then then :else else :queue queue)
+ ;; Send unauthenticated request.
+ (if queue
+ (plz-run
+ (plz-queue queue
+ 'get (ement--mxc-to-url mxc session) :as as
+ :then then :else else :noquery t))
+ (plz 'get (ement--mxc-to-url mxc session) :as as
+ :then then :else else :noquery t))))
+
;;; Footer
(provide 'ement-lib)
diff --git a/ement-room.el b/ement-room.el
index 44362bec19..e66136a84c 100644
--- a/ement-room.el
+++ b/ement-room.el
@@ -5365,15 +5365,8 @@ unauthenticated request to old endpoint."
(declare (indent defun))
(pcase-let* (((cl-struct ement-event content) event)
((map ('url mxc)) content))
- (if authenticatedp
- (ement-api session (ement--mxc-to-endpoint mxc) :version "v1"
- :json-read-fn 'binary :then then :else else
- :queue ement-images-queue)
- ;; Send unauthenticated request.
- (plz-run
- (plz-queue ement-images-queue
- 'get (ement--mxc-to-url mxc session) :as 'binary
- :then then :noquery t)))))
+ (ement--media-request mxc session :then then :else else
+ :queue ement-images-queue :authenticatedp authenticatedp)))
(defun ement-room--format-m.image (event session)
"Return \"m.image\" EVENT on SESSION formatted as a string.
@@ -5504,19 +5497,17 @@ Then invalidate EVENT's node to show the image."
('info (map mimetype size))
('url mxc-url))))
event)
- (url (when mxc-url
- (ement--mxc-to-url mxc-url ement-session)))
(human-size (when size
(file-size-human-readable size)))
(string (format "[file: %s (%s) (%s)]" filename mimetype
human-size)))
(concat (propertize string
- 'action #'browse-url
+ 'action #'ement-room-browse-mxc
'button t
- 'button-data url
+ 'button-data mxc-url
'category t
'face 'button
'follow-link t
- 'help-echo url
+ 'help-echo mxc-url
'keymap button-map
'mouse-face 'highlight)
(propertize " "
@@ -5530,18 +5521,16 @@ Then invalidate EVENT's node to show the image."
('info (map mimetype size w h))
('url mxc-url))))
event)
- (url (when mxc-url
- (ement--mxc-to-url mxc-url ement-session)))
(human-size (file-size-human-readable size))
(string (format "[video: %s (%s) (%sx%s) (%s)]" body mimetype w
h human-size)))
(concat (propertize string
- 'action #'browse-url
+ 'action #'ement-room-browse-mxc
'button t
- 'button-data url
+ 'button-data mxc-url
'category t
'face 'button
'follow-link t
- 'help-echo url
+ 'help-echo mxc-url
'keymap button-map
'mouse-face 'highlight)
(propertize " "
@@ -5554,19 +5543,17 @@ Then invalidate EVENT's node to show the image."
('info (map mimetype duration size))
('url mxc-url))))
event)
- (url (when mxc-url
- (ement--mxc-to-url mxc-url ement-session)))
(human-size (file-size-human-readable size))
(human-duration (format-seconds "%m:%s" (/ duration 1000)))
(string (format "[audio: %s (%s) (%s) (%s)]" body mimetype
human-duration human-size)))
(concat (propertize string
- 'action #'browse-url
+ 'action #'ement-room-browse-mxc
'button t
- 'button-data url
+ 'button-data mxc-url
'category t
'face 'button
'follow-link t
- 'help-echo url
+ 'help-echo mxc-url
'keymap button-map
'mouse-face 'highlight)
(propertize " "
@@ -5885,6 +5872,24 @@ For use in `completion-at-point-functions'."
(or (not ement-auto-sync)
(not (map-elt ement-syncs ement-session)))))])
+;;;; Browsing URLs, EWW
+
+(defun ement-room-browse-mxc (mxc)
+ ;; TODO: If prefix arg, prompt for destination and download to file.
+ "Browse MXC URL on current `ement-session'."
+ ;; For authenticated media, we have to provide our own version of
`eww-retrieve'.
+ (let ((session ement-session))
+ (cl-letf (((symbol-function 'eww-retrieve)
+ (lambda (mxc callback cbargs)
+ (ement--media-request mxc session
+ :as (lambda ()
+ ;; EWW wants to parse the headers itself, so widen
and decode them.
+ (widen)
+ (decode-coding-region (point-min) (point) 'utf-8)
+ ;; HACK: This STATUS argument to `eww-render' is
bogus.
+ (apply callback 'status cbargs))))))
+ (browse-url mxc))))
+
;;;; Footer
(provide 'ement-room)
