mirror of
https://github.com/vale981/ement.el
synced 2025-03-04 17:01:39 -05:00
WIP: Add: Reactions
It works for newly received reactions, but after initial sync, reactions that happened in the past are not displayed. I think it's because the related events aren't found in the room's timeline, but I tried to fix that, and it still doesn't work. I'm guessing there are some assumptions that I'm making wrongly, or something that I don't understand about how the server sends events. We may have to save a list of certain types of events and process them after all other events have been processed. Ugh. The good news is that EWOC makes it pretty easy and reliable to update messages in the buffer.
This commit is contained in:
Adam Porter
parent
91e560371f
commit
81757536f2
4 changed files with 83 additions and 6 deletions
|
|
@ -117,6 +117,15 @@ In a room buffer:
|
|||
+ You can customize settings in the ~ement~ group.
|
||||
- Set ~ement-auto-sync~ to sync new messages automatically.
|
||||
|
||||
*** Displaying symbols and emojis
|
||||
|
||||
Emacs may not display certain symbols and emojis well by default. Based on [[https://emacs.stackexchange.com/questions/62049/override-the-default-font-for-emoji-characters][this question and answer]], you may find that the simplest way to fix this is to install an appropriate font, like [[https://www.google.com/get/noto/#emoji-zsye][Noto Emoji]], and then use this Elisp code:
|
||||
|
||||
#+BEGIN_SRC elisp
|
||||
(setf use-default-font-for-symbols nil)
|
||||
(set-fontset-font t 'unicode "Noto Emoji" nil 'append)
|
||||
#+END_SRC
|
||||
|
||||
* Changelog
|
||||
:PROPERTIES:
|
||||
:TOC: :depth 0
|
||||
|
|
|
|||
|
|
@ -97,7 +97,7 @@ Used by `ement-room-send-message'.")
|
|||
"Suffix for Ement room buffer names."
|
||||
:type 'string)
|
||||
|
||||
(defcustom ement-room-message-format-spec "%B%R%t"
|
||||
(defcustom ement-room-message-format-spec "%B%r%R%t"
|
||||
"Format messages according to this spec.
|
||||
It may contain these specifiers:
|
||||
|
||||
|
|
@ -107,6 +107,7 @@ It may contain these specifiers:
|
|||
%b Message body (plain-text)
|
||||
%B Message body (formatted if available)
|
||||
%i Event ID
|
||||
%r Reactions
|
||||
%s Sender ID
|
||||
%S Sender display name
|
||||
%t Event timestamp, formatted according to
|
||||
|
|
@ -190,6 +191,10 @@ See Info node `(elisp)Specified Space'."
|
|||
'((t (:inherit font-lock-comment-face)))
|
||||
"Membership events (join/part).")
|
||||
|
||||
(defface ement-room-reactions
|
||||
'((t (:inherit font-lock-comment-face :height 0.9)))
|
||||
"Reactions to messages.")
|
||||
|
||||
(defface ement-room-timestamp
|
||||
'((t (:inherit font-lock-comment-face)))
|
||||
"Event timestamps.")
|
||||
|
|
@ -520,8 +525,31 @@ function to `ement-room-event-fns', which see."
|
|||
(declare (indent defun))
|
||||
`(setf (alist-get ,type ement-room-event-fns nil nil #'string=)
|
||||
(lambda (event)
|
||||
;; TODO: Docstring.
|
||||
,@body)))
|
||||
|
||||
(ement-room-defevent "m.reaction"
|
||||
(pcase-let* (((cl-struct ement-event content) event)
|
||||
((map ('m.relates_to relates-to)) content)
|
||||
((map ('event_id related-id) ('rel_type rel-type) _key) relates-to))
|
||||
;; TODO: Handle other rel_types?
|
||||
(pcase rel-type
|
||||
("m.annotation"
|
||||
;; Look for related event in timeline.
|
||||
(if-let ((related-event (cl-loop for event in (ement-room-timeline ement-room)
|
||||
when (equal related-id (ement-event-id event))
|
||||
return event)))
|
||||
;; Found related event: add reaction to local slot and invalidate node.
|
||||
(progn
|
||||
(push event (map-elt (ement-event-local related-event) 'reactions))
|
||||
(ewoc-invalidate ement-ewoc (ement-room--ewoc-last-matching
|
||||
(lambda (data)
|
||||
(and (ement-event-p data)
|
||||
(equal related-id (ement-event-id data)))))))
|
||||
;; No known related event: discard.
|
||||
;; TODO: Is this the correct thing to do?
|
||||
nil)))))
|
||||
|
||||
(ement-room-defevent "m.typing"
|
||||
(pcase-let* (((cl-struct ement-event content) event)
|
||||
((map ('user_ids user-ids)) content)
|
||||
|
|
@ -558,6 +586,17 @@ buffer should be a room's buffer."
|
|||
(funcall pred (ewoc-data node)))
|
||||
finally return node))
|
||||
|
||||
(defun ement-room--ewoc-last-matching (predicate)
|
||||
"Return the last node in current buffer's EWOC matching PREDICATE.
|
||||
PREDICATE is called with node's data. Searches backward from
|
||||
last node."
|
||||
;; Intended to be like `ewoc-collect', but returning as soon as a match is found.
|
||||
(cl-loop with node = (ewoc-nth ement-ewoc -1)
|
||||
while node
|
||||
when (funcall predicate (ewoc-data node))
|
||||
return node
|
||||
do (setf node (ewoc-prev ement-ewoc node))))
|
||||
|
||||
(defun ement-room--insert-ts-headers (&optional start-node end-node)
|
||||
"Insert timestamp headers into current buffer's `ement-ewoc'.
|
||||
Inserts headers between START-NODE and END-NODE, which default to
|
||||
|
|
@ -764,6 +803,9 @@ seconds."
|
|||
:button-face 'ement-room-membership
|
||||
:value event)
|
||||
"")
|
||||
("m.reaction"
|
||||
;; Handled by defevent-based handler.
|
||||
"")
|
||||
(_ (propertize (format "[sender:%s type:%s]"
|
||||
(ement-user-id (ement-event-sender event))
|
||||
(ement-event-type event))
|
||||
|
|
@ -771,6 +813,22 @@ seconds."
|
|||
(propertize " "
|
||||
'display ement-room-event-separator-display-property)))
|
||||
|
||||
(defun ement-room--format-reactions (event)
|
||||
"Return formatted reactions to EVENT."
|
||||
(if-let ((reactions (map-elt (ement-event-local event) 'reactions)))
|
||||
(cl-labels ((format-key-senders
|
||||
(ks) (pcase-let ((`(,key . ,senders) ks))
|
||||
(propertize (format "%s (%s)" key (length senders))
|
||||
'help-echo (string-join senders ", ")))))
|
||||
(cl-loop with keys-senders
|
||||
for reaction in reactions
|
||||
for key = (map-nested-elt (ement-event-content reaction) '(m.relates_to key))
|
||||
for sender-name = (ement-room--user-display-name (ement-event-sender reaction) ement-room)
|
||||
do (push sender-name (alist-get key keys-senders nil nil #'string=))
|
||||
finally return (propertize (concat "\n " (string-join (mapcar #'format-key-senders keys-senders) " "))
|
||||
'face 'ement-room-reactions)))
|
||||
""))
|
||||
|
||||
(cl-defun ement-room--format-message (event &optional (format ement-room-message-format-spec))
|
||||
"Return EVENT formatted according to FORMAT.
|
||||
Format defaults to `ement-room-message-format-spec', which see."
|
||||
|
|
@ -819,6 +877,7 @@ Format defaults to `ement-room-message-format-spec', which see."
|
|||
(?s (propertize (ement-user-id (ement-event-sender event))
|
||||
'face 'ement-room-user))
|
||||
(?S (ement-room--format-user (ement-event-sender event) ement-room))
|
||||
(?r (ement-room--format-reactions event))
|
||||
(?t (propertize (format-time-string ement-room-timestamp-format
|
||||
;; Timestamps are in milliseconds.
|
||||
(/ (ement-event-origin-server-ts event) 1000))
|
||||
|
|
|
|||
|
|
@ -41,7 +41,9 @@
|
|||
color)
|
||||
|
||||
(cl-defstruct ement-event
|
||||
id sender content origin-server-ts type unsigned)
|
||||
id sender content origin-server-ts type unsigned
|
||||
;; The local slot is an alist used by the local client only.
|
||||
local)
|
||||
|
||||
(cl-defstruct ement-server
|
||||
name port uri-prefix)
|
||||
|
|
|
|||
15
ement.el
15
ement.el
|
|
@ -372,15 +372,22 @@ To be called in `ement-sync-callback-hook'."
|
|||
(dolist (buffer buffers)
|
||||
(with-current-buffer buffer
|
||||
(cl-assert ement-room)
|
||||
;; Add the new events to the main timeline slot first, because some events can
|
||||
;; refer to other events, and we want them to be found in the timeline slot.
|
||||
(setf (ement-room-timeline ement-room) (append (ement-room-timeline* ement-room)
|
||||
(ement-room-timeline ement-room)))
|
||||
(when (ement-room-ephemeral ement-room)
|
||||
(ement-room--process-events (ement-room-ephemeral ement-room))
|
||||
(setf (ement-room-ephemeral ement-room) nil))
|
||||
(when (ement-room-timeline* ement-room)
|
||||
(ement-room--insert-events (ement-room-timeline* ement-room))
|
||||
;; Move new events.
|
||||
(setf (ement-room-timeline ement-room) (append (ement-room-timeline* ement-room)
|
||||
(ement-room-timeline ement-room))
|
||||
(ement-room-timeline* ement-room) nil))))))
|
||||
;; For now, we also call `--process-events' for ones that are defined with `ement-room-defevent'.
|
||||
;; FIXME: Unify this.
|
||||
;; HACK: Process these events in reverse order, so that later events
|
||||
;; (like reactions) which refer to earlier events can find them.
|
||||
(ement-room--process-events (reverse (ement-room-timeline* ement-room)))
|
||||
;; Clear new events slot.
|
||||
(setf (ement-room-timeline* ement-room) nil))))))
|
||||
|
||||
(defun ement--push-joined-room-events (session joined-room)
|
||||
"Push events for JOINED-ROOM into that room in SESSION."
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue