hiro/ement.el
1
0
Fork 0
mirror of https://github.com/vale981/ement.el synced 2025-03-05 09:21:37 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP: Put coalesced membership events before user ID headers

Browse source 
This doesn't work yet; it breaks coalescing.  Trying to fix this
requires a lot of looking at debug messages, which hasn't helped yet.

Maybe a better solution would be to rewrite the user ID headers to
themselves use coalescing.

Also, EIEIO actually could be helpful, e.g. since the events and
coalescing structs both have timestamp fields, having a single
accessor would be more convenient than sprinkling typecases around the
code.

Anyway, this is enough for now.
This commit is contained in:
Adam Porter 2021-07-04 19:33:40 -05:00
parent a612cb026c
commit 36a473d67f
1 changed files with 28 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
ement-room.el
View file

@ -450,16 +450,19 @@ the buffer."
(cl-typecase it (cl-typecase it
(ement-event (ement-event-origin-server-ts it)) (ement-event (ement-event-origin-server-ts it))
(ement-coalesced (ement-coalesced-ts it))))) (ement-coalesced (ement-coalesced-ts it)))))
(ement-debug "event<:" "Comparing timestamps:" (list 'A (aref a 0) (it-ts a)) (list 'B (aref b 0) (it-ts b)))
(< (it-ts a) (it-ts b))))) (< (it-ts a) (it-ts b)))))
(node-before (ement-room--ewoc-node-before ewoc event event< :pred (lambda (node) (node-before (ement-room--ewoc-node-before ewoc event event< :pred (lambda (node)
(or (ement-event-p node) (or (ement-event-p node)
(ement-coalesced-p node))))) (ement-coalesced-p node)))))
new-node) new-node)
(pcase (ement-event-type event) (pcase (ement-event-type event)
("m.room.member" (ement-room--insert-coalesced ("m.room.member"
event (lambda (node) (ement-room--insert-coalesced
(and (ement-coalesced-p node) ewoc node-before event
(equal "m.room.member" (ement-event-type (car (ement-coalesced-events node)))))))) (lambda (node)
(and (ement-coalesced-p (ewoc-data node))
(equal "m.room.member" (ement-event-type (car (ement-coalesced-events (ewoc-data node)))))))))
(_ (_
(setf new-node (if (not node-before) (setf new-node (if (not node-before)
(progn (progn
@ -487,6 +490,7 @@ the buffer."
(setf node-before next-node))) (setf node-before next-node)))
(ewoc-enter-after ewoc node-before event))) (ewoc-enter-after ewoc node-before event)))
;; Insert sender where necessary. ;; Insert sender where necessary.
;; FIXME: Use event coalescing for this.
(if (not node-before) (if (not node-before)
(progn (progn
(ement-debug "No event before: Add sender before new node.") (ement-debug "No event before: Add sender before new node.")
@ -524,6 +528,10 @@ the buffer."
(ement-debug "EWOC has data: add at appropriate place.") (ement-debug "EWOC has data: add at appropriate place.")
(cl-labels ((next-matching (cl-labels ((next-matching
(ewoc node next-fn pred) (cl-loop do (setf node (funcall next-fn ewoc node)) (ewoc node next-fn pred) (cl-loop do (setf node (funcall next-fn ewoc node))
(let ((print-level 1)
(print-length 5))
(ement-debug "Next node:" (when node
(ewoc-data node))))
until (or (null node) until (or (null node)
(funcall pred (ewoc-data node))) (funcall pred (ewoc-data node)))
finally return node))) finally return node)))
@ -627,39 +635,37 @@ seconds."
(propertize " " (propertize " "
'display ement-room-event-separator-display-property))) 'display ement-room-event-separator-display-property)))
(defun ement-room--insert-coalesced (event pred) (defun ement-room--insert-coalesced (ewoc node-before event pred)
"FIXME: Docstring." "FIXME: Docstring."
;; Find widget type before or after point. ;; Find widget type before or after point.
(cl-labels ((matching-node (cl-labels ((matching-node
(node) (when (and ;; (let ((print-level 1)) (node) (when (and node (funcall pred node))
;; (ement-debug "Comparing node" node (when node
;; (ewoc-data node)))
;; t)
node
(progn (ement-debug "Node exists") t)
(ewoc-data node)
(progn (ement-debug "Node has data" (ewoc-data node)) t)
(funcall pred (ewoc-data node)))
node))) node)))
(let* ((ewoc ement-ewoc) (let* ((node-after (ewoc-next ewoc node-before))
(point-node (ewoc-locate ewoc))
(node-before (ewoc-prev ewoc point-node))
(node-after (ewoc-next ewoc point-node))
(found-node (or (matching-node node-before) (found-node (or (matching-node node-before)
(matching-node node-after))) (matching-node node-after)
(matching-node (ewoc-prev ewoc node-before))))
new-struct) new-struct)
(if found-node (if found-node
(progn (progn
(ement-debug "Found node") (ement-debug "Found node")
(push event (ement-coalesced-events (ewoc-data found-node))) (push event (ement-coalesced-events (ewoc-data found-node)))
;; (ewoc-set-data found-node (cons event (ewoc-data found-node)))
(ewoc-invalidate ewoc found-node)) (ewoc-invalidate ewoc found-node))
(ement-debug "Inserting new node") (ement-debug "Inserting new node")
(setf new-struct (make-ement-coalesced :events (list event) (setf new-struct (make-ement-coalesced :events (list event)
;; FIXME: Update ts when coalescing? ;; FIXME: Update ts when coalescing?
:ts (ement-event-origin-server-ts event))) :ts (ement-event-origin-server-ts event)))
(if point-node (if node-before
(ewoc-enter-after ewoc point-node new-struct) (progn
(ement-debug "Node found before" (type-of (ewoc-data node-before)))
(cl-typecase (ewoc-data node-before)
(ement-event-sender
;; Don't put under a sender name: enter before it.
(ement-debug "Moving above sender")
(ewoc-enter-before ewoc node-before new-struct))
(otherwise (ement-debug "Inserting after")
(ewoc-enter-after ewoc node-before new-struct))))
(ement-debug "No node before: entering first")
(ewoc-enter-first ewoc new-struct)))))) (ewoc-enter-first ewoc new-struct))))))
(cl-defun ement-room--format-message (event &optional (format ement-room-message-format-spec)) (cl-defun ement-room--format-message (event &optional (format ement-room-message-format-spec))