diff --git a/ement-notify.el b/ement-notify.el index 566401d..321dfbe 100644 --- a/ement-notify.el +++ b/ement-notify.el @@ -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) diff --git a/ement-room.el b/ement-room.el index e9e1f45..a21bb1a 100644 --- a/ement-room.el +++ b/ement-room.el @@ -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