branch: externals/ement
commit 12214bb0ae2590a6bca515fd07ff4295d5df93de
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@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 <a...@alphapapa.net>
;; Maintainer: Adam Porter <a...@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
