[elpa] externals/ement 12214bb0ae 09/10: Meta: v0.6-pre

[ELPA Syncer]

branch: externals/ement
commit 12214bb0ae2590a6bca515fd07ff4295d5df93de
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    Meta: v0.6-pre
---
 README.org   |   5 +++
 ement-lib.el | 139 ++++++++++++++++++++++++++++++++++++-----------------------
 ement.el     |   2 +-
 3 files changed, 90 insertions(+), 56 deletions(-)

diff --git a/README.org b/README.org
index 39ab4d299f..e8154b2108 100644
--- a/README.org
+++ b/README.org
@@ -287,6 +287,11 @@ Note that, while ~matrix-client~ remains usable, and 
probably will for some time
 :TOC:      :depth 0
 :END:
 
+** 0.6-pre
+
+*Changes*
++ Improve ~ement-describe-room~ command (formatting, bindings).
+
 ** 0.5.1
 
 *Fixes*
diff --git a/ement-lib.el b/ement-lib.el
index a8241b9c39..f596ae3ee6 100644
--- a/ement-lib.el
+++ b/ement-lib.el
@@ -299,61 +299,6 @@ members, show in a new buffer; otherwise show in echo 
area."
         :then list-members))
     (message "Listing members of %s..." (ement--format-room room))))
 
-(defun ement-describe-room (room session)
-  "Describe ROOM on SESSION."
-  (interactive (pcase-let ((`(,room ,session) (ement-complete-room :session 
ement-session)))
-                 (list room session)))
-  (cl-labels ((heading (string)
-                       (propertize (or string "") 'face 
'font-lock-builtin-face))
-              (id (string)
-                  (propertize (or string "") 'face 'font-lock-constant-face)))
-    (pcase-let* (((cl-struct ement-room (id room-id) avatar display-name 
canonical-alias members timeline status topic
-                             (local (map fetched-members-p)))
-                  room)
-                 ((cl-struct ement-session user) session)
-                 ((cl-struct ement-user (id user-id)) user)
-                 (inhibit-read-only t))
-      (if (not fetched-members-p)
-          ;; Members not fetched: fetch them and re-call this command.
-          (ement--get-joined-members room session
-            :then (lambda (_) (ement-room-describe room session)))
-        (with-current-buffer (get-buffer-create (format "*Ement room 
description: %s*" (or display-name canonical-alias room-id)))
-          (erase-buffer)
-          (let ((members (cl-sort (cl-loop for user being the hash-values of 
members
-                                           collect (format "%s <%s>" 
(ement--format-user user room session)
-                                                           (id (ement-user-id 
user))))
-                                  (lambda (a b) (string-collate-lessp a b nil 
t)))))
-            (save-excursion
-              (insert "\"" (propertize (or display-name canonical-alias 
room-id) 'face 'font-lock-doc-face) "\"" " is a room "
-                      (propertize (pcase status
-                                    ('invite "invited")
-                                    ('join "joined")
-                                    ('leave "left")
-                                    (_ (symbol-name status)))
-                                  'face 'font-lock-comment-face)
-                      " on session <" (id user-id) ">.\n\n"
-                      (heading "Avatar: ") (or avatar "") "\n\n"
-                      (heading "ID: ") "<" (id room-id) ">" "\n"
-                      (heading "Alias: ") "<" (id canonical-alias) ">" "\n\n"
-                      (heading "Topic: ") (propertize (or topic "[none]") 
'face 'font-lock-comment-face) "\n\n"
-                      (heading "Retrieved events: ") (number-to-string (length 
timeline)) "\n"
-                      (heading "  spanning: ")
-                      (format-time-string "%Y-%m-%d %H:%M:%S"
-                                          (/ (ement-event-origin-server-ts
-                                              (car (cl-sort (copy-sequence 
timeline) #'< :key #'ement-event-origin-server-ts)))
-                                             1000))
-                      (heading " to ")
-                      (format-time-string "%Y-%m-%d %H:%M:%S\n\n"
-                                          (/ (ement-event-origin-server-ts
-                                              (car (cl-sort (copy-sequence 
timeline) #'> :key #'ement-event-origin-server-ts)))
-                                             1000))
-                      (heading "Members") " (" (number-to-string (length 
members)) "):\n")
-              (dolist (member members)
-                (insert "  " member "\n"))))
-          (read-only-mode)
-          (pop-to-buffer (current-buffer)))))))
-(defalias 'ement-room-describe #'ement-describe-room)
-
 (defun ement-send-direct-message (session user-id message)
   "Send a direct MESSAGE to USER-ID on SESSION.
 Uses the latest existing direct room with the user, or creates a
@@ -467,6 +412,90 @@ Sets the name only in ROOM, not globally."
                        (ement-user-id (ement-session-user session))
                        (ement--format-room room))))))
 
+;;;;;; Describe room
+
+(defvar ement-describe-room-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "q") #'quit-window)
+    map)
+  "Keymap for `ement-describe-room-mode' buffers.")
+
+(define-derived-mode ement-describe-room-mode read-only-mode
+  "Ement-Describe-Room" "Major mode for `ement-describe-room' buffers.")
+
+(defun ement-describe-room (room session)
+  "Describe ROOM on SESSION."
+  (interactive (pcase-let ((`(,room ,session) (ement-complete-room :session 
ement-session)))
+                 (list room session)))
+  (cl-labels ((heading (string)
+                       (propertize (or string "") 'face 
'font-lock-builtin-face))
+              (id (string)
+                  (propertize (or string "") 'face 'font-lock-constant-face))
+              (member<
+               (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)
+                 ((cl-struct ement-session user) session)
+                 ((cl-struct ement-user (id user-id)) user)
+                 (inhibit-read-only t))
+      (if (not fetched-members-p)
+          ;; Members not fetched: fetch them and re-call this command.
+          (ement--get-joined-members room session
+            :then (lambda (_) (ement-room-describe room session)))
+        (with-current-buffer (get-buffer-create (format "*Ement room 
description: %s*" (or display-name canonical-alias room-id)))
+          (let ((inhibit-read-only t))
+            (erase-buffer)
+            ;; We avoid looping twice by doing a bit more work here and
+            ;; returning a cons which we destructure.
+            (pcase-let* ((`(,member-pairs . ,name-width)
+                          (cl-loop for user being the hash-values of members
+                                   for formatted = (ement--format-user user 
room session)
+                                   for id = (format "<%s>" (id (ement-user-id 
user)))
+                                   collect (cons formatted id)
+                                   into pairs
+                                   maximizing (string-width id) into width
+                                   finally return (cons (cl-sort pairs 
#'member<) width)))
+                         ;; We put the MXID first, because users may use 
Unicode characters
+                         ;; in their displayname, which `string-width' does 
not always
+                         ;; return perfect results for, and putting it last 
prevents
+                         ;; alignment problems.
+                         (spec (format "%%-%ss %%s" name-width)))
+              (save-excursion
+                (insert "\"" (propertize (or display-name canonical-alias 
room-id) 'face 'font-lock-doc-face) "\"" " is a room "
+                        (propertize (pcase status
+                                      ('invite "invited")
+                                      ('join "joined")
+                                      ('leave "left")
+                                      (_ (symbol-name status)))
+                                    'face 'font-lock-comment-face)
+                        " on session <" (id user-id) ">.\n\n"
+                        (heading "Avatar: ") (or avatar "") "\n\n"
+                        (heading "ID: ") "<" (id room-id) ">" "\n"
+                        (heading "Alias: ") "<" (id canonical-alias) ">" "\n\n"
+                        (heading "Topic: ") (propertize (or topic "[none]") 
'face 'font-lock-comment-face) "\n\n"
+                        (heading "Retrieved events: ") (number-to-string 
(length timeline)) "\n"
+                        (heading "  spanning: ")
+                        (format-time-string "%Y-%m-%d %H:%M:%S"
+                                            (/ (ement-event-origin-server-ts
+                                                (car (cl-sort (copy-sequence 
timeline) #'< :key #'ement-event-origin-server-ts)))
+                                               1000))
+                        (heading " to ")
+                        (format-time-string "%Y-%m-%d %H:%M:%S\n\n"
+                                            (/ (ement-event-origin-server-ts
+                                                (car (cl-sort (copy-sequence 
timeline) #'> :key #'ement-event-origin-server-ts)))
+                                               1000))
+                        (heading "Members") " (" (number-to-string 
(hash-table-count members)) "):\n")
+                (pcase-dolist (`(,formatted . ,id) member-pairs)
+                  (insert "  " (format spec id formatted) "\n")))))
+          (unless (eq major-mode 'ement-describe-room-mode)
+            ;; Without this check, activating the mode again causes a "Cyclic 
keymap
+            ;; inheritance" error.
+            (ement-describe-room-mode))
+          (pop-to-buffer (current-buffer)))))))
+
+(defalias 'ement-room-describe #'ement-describe-room)
+
 ;;;;;; Push rules
 
 ;; NOTE: Although v1.4 of the spec is available and describes setting the push 
rules using
diff --git a/ement.el b/ement.el
index 5e42754731..daa50f8cc5 100644
--- a/ement.el
+++ b/ement.el
@@ -5,7 +5,7 @@
 ;; Author: Adam Porter <adam@alphapapa.net>
 ;; Maintainer: Adam Porter <adam@alphapapa.net>
 ;; URL: https://github.com/alphapapa/ement.el
-;; Version: 0.5.1
+;; Version: 0.6-pre
 ;; 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