[elpa] externals/ement 6cce141042 2/2: Add: (ement-room-toggle-space)

[ELPA Syncer]

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

    Add: (ement-room-toggle-space)
    
    Including:
    
    * ement-lib.el:
    (ement--room-in-space-p): New function.
    (ement--room-spaces): New function.
    
    * ement-room-list.el:
    (ement-room-list-mode-map): New binding.
    
    * ement-room.el:
    (ement-room-mode-map): New binding.
    (ement-room-toggle-space): New command.
    (ement-room-transient): New prefix command.
---
 README.org         |  7 +++++++
 ement-lib.el       | 46 +++++++++++++++++++++++++++++++++++++++++
 ement-room-list.el |  3 +++
 ement-room.el      | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++++-
 4 files changed, 115 insertions(+), 1 deletion(-)

diff --git a/README.org b/README.org
index 08911ec6b7..5aea5d83c8 100644
--- a/README.org
+++ b/README.org
@@ -132,6 +132,7 @@ Ement.el is intended to be installed with Emacs's package 
system, which will ens
       -  ~ement-room-override-name~ to override a room's display name.
       -  ~ement-ignore-user~ to ignore a user (or with interactive prefix, 
un-ignore).
       -  ~ement-room-set-message-format~ to set a room's message format 
buffer-locally.
+      -  ~ement-room-toggle-space~ to toggle a room's membership in a space (a 
way to group rooms in Matrix).
       -  ~ement-directory~ to view a room directory.
       -  ~ement-directory-search~ to search a room directory.
 4.  Use these special buffers to see events from multiple rooms (you can also 
reply to messages from these buffers!):
@@ -211,6 +212,7 @@ These bindings are common to all of the following buffer 
types:
 + Join room: ~R j~
 + Leave room: ~R l~
 + Forget room: ~R F~
++ Toggle room's spaces: ~R s~
 
 *Other*
 
@@ -222,6 +224,8 @@ These bindings are common to all of the following buffer 
types:
 +  Show buffer of next unread room: ~SPC~
 +  Move between room names: ~TAB~ / ~<backtab>~
 
++  Toggle room's spaces: ~s~
+
 *** Directory buffers
 
 + View/join a room: ~RET~ / ~mouse-1~
@@ -291,6 +295,9 @@ Note that, while ~matrix-client~ remains usable, and 
probably will for some time
 
 ** 0.8-pre
 
+*Additions*
++ Command ~ement-room-toggle-space~ toggles a room's membership in a space (a 
way to group rooms in Matrix).
+
 *Changes*
 
 + Room-related commands may be called interactively with a universal prefix to 
prompt for the room/session (allowing to send events or change settings in 
rooms other than the current one).
diff --git a/ement-lib.el b/ement-lib.el
index b7ddcba80f..af743c6829 100644
--- a/ement-lib.el
+++ b/ement-lib.el
@@ -786,10 +786,56 @@ USER is an `ement-user' struct."
 ;; These functions aren't expected to be called by code in other packages (but 
if that
 ;; were necessary, they could be renamed accordingly).
 
+;; (defun ement--room-routing (room)
+;;   "Return a list of servers to route to ROOM through."
+;;   ;; See <https://spec.matrix.org/v1.2/appendices/#routing>.
+;;   ;; FIXME: Ensure highest power level user is at least level 50.
+;;   ;; FIXME: Ignore servers blocked due to server ACLs.
+;;   ;; FIXME: Ignore servers which are IP addresses.
+;;   (cl-labels ((most-powerful-user-in
+;;                (room))
+;;               (servers-by-population-in
+;;                (room))
+;;               (server-of (user)))
+;;     (let (first-server-by-power-level)
+;;       (delete-dups
+;;        (remq nil
+;;              (list
+;;               ;; 1.
+;;               (or (when-let ((user (most-powerful-user-in room)))
+;;                     (setf first-server-by-power-level t)
+;;                     (server-of user))
+;;                   (car (servers-by-population-in room)))
+;;               ;; 2.
+;;               (if first-server-by-power-level
+;;                   (car (servers-by-population-in room))
+;;                 (cl-second (servers-by-population-in room)))
+;;               ;; 3.
+;;               (cl-third (servers-by-population-in room))))))))
+
 (defun ement--room-space-p (room)
   "Return non-nil if ROOM is a space."
   (equal "m.space" (ement-room-type room)))
 
+(defun ement--room-in-space-p (room space)
+  "Return non-nil if ROOM is in SPACE on SESSION."
+  ;; We could use `ement---room-spaces', but since that returns rooms by 
looking them up
+  ;; by ID in the session's rooms list, this is more efficient.
+  (pcase-let* (((cl-struct ement-room (id parent-id) (local (map children))) 
space)
+               ((cl-struct ement-room (id child-id) (local (map parents))) 
room))
+    (or (member parent-id parents)
+        (member child-id children))))
+
+(defun ement--room-spaces (room session)
+  "Return list of ROOM's parent spaces on SESSION."
+  ;; NOTE: This only looks in the room's parents list; it doesn't look in 
every space's children
+  ;; list.  This should be good enough, assuming we add to the lists correctly 
elsewhere.
+  (pcase-let* (((cl-struct ement-session rooms) session)
+               ((cl-struct ement-room (local (map parents))) room))
+    (cl-remove-if-not (lambda (session-room-id)
+                        (member session-room-id parents))
+                      rooms :key #'ement-room-id)))
+
 (cl-defun ement--prism-color (string &key (contrast-with (face-background 
'default nil 'default)))
   "Return a computed color for STRING.
 The color is adjusted to have sufficient contrast with the color
diff --git a/ement-room-list.el b/ement-room-list.el
index 3c734f7e0f..7d2e3f0dc8 100644
--- a/ement-room-list.el
+++ b/ement-room-list.el
@@ -40,12 +40,15 @@
 
 ;;;; Variables
 
+(declare-function ement-room-toggle-space "ement-room")
+
 (defvar ement-room-list-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "RET") #'ement-room-list-RET)
     (define-key map (kbd "SPC") #'ement-room-list-next-unread)
     (define-key map [tab] #'ement-room-list-section-toggle)
     (define-key map [mouse-1] #'ement-room-list-mouse-1)
+    (define-key map (kbd "s") #'ement-room-toggle-space)
     map))
 
 (defvar ement-room-list-timestamp-colors nil
diff --git a/ement-room.el b/ement-room.el
index 0ec32d569f..17a8efeea4 100644
--- a/ement-room.el
+++ b/ement-room.el
@@ -166,6 +166,7 @@ Used to, e.g. call `ement-room-compose-org'.")
     (define-key map (kbd "R l") #'ement-leave-room)
     (define-key map (kbd "R F") #'ement-forget-room)
     (define-key map (kbd "R n") #'ement-room-set-display-name)
+    (define-key map (kbd "R s") #'ement-room-toggle-space)
 
     ;; Other
     (define-key map (kbd "g") #'ement-room-sync)
@@ -1812,6 +1813,52 @@ reaction string, e.g. \"👍\"."
     (goto-char (button-start button))
     (call-interactively #'ement-room-toggle-reaction)))
 
+(defun ement-room-toggle-space (room space session)
+  ;; Naming things is hard, but this seems the best balance between concision, 
ambiguity,
+  ;; and consistency.  The docstring is always there.  (Or there's the sci-fi 
angle:
+  ;; "spacing" a room...)
+  "Toggle ROOM's membership in SPACE on SESSION."
+  (interactive
+   (ement-with-room-and-session
+     :room-form (ement-complete-room :session ement-session
+                  :predicate (lambda (room) (not (ement--room-space-p room))) )
+     (pcase-let* ((prompt (format "Toggle room %S's membership in space: "
+                                  (ement--format-room ement-room)))
+                  ;; TODO: Use different face for spaces the room is already 
in.
+                  (`(,space ,_session) (ement-complete-room :session 
ement-session :prompt prompt :suggest nil
+                                         :predicate #'ement--room-space-p)))
+       (list ement-room space ement-session))))
+  (pcase-let* (((cl-struct ement-room (id child-id)) room)
+               (routing-server (progn
+                                 (string-match (rx (1+ (not (any ":"))) ":" 
(group (1+ anything))) child-id)
+                                 (match-string 1 child-id)))
+               (action (if (ement--room-in-space-p room space)
+                           'remove 'add))
+               (data (pcase action
+                       ('add (ement-alist "via" (vector
+                                                 ;; FIXME: Finish and use the 
routing function.
+                                                 ;; (ement--room-routing room)
+                                                 routing-server)))
+                       ('remove (make-hash-table)))))
+    (ement-put-state space "m.space.child" child-id data session
+      :then (lambda (response-data)
+              ;; It appears that the server doesn't send the new event in the 
next sync (at
+              ;; least, not to the client that put the state), so we must 
simulate receiving it.
+              (pcase-let* (((map event_id) response-data)
+                           ((cl-struct ement-session user) session)
+                           ((cl-struct ement-room (id child-id)) room)
+                           (fake-event (make-ement-event :id event_id :type 
"m.space.child"
+                                                         :sender user 
:state-key child-id
+                                                         :content 
(json-read-from-string (json-encode data)))))
+                (push fake-event (ement-room-timeline space))
+                (run-hook-with-args 'ement-event-hook fake-event space 
session))
+              (ement-message "Room %S %s space %S"
+                             (ement--format-room room)
+                             (pcase action
+                               ('add "added to")
+                               ('remove "removed from"))
+                             (ement--format-room space))))))
+
 ;;;; Functions
 
 (defun ement-room-view (room session)
@@ -4340,7 +4387,18 @@ For use in `completion-at-point-functions'."
                                       (propertize (ement--user-displayname-in
                                                    ement-room (gethash 
(ement-user-id (ement-session-user ement-session))
                                                                        
ement-users))
-                                                  'face 'transient-value))))]]
+                                                  'face 'transient-value))))
+              ("R s" "Toggle spaces" ement-room-toggle-space
+               :description (lambda ()
+                              (format "Toggle spaces (%s)"
+                                      (if-let ((spaces (ement--room-spaces 
ement-room ement-session)))
+                                          (string-join
+                                           (mapcar (lambda (space)
+                                                     (propertize 
(ement-room-display-name space)
+                                                                 'face 
'transient-value))
+                                                   spaces)
+                                           ", ")
+                                        (propertize "none" 'face 
'transient-inactive-value)))))]]
   ["Other"
    ("v" "View event" ement-room-view-event)
    ("g" "Sync new messages" ement-room-sync