From 7903c807fefa25b1ad08e36fecadca4cc8619148 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Mon, 23 Aug 2021 19:08:53 -0500 Subject: [PATCH] Add: Invited rooms i.e. rooms to which the user has been invited, not sending invitations (a separate feature). --- ement-room-list.el | 57 ++++++++++++++++++++++++++++++++-------------- ement-room.el | 43 +++++++++++++++++++++++++++++++++- ement-structs.el | 2 +- ement.el | 53 +++++++++++++++++++++++++++++++++++------- 4 files changed, 128 insertions(+), 27 deletions(-) diff --git a/ement-room-list.el b/ement-room-list.el index 3f581e4..d0886e6 100644 --- a/ement-room-list.el +++ b/ement-room-list.el @@ -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: @@ -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 diff --git a/ement-room.el b/ement-room.el index 7b1b32e..bc5c360 100644 --- a/ement-room.el +++ b/ement-room.el @@ -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: . + ;; 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) diff --git a/ement-structs.el b/ement-structs.el index ee1682a..8a38d7c 100644 --- a/ement-structs.el +++ b/ement-structs.el @@ -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) diff --git a/ement.el b/ement.el index abb1f45..9f9b749 100644 --- a/ement.el +++ b/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