mirror of
https://github.com/vale981/ement.el
synced 2025-03-04 17:01:39 -05:00
Add: Invited rooms
i.e. rooms to which the user has been invited, not sending invitations (a separate feature).
This commit is contained in:
Adam Porter
parent
b361fcccc0
commit
7903c807fe
4 changed files with 128 additions and 27 deletions
|
|
@ -80,6 +80,12 @@
|
|||
"Show room avatars in the room list."
|
||||
:type 'boolean)
|
||||
|
||||
;;;;; Faces
|
||||
|
||||
(defface ement-room-list-invited
|
||||
'((t (:inherit italic)))
|
||||
"Invited rooms.")
|
||||
|
||||
;;;; Bookmark support
|
||||
|
||||
;; Especially useful with Burly: <https://github.com/alphapapa/burly.el>
|
||||
|
|
@ -241,9 +247,12 @@ To be called in `ement-sync-callback-hook'."
|
|||
new-avatar)
|
||||
new-avatar))
|
||||
""))
|
||||
(name-face (if (and buffer (buffer-modified-p buffer))
|
||||
'(:inherit (bold button))
|
||||
'(:inherit button)))
|
||||
(name-face (cond ((eq 'invite (ement-room-type room))
|
||||
'(:inherit (bold button ement-room-list-invited)))
|
||||
((and buffer (buffer-modified-p buffer))
|
||||
'(:inherit (bold button)))
|
||||
(t
|
||||
'(:inherit button))))
|
||||
(e-name (list (propertize (or display-name
|
||||
(ement-room--room-display-name room))
|
||||
;; HACK: Apply face here, otherwise tabulated-list overrides it.
|
||||
|
|
@ -254,15 +263,19 @@ To be called in `ement-sync-callback-hook'."
|
|||
;; Remove newlines from topic. Yes, this can happen.
|
||||
(replace-regexp-in-string "\n" "" topic t t)
|
||||
""))
|
||||
(formatted-timestamp (ts-human-format-duration (- (ts-unix (ts-now)) (/ latest-ts 1000))
|
||||
t))
|
||||
(e-latest (progn
|
||||
(when (string-empty-p formatted-timestamp)
|
||||
;; FIXME: Remove this check when ts-0.3 is released
|
||||
;; (with the fix also included in ts-0.2.1).
|
||||
(message "Ement: Please upgrade the `ts' library to fix a bug")
|
||||
(setf formatted-timestamp "0s"))
|
||||
(propertize formatted-timestamp 'value latest-ts)))
|
||||
(formatted-timestamp (if latest-ts
|
||||
(ts-human-format-duration (- (ts-unix (ts-now)) (/ latest-ts 1000))
|
||||
t)
|
||||
""))
|
||||
(e-latest (or (progn
|
||||
(when (string-empty-p formatted-timestamp)
|
||||
;; FIXME: Remove this check when ts-0.3 is released
|
||||
;; (with the fix also included in ts-0.2.1).
|
||||
(message "Ement: Please upgrade the `ts' library to fix a bug")
|
||||
(setf formatted-timestamp "0s"))
|
||||
(propertize formatted-timestamp 'value latest-ts))
|
||||
;; Invited rooms don't have a latest-ts.
|
||||
""))
|
||||
(e-session (propertize (ement-user-id (ement-session-user session))
|
||||
'value session))
|
||||
;; ((e-tags favorite-p low-priority-p) (ement-room-list--tags room))
|
||||
|
|
@ -272,7 +285,12 @@ To be called in `ement-sync-callback-hook'."
|
|||
;; (e-priority (cond (favorite-p "F")
|
||||
;; (low-priority-p "l")
|
||||
;; ("N")))
|
||||
(e-members (number-to-string member-count)))
|
||||
(e-members (if member-count (number-to-string member-count) "")))
|
||||
(pcase (ement-room-type room)
|
||||
('invite
|
||||
(setf e-topic (concat (propertize "[invited]"
|
||||
'face 'ement-room-list-invited)
|
||||
" " e-topic))))
|
||||
(list room (vector e-unread e-buffer e-direct-p
|
||||
e-avatar e-name e-topic e-latest e-members
|
||||
;; e-priority e-tags
|
||||
|
|
@ -287,15 +305,20 @@ To be called in `ement-sync-callback-hook'."
|
|||
A and B should be entries from `tabulated-list-mode'."
|
||||
(pcase-let* ((`(,_room [,_unread ,_buffer ,_direct ,_avatar ,_name-for-list ,_topic ,_latest ,a-members ,_session]) a)
|
||||
(`(,_room [,_unread ,_buffer ,_direct ,_avatar ,_name-for-list ,_topic ,_latest ,b-members ,_session]) b))
|
||||
(< (string-to-number a-members) (string-to-number b-members))))
|
||||
(when (and a-members b-members)
|
||||
;; Invited rooms may have no member count (I think).
|
||||
(< (string-to-number a-members) (string-to-number b-members)))))
|
||||
|
||||
(defun ement-room-list-latest< (a b)
|
||||
"Return non-nil if entry A has fewer members than room B.
|
||||
A and B should be entries from `tabulated-list-mode'."
|
||||
(pcase-let* ((`(,_room-a [,_unread ,_buffer ,_direct ,_avatar ,_name-for-list ,_topic ,a-latest ,_a-members ,_session]) a)
|
||||
(`(,_room-b [,_unread ,_buffer ,_direct ,_avatar ,_name-for-list ,_topic ,b-latest ,_b-members ,_session]) b))
|
||||
(< (get-text-property 0 'value a-latest)
|
||||
(get-text-property 0 'value b-latest))))
|
||||
(`(,_room-b [,_unread ,_buffer ,_direct ,_avatar ,_name-for-list ,_topic ,b-latest ,_b-members ,_session]) b)
|
||||
(a-latest (get-text-property 0 'value a-latest))
|
||||
(b-latest (get-text-property 0 'value b-latest)))
|
||||
(when (and a-latest b-latest)
|
||||
;; Invited rooms have no latest timestamp.
|
||||
(< a-latest b-latest))))
|
||||
|
||||
;;;; Footer
|
||||
|
||||
|
|
|
|||
|
|
@ -1529,13 +1529,43 @@ data slot."
|
|||
:read-event (when-let ((event (alist-get "m.read" (ement-room-account-data room) nil nil #'equal)))
|
||||
(map-nested-elt event '(content event_id)))
|
||||
:fully-read-event (when-let ((event (alist-get "m.fully_read" (ement-room-account-data room) nil nil #'equal)))
|
||||
(map-nested-elt event '(content event_id)))))
|
||||
(map-nested-elt event '(content event_id))))
|
||||
;; Set initial header and footer.
|
||||
(let ((header (if (cl-find-if (apply-partially #'equal "m.room.encryption")
|
||||
(ement-room-invite-state ement-room)
|
||||
:key #'ement-event-type)
|
||||
(propertize "This appears to be an encrypted room, which is not natively supported by Ement.el. (See information about using Pantalaimon in Ement.el documentation.)"
|
||||
'face 'font-lock-warning-face)
|
||||
""))
|
||||
(footer (pcase (ement-room-type ement-room)
|
||||
;; Set header and footer for an invited room.
|
||||
('invite
|
||||
(concat (propertize "You've been invited to this room. "
|
||||
'face 'font-lock-warning-face)
|
||||
(propertize "[Join this room]"
|
||||
'button '(t)
|
||||
'category 'default-button
|
||||
'mouse-face 'highlight
|
||||
'follow-link t
|
||||
'action (lambda (_button)
|
||||
;; Kill the room buffer so it can be recreated after joining
|
||||
;; (which will cleanly update the room's name, footer, etc).
|
||||
(let ((room ement-room)
|
||||
(session ement-session))
|
||||
(kill-buffer)
|
||||
(message "Joining room... (buffer will be reopened after joining)")
|
||||
(ement-room-join (ement-room-id room) session))))))
|
||||
(_ ""))))
|
||||
(ewoc-set-hf ement-ewoc header footer)))
|
||||
;; Return the buffer!
|
||||
new-buffer)))
|
||||
|
||||
(defun ement-room--room-display-name (room)
|
||||
"Return the displayname for ROOM."
|
||||
;; SPEC: <https://matrix.org/docs/spec/client_server/r0.6.1#calculating-the-display-name-for-a-room>.
|
||||
;; NOTE: The spec seems incomplete, because the algorithm it recommends does not say how
|
||||
;; or when to use "m.room.member" events for rooms without heroes (e.g. invited rooms).
|
||||
;; TODO: Add SESSION argument and use it to remove local user from names.
|
||||
(cl-labels ((latest-event (type content-field)
|
||||
(or (cl-loop for event in (ement-room-timeline room)
|
||||
when (and (equal type (ement-event-type event))
|
||||
|
|
@ -1545,6 +1575,16 @@ data slot."
|
|||
when (and (equal type (ement-event-type event))
|
||||
(not (string-empty-p (alist-get content-field (ement-event-content event)))))
|
||||
return (alist-get content-field (ement-event-content event)))))
|
||||
(member-events-name
|
||||
() (when-let ((member-events (cl-loop for accessor in '(ement-room-timeline ement-room-state ement-room-invite-state)
|
||||
append (cl-remove-if-not (apply-partially #'equal "m.room.member")
|
||||
(funcall accessor room)
|
||||
:key #'ement-event-type))))
|
||||
(string-join (delete-dups
|
||||
(mapcar (lambda (event)
|
||||
(ement-room--user-display-name (ement-event-sender event) room))
|
||||
member-events))
|
||||
", ")))
|
||||
(heroes-name
|
||||
() (pcase-let* (((cl-struct ement-room summary) room)
|
||||
((map ('m.heroes hero-ids) ('m.joined_member_count joined-count)
|
||||
|
|
@ -1582,6 +1622,7 @@ data slot."
|
|||
(or (latest-event "m.room.name" 'name)
|
||||
(latest-event "m.room.canonical_alias" 'alias)
|
||||
(heroes-name)
|
||||
(member-events-name)
|
||||
(ement-room-id room))))
|
||||
|
||||
(defun ement-room--user-display-name (user room)
|
||||
|
|
|
|||
|
|
@ -60,7 +60,7 @@
|
|||
(cl-defstruct ement-room
|
||||
id display-name prev-batch
|
||||
summary state timeline ephemeral account-data unread-notifications
|
||||
latest-ts topic canonical-alias avatar
|
||||
latest-ts topic canonical-alias avatar type invite-state
|
||||
;; The local slot is an alist used by the local client only.
|
||||
local)
|
||||
|
||||
|
|
|
|||
53
ement.el
53
ement.el
|
|
@ -409,21 +409,39 @@ Runs `ement-sync-callback-hook' with SESSION."
|
|||
(setf (map-elt ement-syncs session) nil)
|
||||
(pcase-let* (((map rooms ('next_batch next-batch) ('account_data (map ('events account-data-events))))
|
||||
data)
|
||||
((map ('join joined-rooms)) rooms)
|
||||
;; FIXME: Only counts events in joined-rooms list.
|
||||
;; HACK: In `ement--push-joined-room-events', we do
|
||||
;; something with each event 3 times, so we multiply
|
||||
;; this by 3.
|
||||
(num-events (* 3 (cl-loop for (_id . room) in joined-rooms
|
||||
sum (length (map-nested-elt room '(state events)))
|
||||
sum (length (map-nested-elt room '(timeline events)))))))
|
||||
((map ('join joined-rooms) ('invite invited-rooms)) rooms)
|
||||
(num-events (+
|
||||
;; HACK: In `ement--push-joined-room-events', we do something
|
||||
;; with each event 3 times, so we multiply this by 3.
|
||||
;; FIXME: That calculation doesn't seem to be quite right, because
|
||||
;; the progress reporter never seems to hit 100% before it's done.
|
||||
(* 3 (cl-loop for (_id . room) in joined-rooms
|
||||
sum (length (map-nested-elt room '(state events)))
|
||||
sum (length (map-nested-elt room '(timeline events)))))
|
||||
(cl-loop for (_id . room) in invited-rooms
|
||||
sum (length (map-nested-elt room '(invite_state events)))))))
|
||||
;; Append account data events.
|
||||
(cl-callf2 append (cl-coerce account-data-events 'list) (ement-session-account-data session))
|
||||
;; Process invited and joined rooms.
|
||||
(ement-with-progress-reporter (:when (ement--sync-messages-p session)
|
||||
:reporter ("Ement: Reading events..." 0 num-events))
|
||||
;; Invited rooms.
|
||||
(mapc (apply-partially #'ement--push-invite-room-events session) invited-rooms)
|
||||
;; Joined rooms.
|
||||
(mapc (apply-partially #'ement--push-joined-room-events session) joined-rooms))
|
||||
;; TODO: Process "left" rooms (remove room structs, etc).
|
||||
;; NOTE: We update the next-batch token before updating any room buffers. This means
|
||||
;; that any errors in updating room buffers (like for unexpected event formats that
|
||||
;; expose a bug) could cause events to not appear in the buffer, but the user could
|
||||
;; still dismiss the error and start syncing again, and the client could remain
|
||||
;; usable. Updating the token after doing everything would be preferable in some
|
||||
;; ways, but it would mean that an event that exposes a bug would be processed again
|
||||
;; on every sync, causing the same error each time. It would seem preferable to
|
||||
;; maintain at least some usability rather than to keep repeating a broken behavior.
|
||||
(setf (ement-session-next-batch session) next-batch)
|
||||
;; Run hooks which update buffers, etc.
|
||||
(run-hook-with-args 'ement-sync-callback-hook session)
|
||||
;; Show sync message if appropriate, and run after-initial-sync-hook.
|
||||
(when (ement--sync-messages-p session)
|
||||
(message (concat "Ement: Sync done."
|
||||
(unless (ement-session-has-synced-p session)
|
||||
|
|
@ -432,6 +450,23 @@ Runs `ement-sync-callback-hook' with SESSION."
|
|||
(setf (ement-session-has-synced-p session) t)
|
||||
" Use commands `ement-list-rooms' or `ement-view-room' to view a room."))))))
|
||||
|
||||
(defun ement--push-invite-room-events (session invited-room)
|
||||
"Push events for INVITED-ROOM into that room in SESSION."
|
||||
;; TODO: Make ement-session-rooms a hash-table.
|
||||
(pcase-let* ((`(,invited-room-id . ,(map ('invite_state (map events)))) invited-room)
|
||||
(invited-room-id (symbol-name invited-room-id))
|
||||
(room (or (cl-find-if (apply-partially #'equal invited-room-id)
|
||||
(ement-session-rooms session)
|
||||
:key #'ement-room-id)
|
||||
(car (push (make-ement-room :id invited-room-id)
|
||||
(ement-session-rooms session))))))
|
||||
(setf (ement-room-type room) 'invite)
|
||||
;; Push the StrippedState events to the room's invite-state.
|
||||
;; (These events have no timestamp data.)
|
||||
(cl-loop for event across-ref events do
|
||||
(setf event (ement--make-event event))
|
||||
(push event (ement-room-invite-state room)))))
|
||||
|
||||
(defun ement--auto-sync (session)
|
||||
"If `ement-auto-sync' is non-nil, sync SESSION again."
|
||||
(when ement-auto-sync
|
||||
|
|
@ -475,6 +510,7 @@ To be called in `ement-sync-callback-hook'."
|
|||
"Push events for JOINED-ROOM into that room in SESSION."
|
||||
(pcase-let* ((`(,id . ,event-types) joined-room)
|
||||
(id (symbol-name id)) ; Really important that the ID is a STRING!
|
||||
;; TODO: Make ement-session-rooms a hash-table.
|
||||
(room (or (cl-find-if (lambda (room)
|
||||
(equal id (ement-room-id room)))
|
||||
(ement-session-rooms session))
|
||||
|
|
@ -485,6 +521,7 @@ To be called in `ement-sync-callback-hook'."
|
|||
event-types)
|
||||
(latest-timestamp))
|
||||
(ignore unread-notifications summary state ephemeral)
|
||||
(setf (ement-room-type room) 'join)
|
||||
;; NOTE: The idea is that, assuming that events in the sync reponse are in
|
||||
;; chronological order, we push them to the lists in the room slots in that order,
|
||||
;; leaving the head of each list as the most recent event of that type. That means
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue