Support proposed MSC4144: Per-message profiles

matrix-org/matrix-spec-proposals#4144

Author: Thaodan

ement-lib.el

@@ -997,11 +997,13 @@ avatars, etc."
                                                    "white" "black")))))))
       (apply #'color-rgb-to-hex (append color-rgb (list 2))))))
 
-(cl-defun ement--format-user (user &optional (room ement-room) (session ement-session))
+(cl-defun ement--format-user (user &optional (room ement-room) (session ement-session) per-message-displayname)
   "Format `ement-user' USER for ROOM on SESSION.
-ROOM defaults to the value of `ement-room'."
-  (let ((face (cond ((equal (ement-user-id (ement-session-user session))
-                            (ement-user-id user))
+ROOM defaults to the value of `ement-room'.
+Optionally use PER-MESSAGE-DISPLAYNAME instead of the users global displayname."
+  (let ((face (cond ((and session
+                      (equal (ement-user-id (ement-session-user session))
+                            (ement-user-id user)))
                      'ement-room-self)
                     (ement-room-prism
                      `(:inherit ement-room-user :foreground ,(or (ement-user-color user)
@@ -1011,7 +1013,8 @@ ROOM defaults to the value of `ement-room'."
     ;; FIXME: If a membership state event has not yet been received, this
     ;; sets the display name in the room to the user ID, and that prevents
     ;; the display name from being used if the state event arrives later.
-    (propertize (ement--user-displayname-in room user)
+    (propertize (or per-message-displayname
+                    (ement--user-displayname-in room user))
                 'face face
                 'help-echo (ement-user-id user))))
 

ement-room.el

@@ -1357,8 +1357,9 @@ spec) without requiring all events to use the same margin width."
 (ement-room-define-event-formatter ?S
   "Sender display name."
   (ignore session)
-  (pcase-let ((sender (ement--format-user (ement-event-sender event) room))
-              ((cl-struct ement-room (local (map buffer))) room))
+  (pcase-let* ((per-message-displayname (ement-room--per-message-profile-displayname event))
+               (sender (ement--format-user (ement-event-sender event) room nil per-message-displayname))
+               ((cl-struct ement-room (local (map buffer))) room))
     ;; NOTE: When called from an `ement-notify' function, ROOM may have no buffer.  In
     ;; that case, just use the current buffer (which should be a temp buffer used to
     ;; format the event).
@@ -4199,6 +4200,21 @@ Format defaults to `ement-room-message-format-spec', which see."
                          'display `((margin right-margin) ,string))))))
       (buffer-string))))
 
+;; https://github.com/beeper/matrix-spec-proposals/blob/b24060e2a66dc3e9b459f634ba91d3a34d702efa/proposals/4144-per-message-profile.md
+(defun ement-room--per-message-profile-p (event)
+  "Test if EVENT contains a per-messsage-profile, if so return it."
+  ;; NOTE: The per message profile is essentially a ement-user but with additional
+  ;;       has_fallback flag. Not sure if it actually should be it's own type.
+  (or (alist-get 'm.per_message_profile (ement-event-content event) )
+      (alist-get 'com.beeper.per_message_profile (ement-event-content event) )))
+
+(defun ement-room--per-message-profile-displayname (event)
+  "Return displayname of the EVENT if it contains a per-message profile fallback."
+  (when-let* ((profile (ement-room--per-message-profile-p event)))
+    (and (alist-get 'has_fallback profile)
+         (alist-get 'displayname profile))))
+(defalias 'ement-room--per-message-profile-fallback-p 'ement-room--per-message-profile-displayname)
+
 (cl-defun ement-room--format-message-body (event session &key (formatted-p t))
   "Return formatted body of \"m.room.message\" EVENT on SESSION.
 If FORMATTED-P, return the formatted body content, when available."
@@ -4213,13 +4229,16 @@ If FORMATTED-P, return the formatted body content, when available."
                 content)
                (body (or new-body main-body))
                (formatted-body (or new-formatted-body formatted-body))
+               (fallback-username (ement-room--per-message-profile-fallback-p event))
                (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 body)
+                         (if fallback-username
+                             (string-trim-left body (concat fallback-username ": "))
+                         (copy-sequence body))
                        (pcase (or new-content-format content-format)
                          ("org.matrix.custom.html"
                           (save-match-data
-                            (ement-room--render-html formatted-body)))
+                            (ement-room--render-html formatted-body fallback-username)))
                          (_ (format "[unknown body format: %s] %s"
                                     (or new-content-format content-format) body)))))
                (appendix (pcase msgtype
@@ -4261,8 +4280,9 @@ If FORMATTED-P, return the formatted body content, when available."
       (setf body "[redacted]"))
     body))
 
-(defun ement-room--render-html (string)
+(defun ement-room--render-html (string &optional has-fallback)
   "Return rendered version of HTML STRING.
+Remove per-message-profile fallback if HAS-FALLBACK is non-nil.
 HTML is rendered to Emacs text using `shr-insert-document'."
   (with-current-buffer
       (or (get-buffer " *ement-room--render-html*")
@@ -4281,6 +4301,8 @@ HTML is rendered to Emacs text using `shr-insert-document'."
       ;; resized (i.e. the wrapping is adjusted automatically by redisplay
       ;; rather than requiring the message to be re-rendered to HTML).
       (let ((shr-use-fonts ement-room-use-variable-pitch)
+            (dom (libxml-parse-html-region (point-min) (point-max)))
+
             (old-fn (symbol-function 'shr-tag-blockquote))) ;; Bind to a var to avoid unknown-function linting errors.
         (cl-letf (((symbol-function 'shr-fill-line) #'ignore)
                   ((symbol-function 'shr-tag-blockquote)
@@ -4292,8 +4314,9 @@ HTML is rendered to Emacs text using `shr-insert-document'."
                                                line-prefix "    "))
                        ;; NOTE: We use our own gv, `ement-text-property'; very convenient.
                        (add-face-text-property beg (point-max) 'ement-room-quote 'append)))))
-          (shr-insert-document
-           (libxml-parse-html-region (point-min) (point-max))))))
+          (when-let* ((data-mx-profile-fallback-tag (and has-fallback (dom-child-by-tag dom 'strong))))
+            (setq dom (dom-remove-node dom data-mx-profile-fallback-tag))))
+          (shr-insert-document dom)))
     (string-trim (buffer-substring (point) (point-max)))))
 
 (cl-defun ement-room--event-mentions-user-p (event user &optional (room ement-room))