branch: externals-release/ement
commit 71c2d2e3b5afe5439ae36d84df6691bd8f1963d1
Merge: 2b39a87155 ca3b0e7da1
Author: Adam Porter <[email protected]>
Commit: Adam Porter <[email protected]>
Release: v0.17
---
README.org | 19 +++++
ement-directory.el | 11 +--
ement-macros.el | 24 +++++++
ement-room-list.el | 109 ++++++++++++++++------------
ement-room.el | 168 ++++++++++++++++++++++++++++++++++++-------
ement-tabulated-room-list.el | 34 ++++++---
ement.el | 9 ++-
7 files changed, 288 insertions(+), 86 deletions(-)
diff --git a/README.org b/README.org
index 48ff4de19a..fc43423943 100644
--- a/README.org
+++ b/README.org
@@ -297,6 +297,25 @@ Ement.el doesn't support encrypted rooms natively, but it
can be used transparen
:TOC: :depth 0
:END:
+** 0.17
+
+*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-avatar-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.
+
+*Changes*
+
++ 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]].)
++ Workaround change in ~magit-section~ that broke fontification in room-list
and directory buffers. (See
[[https://github.com/alphapapa/ement.el/issues/331][#331]].)
++ Handle non-symbol commands in ~command-history~.
([[https://github.com/alphapapa/ement.el/issues/330][#330]]. Thanks to
[[https://github.com/stsquad][Alex Bennée]] for reporting.)
+
** 0.16
*Compatibility*
diff --git a/ement-directory.el b/ement-directory.el
index 73d307042a..b0b7578a6c 100644
--- a/ement-directory.el
+++ b/ement-directory.el
@@ -93,7 +93,8 @@
(_ (when-let ((room (cl-find id (ement-session-rooms session)
:key #'ement-room-id :test #'equal))
((ement--room-direct-p room session)))
- (propertize "People" 'face 'ement-room-list-direct))))))
+ (ement-propertize "People"
+ 'face 'ement-room-list-direct))))))
(defcustom ement-directory-default-keys
'((joined-p
@@ -143,8 +144,8 @@
'ement-room-list-name)))))
;; NOTE: We can't use `ement--room-display-name' because these aren't room
structs,
;; and we don't have membership data.
- (propertize (or name canonical-alias "[unnamed]")
- 'face face)))
+ (ement-propertize (or name canonical-alias "[unnamed]")
+ 'face face)))
(ement-directory-define-column "Alias" (:max-width 25)
(pcase-let (((map ('canonical_alias alias)) item))
@@ -419,8 +420,8 @@ SPACE may be a room ID or an `ement-room' struct."
;; TODO: Use space's alias where possible.
:buffer-name (format "*Ement Directory: space %s"
(ement--format-room space session))
:root-section-name (format "*Ement Directory: rooms in %s %s"
- (propertize "space"
- 'face
'font-lock-type-face)
+ (ement-propertize "space"
+ 'face 'font-lock-type-face)
(ement--format-room space
session))
:init-fn (lambda ()
(setf (alist-get 'session ement-directory-etc)
session
diff --git a/ement-macros.el b/ement-macros.el
index 9a46077500..87c10c5b74 100644
--- a/ement-macros.el
+++ b/ement-macros.el
@@ -228,6 +228,30 @@ BODY may begin with property list arguments, including:
ement-session session)))
,@body)))
+(defmacro ement-propertize (string &rest properties)
+ "Like `propertize', but auto-set `font-lock-face' property.
+If the `face' property is set, also set the `font-lock-face' property to
+the same value."
+ ;; This is a workaround for a change in `magit-section'; see
+ ;; <https://github.com/alphapapa/ement.el/issues/331>. By setting both face
properties,
+ ;; we should preserve backward compatibility. Someday this can be removed
and we'll
+ ;; just call `propertize' again.
+ (declare (indent defun))
+ (when (and (member ''face properties)
+ (not (member ''font-lock-face properties)))
+ (pcase (plist-get properties ''face #'equal)
+ ((or (pred atom) `(quote ,(pred atom)))
+ `(propertize ,string ,@properties
+ 'font-lock-face ,(plist-get properties ''face #'equal)))
+ (_
+ ;; Avoid evaluating the 'face property's form twice.
+ (let ((value-form (plist-get properties ''face #'equal))
+ (value-var (gensym "ement-propertize-")))
+ (setf (plist-get properties ''face #'equal) value-var
+ (plist-get properties ''font-lock-face #'equal) value-var)
+ `(let ((,value-var ,value-form))
+ (propertize ,string ,@properties)))))))
+
;;;; Variables
diff --git a/ement-room-list.el b/ement-room-list.el
index 81084b96a3..97674b49b3 100644
--- a/ement-room-list.el
+++ b/ement-room-list.el
@@ -35,10 +35,6 @@
(require 'ement-lib)
-(defgroup ement-room-list nil
- "Group Ement rooms with Taxy."
- :group 'ement)
-
;;;; Mouse commands
;; Since mouse-activated commands must handle mouse events, we define a simple
macro to
@@ -127,6 +123,11 @@ Set automatically when `ement-room-list-mode' is
activated.")
;;;; Customization
+(defgroup ement-room-list-faces nil
+ "Faces for room list buffers."
+ :group 'ement-room-list
+ :group 'ement-faces)
+
(defgroup ement-room-list nil
"Options for room list buffers."
:group 'ement)
@@ -139,12 +140,19 @@ Set automatically when `ement-room-list-mode' is
activated.")
"Show room avatars in the room list."
:type 'boolean)
+(defcustom ement-room-list-avatar-generation (image-type-available-p 'svg)
+ "Generate SVG-based avatars for rooms that have none."
+ :type 'boolean)
+
(defcustom ement-room-list-space-prefix "Space: "
"Prefix applied to space names."
:type 'string)
;;;;; Faces
+;; TODO: Inherit from a single face to allow certain attributes to be disabled
+;; (e.g. underline), in case a face inherited from has such attributes.
+
(defface ement-room-list-direct
;; We want to use `font-lock-constant-face' as the base face (because it
seems to look
;; nice with most themes), but that face sometimes is defined as bold, which
interferes
@@ -155,45 +163,54 @@ Set automatically when `ement-room-list-mode' is
activated.")
(progn
(copy-face 'font-lock-constant-face 'ement--font-lock-constant-face)
(set-face-attribute 'ement--font-lock-constant-face nil :weight
'unspecified)
- '((t (:inherit (ement--font-lock-constant-face ement-room-list-name)))))
- "Direct rooms.")
+ '((t (:inherit (ement--font-lock-constant-face ement-room-list-name)
:underline nil))))
+ "Direct rooms."
+ :group 'ement-room-list-faces)
(defface ement-room-list-favourite '((t (:inherit (font-lock-doc-face
ement-room-list-name))))
- "Favourite rooms.")
+ "Favourite rooms."
+ :group 'ement-room-list-faces)
(defface ement-room-list-invited
'((t (:inherit (italic ement-room-list-name))))
- "Invited rooms.")
+ "Invited rooms."
+ :group 'ement-room-list-faces)
(defface ement-room-list-left
'((t (:strike-through t :inherit ement-room-list-name)))
- "Left rooms.")
+ "Left rooms."
+ :group 'ement-room-list-faces)
(defface ement-room-list-low-priority '((t (:inherit (font-lock-comment-face
ement-room-list-name))))
- "Low-priority rooms.")
+ "Low-priority rooms."
+ :group 'ement-room-list-faces)
(defface ement-room-list-name
- '((t (:inherit (font-lock-function-name-face button))))
- "Non-direct rooms.")
+ '((t (:inherit (font-lock-function-name-face button) :underline nil)))
+ "Non-direct rooms."
+ :group 'ement-room-list-faces)
(defface ement-room-list-space '((t (:inherit
(font-lock-regexp-grouping-backslash ement-room-list-name))))
"Space rooms."
- :group 'ement-room-list)
+ :group 'ement-room-list-faces)
(defface ement-room-list-unread
'((t (:inherit (bold ement-room-list-name))))
- "Unread rooms.")
+ "Unread rooms."
+ :group 'ement-room-list-faces)
(defface ement-room-list-recent '((t (:inherit font-lock-warning-face)))
"Latest timestamp of recently updated rooms.
The foreground color is used to generate a gradient of colors
from recent to non-recent for rooms updated in the past 24
-hours but at least one hour ago.")
+hours but at least one hour ago."
+ :group 'ement-room-list-faces)
(defface ement-room-list-very-recent '((t (:inherit error)))
"Latest timestamp of very recently updated rooms.
The foreground color is used to generate a gradient of colors
-from recent to non-recent for rooms updated in the past hour.")
+from recent to non-recent for rooms updated in the past hour."
+ :group 'ement-room-list-faces)
;;;; Keys
@@ -237,7 +254,7 @@ from recent to non-recent for rooms updated in the past
hour.")
(ement-room-list-define-key people ()
(pcase-let ((`[,room ,session] item))
(when (ement--room-direct-p room session)
- (propertize "People" 'face 'ement-room-list-direct))))
+ (ement-propertize "People" 'face 'ement-room-list-direct))))
(ement-room-list-define-key space (&key name id)
(pcase-let* ((`[,room ,session] item)
@@ -268,7 +285,7 @@ from recent to non-recent for rooms updated in the past
hour.")
(_
;; TODO: How to handle this better? (though it
should be very rare)
(string-join (mapcar #'format-space parents) ",
"))))))
- (propertize key 'face 'ement-room-list-space)))))
+ (ement-propertize key 'face 'ement-room-list-space)))))
(ement-room-list-define-key space-p ()
"Groups rooms that are themselves spaces."
@@ -338,7 +355,7 @@ from recent to non-recent for rooms updated in the past
hour.")
:then #'identity
(pcase-let ((`[,room ,_session] item))
(when (ement--room-favourite-p room)
- (propertize "Favourite" 'face 'ement-room-list-favourite))))
+ (ement-propertize "Favourite" 'face 'ement-room-list-favourite))))
(ement-room-list-define-key low-priority ()
:then #'identity
@@ -403,15 +420,18 @@ from recent to non-recent for rooms updated in the past
hour.")
(propertize " " 'display
(ement--resize-image (get-text-property 0
'display avatar)
nil
(frame-char-height)))
- ;; Room has no avatar: make one.
- (let* ((string (or display-name (ement--room-display-name
room)))
- (ement-room-prism-minimum-contrast 1)
- (color (ement--prism-color string :contrast-with
"white")))
- (when (string-match (rx bos (or "#" "!" "@")) string)
- (setf string (substring string 1)))
- (propertize " " 'display (svg-lib-tag (substring string
0 1) nil
- :background color
:foreground "white"
- :stroke 0))))))
+ ;; Room has no avatar.
+ (if ement-room-list-avatar-generation
+ (let* ((string (or display-name
(ement--room-display-name room)))
+ (ement-room-prism-minimum-contrast 1)
+ (color (ement--prism-color string
:contrast-with "white")))
+ (when (string-match (rx bos (or "#" "!" "@"))
string)
+ (setf string (substring string 1)))
+ (propertize " " 'display (svg-lib-tag (substring
string 0 1) nil
+ :background
color :foreground "white"
+ :stroke 0)))
+ ;; Avatar generation disabled: use a two-space string.
+ " "))))
(setf (alist-get 'room-list-avatar (ement-room-local room))
new-avatar)))
;; Avatars disabled: use a two-space string.
" ")))
@@ -442,10 +462,10 @@ from recent to non-recent for rooms updated in the past
hour.")
(push 'ement-room-list-invited (map-elt face :inherit)))
('leave
(push 'ement-room-list-left (map-elt face :inherit))))
- (propertize display-name
- 'face face
- 'mouse-face 'highlight
- 'keymap ement-room-list-button-map))
+ (ement-propertize display-name
+ 'face face
+ 'mouse-face 'highlight
+ 'keymap ement-room-list-button-map))
"")))
(ement-room-list-define-column #("Unread" 0 6 (help-echo "Unread events
(Notifications:Highlights)")) (:align 'right)
@@ -455,13 +475,13 @@ from recent to non-recent for rooms updated in the past
hour.")
(and (equal 0 notification_count)
(equal 0 highlight_count)))
""
- (concat (propertize (number-to-string notification_count)
- 'face (if (zerop highlight_count)
- 'default
- 'ement-room-mention))
+ (concat (ement-propertize (number-to-string notification_count)
+ 'face (if (zerop highlight_count)
+ 'default
+ 'ement-room-mention))
":"
- (propertize (number-to-string highlight_count)
- 'face 'highlight)))))
+ (ement-propertize (number-to-string highlight_count)
+ 'face 'highlight)))))
(ement-room-list-define-column "Latest" ()
(pcase-let ((`[,(cl-struct ement-room latest-ts) ,_session] item))
@@ -478,8 +498,9 @@ from recent to non-recent for rooms updated in the past
hour.")
(face (list :foreground (elt ement-room-list-timestamp-colors
n)))
(formatted-ts (ement--human-format-duration difference-seconds
'abbreviate)))
(string-match (rx (1+ digit) (repeat 1 alpha)) formatted-ts)
- (propertize (match-string 0 formatted-ts) 'face face
- 'help-echo formatted-ts))
+ (ement-propertize (match-string 0 formatted-ts)
+ 'face face
+ 'help-echo formatted-ts))
"")))
(ement-room-list-define-column "Topic" (:max-width 35)
@@ -488,11 +509,11 @@ from recent to non-recent for rooms updated in the past
hour.")
(when topic
(setf topic (replace-regexp-in-string "\n" " " topic 'fixedcase
'literal)))
(pcase status
- ('invite (concat (propertize "[invited]"
- 'face 'ement-room-list-invited)
+ ('invite (concat (ement-propertize "[invited]"
+ 'face 'ement-room-list-invited)
" " topic))
- ('leave (concat (propertize "[left]"
- 'face 'ement-room-list-left)
+ ('leave (concat (ement-propertize "[left]"
+ 'face 'ement-room-list-left)
" " topic))
(_ (or topic "")))))
diff --git a/ement-room.el b/ement-room.el
index e66136a84c..a794b78ffb 100644
--- a/ement-room.el
+++ b/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)
@@ -309,6 +310,11 @@ Does not include filenames, emotes, etc.")
;;;; Customization
+(defgroup ement-room-faces nil
+ "Faces for room buffers."
+ :group 'ement-room
+ :group 'ement-faces)
+
(defgroup ement-room nil
"Options for room buffers."
:group 'ement)
@@ -331,77 +337,109 @@ If more than this many users have sent a reaction, show
the
number of senders instead (and the names in a tooltip)."
:type 'natnum)
+(defcustom ement-room-hide-redacted-message-content t
+ "Hide content in redacted messages.
+If nil, redacted messages' content will remain visible with a
+strikethrough face until the session is terminated (a new session
+will not receive the redacted content).
+
+Disabling this option may be useful for room administrators and
+moderators, so they can see content redacted by other users and
+handle it appropriately. However, one should use this option
+with caution, as it will keep unpleasant content visible even
+after it has been redacted.
+
+After changing this option, a room's buffer must be killed and
+reopened for existing messages to be rendered accordingly."
+ :type '(choice (const :tag "Hide content" t)
+ (const :tag "Strikethrough" nil)))
+
;;;;; Faces
(defface ement-room-name
'((t (:inherit font-lock-function-name-face)))
- "Room name shown in header line.")
+ "Room name shown in header line."
+ :group 'ement-room-faces)
(defface ement-room-membership
'((t (:height 0.8 :inherit font-lock-comment-face)))
- "Membership events (join/part).")
+ "Membership events (join/part)."
+ :group 'ement-room-faces)
(defface ement-room-reactions
'((t (:inherit font-lock-comment-face :height 0.9)))
- "Reactions to messages (including the user count).")
+ "Reactions to messages (including the user count)."
+ :group 'ement-room-faces)
(defface ement-room-reactions-key
'((t (:inherit ement-room-reactions :height 1.5)))
"Reactions to messages (the key, i.e. the emoji part).
Uses a separate face to allow the key to be shown at a different
size, because in some fonts, emojis are too small relative to
-normal text.")
+normal text."
+ :group 'ement-room-faces)
(defface ement-room-timestamp
'((t (:inherit font-lock-comment-face)))
- "Event timestamps.")
+ "Event timestamps."
+ :group 'ement-room-faces)
(defface ement-room-user
'((t (:inherit font-lock-function-name-face :weight bold :overline t)))
- "Usernames.")
+ "Usernames."
+ :group 'ement-room-faces)
(defface ement-room-self
'((t (:inherit (font-lock-variable-name-face ement-room-user) :weight bold)))
- "Own username.")
+ "Own username."
+ :group 'ement-room-faces)
(defface ement-room-message-text
'((t (:inherit default)))
- "Text message bodies.")
+ "Text message bodies."
+ :group 'ement-room-faces)
(defface ement-room-message-emote
'((t (:inherit italic)))
- "Emote message bodies.")
+ "Emote message bodies."
+ :group 'ement-room-faces)
(defface ement-room-quote
'((t (:height 0.9 :inherit font-lock-comment-face)))
"Quoted parts of messages.
-Anything wrapped by HTML BLOCKQUOTE tag.")
+Anything wrapped by HTML BLOCKQUOTE tag."
+ :group 'ement-room-faces)
(defface ement-room-redacted
'((t (:strike-through t)))
- "Redacted messages.")
+ "Redacted messages."
+ :group 'ement-room-faces)
(defface ement-room-self-message
'((t (:inherit (font-lock-variable-name-face))))
"Oneself's message bodies.
Note that this does not need to inherit
`ement-room-message-text', because that face is combined with
-this one automatically.")
+this one automatically."
+ :group 'ement-room-faces)
(defface ement-room-timestamp-header
'((t (:inherit header-line :weight bold :height 1.1)))
- "Timestamp headers.")
+ "Timestamp headers."
+ :group 'ement-room-faces)
(defface ement-room-mention
;; TODO(30.1): Remove when not supporting Emacs 27 anymore.
(if (version< emacs-version "27.1")
'((t (:inherit hl-line)))
'((t (:inherit hl-line :extend t))))
- "Messages that mention the local user.")
+ "Messages that mention the local user."
+ :group 'ement-room-faces)
(defface ement-room-wrap-prefix
`((t :inherit highlight))
- "Face applied to `ement-room-wrap-prefix', which see.")
+ "Face applied to `ement-room-wrap-prefix', which see."
+ :group 'ement-room-faces)
;;;;; Options
@@ -2465,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.
@@ -3237,12 +3286,12 @@ function to `ement-room-event-fns', which see."
(defface ement-room-read-receipt-marker
'((t (:inherit show-paren-match)))
"Read marker line in rooms."
- :group 'ement-room)
+ :group 'ement-room-faces)
(defface ement-room-fully-read-marker
'((t (:inherit isearch)))
"Fully read marker line in rooms."
- :group 'ement-room)
+ :group 'ement-room-faces)
(defcustom ement-room-send-read-receipts t
"Whether to send read receipts.
@@ -4144,6 +4193,14 @@ If FORMATTED-P, return the formatted body content, when
available."
(when (equal "m.replace" rel-type)
;; Message is an edit.
(setf body (concat body " " (propertize "[edited]" 'face
'font-lock-comment-face))))
+ (when (and (or local-redacted-by unsigned-redacted-by)
+ ement-room-hide-redacted-message-content)
+ ;; Message is redacted and hiding is enabled: override the body to hide
the content.
+ ;; (This is a bit of a hack, since we've already prepared the body at
this point,
+ ;; but retrofitting this into the existing logic is more than I want to
do right
+ ;; now. There are probably 3 or 4 different ways and places we could
handle
+ ;; redaction of content, and this seems like the simplest.)
+ (setf body "[redacted]"))
body))
(defun ement-room--render-html (string)
@@ -5501,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 #'call-interactively
'button t
- 'button-data mxc-url
+ 'button-data #'ement-room-download-file
'category t
'face 'button
'follow-link t
@@ -5524,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 #'call-interactively
'button t
- 'button-data mxc-url
+ 'button-data #'ement-room-download-file
'category t
'face 'button
'follow-link t
@@ -5547,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
@@ -5788,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)
@@ -5888,7 +5946,67 @@ 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
+
+;; We load `eww' to define this variable on-demand.
+(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 (progn
+ (require 'eww)
+ (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)
+ body)))
+ event)
+ (started-at (current-time))
+ (filename (if (not event-filename)
+ body
+ (if (equal body event-filename)
+ body
+ event-filename))))
+ (when (file-directory-p destination)
+ (unless (file-exists-p destination)
+ (make-directory destination 'parents))
+ (setf destination (file-name-concat destination filename)))
+ (unless (file-writable-p destination)
+ ;; FIXME: Pressing "C-u" before clicking a download link doesn't work.
+ (user-error "Destination path not writable: %S (Call with prefix to
prompt for filename)"
+ destination))
+ (when (file-exists-p destination)
+ (user-error "File already exists: %S (Call with prefix to prompt for
filename)" 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))))
+ (message "Downloading to %S..." destination)))
;;;; Footer
diff --git a/ement-tabulated-room-list.el b/ement-tabulated-room-list.el
index 4b70d3eaea..63b9ffbd53 100644
--- a/ement-tabulated-room-list.el
+++ b/ement-tabulated-room-list.el
@@ -69,8 +69,13 @@ Set automatically when `ement-tabulated-room-list-mode' is
activated.")
;;;; Customization
+(defgroup ement-tabulated-room-list-faces nil
+ "Faces for tabulated room list buffers."
+ :group 'ement-tabulated-room-list
+ :group 'ement-faces)
+
(defgroup ement-tabulated-room-list nil
- "Options for the room list buffer."
+ "Options for tabulated room list buffers."
:group 'ement)
(defcustom ement-tabulated-room-list-auto-update t
@@ -90,44 +95,53 @@ For example, \"1h54m3s\" becomes \"1h\"."
(defface ement-tabulated-room-list-name
'((t (:inherit (font-lock-function-name-face button))))
- "Non-direct rooms.")
+ "Non-direct rooms."
+ :group 'ement-tabulated-room-list-faces)
(defface ement-tabulated-room-list-direct
;; In case `font-lock-constant-face' is bold, we set the weight to normal,
so it can be
;; made bold for unread rooms only.
'((t (:weight normal :inherit (font-lock-constant-face
ement-tabulated-room-list-name))))
- "Direct rooms.")
+ "Direct rooms."
+ :group 'ement-tabulated-room-list-faces)
(defface ement-tabulated-room-list-invited
'((t (:inherit (italic ement-tabulated-room-list-name))))
- "Invited rooms.")
+ "Invited rooms."
+ :group 'ement-tabulated-room-list-faces)
(defface ement-tabulated-room-list-left
'((t (:strike-through t :inherit ement-tabulated-room-list-name)))
- "Left rooms.")
+ "Left rooms."
+ :group 'ement-tabulated-room-list-faces)
(defface ement-tabulated-room-list-unread
'((t (:inherit (bold ement-tabulated-room-list-name))))
- "Unread rooms.")
+ "Unread rooms."
+ :group 'ement-tabulated-room-list-faces)
(defface ement-tabulated-room-list-favourite '((t (:inherit
(font-lock-doc-face ement-tabulated-room-list-name))))
- "Favourite rooms.")
+ "Favourite rooms."
+ :group 'ement-tabulated-room-list-faces)
(defface ement-tabulated-room-list-low-priority '((t (:inherit
(font-lock-comment-face ement-tabulated-room-list-name))))
- "Low-priority rooms.")
+ "Low-priority rooms."
+ :group 'ement-tabulated-room-list-faces)
(defface ement-tabulated-room-list-recent
'((t (:inherit font-lock-warning-face)))
"Latest timestamp of recently updated rooms.
The foreground color is used to generate a gradient of colors
from recent to non-recent for rooms updated in the past 24
-hours but at least one hour ago.")
+hours but at least one hour ago."
+ :group 'ement-tabulated-room-list-faces)
(defface ement-tabulated-room-list-very-recent
'((t (:inherit error)))
"Latest timestamp of very recently updated rooms.
The foreground color is used to generate a gradient of colors
-from recent to non-recent for rooms updated in the past hour.")
+from recent to non-recent for rooms updated in the past hour."
+ :group 'ement-tabulated-room-list-faces)
;;;; Bookmark support
diff --git a/ement.el b/ement.el
index ea155113c4..118d9ced91 100644
--- a/ement.el
+++ b/ement.el
@@ -5,7 +5,7 @@
;; Author: Adam Porter <[email protected]>
;; Maintainer: Adam Porter <[email protected]>
;; URL: https://github.com/alphapapa/ement.el
-;; Version: 0.16
+;; Version: 0.17
;; Package-Requires: ((emacs "27.1") (map "2.1") (persist "0.5") (plz "0.6")
(taxy "0.10") (taxy-magit-section "0.13") (svg-lib "0.2.5") (transient "0.3.7"))
;; Keywords: comm
@@ -116,6 +116,10 @@ by users; ones who do so should know what they're doing.")
;;;; Customization
+(defgroup ement-faces nil
+ "Faces for Ement."
+ :group 'ement)
+
(defgroup ement nil
"Options for Ement, the Matrix client."
:group 'comm)
@@ -1091,7 +1095,8 @@ interactive arguments passed to the command, which in our
case
includes large data structures that should never be persisted!"
(setf command-history
(cl-remove-if (pcase-lambda (`(,command . ,_))
- (string-match-p (rx bos "ement-") (symbol-name
command)))
+ (cl-typecase command
+ (symbol (string-match-p (rx bos "ement-")
(symbol-name command)))))
command-history)))
(cl-pushnew 'ement--savehist-save-hook savehist-save-hook))
