[elpa] externals/ement f5b9b6894f 1/2: Add/Change: (ement-with-room-and-session) And use in commands

[ELPA Syncer]

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

    Add/Change: (ement-with-room-and-session) And use in commands
---
 README.org      |   3 +-
 ement-lib.el    |  70 +++++++++++++++++++-----------------
 ement-macros.el |  16 +++++++++
 ement-room.el   | 109 ++++++++++++++++++++++++++++++++------------------------
 4 files changed, 118 insertions(+), 80 deletions(-)

diff --git a/README.org b/README.org
index 66381ef544..b803a93f0c 100644
--- a/README.org
+++ b/README.org
@@ -113,7 +113,7 @@ Ement.el is intended to be installed with Emacs's package 
system, which will ens
 
 1.  Call command ~ement-connect~ to connect.  Multiple sessions are supported, 
so you may call the command again to connect to another account.
 2.  Wait for initial sync to complete (which can take a few moments--initial 
sync JSON requests can be large).
-3.  Use these commands:
+3.  Use these commands (room-related commands may be called with universal 
prefix to prompt for the room):
       -  ~ement-list-rooms~ to view the list of joined rooms.
       -  ~ement-view-room~ to view a room's buffer, selected with completion.
       -  ~ement-create-room~ to create a new room.
@@ -293,6 +293,7 @@ Note that, while ~matrix-client~ remains usable, and 
probably will for some time
 
 *Changes*
 
++ Room-related commands may be called interactively with a universal prefix to 
prompt for the room/session (e.g. allowing to send events or change settings in 
rooms other than the current one).
 + Command ~ement-room-list~ reuses an existing window showing the room list 
when possible.  ([[https://github.com/alphapapa/ement.el/issues/131][#131]].  
Thanks to [[https://github.com/jeffbowman][Jeff Bowman]] for suggesting.)
 
 *Fixes*
diff --git a/ement-lib.el b/ement-lib.el
index e0949fc4ec..3c2cd51936 100644
--- a/ement-lib.el
+++ b/ement-lib.el
@@ -244,13 +244,13 @@ If UNIGNORE-P (interactively, with prefix), un-ignore 
USER."
               (message "Ement: User %s %s." user-id (if unignore-p "unignored" 
"ignored"))))))
 
 (defun ement-invite-user (user-id room session)
-  "Invite USER-ID to ROOM on SESSION."
+  "Invite USER-ID to ROOM on SESSION.
+Interactively, with prefix, prompt for room and session,
+otherwise use current room."
   ;; SPEC: 10.4.2.1.
   (interactive
-   (let* ((session (ement-complete-session))
-          (user-id (ement-complete-user-id))
-          (room (car (ement-complete-room :session session))))
-     (list user-id room session)))
+   (ement-with-room-and-session
+     (list (ement-complete-user-id) ement-room ement-session)))
   (pcase-let* ((endpoint (format "rooms/%s/invite"
                                  (url-hexify-string (ement-room-id room))))
                (data (ement-alist "user_id" user-id) ))
@@ -263,9 +263,13 @@ If UNIGNORE-P (interactively, with prefix), un-ignore 
USER."
 
 (defun ement-list-members (room session bufferp)
   "Show members of ROOM on SESSION.
-If BUFFERP (interactively, with prefix), or if there are many
-members, show in a new buffer; otherwise show in echo area."
-  (interactive (list ement-room ement-session current-prefix-arg))
+Interactively, with prefix, prompt for room and session,
+otherwise use current room.  If BUFFERP (interactively, with
+prefix), or if there are many members, show in a new buffer;
+otherwise show in echo area."
+  (interactive
+   (ement-with-room-and-session
+     (list ement-room ement-session current-prefix-arg)))
   (pcase-let* (((cl-struct ement-room members (local (map fetched-members-p))) 
room)
                (list-members
                 (lambda (&optional _)
@@ -386,16 +390,16 @@ Sets global displayname."
 
 (defun ement-room-set-display-name (display-name room session)
   "Set DISPLAY-NAME for user in ROOM on SESSION.
-Sets the name only in ROOM, not globally."
+Interactively, with prefix, prompt for room and session,
+otherwise use current room.  Sets the name only in ROOM, not
+globally."
   (interactive
-   (pcase-let* ((`(,room ,session) (or (when (bound-and-true-p ement-room)
-                                         (list ement-room ement-session))
-                                       (ement-complete-room)))
-                (prompt (format "Set display-name in %S to: "
-                                (ement--format-room room)))
-                (display-name (read-string prompt nil nil
-                                           (ement-user-displayname 
(ement-session-user session)))))
-     (list display-name room session)))
+   (ement-with-room-and-session
+     (let* ((prompt (format "Set display-name in %S to: "
+                            (ement--format-room ement-room)))
+            (display-name (read-string prompt nil nil
+                                       (ement-user-displayname 
(ement-session-user ement-session)))))
+       (list display-name ement-room ement-session))))
   ;; NOTE: This does not seem to be documented in the spec, so we imitate the
   ;; "/myroomnick" command in SlashCommands.tsx from matrix-react-sdk.
   (pcase-let* (((cl-struct ement-room state) room)
@@ -426,9 +430,10 @@ Sets the name only in ROOM, not globally."
   "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)))
+  "Describe ROOM on SESSION.
+Interactively, with prefix, prompt for room and session,
+otherwise use current room."
+  (interactive (ement-with-room-and-session (list ement-room ement-session)))
   (cl-labels ((heading (string)
                        (propertize (or string "") 'face 
'font-lock-builtin-face))
               (id (string)
@@ -558,8 +563,9 @@ Returns one of nil (meaning default rules are used), 
`all-loud',
 
 (defun ement-room-set-notification-state (state room session)
   "Set notification STATE for ROOM on SESSION.
-STATE may be nil to set the rules to default, `all',
-`mentions-and-keywords', or `none'."
+Interactively, with prefix, prompt for room and session,
+otherwise use current room.  STATE may be nil to set the rules to
+default, `all', `mentions-and-keywords', or `none'."
   ;; This merely attempts to reproduce the behavior of Element's simple 
notification
   ;; options.  It does not attempt to offer all of the features defined in the 
spec.  And,
   ;; yes, it is rather awkward, having to sometimes* make multiple requests of 
different
@@ -576,17 +582,15 @@ STATE may be nil to set the rules to default, `all',
 
   ;; TODO: Support `all-loud' ("all_messages_loud").
   (interactive
-   (pcase-let* ((`(,room ,session) (or (when (bound-and-true-p ement-room)
-                                         (list ement-room ement-session))
-                                       (ement-complete-room)))
-                (prompt (format "Set notification rules for %s: " 
(ement--format-room room)))
-                (available-states (ement-alist "Default" nil
-                                               "All messages" 'all
-                                               "Mentions and keywords" 
'mentions-and-keywords
-                                               "None" 'none))
-                (selected-rule (completing-read prompt (mapcar #'car 
available-states) nil t))
-                (state (alist-get selected-rule available-states nil nil 
#'equal)))
-     (list state room session)))
+   (ement-with-room-and-session
+     (let* ((prompt (format "Set notification rules for %s: " 
(ement--format-room ement-room)))
+            (available-states (ement-alist "Default" nil
+                                           "All messages" 'all
+                                           "Mentions and keywords" 
'mentions-and-keywords
+                                           "None" 'none))
+            (selected-rule (completing-read prompt (mapcar #'car 
available-states) nil t))
+            (state (alist-get selected-rule available-states nil nil #'equal)))
+       (list state ement-room ement-session))))
   (cl-labels ((set-rule (kind rule queue message-fn)
                         (pcase-let* (((cl-struct ement-room (id room-id)) room)
                                      (rule-id (url-hexify-string room-id))
diff --git a/ement-macros.el b/ement-macros.el
index 9d96080050..11c8f61a8c 100644
--- a/ement-macros.el
+++ b/ement-macros.el
@@ -194,6 +194,22 @@ reporter's min-value to its max-value."
          (ement-debug (format "Ement: Progress reporter done (took %.2f 
seconds)"
                               (float-time (time-subtract (current-time) 
,start-time-sym))))))))
 
+;;;;; Room-related macros
+
+(cl-defmacro ement-with-room-and-session (&rest body)
+  "Eval BODY with `ement-room' and `ement-session' bound.
+If in an `ement-room' buffer and `current-prefix-arg' is nil, use
+buffer-local value of `ement-room' and `ement-session';
+otherwise, prompt for them with `ement-complete-room'."
+  (declare (indent defun))
+  `(let ((ement-room ement-room)
+         (ement-session ement-session))
+     (when (or current-prefix-arg (not ement-room))
+       (pcase-let ((`(,room ,session) (ement-complete-room :suggest t)))
+         (setf ement-room room
+               ement-session session)))
+     ,@body))
+
 ;;;; Variables
 
 
diff --git a/ement-room.el b/ement-room.el
index 43cae7086a..0ec32d569f 100644
--- a/ement-room.el
+++ b/ement-room.el
@@ -1016,15 +1016,19 @@ Note that, if ROOM has no buffer, STRING is returned 
unchanged."
 
 (defun ement-room-override-name (name room session)
   "Set display NAME override for ROOM on SESSION.
-If NAME is the empty string, remove the override.
+Interactively, with prefix, prompt for room and session,
+otherwise use current room.  If NAME is the empty string, remove
+the override.
 
 Sets account-data event of type
 \"org.matrix.msc3015.m.room.name.override\".  This name is only
 used by clients that respect this proposed override.  See
 
<https://github.com/matrix-org/matrix-spec-proposals/pull/3015#issuecomment-1451017296>."
-  (interactive (pcase-let* ((`(,room ,session) (ement-complete-room :suggest 
t))
-                            (name (read-string "Set name override: ")))
-                 (list name room session)))
+  (interactive
+   (ement-with-room-and-session
+     (let* ((prompt (format "Set name override (%s): " (ement--format-room 
ement-room)))
+            (name (read-string prompt nil nil (ement-room-display-name 
ement-room))))
+       (list name ement-room ement-session))))
   (ement-put-account-data session "org.matrix.msc3015.m.room.name.override"
     (if (string-empty-p name)
         ;; `json-encode' wants an empty hash table to represent an empty map.  
And
@@ -1170,11 +1174,14 @@ option."
 
 (defun ement-room-set-topic (session room topic)
   "Set ROOM's TOPIC on SESSION.
-Interactively, set the current buffer's ROOM's TOPIC."
-  (interactive (list ement-session ement-room
-                     (read-string (format "New topic (%s): "
-                                          (ement-room-display-name ement-room))
-                                  (ement-room-topic ement-room) nil nil 
'inherit-input-method)))
+Interactively, with prefix, prompt for room and session,
+otherwise use current room."
+  (interactive
+   (ement-with-room-and-session
+     (list ement-session ement-room
+           (read-string (format "New topic (%s): "
+                                (ement-room-display-name ement-room))
+                        (ement-room-topic ement-room) nil nil 
'inherit-input-method))))
   (pcase-let* (((cl-struct ement-room (id room-id) display-name) room)
                (endpoint (format "rooms/%s/state/m.room.topic" 
(url-hexify-string room-id)))
                (data (ement-alist "topic" topic)))
@@ -1183,14 +1190,18 @@ Interactively, set the current buffer's ROOM's TOPIC."
               (message "Topic set (%s): %s" display-name topic)))))
 
 (cl-defun ement-room-send-file (file body room session &key (msgtype "m.file"))
-  "Send FILE to ROOM on SESSION, using message BODY and MSGTYPE."
+  "Send FILE to ROOM on SESSION, using message BODY and MSGTYPE.
+Interactively, with prefix, prompt for room and session,
+otherwise use current room."
   ;; TODO: Support URLs to remote files.
-  (interactive (ement-room-with-typing
-                 (let* ((file (read-file-name (format "Send file (%s): " 
(ement-room-display-name ement-room))
-                                              nil nil 'confirm))
-                        (body (ement-room-read-string (format "Message body 
(%s): " (ement-room-display-name ement-room))
-                                                      (file-name-nondirectory 
file) nil nil 'inherit-input-method)))
-                   (list file body ement-room ement-session))))
+  (interactive
+   (ement-with-room-and-session
+     (ement-room-with-typing
+       (let* ((file (read-file-name (format "Send file (%s): " 
(ement-room-display-name ement-room))
+                                    nil nil 'confirm))
+              (body (ement-room-read-string (format "Message body (%s): " 
(ement-room-display-name ement-room))
+                                            (file-name-nondirectory file) nil 
nil 'inherit-input-method)))
+         (list file body ement-room ement-session)))))
   ;; NOTE: The typing notification won't be quite right, because it'll be 
canceled while waiting
   ;; for the file to upload.  It would be awkward to handle that, so this will 
do for now.
   (when (yes-or-no-p (format "Upload file %S to room %S? "
@@ -1223,14 +1234,18 @@ Interactively, set the current buffer's ROOM's TOPIC."
                                            :room room :session session 
:content content :data))))))))
 
 (defun ement-room-send-image (file body room session)
-  "Send image FILE to ROOM on SESSION, using message BODY."
+  "Send image FILE to ROOM on SESSION, using message BODY.
+Interactively, with prefix, prompt for room and session,
+otherwise use current room."
   ;; TODO: Support URLs to remote files.
-  (interactive (ement-room-with-typing
-                 (let* ((file (read-file-name (format "Send image file (%s): " 
(ement-room-display-name ement-room))
-                                              nil nil 'confirm))
-                        (body (ement-room-read-string (format "Message body 
(%s): " (ement-room-display-name ement-room))
-                                                      (file-name-nondirectory 
file) nil nil 'inherit-input-method)))
-                   (list file body ement-room ement-session))))
+  (interactive
+   (ement-with-room-and-session
+     (ement-room-with-typing
+       (let* ((file (read-file-name (format "Send image file (%s): " 
(ement-room-display-name ement-room))
+                                    nil nil 'confirm))
+              (body (ement-room-read-string (format "Message body (%s): " 
(ement-room-display-name ement-room))
+                                            (file-name-nondirectory file) nil 
nil 'inherit-input-method)))
+         (list file body ement-room ement-session)))))
   (ement-room-send-file file body room session :msgtype "m.image"))
 
 (defun ement-room-dnd-upload-file (uri _action)
@@ -1548,6 +1563,9 @@ EVENT should be an `ement-event' or 
`ement-room-membership-events' struct."
 
 (cl-defun ement-room-send-message (room session &key body formatted-body 
replying-to-event)
   "Send message to ROOM on SESSION with BODY and FORMATTED-BODY.
+Interactively, with prefix, prompt for room and session,
+otherwise use current room.
+
 REPLYING-TO-EVENT may be an event the message is in reply to; the
 message will reference it appropriately.
 
@@ -1555,15 +1573,13 @@ If `ement-room-send-message-filter' is non-nil, the 
message's
 content alist is passed through it before sending.  This may be
 used to, e.g. process the BODY into another format and add it to
 the content (e.g. see `ement-room-send-org-filter')."
-  (interactive (progn
-                 (cl-assert ement-room) (cl-assert ement-session)
-                 (let* ((room ement-room)
-                        (session ement-session)
-                        (prompt (format "Send message (%s): " 
(ement-room-display-name room)))
-                        (body (ement-room-with-typing
-                                (ement-room-read-string prompt nil nil nil
-                                                        
'inherit-input-method))))
-                   (list room session :body body))))
+  (interactive
+   (ement-with-room-and-session
+     (let* ((prompt (format "Send message (%s): " (ement-room-display-name 
ement-room)))
+            (body (ement-room-with-typing
+                    (ement-room-read-string prompt nil nil nil
+                                            'inherit-input-method))))
+       (list ement-room ement-session :body body))))
   (ement-send-message room session :body body :formatted-body formatted-body
     :replying-to-event replying-to-event :filter ement-room-send-message-filter
     :then #'ement-room-send-event-callback)
@@ -1582,20 +1598,20 @@ the content (e.g. see `ement-room-send-org-filter')."
 
 (cl-defun ement-room-send-emote (room session &key body)
   "Send emote to ROOM on SESSION with BODY.
+Interactively, with prefix, prompt for room and session,
+otherwise use current room.
 
 If `ement-room-send-message-filter' is non-nil, the message's
 content alist is passed through it before sending.  This may be
 used to, e.g. process the BODY into another format and add it to
 the content (e.g. see `ement-room-send-org-filter')."
-  (interactive (progn
-                 (cl-assert ement-room) (cl-assert ement-session)
-                 (let* ((room ement-room)
-                        (session ement-session)
-                        (prompt (format "Send emote (%s): " 
(ement-room-display-name room)))
-                        (body (ement-room-with-typing
-                                (ement-room-read-string prompt nil nil nil
-                                                        
'inherit-input-method))))
-                   (list room session :body body))))
+  (interactive
+   (ement-with-room-and-session
+     (let* ((prompt (format "Send emote (%s): " (ement-room-display-name 
ement-room)))
+            (body (ement-room-with-typing
+                    (ement-room-read-string prompt nil nil nil
+                                            'inherit-input-method))))
+       (list ement-room ement-session :body body))))
   (cl-assert (not (string-empty-p body)))
   (pcase-let* (((cl-struct ement-room (id room-id) (local (map buffer))) room)
                (window (when buffer (get-buffer-window buffer)))
@@ -3447,11 +3463,12 @@ HTML is rendered to Emacs text using 
`shr-insert-document'."
 
 (cl-defun ement-room-compose-message (room session &key body)
   "Compose a message to ROOM on SESSION.
-Interactively, compose to the current buffer's room.  With BODY,
-use it as the initial message contents."
-  (interactive (progn
-                 (cl-assert ement-room) (cl-assert ement-session)
-                 (list ement-room ement-session)))
+Interactively, with prefix, prompt for room and session,
+otherwise use current room.  With BODY, use it as the initial
+message contents."
+  (interactive
+   (ement-with-room-and-session
+     (list ement-room ement-session)))
   (let* ((compose-buffer (generate-new-buffer (format "*Ement compose: %s*" 
(ement--room-display-name ement-room))))
          (send-message-filter ement-room-send-message-filter))
     (with-current-buffer compose-buffer