mirror of
https://github.com/vale981/ement.el
synced 2025-03-04 17:01:39 -05:00
WIP
We need to compare event rooms, which aren't in the event structs, so this is more complicated than I realized.
This commit is contained in:
Adam Porter
parent
a5c96bd682
commit
94c626d985
2 changed files with 118 additions and 23 deletions
|
|
@ -232,32 +232,35 @@ anything if session hasn't finished initial sync."
|
|||
(ement-room room)
|
||||
(ement-room-sender-in-left-margin nil)
|
||||
(ement-room-message-format-spec "%o%O » %S> %B%R%t")
|
||||
(ement-room-coalesce-events t)
|
||||
(ement-room-coalescable-events ement-notify-coalescable-events)
|
||||
(new-node (ement-room--insert-event event))
|
||||
(inhibit-read-only t)
|
||||
start end)
|
||||
(ewoc-goto-node ement-ewoc new-node)
|
||||
(setf start (point))
|
||||
(if-let (next-node (ewoc-next ement-ewoc new-node))
|
||||
(ewoc-goto-node ement-ewoc next-node)
|
||||
(goto-char (point-max)))
|
||||
(setf end (- (point) 2))
|
||||
(add-text-properties start end
|
||||
(list 'button '(t)
|
||||
'category 'default-button
|
||||
'action #'ement-notify-button-action
|
||||
'session session
|
||||
'room room
|
||||
'event event))
|
||||
;; Remove button face property.
|
||||
(alter-text-property start end 'face
|
||||
(lambda (face)
|
||||
(pcase face
|
||||
('button nil)
|
||||
((pred listp) (remq 'button face))
|
||||
(_ face))))
|
||||
(when ement-notify-prism-background
|
||||
(add-face-text-property start end (list :background (ement-notify--room-background-color room)
|
||||
:extend t))))))))
|
||||
;; (ewoc-goto-node ement-ewoc new-node)
|
||||
;; (setf start (point))
|
||||
;; (if-let (next-node (ewoc-next ement-ewoc new-node))
|
||||
;; (ewoc-goto-node ement-ewoc next-node)
|
||||
;; (goto-char (point-max)))
|
||||
;; (setf end (- (point) 2))
|
||||
;; (add-text-properties start end
|
||||
;; (list 'button '(t)
|
||||
;; 'category 'default-button
|
||||
;; 'action #'ement-notify-button-action
|
||||
;; 'session session
|
||||
;; 'room room
|
||||
;; 'event event))
|
||||
;; ;; Remove button face property.
|
||||
;; (alter-text-property start end 'face
|
||||
;; (lambda (face)
|
||||
;; (pcase face
|
||||
;; ('button nil)
|
||||
;; ((pred listp) (remq 'button face))
|
||||
;; (_ face))))
|
||||
;; (when ement-notify-prism-background
|
||||
;; (add-face-text-property start end (list :background (ement-notify--room-background-color room)
|
||||
;; :extend t)))
|
||||
)))))
|
||||
|
||||
(defun ement-notify--log-buffer (name)
|
||||
"Return an Ement notifications buffer named NAME."
|
||||
|
|
@ -318,6 +321,41 @@ According to the room's notification configuration on the server."
|
|||
(when body
|
||||
(string-match-p (rx bow "@room" (or ":" (1+ blank))) body))))
|
||||
|
||||
;;;; Coalescing
|
||||
|
||||
(cl-defstruct ement-notify-room-events
|
||||
"Struct grouping room events.
|
||||
After adding events, use `ement-notify-room-events--update'
|
||||
to sort events and update other slots."
|
||||
(events nil :documentation "Message events, latest first.")
|
||||
(earliest-ts nil :documentation "Timestamp of earliest event.")
|
||||
(latest-ts nil :documentation "Timestamp of latest event."))
|
||||
|
||||
(defun ement-notify-room-events--update (struct)
|
||||
"Return STRUCT having sorted its events and updated its slots."
|
||||
;; Like the room timeline slot, events are sorted latest-first.
|
||||
(setf (ement-notify-room-events-events struct) (cl-sort (ement-notify-room-events-events struct) #'>
|
||||
:key #'ement-event-origin-server-ts)
|
||||
(ement-notify-room-events-earliest-ts struct) (ement-event-origin-server-ts
|
||||
(car (last (ement-notify-room-events-events struct))))
|
||||
(ement-notify-room-events-latest-ts struct) (ement-event-origin-server-ts
|
||||
(car (ement-notify-room-events-events struct))))
|
||||
struct)
|
||||
|
||||
(defvar ement-notify-coalescable-events
|
||||
(ement-alist "m.room.message" '( ement-notify-room-events ement-notify-room-events-p
|
||||
make-ement-notify-room-events ement-notify-room-events--update
|
||||
(lambda (a b)
|
||||
;; FIXME: We need to compare event rooms, which
|
||||
;; aren't in the event structs, so this is more
|
||||
;; complicated than I realized.
|
||||
(equal (ement-event-send )))))
|
||||
"Alist mapping event type strings to structs which may coalesce them.
|
||||
The value is a list of four symbols: the struct type, the struct
|
||||
predicate, the struct constructor, and a function which is called
|
||||
after changing the struct's value to update it in some way (which
|
||||
should be `identity' if nothing else).")
|
||||
|
||||
;;;; Footer
|
||||
|
||||
(provide 'ement-notify)
|
||||
|
|
|
|||
|
|
@ -2677,6 +2677,18 @@ the first and last nodes in the buffer, respectively."
|
|||
;; Node B is an event with a different sender: insert header.
|
||||
(ewoc-enter-before ewoc node-b (ement-event-sender b-data))))))))
|
||||
|
||||
(defvar ement-room-coalescable-events
|
||||
(ement-alist "m.room.member" '( ement-room-membership-events ement-room-membership-events-p
|
||||
make-ement-room-membership-events ement-room-membership-events--update
|
||||
(lambda (_a _b) t)))
|
||||
"Alist mapping event type strings to structs which may coalesce them.
|
||||
The value is a list of five symbols: the struct type, the struct
|
||||
predicate, the struct constructor, a function which is called
|
||||
after changing the struct's value to update it in some way (which
|
||||
should be `identity' if nothing else), and a predicate called
|
||||
with two event arguments, which should return non-nil if they may
|
||||
be coalesced.")
|
||||
|
||||
(defun ement-room--coalesce-nodes (a b ewoc)
|
||||
"Try to coalesce events in nodes A and B in EWOC, returning non-nil if done."
|
||||
(cl-labels ((coalescable-p
|
||||
|
|
@ -2699,6 +2711,51 @@ the first and last nodes in the buffer, respectively."
|
|||
(ewoc-invalidate ewoc absorbing-node)
|
||||
t))))
|
||||
|
||||
(defun ement-room--coalesce-nodes (a b ewoc)
|
||||
"Try to coalesce events in nodes A and B in EWOC, returning non-nil if done."
|
||||
(let (struct-type predicate constructor updater event-predicate)
|
||||
(cl-labels ((coalescable-type
|
||||
(node) (when (ement-event-p (ewoc-data node))
|
||||
(or (pcase-let ((`(,ty ,p ,c ,u, ep)
|
||||
(alist-get (ement-event-type (ewoc-data node))
|
||||
ement-room-coalescable-events nil nil #'equal)))
|
||||
(when ty
|
||||
(setf struct-type ty
|
||||
predicate p
|
||||
constructor c
|
||||
updater u
|
||||
event-predicate ep))
|
||||
(ement-event-type (ewoc-data node)))
|
||||
(cl-loop for (event-type . (ty p c u)) in ement-room-coalescable-events
|
||||
when (funcall p (ewoc-data node))
|
||||
do (setf struct-type ty
|
||||
predicate p
|
||||
constructor c
|
||||
updater u
|
||||
event-predicate ep)
|
||||
and return event-type)))))
|
||||
(let ((a-type (coalescable-type a))
|
||||
(b-type (coalescable-type b)))
|
||||
(when (and (equal a-type b-type) a-type b-type
|
||||
(funcall event-predicate (ewoc-data a) (ewoc-data b)))
|
||||
(let* ((absorbing-node (if (or (funcall predicate (ewoc-data a))
|
||||
(not (funcall predicate (ewoc-data b))))
|
||||
a b))
|
||||
(absorbed-node (if (eq absorbing-node a) b a)))
|
||||
(cl-typecase (ewoc-data absorbing-node)
|
||||
(ement-event
|
||||
;; Absorbing node is a plain event node: replace it with the coalescable node.
|
||||
(setf (ewoc-data absorbing-node)
|
||||
(funcall updater
|
||||
(funcall constructor :events (list (ewoc-data absorbing-node)))))))
|
||||
;; Add absorbed node's data to the absorbing node and update it, delete the
|
||||
;; absorbed node, and invalidate the absorbing node.
|
||||
(push (ewoc-data absorbed-node) (cl-struct-slot-value struct-type 'events (ewoc-data absorbing-node)))
|
||||
(funcall updater (ewoc-data absorbing-node))
|
||||
(ewoc-delete ewoc absorbed-node)
|
||||
(ewoc-invalidate ewoc absorbing-node)
|
||||
t))))))
|
||||
|
||||
(defun ement-room--insert-event (event)
|
||||
"Insert EVENT into current buffer."
|
||||
(cl-labels ((format-event
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue