Merge: Support downloading media

See #323.

Author: alphapapa

README.org

@@ -301,6 +301,7 @@ Ement.el doesn't support encrypted rooms natively, but it can be used transparen
 
 *Additions*
 
++ Command ~ement-room-download-file~, which downloads the file in the event at point (for image, audio, video, and file messages).  ([[https://github.com/alphapapa/ement.el/pull/323][#323]].  Thanks to [[https://github.com/viiru-][Arto Jantunen]].)
 + Customization groups for faces.  (Thanks to [[https://github.com/phil-s][Phil Sainty]].)
 + Option ~ement-room-hide-redacted-message-content~, which hides the content of redacted messages by default.  It may be disabled to keep redacted content visible with a strikethrough face, which may be useful for room moderators, but users should keep in mind that doing so will leave unpleasant content visible in the current session, even after being redacted by moderators.
 + Option ~ement-room-list-avatars-generation~: if disabled, SVG-based room avatars are not generated.  This option automatically tests whether SVG support is available in Emacs, and should allow use with builds of Emacs that lack =librsvg= support. 
@@ -309,6 +310,10 @@ Ement.el doesn't support encrypted rooms natively, but it can be used transparen
 
 + Disable underline for faces ~ement-room-list-direct~ and ~ement-room-list-name~ (in case a face they inherit from enables it, e.g. when themed).
 
+*Fixes*
+
++ Call ~eww-browse-url~ instead of ~browse-url~ in ~ement-room-browse-mxc~ (because the latter is not useful for authenticated media if the user has configured it to use a different browser).  ([[https://github.com/alphapapa/ement.el/pull/323][#323]].  Thanks to [[https://github.com/viiru-][Arto Jantunen]].)
+
 ** 0.16
 
 *Compatibility*

ement-room.el

@@ -195,6 +195,7 @@ keymap directly the issue may be visible.")
     (define-key map (kbd "s f") #'ement-room-send-file)
     (define-key map (kbd "s i") #'ement-room-send-image)
     (define-key map (kbd "v") #'ement-room-view-event)
+    (define-key map (kbd "D") #'ement-room-download-file)
 
     ;; Users
     (define-key map (kbd "u RET") #'ement-send-direct-message)
@@ -2502,6 +2503,17 @@ To be used in `ement-room-view-hook', which see."
       (goto-char (ewoc-location node))
     (error "Event not found in buffer: %S" (ement-event-id event))))
 
+(defun ement-room--event-at (pos)
+  "Return event at POS or signal an error."
+  ;; TODO: Use this where appropriate.
+  (save-excursion
+    (goto-char pos)
+    (cl-assert ement-ewoc)
+    (let ((data (ewoc-data (ewoc-locate ement-ewoc))))
+      (cl-typecase data
+        (ement-event data)
+        (otherwise (user-error "No event at point"))))))
+
 (cl-defun ement-room-retro-callback (room session data
                                           &key (set-prev-batch t))
   "Push new DATA to ROOM on SESSION and add events to room buffer.
@@ -5546,9 +5558,9 @@ Then invalidate EVENT's node to show the image."
                              (file-size-human-readable size)))
                (string (format "[file: %s (%s) (%s)]" filename mimetype human-size)))
     (concat (propertize string
-                        'action #'ement-room-browse-mxc
+                        'action #'ement-room-download-file
                         'button t
-                        'button-data mxc-url
+                        'button-data event
                         'category t
                         'face 'button
                         'follow-link t
@@ -5569,9 +5581,9 @@ Then invalidate EVENT's node to show the image."
                (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 #'ement-room-browse-mxc
+                        'action #'ement-room-download-file
                         'button t
-                        'button-data mxc-url
+                        'button-data event
                         'category t
                         'face 'button
                         'follow-link t
@@ -5592,9 +5604,9 @@ Then invalidate EVENT's node to show the image."
                (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 #'ement-room-browse-mxc
+                        'action #'ement-room-download-file
                         'button t
-                        'button-data mxc-url
+                        'button-data event
                         'category t
                         'face 'button
                         'follow-link t
@@ -5833,7 +5845,8 @@ For use in `completion-at-point-functions'."
               ("s r" "Send reaction" ement-room-send-reaction)
               ("s e" "Send emote" ement-room-send-emote)
               ("s f" "Send file" ement-room-send-file)
-              ("s i" "Send image" ement-room-send-image)]
+              ("s i" "Send image" ement-room-send-image)
+              ("D" "Download event media" ement-room-download-file)]
              ["Users"
               ("u RET" "Send direct message" ement-send-direct-message)
               ("u i" "Invite user" ement-invite-user)
@@ -5933,7 +5946,56 @@ For use in `completion-at-point-functions'."
                          (decode-coding-region (point-min) (point) 'utf-8)
                          ;; HACK: This STATUS argument to `eww-render' is bogus.
                          (apply callback 'status cbargs))))))
-      (browse-url mxc))))
+      (eww-browse-url mxc))))
+
+;;;; Downloading media/files
+
+(defvar eww-download-directory)
+
+(defun ement-room-download-file (event destination)
+  "Download EVENT's file to DESTINATION.
+If DESTINATION is a directory, use the file's default name;
+otherwise, download to the filename.  Interactively, download to
+`eww-download-directory'; with prefix, prompt for destination."
+  (interactive (list (ement-room--event-at (point))
+                     (if current-prefix-arg
+                         (expand-file-name
+                          (read-file-name
+                           "Download to: "
+                           (cl-typecase eww-download-directory
+                             (string eww-download-directory)
+                             (function (funcall eww-download-directory)))))
+                       (expand-file-name
+                        (cl-typecase eww-download-directory
+                          (string eww-download-directory)
+                          (function (funcall eww-download-directory)))))))
+  (pcase-let (((cl-struct ement-event
+                          (content (map ('filename event-filename)
+                                        ('url mxc-url))))
+               event)
+              (started-at (current-time)))
+    (when (directory-name-p destination)
+      (unless (file-exists-p destination)
+        (make-directory destination 'parents))
+      (setf destination (file-name-concat destination event-filename)))
+    (unless (file-writable-p destination)
+      (user-error "Destination path not writable: %S" destination))
+    (when (file-exists-p destination)
+      (user-error "File already exists: %S" destination))
+    ;; TODO: For bonus points, provide a way to cancel a download (otherwise the user
+    ;; would have to use `list-processes' and find the right one to delete), and to see
+    ;; progress (perhaps borrowing some of the relevant code in hyperdrive.el).
+    (ement--media-request mxc-url ement-session :authenticatedp t
+      :as `(file ,destination)
+      :then (lambda (&rest _)
+              (let* ((file-size (file-attribute-size
+                                 (file-attributes destination)))
+                     (duration (float-time (time-subtract (current-time) started-at)))
+                     (speed (file-size-human-readable (/ file-size duration))))
+                (message "File downloaded: %S (%s in %s at %s/sec) "
+                         destination (file-size-human-readable file-size)
+                         (format-seconds "%h:%m:%s%z seconds" duration)
+                         speed))))))
 
 ;;;; Footer