Skip to content

Commit

Permalink
Minor refactoring and tidying
Browse files Browse the repository at this point in the history
  • Loading branch information
@alphapapa
alphapapa committed May 19, 2023
1 parent 6976137 commit e4e71ad
Showing 1 changed file with 58 additions and 59 deletions.
117 changes: 58 additions & 59 deletions ement-room.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3373,18 +3373,19 @@ Format defaults to `ement-room-message-format-spec', which see."
If FORMATTED-P, return the formatted body content, when available."
(pcase-let* (((cl-struct ement-event content
(unsigned (map ('redacted_by unsigned-redacted-by)))
(local (map ('redacted-by local-redacted-by)))
(local (map ('reply reply-event))))
(local (map ('redacted-by local-redacted-by))))
event)
((map ('body main-body) msgtype ('format content-format) ('formatted_body formatted-body)
('m.relates_to (map ('rel_type rel-type)))
('m.relates_to (map ('m.in_reply_to (map ('event_id reply-event-id)))))
('m.relates_to (map ('m.in_reply_to (map ('event_id replied-to-event-id)))))
('m.new_content (map ('body new-body) ('formatted_body new-formatted-body)
('format new-content-format))))
content)
(body (or new-body main-body))
(formatted-body (or new-formatted-body formatted-body))
(reply-in-body-p (and formatted-body
(quote-in-body-p (and formatted-body
;; FIXME: What if the message has no formatted body
;; but has a plain-text quoted reply?
(string-match-p "<mx-reply>" formatted-body)))
(appendix (pcase msgtype
;; TODO: Face for m.notices.
Expand All @@ -3394,35 +3395,45 @@ If FORMATTED-P, return the formatted body content, when available."
("m.video" (ement-room--format-m.video event))
(_ (if (or local-redacted-by unsigned-redacted-by)
nil
(format "[unsupported msgtype: %s]" msgtype))))))
;; When reply event is nil, try to fetch it.
(when (and reply-event-id
(not reply-in-body-p)
(not reply-event))
;; During initial sync, `ement-ewoc' maybe nil.
(if-let* ((ement-ewoc (buffer-local-value 'ement-ewoc
(alist-get 'buffer (ement-room-local ement-room))))
(node (and ement-ewoc
(ement-room--ewoc-last-matching ement-ewoc
(lambda (data)
(and (ement-event-p data)
(equal (ement-event-id data) reply-event-id)))))))
(setf (map-elt (ement-event-local event) 'reply) (ewoc-data node)
reply-event (ewoc-data node))
(ement-api ement-session (format "rooms/%s/event/%s" (ement-room-id ement-room) reply-event-id)
:then (apply-partially #'ement-room--rich-reply-callback ement-room event))))
(format "[unsupported msgtype: %s]" msgtype)))))
(event-replied-to))
(when (and replied-to-event-id (not quote-in-body-p))
;; Message is a reply, but event being replied to is not quoted in the body and a
;; reference to it has not already been stored in this event: find or fetch the
;; event being replied to.
(if-let ((replied-to-event (gethash replied-to-event-id (ement-session-events ement-session))))
;; Found event in session's events table: use it.
(setf event-replied-to replied-to-event)
;; Replied-to event not found: fetch it and redisplay this event.
(ement-api ement-session (format "rooms/%s/event/%s" (ement-room-id ement-room) replied-to-event-id)
:then (let ((room ement-room)
(session ement-session))
(lambda (fetched-event)
(when fetched-event
(pcase-let* ((new-event (ement--make-event fetched-event))
((cl-struct ement-room (local (map buffer))) room))
(puthash (ement-event-id new-event) new-event (ement-session-events session))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when-let ((node (ement-room--ewoc-last-matching ement-ewoc
;; This is probably ok, but it might be safer
;; to test the event ID.
(lambda (data) (eq data event)))))
(ewoc-invalidate ement-ewoc node)))))))))))
(setq body
(if (or (not formatted-p) (not formatted-body))
;; Copy the string so as not to add face properties to the one in the struct.
(copy-sequence (if (and reply-event (null reply-in-body-p))
(ement-room--rich-reply-text ement-room reply-event body)
body))
(if (and event-replied-to (not quote-in-body-p))
(concat (ement-room--format-quotation-text event-replied-to)
"\n" body)
;; Copy the string so as not to add face properties to the one in the struct.
(copy-sequence body))
(pcase (or new-content-format content-format)
("org.matrix.custom.html"
(save-match-data
(ement-room--render-html
(if (and reply-event (null reply-in-body-p))
(ement-room--rich-reply-html ement-room reply-event formatted-body)
(if (and event-replied-to (not quote-in-body-p))
(concat (ement-room--format-quotation-html event-replied-to ement-room)
"\n" formatted-body)
formatted-body))))
(_ (format "[unknown body format: %s] %s"
(or new-content-format content-format) body)))))
Expand All @@ -3447,43 +3458,31 @@ If FORMATTED-P, return the formatted body content, when available."
(setf body (concat body " " (propertize "[edited]" 'face 'font-lock-comment-face))))
body))

(defun ement-room--rich-reply-callback (room event reply-event)
(when reply-event
(pcase-let* (((cl-struct ement-room (local (map buffer))) room))
(setf (map-elt (ement-event-local event) 'reply) (ement--make-event reply-event))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when-let ((node (ement-room--ewoc-last-matching ement-ewoc
(lambda (data) (eq data event)))))
(ewoc-invalidate ement-ewoc node)))))))

(defun ement-room--rich-reply-text (room reply-event body)
(format "> <%s> %s
(defun ement-room--format-quotation-text (quoted-event)
"Return text for QUOTED-EVENT."
(pcase-let* (((cl-struct ement-event sender (content (map body))) quoted-event)
((cl-struct ement-user (id sender-id)) sender))
;; FIXME: If the body spans lines, how should we handle them? Omit subsequent lines,
;; collapse into one line, or quote-prefix each line?
(format "> <%s> %s" sender-id body)))

%s"
(ement-user-id (ement-event-sender reply-event))
(map-elt (ement-event-content reply-event) 'body)
body))

(defun ement-room--rich-reply-html (room reply-event body)
(format
"<mx-reply><blockquote>
(defun ement-room--format-quotation-html (quoted-event room)
"Return HTML for QUOTED-EVENT in ROOM."
(pcase-let* (((cl-struct ement-room (id room-id)) room)
((cl-struct ement-event content (id event-id) sender) quoted-event)
((cl-struct ement-user (id sender-id)) sender)
((map format body ('formatted_body formatted-body)) content))
(format "<mx-reply><blockquote>
<a href=\"https://matrix.to/#/%s/%s\">In reply to</a>
<a href=\"https://matrix.to/#/%s\">%s</a>
<br />
%s
</blockquote></mx-reply>
%s"
(ement-room-id ement-room)
(ement-event-id reply-event)
(ement-user-id (ement-event-sender reply-event))
(or (ement-user-displayname (ement-event-sender reply-event))
(ement-user-id (ement-event-sender reply-event)))
(let ((content (ement-event-content reply-event)))
(if (equal (map-elt content 'format) "org.matrix.custom.html")
(map-elt content 'formatted_body)
(map-elt content 'body)))
body))
</blockquote></mx-reply>"
room-id event-id sender-id
(ement--user-displayname-in room sender)
(pcase format
("org.matrix.custom.html" formatted-body)
(_ body)))))

(defun ement-room--render-html (string)
"Return rendered version of HTML STRING.
Expand Down

0 comments on commit e4e71ad

Please sign in to comment.