branch: externals-release/ement
commit b88e303b348a30af23d63f4d820780df55570913
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Tidy: Indentation of cl-labels forms
Developing on Emacs 29.1 now, so now makem.sh's lint-indent rule will
run clean.
---
ement-directory.el | 40 ++---
ement-lib.el | 450 ++++++++++++++++++++++++++---------------------------
ement-notify.el | 14 +-
ement-room-list.el | 136 ++++++++--------
ement.el | 290 +++++++++++++++++-----------------
5 files changed, 462 insertions(+), 468 deletions(-)
diff --git a/ement-directory.el b/ement-directory.el
index 4f61d2c684..5a7b5968be 100644
--- a/ement-directory.el
+++ b/ement-directory.el
@@ -296,31 +296,31 @@ APPEND-P, add ROOMS to buffer rather than replacing
existing
contents. To be called by `ement-directory-search'."
(declare (indent defun))
(let (column-sizes window-start)
- (cl-labels ((format-item
- ;; NOTE: We use the buffer-local variable
`ement-directory-etc' rather
- ;; than a closure variable because the taxy-magit-section
struct's format
- ;; table is not stored in it, and we can't reuse closures'
variables.
- ;; (It would be good to store the format table in the
taxy-magit-section
- ;; in the future, to make this cleaner.)
- (item) (gethash item (alist-get 'format-table
ement-directory-etc)))
+ (cl-labels ((format-item (item)
+ ;; NOTE: We use the buffer-local variable
`ement-directory-etc' rather
+ ;; than a closure variable because the taxy-magit-section
struct's format
+ ;; table is not stored in it, and we can't reuse closures'
variables.
+ ;; (It would be good to store the format table in the
taxy-magit-section
+ ;; in the future, to make this cleaner.)
+ (gethash item (alist-get 'format-table ement-directory-etc)))
;; NOTE: Since these functions take an "item" (which is a
[room session]
;; vector), they're prefixed "item-" rather than "room-".
- (size
- (item) (pcase-let (((map ('num_joined_members size)) item))
- size))
+ (size (item)
+ (pcase-let (((map ('num_joined_members size)) item))
+ size))
(t<nil (a b) (and a (not b)))
(t>nil (a b) (and (not a) b))
(make-fn (&rest args)
- (apply #'make-taxy-magit-section
- :make #'make-fn
- :format-fn #'format-item
- ;; FIXME: Should we reuse
`ement-room-list-level-indent' here?
- :level-indent ement-room-list-level-indent
- ;; :visibility-fn #'visible-p
- ;; :heading-indent 2
- :item-indent 2
- ;; :heading-face-fn #'heading-face
- args)))
+ (apply #'make-taxy-magit-section
+ :make #'make-fn
+ :format-fn #'format-item
+ ;; FIXME: Should we reuse
`ement-room-list-level-indent' here?
+ :level-indent ement-room-list-level-indent
+ ;; :visibility-fn #'visible-p
+ ;; :heading-indent 2
+ :item-indent 2
+ ;; :heading-face-fn #'heading-face
+ args)))
(with-current-buffer (get-buffer-create buffer-name)
(unless (eq 'ement-directory-mode major-mode)
;; Don't obliterate buffer-local variables.
diff --git a/ement-lib.el b/ement-lib.el
index 9b040fcf12..bf9d7b733b 100644
--- a/ement-lib.el
+++ b/ement-lib.el
@@ -172,8 +172,7 @@ include with the request (see Matrix spec)."
:alias (read-string "New room alias (e.g. \"foo\" for
\"#foo:matrix.org\"): ")
:topic (read-string "New room topic: ")
:visibility (completing-read "New room visibility: "
'(private public))))
- (cl-labels ((given-p
- (var) (and var (not (string-empty-p var)))))
+ (cl-labels ((given-p (var) (and var (not (string-empty-p var)))))
(pcase-let* ((endpoint "createRoom")
(data (ement-aprog1
(ement-alist "visibility" visibility)
@@ -419,14 +418,14 @@ new one automatically if necessary."
(ement-with-room-and-session
(let* ((prompt (format "Toggle tag (%s): " (ement--format-room
ement-room)))
(default-tags
- (ement-alist (propertize "Favourite"
- 'face (when (ement--room-tagged-p
"m.favourite" ement-room)
- 'transient-value))
- "m.favourite"
- (propertize "Low-priority"
- 'face (when (ement--room-tagged-p
"m.lowpriority" ement-room)
- 'transient-value))
- "m.lowpriority"))
+ (ement-alist (propertize "Favourite"
+ 'face (when (ement--room-tagged-p
"m.favourite" ement-room)
+ 'transient-value))
+ "m.favourite"
+ (propertize "Low-priority"
+ 'face (when (ement--room-tagged-p
"m.lowpriority" ement-room)
+ 'transient-value))
+ "m.lowpriority"))
(input (completing-read prompt default-tags))
(tag (alist-get input default-tags (concat "u." input) nil
#'string=)))
(list tag ement-room ement-session))))
@@ -510,11 +509,11 @@ Interactively, with prefix, prompt for room and session,
otherwise use current room."
(interactive (ement-with-room-and-session (list ement-room ement-session)))
(cl-labels ((heading (string)
- (propertize (or string "") 'face
'font-lock-builtin-face))
+ (propertize (or string "") 'face 'font-lock-builtin-face))
(id (string)
- (propertize (or string "") 'face 'font-lock-constant-face))
+ (propertize (or string "") 'face 'font-lock-constant-face))
(member<
- (a b) (string-collate-lessp (car a) (car b) nil t)))
+ (a b) (string-collate-lessp (car a) (car b) nil t)))
(pcase-let* (((cl-struct ement-room (id room-id) avatar display-name
canonical-alias members timeline status topic
(local (map fetched-members-p)))
room)
@@ -601,31 +600,31 @@ Returns one of nil (meaning default rules are used),
`all-loud',
(let ((push-rules (cl-find-if (lambda (alist)
(equal "m.push_rules" (alist-get 'type
alist)))
(ement-session-account-data session))))
- (cl-labels ((override-mute-rule-for-room-p
- ;; Following findOverrideMuteRule() in RoomNotifs.ts.
- (room) (when-let ((overrides (map-nested-elt push-rules
'(content global override))))
- (cl-loop for rule in overrides
- when (and (alist-get 'enabled rule)
- (rule-for-room-p rule room))
- return rule)))
- (rule-for-room-p
- ;; Following isRuleForRoom() in RoomNotifs.ts.
- (rule room) (and (/= 1 (length (alist-get 'conditions rule)))
- (pcase-let* ((condition (elt (alist-get
'conditions rule) 0))
- ((map kind key pattern)
condition))
- (and (equal "event_match" kind)
- (equal "room_id" key)
- (equal (ement-room-id room)
pattern)))))
- (mute-rule-p
- (rule) (when-let ((actions (alist-get 'actions rule)))
- (seq-contains-p actions "dont_notify")))
- ;; NOTE: Although v1.7 of the spec says that "dont_notify" is
- ;; obsolete, the latest revision of matrix-react-sdk
(released last week
- ;; as v3.77.1) still works as modeled here.
- (tweak-rule-p
- (type rule) (when-let ((actions (alist-get 'actions rule)))
- (and (seq-contains-p actions "notify")
- (seq-contains-p actions `(set_tweak .
,type) 'seq-contains-p)))))
+ (cl-labels ((override-mute-rule-for-room-p (room)
+ ;; Following findOverrideMuteRule() in RoomNotifs.ts.
+ (when-let ((overrides (map-nested-elt push-rules '(content
global override))))
+ (cl-loop for rule in overrides
+ when (and (alist-get 'enabled rule)
+ (rule-for-room-p rule room))
+ return rule)))
+ (rule-for-room-p (rule room)
+ ;; Following isRuleForRoom() in RoomNotifs.ts.
+ (and (/= 1 (length (alist-get 'conditions rule)))
+ (pcase-let* ((condition (elt (alist-get 'conditions
rule) 0))
+ ((map kind key pattern) condition))
+ (and (equal "event_match" kind)
+ (equal "room_id" key)
+ (equal (ement-room-id room) pattern)))))
+ (mute-rule-p (rule)
+ (when-let ((actions (alist-get 'actions rule)))
+ (seq-contains-p actions "dont_notify")))
+ ;; NOTE: Although v1.7 of the spec says that "dont_notify" is
+ ;; obsolete, the latest revision of matrix-react-sdk (released
last week
+ ;; as v3.77.1) still works as modeled here.
+ (tweak-rule-p (type rule)
+ (when-let ((actions (alist-get 'actions rule)))
+ (and (seq-contains-p actions "notify")
+ (seq-contains-p actions `(set_tweak . ,type)
'seq-contains-p)))))
;; If none of these match, nil is returned, meaning that the default
rule is used
;; for the room.
(if (override-mute-rule-for-room-p room)
@@ -675,34 +674,34 @@ default, `all', `mentions-and-keywords', or `none'."
(state (alist-get selected-rule available-states nil nil #'equal)))
(list state ement-room ement-session))))
(cl-labels ((set-rule (kind rule queue message-fn)
- (pcase-let* (((cl-struct ement-room (id room-id)) room)
- (rule-id (url-hexify-string room-id))
- (endpoint (format
"pushrules/global/%s/%s" kind rule-id))
- (method (if rule 'put 'delete))
- (then (if rule
- ;; Setting rules requires
PUTting the rules, then making a second
- ;; request to enable them.
- (lambda (_data)
- (ement-api session (concat
endpoint "/enabled") :queue queue :version "r0"
- :method 'put :data
(json-encode (ement-alist 'enabled t))
- :then message-fn))
- message-fn)))
- (ement-api session endpoint :queue queue :method
method :version "r0"
- :data (json-encode rule)
- :then then
- :else (lambda (plz-error)
- (pcase-let* (((cl-struct plz-error
response) plz-error)
- ((cl-struct plz-response
status) response))
- (pcase status
- (404 (pcase rule
- (`nil
- ;; Room already had no rules,
so none being found is not an
- ;; error.
- nil)
- (_ ;; Unexpected error:
re-signal.
- (ement-api-error plz-error))))
- (_ ;; Unexpected error: re-signal.
- (ement-api-error plz-error)))))))))
+ (pcase-let* (((cl-struct ement-room (id room-id)) room)
+ (rule-id (url-hexify-string room-id))
+ (endpoint (format "pushrules/global/%s/%s" kind
rule-id))
+ (method (if rule 'put 'delete))
+ (then (if rule
+ ;; Setting rules requires PUTting the
rules, then making a second
+ ;; request to enable them.
+ (lambda (_data)
+ (ement-api session (concat endpoint
"/enabled") :queue queue :version "r0"
+ :method 'put :data (json-encode
(ement-alist 'enabled t))
+ :then message-fn))
+ message-fn)))
+ (ement-api session endpoint :queue queue :method method
:version "r0"
+ :data (json-encode rule)
+ :then then
+ :else (lambda (plz-error)
+ (pcase-let* (((cl-struct plz-error response)
plz-error)
+ ((cl-struct plz-response status)
response))
+ (pcase status
+ (404 (pcase rule
+ (`nil
+ ;; Room already had no rules, so none
being found is not an
+ ;; error.
+ nil)
+ (_ ;; Unexpected error: re-signal.
+ (ement-api-error plz-error))))
+ (_ ;; Unexpected error: re-signal.
+ (ement-api-error plz-error)))))))))
(pcase-let* ((available-states
(ement-alist
nil (ement-alist
@@ -789,13 +788,13 @@ Selects from seen users on all sessions. If point is on
an
event, suggests the event's sender as initial input. Allows
unseen user IDs to be input as well."
(cl-labels ((format-user (user)
- ;; FIXME: Per-room displaynames are now stored in
room structs
- ;; rather than user structs, so to be complete,
this needs to
- ;; iterate over all known rooms, looking for the
user's
- ;; displayname in that room.
- (format "%s <%s>"
- (ement-user-displayname user)
- (ement-user-id user))))
+ ;; FIXME: Per-room displaynames are now stored in room structs
+ ;; rather than user structs, so to be complete, this needs to
+ ;; iterate over all known rooms, looking for the user's
+ ;; displayname in that room.
+ (format "%s <%s>"
+ (ement-user-displayname user)
+ (ement-user-id user))))
(let* ((display-to-id
(cl-loop for key being the hash-keys of ement-users
using (hash-values value)
@@ -921,31 +920,30 @@ avatars, etc."
;; string as argument.)
;; TODO: Try using HSV somehow so we could avoid having so many strings
return a
;; nearly-black color.
- (cl-labels ((relative-luminance
- ;; Copy of `modus-themes-wcag-formula', an elegant
- ;; implementation by Protesilaos Stavrou. Also see
- ;; <https://en.wikipedia.org/wiki/Relative_luminance> and
- ;; <https://www.w3.org/TR/WCAG20/#relativeluminancedef>.
- (rgb) (cl-loop for k in '(0.2126 0.7152 0.0722)
- for x in rgb
- sum (* k (if (<= x 0.03928)
- (/ x 12.92)
- (expt (/ (+ x 0.055) 1.055) 2.4)))))
- (contrast-ratio
- ;; Copy of `modus-themes-contrast'; see above.
- (a b) (let ((ct (/ (+ (relative-luminance a) 0.05)
- (+ (relative-luminance b) 0.05))))
- (max ct (/ ct))))
- (increase-contrast
- (color against target toward)
- (let ((gradient (cdr (color-gradient color toward 20)))
- new-color)
- (cl-loop do (setf new-color (pop gradient))
- while new-color
- until (>= (contrast-ratio new-color against) target)
- ;; Avoid infinite loop in case of weirdness
- ;; by returning color as a fallback.
- finally return (or new-color color)))))
+ (cl-labels ((relative-luminance (rgb)
+ ;; Copy of `modus-themes-wcag-formula', an elegant
+ ;; implementation by Protesilaos Stavrou. Also see
+ ;; <https://en.wikipedia.org/wiki/Relative_luminance> and
+ ;; <https://www.w3.org/TR/WCAG20/#relativeluminancedef>.
+ (cl-loop for k in '(0.2126 0.7152 0.0722)
+ for x in rgb
+ sum (* k (if (<= x 0.03928)
+ (/ x 12.92)
+ (expt (/ (+ x 0.055) 1.055) 2.4)))))
+ (contrast-ratio (a b)
+ ;; Copy of `modus-themes-contrast'; see above.
+ (let ((ct (/ (+ (relative-luminance a) 0.05)
+ (+ (relative-luminance b) 0.05))))
+ (max ct (/ ct))))
+ (increase-contrast (color against target toward)
+ (let ((gradient (cdr (color-gradient color toward 20)))
+ new-color)
+ (cl-loop do (setf new-color (pop gradient))
+ while new-color
+ until (>= (contrast-ratio new-color against) target)
+ ;; Avoid infinite loop in case of weirdness
+ ;; by returning color as a fallback.
+ finally return (or new-color color)))))
(let* ((id string)
(id-hash (float (+ (abs (sxhash id))
ement-room-prism-color-adjustment)))
;; TODO: Wrap-around the value to get the color I want.
@@ -1024,12 +1022,12 @@ period, anywhere in the body."
;; "@foo and @bar:matrix.org: hi"
;; "foo: how about you and @bar ..."
(declare (indent defun))
- (cl-labels ((members-having-displayname
- ;; Iterating over the hash table values isn't as efficient as a
hash
- ;; lookup, but in most rooms it shouldn't be a problem.
- (name members) (cl-loop for user being the hash-values of
members
- when (equal name
(ement--user-displayname-in room user))
- collect user)))
+ (cl-labels ((members-having-displayname (name members)
+ ;; Iterating over the hash table values isn't as efficient as
a hash
+ ;; lookup, but in most rooms it shouldn't be a problem.
+ (cl-loop for user being the hash-values of members
+ when (equal name (ement--user-displayname-in room
user))
+ collect user)))
(pcase-let* (((cl-struct ement-room members) room)
(regexp (rx (or bos bow (1+ blank))
(or (seq (group
@@ -1216,35 +1214,34 @@ DATA is an unsent message event's data alist."
(defun ement--direct-room-for-user (user session)
"Return last-modified direct room with USER on SESSION, if one exists."
;; Loosely modeled on the Element function findDMForUser in createRoom.ts.
- (cl-labels ((membership-event-for-p
- (event user) (and (equal "m.room.member" (ement-event-type
event))
- (equal (ement-user-id user)
(ement-event-state-key event))))
- (latest-membership-for
- (user room)
- (when-let ((latest-membership-event
- (car
- (cl-sort
- ;; I guess we need to check both state and
timeline events.
- (append (cl-remove-if-not (lambda (event)
-
(membership-event-for-p event user))
- (ement-room-state room))
- (cl-remove-if-not (lambda (event)
-
(membership-event-for-p event user))
- (ement-room-timeline
room)))
- (lambda (a b)
- ;; Sort latest first so we can use the car.
- (> (ement-event-origin-server-ts a)
- (ement-event-origin-server-ts b)))))))
- (alist-get 'membership (ement-event-content
latest-membership-event))))
- (latest-event-in
- (room) (car
- (cl-sort
- (append (ement-room-state room)
- (ement-room-timeline room))
- (lambda (a b)
- ;; Sort latest first so we can use the car.
- (> (ement-event-origin-server-ts a)
- (ement-event-origin-server-ts b)))))))
+ (cl-labels ((membership-event-for-p (event user)
+ (and (equal "m.room.member" (ement-event-type event))
+ (equal (ement-user-id user) (ement-event-state-key
event))))
+ (latest-membership-for (user room)
+ (when-let ((latest-membership-event
+ (car
+ (cl-sort
+ ;; I guess we need to check both state and
timeline events.
+ (append (cl-remove-if-not (lambda (event)
+
(membership-event-for-p event user))
+ (ement-room-state
room))
+ (cl-remove-if-not (lambda (event)
+
(membership-event-for-p event user))
+ (ement-room-timeline
room)))
+ (lambda (a b)
+ ;; Sort latest first so we can use the car.
+ (> (ement-event-origin-server-ts a)
+ (ement-event-origin-server-ts b)))))))
+ (alist-get 'membership (ement-event-content
latest-membership-event))))
+ (latest-event-in (room)
+ (car
+ (cl-sort
+ (append (ement-room-state room)
+ (ement-room-timeline room))
+ (lambda (a b)
+ ;; Sort latest first so we can use the car.
+ (> (ement-event-origin-server-ts a)
+ (ement-event-origin-server-ts b)))))))
(let* ((direct-rooms (cl-remove-if-not
(lambda (room)
(ement--room-direct-p room session))
@@ -1430,10 +1427,10 @@ Works in major-modes `ement-room-mode',
(defun ement--room-direct-p (room session)
"Return non-nil if ROOM on SESSION is a direct chat."
- (cl-labels ((content-contains-room-id
- (content room-id) (cl-loop for (_user-id . room-ids) in content
- ;; NOTE: room-ids is a vector.
- thereis (seq-contains-p room-ids
room-id))))
+ (cl-labels ((content-contains-room-id (content room-id)
+ (cl-loop for (_user-id . room-ids) in content
+ ;; NOTE: room-ids is a vector.
+ thereis (seq-contains-p room-ids room-id))))
(pcase-let* (((cl-struct ement-session account-data) session)
((cl-struct ement-room id) room))
(or (cl-loop for event in account-data
@@ -1452,63 +1449,62 @@ Works in major-modes `ement-room-mode',
;; 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))
- (not (string-empty-p
(alist-get content-field (ement-event-content event)))))
- return (alist-get content-field
(ement-event-content event)))
- (cl-loop for event in (ement-room-state room)
- 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--user-displayname-in room
(ement-event-sender event)))
- member-events))
- ", ")))
- (heroes-name
- () (pcase-let* (((cl-struct ement-room summary) room)
- ((map ('m.heroes hero-ids)
('m.joined_member_count joined-count)
- ('m.invited_member_count invited-count))
- summary))
- ;; TODO: Disambiguate hero display names.
- (when hero-ids
- (cond ((<= (+ joined-count invited-count) 1)
- ;; Empty room.
- (empty-room hero-ids joined-count))
- ((>= (length hero-ids) (1- (+ joined-count
invited-count)))
- ;; Members == heroes.
- (hero-names hero-ids))
- ((and (< (length hero-ids) (1- (+ joined-count
invited-count)))
- (> (+ joined-count invited-count) 1))
- ;; More members than heroes.
- (heroes-and-others hero-ids joined-count))))))
- (hero-names
- (heroes) (string-join (mapcar #'hero-name heroes) ", "))
- (hero-name
- (id) (if-let ((user (gethash id ement-users)))
- (ement--user-displayname-in room user)
- id))
- (heroes-and-others
- (heroes joined)
- (format "%s, and %s others" (hero-names heroes)
- (- joined (length heroes))))
- (name-override
- () (when-let ((event (alist-get
"org.matrix.msc3015.m.room.name.override"
- (ement-room-account-data room)
- nil nil #'equal)))
- (map-nested-elt event '(content name))))
- (empty-room
- (heroes joined) (cl-etypecase (length heroes)
- ((satisfies zerop) "Empty room")
- ((number 1 5) (format "Empty room (was %s)"
- (hero-names heroes)))
- (t (format "Empty room (was %s)"
- (heroes-and-others heroes
joined))))))
+ (or (cl-loop for event in (ement-room-timeline room)
+ 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)))
+ (cl-loop for event in (ement-room-state room)
+ 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--user-displayname-in room
(ement-event-sender event)))
+ member-events))
+ ", ")))
+ (heroes-name ()
+ (pcase-let* (((cl-struct ement-room summary) room)
+ ((map ('m.heroes hero-ids)
('m.joined_member_count joined-count)
+ ('m.invited_member_count invited-count))
+ summary))
+ ;; TODO: Disambiguate hero display names.
+ (when hero-ids
+ (cond ((<= (+ joined-count invited-count) 1)
+ ;; Empty room.
+ (empty-room hero-ids joined-count))
+ ((>= (length hero-ids) (1- (+ joined-count
invited-count)))
+ ;; Members == heroes.
+ (hero-names hero-ids))
+ ((and (< (length hero-ids) (1- (+ joined-count
invited-count)))
+ (> (+ joined-count invited-count) 1))
+ ;; More members than heroes.
+ (heroes-and-others hero-ids joined-count))))))
+ (hero-names (heroes)
+ (string-join (mapcar #'hero-name heroes) ", "))
+ (hero-name (id)
+ (if-let ((user (gethash id ement-users)))
+ (ement--user-displayname-in room user)
+ id))
+ (heroes-and-others (heroes joined)
+ (format "%s, and %s others" (hero-names heroes)
+ (- joined (length heroes))))
+ (name-override ()
+ (when-let ((event (alist-get
"org.matrix.msc3015.m.room.name.override"
+ (ement-room-account-data room)
+ nil nil #'equal)))
+ (map-nested-elt event '(content name))))
+ (empty-room (heroes joined)
+ (cl-etypecase (length heroes)
+ ((satisfies zerop) "Empty room")
+ ((number 1 5) (format "Empty room (was %s)"
+ (hero-names heroes)))
+ (t (format "Empty room (was %s)"
+ (heroes-and-others heroes joined))))))
(or (name-override)
(latest-event "m.room.name" 'name)
(latest-event "m.room.canonical_alias" 'alias)
@@ -1564,19 +1560,19 @@ is not at the latest known message event."
;; A room should rarely, if ever, have a nil timeline, but in case
it does
;; (which apparently can happen, given user reports), it should not
be
;; considered unread.
- (cl-labels ((event-counts-toward-unread-p
- ;; NOTE: We only consider message events, so
membership, reaction,
- ;; etc. events will not mark a room as unread.
Ideally, I think
- ;; that join/leave events should, at least optionally,
mark a room
- ;; as unread (e.g. in a 1:1 room with a friend, if the
other user
- ;; left, one would probably want to know, and marking
the room
- ;; unread would help the user notice), but since
membership events
- ;; have to be processed to understand their meaning,
it's not
- ;; straightforward to know whether one should mark a
room unread.
-
- ;; FIXME: Use code from
`ement-room--format-member-event' to
- ;; distinguish ones that should count.
- (event) (equal "m.room.message" (ement-event-type
event))))
+ (cl-labels ((event-counts-toward-unread-p (event)
+ ;; NOTE: We only consider message events, so
membership, reaction,
+ ;; etc. events will not mark a room as unread.
Ideally, I think
+ ;; that join/leave events should, at least optionally,
mark a room
+ ;; as unread (e.g. in a 1:1 room with a friend, if the
other user
+ ;; left, one would probably want to know, and marking
the room
+ ;; unread would help the user notice), but since
membership events
+ ;; have to be processed to understand their meaning,
it's not
+ ;; straightforward to know whether one should mark a
room unread.
+
+ ;; FIXME: Use code from
`ement-room--format-member-event' to
+ ;; distinguish ones that should count.
+ (equal "m.room.message" (ement-event-type event))))
(let ((our-read-receipt-event-id (car (gethash our-id receipts)))
(first-counting-event (cl-find-if
#'event-counts-toward-unread-p timeline)))
(cond ((equal fully-read-event-id (ement-event-id (car
timeline)))
@@ -1630,11 +1626,11 @@ problems."
(if-let ((cached-name (gethash user (ement-room-displaynames room))))
cached-name
;; Put timeline events before state events, because IIUC they should be
more recent.
- (cl-labels ((join-displayname-event-p
- (event) (and (eq user (ement-event-sender event))
- (equal "m.room.member" (ement-event-type event))
- (equal "join" (alist-get 'membership
(ement-event-content event)))
- (alist-get 'displayname (ement-event-content
event)))))
+ (cl-labels ((join-displayname-event-p (event)
+ (and (eq user (ement-event-sender event))
+ (equal "m.room.member" (ement-event-type event))
+ (equal "join" (alist-get 'membership
(ement-event-content event)))
+ (alist-get 'displayname (ement-event-content event)))))
;; FIXME: Should probably sort the relevant events to get the latest one.
(if-let* ((displayname (or (cl-loop for event in (ement-room-timeline
room)
when (join-displayname-event-p event)
@@ -1733,19 +1729,19 @@ seconds, etc."
(if (< seconds 1)
(if abbreviate "0s" "0 seconds")
(cl-macrolet ((format> (place)
- ;; When PLACE is greater than 0, return formatted
string using its symbol name.
- `(when (> ,place 0)
- (format "%d%s%s" ,place
- (if abbreviate "" " ")
- (if abbreviate
- ,(substring (symbol-name place) 0 1)
- ,(symbol-name place)))))
+ ;; When PLACE is greater than 0, return formatted string
using its symbol name.
+ `(when (> ,place 0)
+ (format "%d%s%s" ,place
+ (if abbreviate "" " ")
+ (if abbreviate
+ ,(substring (symbol-name place) 0 1)
+ ,(symbol-name place)))))
(join-places (&rest places)
- ;; Return string joining the names and values
of PLACES.
- `(string-join (delq nil
- (list ,@(cl-loop for place
in places
- collect
`(format> ,place))))
- (if abbreviate "" ", "))))
+ ;; Return string joining the names and values of PLACES.
+ `(string-join (delq nil
+ (list ,@(cl-loop for place in places
+ collect `(format>
,place))))
+ (if abbreviate "" ", "))))
(pcase-let ((`(,years ,days ,hours ,minutes ,seconds)
(ement--human-duration seconds)))
(join-places years days hours minutes seconds)))))
@@ -1756,9 +1752,9 @@ a simple calculation that does not account for leap
years, leap
seconds, etc."
;; Copied from `ts-human-format-duration' (same author).
(cl-macrolet ((dividef (place divisor)
- ;; Divide PLACE by DIVISOR, set PLACE to the
remainder, and return the quotient.
- `(prog1 (/ ,place ,divisor)
- (setf ,place (% ,place ,divisor)))))
+ ;; Divide PLACE by DIVISOR, set PLACE to the remainder, and
return the quotient.
+ `(prog1 (/ ,place ,divisor)
+ (setf ,place (% ,place ,divisor)))))
(let* ((seconds (floor seconds))
(years (dividef seconds 31536000))
(days (dividef seconds 86400))
diff --git a/ement-notify.el b/ement-notify.el
index 173a173a82..c341678b40 100644
--- a/ement-notify.el
+++ b/ement-notify.el
@@ -214,13 +214,13 @@ If ROOM has no existing buffer, do nothing."
(function dbus-get-unique-name "dbusbind.c")
(function x-change-window-property "xfns.c")
(function x-window-property "xfns.c"))
- (cl-labels ((mark-frame-urgent
- (frame) (let* ((prop "WM_HINTS")
- (hints (cl-coerce
- (x-window-property prop frame prop nil
nil t)
- 'list)))
- (setf (car hints) (logior (car hints) 256))
- (x-change-window-property prop hints nil prop 32 t))))
+ (cl-labels ((mark-frame-urgent (frame)
+ (let* ((prop "WM_HINTS")
+ (hints (cl-coerce
+ (x-window-property prop frame prop nil nil t)
+ 'list)))
+ (setf (car hints) (logior (car hints) 256))
+ (x-change-window-property prop hints nil prop 32 t))))
(when-let* ((buffer (alist-get 'buffer (ement-room-local room)))
(frames (cl-loop for frame in (frame-list)
when (eq 'x (framep frame))
diff --git a/ement-room-list.el b/ement-room-list.el
index 224b375073..232ef6d2c8 100644
--- a/ement-room-list.el
+++ b/ement-room-list.el
@@ -165,10 +165,10 @@ from recent to non-recent for rooms updated in the past
hour.")
(ement-room-list-define-key membership (&key name status)
;; FIXME: Docstring: status should be a symbol of either `invite', `join',
`leave'.
(cl-labels ((format-membership (membership)
- (pcase membership
- ('join "Joined")
- ('invite "Invited")
- ('leave "[Left]"))))
+ (pcase membership
+ ('join "Joined")
+ ('invite "Invited")
+ ('leave "[Left]"))))
(pcase-let ((`[,(cl-struct ement-room (status membership)) ,_session]
item))
(if status
(when (equal status membership)
@@ -200,12 +200,12 @@ from recent to non-recent for rooms updated in the past
hour.")
(pcase-let* ((`[,room ,session] item)
((cl-struct ement-session rooms) session)
((cl-struct ement-room type (local (map parents))) room))
- (cl-labels ((format-space
- (id) (let* ((parent-room (cl-find id rooms :key
#'ement-room-id :test #'equal))
- (space-name (if parent-room
- (ement-room-display-name
parent-room)
- id)))
- (concat "Space: " space-name))))
+ (cl-labels ((format-space (id)
+ (let* ((parent-room (cl-find id rooms :key #'ement-room-id
:test #'equal))
+ (space-name (if parent-room
+ (ement-room-display-name parent-room)
+ id)))
+ (concat "Space: " space-name))))
(when-let ((key (if id
;; ID specified.
(cond ((or (member id parents)
@@ -553,64 +553,64 @@ DISPLAY-BUFFER-ACTION is nil, the buffer is not
displayed."
(format-item (item) (gethash item format-table))
;; NOTE: Since these functions take an "item" (which is a
[room session]
;; vector), they're prefixed "item-" rather than "room-".
- (item-latest-ts
- (item) (or (ement-room-latest-ts (elt item 0))
- ;; Room has no latest timestamp. FIXME: This
shouldn't
- ;; happen, but it can, maybe due to oversights
elsewhere.
- 0))
- (item-unread-p
- (item) (pcase-let ((`[,room ,session] item))
- (ement--room-unread-p room session)))
- (item-left-p
- (item) (pcase-let ((`[,(cl-struct ement-room status)
,_session] item))
- (equal 'leave status)))
- (item-buffer-p
- (item) (pcase-let ((`[,(cl-struct ement-room (local (map
buffer))) ,_session] item))
- (buffer-live-p buffer)))
- (taxy-unread-p
- (taxy) (or (cl-some #'item-unread-p (taxy-items taxy))
- (cl-some #'taxy-unread-p (taxy-taxys taxy))))
- (item-space-p
- (item) (pcase-let ((`[,(cl-struct ement-room type) ,_session]
item))
- (equal "m.space" type)))
- (item-favourite-p
- (item) (pcase-let ((`[,room ,_session] item))
- (ement--room-favourite-p room)))
- (item-low-priority-p
- (item) (pcase-let ((`[,room ,_session] item))
- (ement--room-low-priority-p room)))
- (visible-p
- ;; This is very confusing and doesn't currently work.
- (section) (let ((value (oref section value)))
- (if (cl-typecase value
- (taxy-magit-section (item-unread-p value))
- (ement-room nil))
- 'show
- 'hide)))
- (item-invited-p
- (item) (pcase-let ((`[,(cl-struct ement-room status)
,_session] item))
- (equal 'invite status)))
- (taxy-latest-ts
- (taxy) (apply #'max most-negative-fixnum
- (delq nil
- (list
- (when (taxy-items taxy)
- (item-latest-ts (car (taxy-items
taxy))))
- (when (taxy-taxys taxy)
- (cl-loop for sub-taxy in (taxy-taxys
taxy)
- maximizing (taxy-latest-ts
sub-taxy)))))))
+ (item-latest-ts (item)
+ (or (ement-room-latest-ts (elt item 0))
+ ;; Room has no latest timestamp. FIXME: This shouldn't
+ ;; happen, but it can, maybe due to oversights elsewhere.
+ 0))
+ (item-unread-p (item)
+ (pcase-let ((`[,room ,session] item))
+ (ement--room-unread-p room session)))
+ (item-left-p (item)
+ (pcase-let ((`[,(cl-struct ement-room status) ,_session]
item))
+ (equal 'leave status)))
+ (item-buffer-p (item)
+ (pcase-let ((`[,(cl-struct ement-room (local (map buffer)))
,_session] item))
+ (buffer-live-p buffer)))
+ (taxy-unread-p (taxy)
+ (or (cl-some #'item-unread-p (taxy-items taxy))
+ (cl-some #'taxy-unread-p (taxy-taxys taxy))))
+ (item-space-p (item)
+ (pcase-let ((`[,(cl-struct ement-room type) ,_session] item))
+ (equal "m.space" type)))
+ (item-favourite-p (item)
+ (pcase-let ((`[,room ,_session] item))
+ (ement--room-favourite-p room)))
+ (item-low-priority-p (item)
+ (pcase-let ((`[,room ,_session] item))
+ (ement--room-low-priority-p room)))
+ (visible-p (section)
+ ;; This is very confusing and doesn't currently work.
+ (let ((value (oref section value)))
+ (if (cl-typecase value
+ (taxy-magit-section (item-unread-p value))
+ (ement-room nil))
+ 'show
+ 'hide)))
+ (item-invited-p (item)
+ (pcase-let ((`[,(cl-struct ement-room status) ,_session]
item))
+ (equal 'invite status)))
+ (taxy-latest-ts (taxy)
+ (apply #'max most-negative-fixnum
+ (delq nil
+ (list
+ (when (taxy-items taxy)
+ (item-latest-ts (car (taxy-items taxy))))
+ (when (taxy-taxys taxy)
+ (cl-loop for sub-taxy in (taxy-taxys taxy)
+ maximizing (taxy-latest-ts
sub-taxy)))))))
(t<nil (a b) (and a (not b)))
(t>nil (a b) (and (not a) b))
(make-fn (&rest args)
- (apply #'make-taxy-magit-section
- :make #'make-fn
- :format-fn #'format-item
- :level-indent ement-room-list-level-indent
- ;; :visibility-fn #'visible-p
- ;; :heading-indent 2
- :item-indent 2
- ;; :heading-face-fn #'heading-face
- args)))
+ (apply #'make-taxy-magit-section
+ :make #'make-fn
+ :format-fn #'format-item
+ :level-indent ement-room-list-level-indent
+ ;; :visibility-fn #'visible-p
+ ;; :heading-indent 2
+ :item-indent 2
+ ;; :heading-face-fn #'heading-face
+ args)))
;; (when (get-buffer buffer-name)
;; (kill-buffer buffer-name))
(unless ement-sessions
@@ -626,9 +626,9 @@ DISPLAY-BUFFER-ACTION is nil, the buffer is not displayed."
append (cl-loop for room in (ement-session-rooms
session)
collect (vector room session))))
(taxy (cl-macrolet ((first-item
- (pred) `(lambda (taxy)
- (when (taxy-items taxy)
- (,pred (car (taxy-items
taxy))))))
+ (pred) `(lambda (taxy)
+ (when (taxy-items taxy)
+ (,pred (car (taxy-items
taxy))))))
(name= (name) `(lambda (taxy)
(equal ,name (taxy-name
taxy)))))
(thread-last
diff --git a/ement.el b/ement.el
index 1baa9984e6..a4913919cd 100644
--- a/ement.el
+++ b/ement.el
@@ -227,106 +227,105 @@ the port, e.g.
(1 (list :session (cdar ement-sessions)))
(otherwise (list :session (ement-complete-session))))))
(let (sso-server-process)
- (cl-labels ((new-session
- () (unless (string-match (rx bos "@" (group (1+ (not (any
":")))) ; Username
- ":" (group (optional (1+ (not
(any blank)))))) ; Server name
- user-id)
- (user-error "Invalid user ID format: use
@USERNAME:SERVER"))
- (let* ((username (match-string 1 user-id))
- (server-name (match-string 2 user-id))
- (uri-prefix (or uri-prefix (ement--hostname-uri
server-name)))
- (user (make-ement-user :id user-id :username username))
- (server (make-ement-server :name server-name
:uri-prefix uri-prefix))
- (transaction-id (ement--initial-transaction-id))
- (initial-device-display-name (format "Ement.el: %s@%s"
- ;; Just to be
extra careful:
- (or
user-login-name "[unknown user-login-name]")
- (or (system-name)
"[unknown system-name]")))
- (device-id (secure-hash 'sha256
initial-device-display-name)))
- (make-ement-session :user user :server server
:transaction-id transaction-id
- :device-id device-id
:initial-device-display-name initial-device-display-name
- :events (make-hash-table :test
#'equal))))
- (password-login
- () (pcase-let* (((cl-struct ement-session user device-id
initial-device-display-name) session)
- ((cl-struct ement-user id) user)
- (data (ement-alist "type" "m.login.password"
- "identifier"
- (ement-alist "type"
"m.id.user"
- "user" id)
- "password" (or password
-
(read-passwd (format "Password for %s: " id)))
- "device_id" device-id
-
"initial_device_display_name" initial-device-display-name)))
- ;; TODO: Clear password in callback (if we decide to
hold on to it for retrying login timeouts).
- (ement-api session "login" :method 'post :data
(json-encode data)
- :then (apply-partially #'ement--login-callback
session))
- (ement-message "Logging in with password...")))
- (sso-filter
- (process string)
- ;; NOTE: This is technically wrong, because it's not
guaranteed that the
- ;; string will be a complete request--it could just be a
chunk. But in
- ;; practice, if this works, it's much simpler than setting up
process log
- ;; functions and per-client buffers for this throwaway,
pretend HTTP server.
- (when (string-match (rx "GET /?loginToken=" (group (0+ nonl))
" " (0+ nonl)) string)
- (unwind-protect
- (pcase-let* ((token (match-string 1 string))
- ((cl-struct ement-session user device-id
initial-device-display-name)
- session)
- ((cl-struct ement-user id) user)
- (data (ement-alist
- "type" "m.login.token"
- "identifier" (ement-alist "type"
"m.id.user"
- "user" id)
- "token" token
- "device_id" device-id
- "initial_device_display_name"
initial-device-display-name)))
- (ement-api session "login" :method 'post
- :data (json-encode data)
- :then (apply-partially #'ement--login-callback
session))
- (process-send-string process "HTTP/1.0 202 Accepted
+ (cl-labels ((new-session ()
+ (unless (string-match (rx bos "@" (group (1+ (not (any
":")))) ; Username
+ ":" (group (optional (1+ (not (any
blank)))))) ; Server name
+ user-id)
+ (user-error "Invalid user ID format: use
@USERNAME:SERVER"))
+ (let* ((username (match-string 1 user-id))
+ (server-name (match-string 2 user-id))
+ (uri-prefix (or uri-prefix (ement--hostname-uri
server-name)))
+ (user (make-ement-user :id user-id :username
username))
+ (server (make-ement-server :name server-name
:uri-prefix uri-prefix))
+ (transaction-id (ement--initial-transaction-id))
+ (initial-device-display-name (format "Ement.el: %s@%s"
+ ;; Just to be
extra careful:
+ (or
user-login-name "[unknown user-login-name]")
+ (or
(system-name) "[unknown system-name]")))
+ (device-id (secure-hash 'sha256
initial-device-display-name)))
+ (make-ement-session :user user :server server
:transaction-id transaction-id
+ :device-id device-id
:initial-device-display-name initial-device-display-name
+ :events (make-hash-table :test
#'equal))))
+ (password-login ()
+ (pcase-let* (((cl-struct ement-session user device-id
initial-device-display-name) session)
+ ((cl-struct ement-user id) user)
+ (data (ement-alist "type" "m.login.password"
+ "identifier"
+ (ement-alist "type"
"m.id.user"
+ "user" id)
+ "password" (or password
+ (read-passwd
(format "Password for %s: " id)))
+ "device_id" device-id
+
"initial_device_display_name" initial-device-display-name)))
+ ;; TODO: Clear password in callback (if we decide to hold
on to it for retrying login timeouts).
+ (ement-api session "login" :method 'post :data
(json-encode data)
+ :then (apply-partially #'ement--login-callback session))
+ (ement-message "Logging in with password...")))
+ (sso-filter (process string)
+ ;; NOTE: This is technically wrong, because it's not
guaranteed that the
+ ;; string will be a complete request--it could just be a
chunk. But in
+ ;; practice, if this works, it's much simpler than setting
up process log
+ ;; functions and per-client buffers for this throwaway,
pretend HTTP server.
+ (when (string-match (rx "GET /?loginToken=" (group (0+
nonl)) " " (0+ nonl)) string)
+ (unwind-protect
+ (pcase-let* ((token (match-string 1 string))
+ ((cl-struct ement-session user device-id
initial-device-display-name)
+ session)
+ ((cl-struct ement-user id) user)
+ (data (ement-alist
+ "type" "m.login.token"
+ "identifier" (ement-alist "type"
"m.id.user"
+ "user"
id)
+ "token" token
+ "device_id" device-id
+ "initial_device_display_name"
initial-device-display-name)))
+ (ement-api session "login" :method 'post
+ :data (json-encode data)
+ :then (apply-partially #'ement--login-callback
session))
+ (process-send-string process "HTTP/1.0 202 Accepted
Content-Type: text/plain; charset=utf-8
Ement: SSO login accepted; session token received. Connecting to Matrix
server. (You may close this page.)")
- (process-send-eof process))
- (delete-process sso-server-process)
- (delete-process process))))
+ (process-send-eof process))
+ (delete-process sso-server-process)
+ (delete-process process))))
(sso-login ()
- (setf sso-server-process
- (make-network-process
- :name "ement-sso" :family 'ipv4 :host 'local
:service ement-sso-server-port
- :filter #'sso-filter :server t :noquery t))
- ;; Kill server after 2 minutes in case of problems.
- (run-at-time 120 nil (lambda ()
- (when (process-live-p
sso-server-process)
- (delete-process
sso-server-process))))
- (let ((url (concat (ement-server-uri-prefix
(ement-session-server session))
-
"/_matrix/client/r0/login/sso/redirect?redirectUrl=http://localhost:";
- (number-to-string
ement-sso-server-port))))
- (funcall browse-url-secondary-browser-function
url)
- (message "Browsing to single sign-on page
<%s>..." url)))
- (flows-callback
- (data) (let ((flows (cl-loop for flow across (map-elt data
'flows)
- for type = (map-elt flow 'type)
- when (member type
'("m.login.password" "m.login.sso"))
- collect type)))
- (pcase (length flows)
- (0 (error "Ement: No supported login flows:
Server:%S Supported flows:%S"
- (ement-server-uri-prefix
(ement-session-server session))
- (map-elt data 'flows)))
- (1 (pcase (car flows)
- ("m.login.password" (password-login))
- ("m.login.sso" (sso-login))
- (_ (error "Ement: Unsupported login flow: %s
Server:%S Supported flows:%S"
- (car flows)
(ement-server-uri-prefix (ement-session-server session))
- (map-elt data 'flows)))))
- (_ (pcase (completing-read "Select authentication
method: "
- (cl-loop for flow in
flows
- collect
(string-trim-left flow (rx "m.login."))))
- ("password" (password-login))
- ("sso" (sso-login))
- (else (error "Ement: Unsupported login
flow:%S Server:%S Supported flows:%S"
- else (ement-server-uri-prefix
(ement-session-server session))
- (map-elt data 'flows)))))))))
+ (setf sso-server-process
+ (make-network-process
+ :name "ement-sso" :family 'ipv4 :host 'local :service
ement-sso-server-port
+ :filter #'sso-filter :server t :noquery t))
+ ;; Kill server after 2 minutes in case of problems.
+ (run-at-time 120 nil (lambda ()
+ (when (process-live-p
sso-server-process)
+ (delete-process
sso-server-process))))
+ (let ((url (concat (ement-server-uri-prefix
(ement-session-server session))
+
"/_matrix/client/r0/login/sso/redirect?redirectUrl=http://localhost:";
+ (number-to-string
ement-sso-server-port))))
+ (funcall browse-url-secondary-browser-function url)
+ (message "Browsing to single sign-on page <%s>..." url)))
+ (flows-callback (data)
+ (let ((flows (cl-loop for flow across (map-elt data 'flows)
+ for type = (map-elt flow 'type)
+ when (member type '("m.login.password"
"m.login.sso"))
+ collect type)))
+ (pcase (length flows)
+ (0 (error "Ement: No supported login flows: Server:%S
Supported flows:%S"
+ (ement-server-uri-prefix (ement-session-server
session))
+ (map-elt data 'flows)))
+ (1 (pcase (car flows)
+ ("m.login.password" (password-login))
+ ("m.login.sso" (sso-login))
+ (_ (error "Ement: Unsupported login flow: %s
Server:%S Supported flows:%S"
+ (car flows) (ement-server-uri-prefix
(ement-session-server session))
+ (map-elt data 'flows)))))
+ (_ (pcase (completing-read "Select authentication
method: "
+ (cl-loop for flow in flows
+ collect
(string-trim-left flow (rx "m.login."))))
+ ("password" (password-login))
+ ("sso" (sso-login))
+ (else (error "Ement: Unsupported login flow:%S
Server:%S Supported flows:%S"
+ else (ement-server-uri-prefix
(ement-session-server session))
+ (map-elt data 'flows)))))))))
(if session
;; Start syncing given session.
(let ((user-id (ement-user-id (ement-session-user session))))
@@ -456,20 +455,20 @@ To be called from `ement-disconnect-hook'."
If no URI is found, prompt the user for the hostname."
;; FIXME: When fail-prompting, a URI should be returned, not just a hostname.
;; SPEC: <https://matrix.org/docs/spec/client_server/r0.6.1#id178> ("4.1
Well-known URI")
- (cl-labels ((fail-prompt
- () (let ((input (read-string "Auto-discovery of server's
well-known URI failed. Input server hostname, or leave blank to use server
name: ")))
- (pcase input
- ("" hostname)
- (_ input))))
+ (cl-labels ((fail-prompt ()
+ (let ((input (read-string "Auto-discovery of server's
well-known URI failed. Input server hostname, or leave blank to use server
name: ")))
+ (pcase input
+ ("" hostname)
+ (_ input))))
(parse (string)
- (if-let* ((object (ignore-errors (json-read-from-string
string)))
- (url (map-nested-elt object '(m.homeserver
base_url)))
- ((string-match-p
- (rx bos "http" (optional "s") "://" (1+ nonl))
- url)))
- url
- ;; Parsing error: FAIL_PROMPT.
- (fail-prompt))))
+ (if-let* ((object (ignore-errors (json-read-from-string
string)))
+ (url (map-nested-elt object '(m.homeserver
base_url)))
+ ((string-match-p
+ (rx bos "http" (optional "s") "://" (1+ nonl))
+ url)))
+ url
+ ;; Parsing error: FAIL_PROMPT.
+ (fail-prompt))))
(condition-case err
(let ((response (plz 'get (concat "https://"; hostname
"/.well-known/matrix/client")
:as 'response :then 'sync)))
@@ -724,23 +723,22 @@ Also used for left rooms, in which case STATUS should be
set to
(alist-get 'new-account-data-events (ement-room-local room)))
;; Save state and timeline events.
- (cl-macrolet ((push-events
- (type accessor)
- ;; Push new events of TYPE to room's slot of ACCESSOR, and
return the latest timestamp pushed.
- `(let ((ts 0))
- ;; NOTE: We replace each event in the vector with the
- ;; struct, which is used when calling hooks later.
- (cl-loop for event across-ref (alist-get 'events ,type)
- do (setf event (ement--make-event event))
- do (push event (,accessor room))
- (when (ement--sync-messages-p session)
- (ement-progress-update))
- (when (> (ement-event-origin-server-ts event)
ts)
- (setf ts (ement-event-origin-server-ts
event))))
- ;; One would think that one should use `maximizing'
here, but, completely
- ;; inexplicably, it sometimes returns nil, even when
every single value it's comparing
- ;; is a number. It's absolutely bizarre, but I have to
do the equivalent manually.
- ts)))
+ (cl-macrolet ((push-events (type accessor)
+ ;; Push new events of TYPE to room's slot of ACCESSOR, and
return the latest timestamp pushed.
+ `(let ((ts 0))
+ ;; NOTE: We replace each event in the vector with the
+ ;; struct, which is used when calling hooks later.
+ (cl-loop for event across-ref (alist-get 'events ,type)
+ do (setf event (ement--make-event event))
+ do (push event (,accessor room))
+ (when (ement--sync-messages-p session)
+ (ement-progress-update))
+ (when (> (ement-event-origin-server-ts event)
ts)
+ (setf ts (ement-event-origin-server-ts
event))))
+ ;; One would think that one should use `maximizing'
here, but, completely
+ ;; inexplicably, it sometimes returns nil, even when
every single value it's comparing
+ ;; is a number. It's absolutely bizarre, but I have to
do the equivalent manually.
+ ts)))
;; FIXME: This is a bit convoluted and hacky now. Refactor it.
(setf latest-timestamp
(max (push-events state ement-room-state)
@@ -827,16 +825,16 @@ Adds sender to `ement-users' when necessary."
(defun ement--read-sessions ()
"Return saved sessions alist read from disk.
Returns nil if unable to read `ement-sessions-file'."
- (cl-labels ((plist-to-session
- (plist) (pcase-let* (((map (:user user-data) (:server
server-data)
- (:token token) (:transaction-id
transaction-id))
- plist)
- (user (apply #'make-ement-user user-data))
- (server (apply #'make-ement-server
server-data))
- (session (make-ement-session :user user
:server server
- :token token
:transaction-id transaction-id)))
- (setf (ement-session-events session) (make-hash-table
:test #'equal))
- session)))
+ (cl-labels ((plist-to-session (plist)
+ (pcase-let* (((map (:user user-data) (:server server-data)
+ (:token token) (:transaction-id
transaction-id))
+ plist)
+ (user (apply #'make-ement-user user-data))
+ (server (apply #'make-ement-server server-data))
+ (session (make-ement-session :user user :server
server
+ :token token
:transaction-id transaction-id)))
+ (setf (ement-session-events session) (make-hash-table :test
#'equal))
+ session)))
(when (file-exists-p ement-sessions-file)
(pcase-let* ((read-circle t)
(sessions (with-temp-buffer
@@ -858,16 +856,16 @@ Returns nil if unable to read `ement-sessions-file'."
;; NOTE: This writes all current sessions, even if there are multiple active
ones and only one
;; is being disconnected. That's probably okay, but it might be something
to keep in mind.
- (cl-labels ((session-plist
- (session) (pcase-let* (((cl-struct ement-session user server
token transaction-id) session)
- ((cl-struct ement-user (id user-id)
username) user)
- ((cl-struct ement-server (name
server-name) uri-prefix) server))
- (list :user (list :id user-id
- :username username)
- :server (list :name server-name
- :uri-prefix uri-prefix)
- :token token
- :transaction-id transaction-id))))
+ (cl-labels ((session-plist (session)
+ (pcase-let* (((cl-struct ement-session user server token
transaction-id) session)
+ ((cl-struct ement-user (id user-id) username)
user)
+ ((cl-struct ement-server (name server-name)
uri-prefix) server))
+ (list :user (list :id user-id
+ :username username)
+ :server (list :name server-name
+ :uri-prefix uri-prefix)
+ :token token
+ :transaction-id transaction-id))))
(message "Ement: Writing sessions...")
(with-temp-file ement-sessions-file
(pcase-let* ((print-level nil)
