Merge remote-tracking branch 'origin/master' into fix/setf-point-depr…

…ecation

README.org

@@ -287,16 +287,20 @@ Note that, while ~matrix-client~ remains usable, and probably will for some time
 :TOC:      :depth 0
 :END:
 
-** 0.5-pre
+** 0.5
 
 *Additions*
 + Present "joined-and-left" and "rejoined-and-left" membership event pairs as such.
++ Process and show rooms' canonical alias events.
 
 *Changes*
++ The [[https://github.com/alphapapa/taxy.el][taxy.el]]-based room list, with programmable, smart grouping, is now the default ~ement-room-list~.  (The old, ~tabulated-list-mode~-based room list is available as ~ement-tabulated-room-list~.)
 + When selecting a room to view with completion, don't offer spaces.
++ When selecting a room with completion, empty aliases and topics are omitted instead of being displayed as nil.
 
 *Fixes*
 + Use of send-message filter when replying.
++ Replies may be written in compose buffers.
 
 ** 0.4.1
 

ement-lib.el

@@ -1138,18 +1138,24 @@ m.replace metadata)."
   "Return ROOM formatted with name, alias, ID, and optionally TOPIC.
 Suitable for use in completion, etc."
   (if topic
-      (format "\"%s\" <%s> (<%s>): \"%s\""
+      (format "%s%s(<%s>)%s"
               (or (ement-room-display-name room)
                   (setf (ement-room-display-name room)
                         (ement--room-display-name room)))
-              (ement-room-canonical-alias room)
+              (if (ement-room-canonical-alias room)
+                  (format " <%s> " (ement-room-canonical-alias room))
+                " ")
               (ement-room-id room)
-              (ement-room-topic room))
-    (format "\"%s\" <%s> (<%s>)"
+              (if (ement-room-topic room)
+                  (format ": \"%s\"" (ement-room-topic room))
+                ""))
+    (format "%s%s(<%s>)"
             (or (ement-room-display-name room)
                 (setf (ement-room-display-name room)
                       (ement--room-display-name room)))
-            (ement-room-canonical-alias room)
+            (if (ement-room-canonical-alias room)
+                (format " <%s> " (ement-room-canonical-alias room))
+              " ")
             (ement-room-id room))))
 
 (defun ement--members-alist (room)

ement-notify.el

@@ -165,7 +165,7 @@ margins in Emacs.  But it's useful, anyway."
   (save-window-excursion
     ;; Not sure why `call-interactively' doesn't work for `push-button' but oh well.
     (push-button)
-    (call-interactively #'ement-room-send-reply)))
+    (call-interactively #'ement-room-write-reply)))
 
 (defun ement-notify-switch-to-notifications-buffer ()
   "Switch to \"*Ement Notifications*\" buffer."

ement-room.el

@@ -96,12 +96,16 @@ Used to avoid overlapping requests.")
 Used by `ement-room-send-message'.")
 
 (defvar-local ement-room-replying-to-overlay nil
-  "Used by `ement-room-send-reply'.")
+  "Used by `ement-room-write-reply'.")
 
 (defvar-local ement-room-read-receipt-request nil
   "Maps event ID to request updating read receipt to that event.
 An alist of one entry.")
 
+(defvar ement-room-read-string-setup-hook nil
+  "Normal hook run by `ement-room-read-string' after switching to minibuffer.
+Should be used to, e.g. propagate variables to the minibuffer.")
+
 (defvar ement-room-compose-hook nil
   "Hook run in compose buffers when created.
 Used to, e.g. call `ement-room-compose-org'.")
@@ -131,7 +135,7 @@ Used to, e.g. call `ement-room-compose-org'.")
 
     ;; Messages
     (define-key map (kbd "RET") #'ement-room-send-message)
-    (define-key map (kbd "S-<return>") #'ement-room-send-reply)
+    (define-key map (kbd "S-<return>") #'ement-room-write-reply)
     (define-key map (kbd "M-RET") #'ement-room-compose-message)
     (define-key map (kbd "<insert>") #'ement-room-edit-message)
     (define-key map (kbd "C-k") #'ement-room-delete-message)
@@ -1668,7 +1672,7 @@ The message must be one sent by the local user."
                    (user-error "Message not deleted"))))
   (ement-redact event room session reason))
 
-(defun ement-room-send-reply ()
+(defun ement-room-write-reply ()
   "Send a reply to event at point."
   (interactive)
   (cl-assert ement-ewoc) (cl-assert ement-room) (cl-assert ement-session)
@@ -1678,6 +1682,9 @@ The message must be one sent by the local user."
                  (room ement-room)
                  (session ement-session)
                  (prompt (format "Send reply (%s): " (ement-room-display-name room)))
+                 (ement-room-read-string-setup-hook
+                  (lambda ()
+                    (setq-local ement-room-replying-to-event event)))
                  (body (ement-room-with-typing
                          (ement-room-read-string prompt nil nil nil 'inherit-input-method))))
       (ement-room-send-message room session :body body :replying-to-event event))))
@@ -1952,7 +1959,8 @@ and erases the buffer."
   "Call `read-from-minibuffer', binding variables and keys for Ement.
 Arguments PROMPT, INITIAL-INPUT, HISTORY, DEFAULT-VALUE, and
 INHERIT-INPUT-METHOD are as those expected by `read-string',
-which see."
+which see.  Runs hook `ement-room-read-string-setup-hook', which
+see."
   (let ((room ement-room)
         (session ement-session))
     (minibuffer-with-setup-hook
@@ -1962,7 +1970,8 @@ which see."
           (setq-local ement-session session)
           (setq-local completion-at-point-functions
                       '(ement-room--complete-members-at-point ement-room--complete-rooms-at-point))
-          (visual-line-mode 1))
+          (visual-line-mode 1)
+          (run-hooks 'ement-room-read-string-setup-hook))
       (read-from-minibuffer prompt initial-input ement-room-minibuffer-map
                             nil history default-value inherit-input-method))))
 
@@ -2301,6 +2310,23 @@ function to `ement-room-event-fns', which see."
                     new-level))
           'face 'ement-room-membership)))))
 
+(ement-room-defevent "m.room.canonical_alias"
+  (ement-room--insert-event event))
+
+(defun ement-room--format-canonical-alias-event (event room _session)
+  "Return canonical alias EVENT in ROOM formatted as a string."
+  (pcase-let (((cl-struct ement-event sender
+                          ;; TODO: Include alt_aliases, maybe.
+                          ;; TODO: Include old alias when it is being replaced.
+                          (content (map alias)))
+               event))
+    (ement-room-wrap-prefix
+      (format "%s set the canonical alias to <%s>"
+              (propertize (ement--user-displayname-in room sender)
+                          'help-echo (ement-user-id sender))
+              alias)
+      'face 'ement-room-membership)))
+
 (ement-room-defevent "m.room.redaction"
   ;; We handle redaction events here rather than an `ement-defevent' handler.  This way we
   ;; do less work for events in rooms that the user isn't looking at, at the cost of doing
@@ -3059,6 +3085,8 @@ Formats according to `ement-room-message-format-spec', which see."
                'face 'ement-room-membership))
             ("m.room.power_levels"
              (ement-room--format-power-levels-event event room session))
+            ("m.room.canonical_alias"
+             (ement-room--format-canonical-alias-event event room session))
             (_ (ement-room-wrap-prefix
                  (format "[sender:%s type:%s]"
                          (ement-user-id (ement-event-sender event))
@@ -3421,6 +3449,7 @@ To be called from a minibuffer opened from
                                                                    (ement-room-id ement-room)))))
          (input-method current-input-method) ; Capture this value from the minibuffer.
          (send-message-filter ement-room-send-message-filter)
+         (replying-to-event ement-room-replying-to-event)
          (compose-fn (lambda ()
                        ;; HACK: Since exiting the minibuffer restores the previous window configuration,
                        ;; we have to do some magic to get the new compose buffer to appear.
@@ -3430,6 +3459,13 @@ To be called from a minibuffer opened from
                        (ement-room-compose-message ement-room ement-session :body body)
 		       ;; FIXME: This doesn't propagate the send-message-filter to the minibuffer.
                        (setf ement-room-send-message-filter send-message-filter)
+                       (setq-local ement-room-replying-to-event replying-to-event)
+                       (when replying-to-event
+                         (setq-local header-line-format
+                                     (concat header-line-format
+                                             (format " (Replying to message from %s)"
+                                                     (ement--user-displayname-in
+                                                      ement-room (ement-event-sender replying-to-event))))))
                        (let* ((compose-buffer (current-buffer))
                               (show-buffer-fn-symbol (gensym "ement-show-compose-buffer"))
                               (show-buffer-fn (lambda ()
@@ -3458,14 +3494,22 @@ To be called from an `ement-room-compose' buffer."
   (let ((room ement-room)
         (session ement-session)
         (input-method current-input-method)
-        (send-message-filter ement-room-send-message-filter))
+        (send-message-filter ement-room-send-message-filter)
+        (replying-to-event ement-room-replying-to-event))
     (quit-restore-window nil 'kill)
     (ement-view-room room session)
     (let* ((prompt (format "Send message (%s): " (ement-room-display-name ement-room)))
            (current-input-method input-method) ; Bind around read-string call.
            (ement-room-send-message-filter send-message-filter)
-           (body (ement-room-read-string prompt (car kill-ring) nil nil 'inherit-input-method)))
-      (ement-room-send-message ement-room ement-session :body body))))
+           (pos (when replying-to-event
+                  (ewoc-location (ement-room--ewoc-last-matching ement-ewoc
+                                   (lambda (data)
+                                     (eq data replying-to-event))))))
+           (body (if replying-to-event
+                     (ement-room-with-highlighted-event-at pos
+                       (ement-room-read-string prompt (car kill-ring) nil nil 'inherit-input-method))
+                   (ement-room-read-string prompt (car kill-ring) nil nil 'inherit-input-method)) ))
+      (ement-room-send-message ement-room ement-session :body body :replying-to-event replying-to-event))))
 
 (defun ement-room-init-compose-buffer (room session)
   "Eval BODY, setting up the current buffer as a compose buffer.
@@ -4164,7 +4208,7 @@ For use in `completion-at-point-functions'."
                                                                   :test #'equal))
                                                   'face 'transient-value))))
               ("RET" "Write message" ement-room-send-message)
-              ("S-RET" "Write reply" ement-room-send-reply)
+              ("S-RET" "Write reply" ement-room-write-reply)
               ("M-RET" "Compose message in buffer" ement-room-compose-message)
               ("<insert>" "Edit message" ement-room-edit-message)
               ("C-k" "Delete message" ement-room-delete-message)

ement.el

@@ -5,7 +5,7 @@
 ;; Author: Adam Porter <[email protected]>
 ;; Maintainer: Adam Porter <[email protected]>
 ;; URL: https://github.com/alphapapa/ement.el
-;; Version: 0.5-pre
+;; Version: 0.5
 ;; Package-Requires: ((emacs "27.1") (map "2.1") (plz "0.2") (taxy "0.10") (taxy-magit-section "0.12.1") (svg-lib "0.2.5") (transient "0.3.7"))
 ;; Keywords: comm
 
@@ -953,6 +953,11 @@ and `session' to the session.  Adds function to
         (setf (alist-get 'parents (ement-room-local child-room))
               (delete parent-room-id (alist-get 'parents (ement-room-local child-room))))))))
 
+(ement-defevent "m.room.canonical_alias"
+  (ignore session)
+  (pcase-let (((cl-struct ement-event (content (map alias))) event))
+    (setf (ement-room-canonical-alias room) alias)))
+
 (defun ement--link-children (session)
   "Link child rooms in SESSION.
 To be called after initial sync."