[elpa] externals/ement a48e55d655 4/4: Add: ement-directory

[ELPA Syncer]

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

    Add: ement-directory
---
 README.org         |   6 +-
 ement-directory.el | 295 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 300 insertions(+), 1 deletion(-)

diff --git a/README.org b/README.org
index de17fc70ef..7861e1a818 100644
--- a/README.org
+++ b/README.org
@@ -131,6 +131,8 @@ Ement.el is intended to be installed with Emacs's package 
system, which will ens
       -  ~ement-room-occur~ to search in a room's known events.
       -  ~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-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!):
       -  See all new events that mention you in the =*Ement Mentions*= buffer.
       -  See all new events in rooms that have open buffers in the =*Ement 
Notifications*= buffer.
@@ -281,7 +283,9 @@ Note that, while ~matrix-client~ remains usable, and 
probably will for some time
 
 ** 0.3-pre
 
-Nothing new yet.
+*Added*
++ Command ~ement-directory~ shows a server's room directory.
++ Command ~ement-directory-search~ searches a server's room directory.
 
 ** 0.2.1
 
diff --git a/ement-directory.el b/ement-directory.el
new file mode 100644
index 0000000000..ab21f4f40d
--- /dev/null
+++ b/ement-directory.el
@@ -0,0 +1,295 @@
+;;; ement-directory.el --- Public room directory support                       
-*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022  Free Software Foundation, Inc.
+
+;; Author: Adam Porter <adam@alphapapa.net>
+;; Maintainer: Adam Porter <adam@alphapapa.net>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides support for viewing and searching public room 
directories on
+;; Matrix homeservers.
+
+;; To make rendering the list flexible and useful, we'll use 
`taxy-magit-section'.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'ement)
+(require 'ement-taxy)
+
+(require 'taxy)
+(require 'taxy-magit-section)
+
+;;;; Variables
+
+(defvar ement-directory-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "RET") #'ement-directory-RET)
+    (define-key map [mouse-1] #'ement-directory-mouse-1)
+    map))
+
+(defgroup ement-directory nil
+  "Options for room directories."
+  :group 'ement)
+
+;;;; Mode
+
+(define-derived-mode ement-directory-mode magit-section-mode "Ement-Directory"
+  :global nil)
+
+(defvar-local ement-directory-revert-function nil
+  "Function used as `revert-buffer-function'.")
+
+(defvar-local ement-directory-session nil)
+
+;;;;; Keys
+
+(eval-and-compile
+  (taxy-define-key-definer ement-directory-define-key
+    ement-directory-keys "ement-directory-key" "FIXME: Docstring."))
+
+;; TODO: Other keys like guest_can_join, world_readable, etc.  (Last-updated 
time would be
+;; nice, but the server doesn't include that in the results.)
+
+(ement-directory-define-key joined-p ()
+  (pcase-let (((map ('room_id id)) item))
+    (when (cl-find id (ement-session-rooms ement-directory-session)
+                   :key #'ement-room-id :test #'equal)
+      "Joined")))
+
+(ement-directory-define-key size (&key < >)
+  (pcase-let (((map ('num_joined_members size)) item))
+    (cond ((and < (< size <))
+           (format "< %s members" <))
+          ((and > (> size >))
+           (format "> %s members" >)))))
+
+(ement-directory-define-key space-p ()
+  "Groups rooms that are themselves spaces."
+  (pcase-let (((map ('room_type type)) item))
+    (when (equal "m.space" type)
+      "Spaces")))
+
+(defcustom ement-directory-default-keys
+  '((joined-p)
+    (space-p)
+    ((size :> 10000))
+    ((size :> 1000))
+    ((size :> 100))
+    ((size :> 10))
+    ((size :< 11)))
+  "Default keys."
+  :type 'sexp)
+
+;;;; Columns
+
+(defvar-local ement-directory-room-avatar-cache (make-hash-table)
+  ;; Use a buffer-local variable so that the cache is cleared when the buffer 
is closed.
+  "Hash table caching room avatars for the `ement-directory' room list.")
+
+(eval-and-compile
+  (taxy-magit-section-define-column-definer "ement-directory"))
+
+;; TODO: Fetch avatars (with queueing and async updating/insertion?).
+
+(ement-directory-define-column #("✓" 0 1 (help-echo "Joined")) ()
+  (pcase-let (((map ('room_id id)) item))
+    (if (cl-find id (ement-session-rooms ement-directory-session)
+                 :key #'ement-room-id :test #'equal)
+        "✓"
+      " ")))
+
+(ement-directory-define-column "Name" (:max-width 25)
+  (pcase-let (((map name) item))
+    (or name "[unnamed]")))
+
+(ement-directory-define-column "Alias" (:max-width 25)
+  (pcase-let (((map ('canonical_alias alias)) item))
+    (or alias "")))
+
+(ement-directory-define-column "Size" ()
+  (pcase-let (((map ('num_joined_members size)) item))
+    (number-to-string size)))
+
+(ement-directory-define-column "Topic" (:max-width 50)
+  (pcase-let (((map topic) item))
+    (if topic
+        (replace-regexp-in-string "\n" " | " topic nil t)
+      "")))
+
+(ement-directory-define-column "ID" ()
+  (pcase-let (((map ('room_id id)) item))
+    id))
+
+(unless ement-directory-columns
+  ;; TODO: Automate this or document it
+  (setq-default ement-directory-columns
+                '("Name" "Alias" "Size" "Topic" "ID")))
+
+;;;; Commands
+
+(cl-defun ement-directory (&key server session (limit 1000))
+  "View the public room directory on SERVER with SESSION.
+Interactively, With prefix, prompt for server and number of
+rooms."
+  (interactive (let* ((session (ement-complete-session :prompt "Search on 
session: "))
+                      (server (if current-prefix-arg
+                                  (read-string "Search on server: ")
+                                (ement-server-name (ement-session-server 
session))))
+                      (limit (when current-prefix-arg
+                               (read-number "Limit number of rooms: " 1000))))
+                 (list :server server :session session :limit limit)))
+  (pcase-let ((revert-function (lambda (&rest _ignore)
+                                 (interactive)
+                                 (ement-directory :server server :session 
session)))
+              (endpoint "publicRooms"))
+    (ement-api session endpoint :params (list (list "limit" limit))
+      :then (lambda (results)
+              (ement-directory--view results :session session
+                                     :buffer-name (format "*Ement Directory: 
%s*" server)
+                                     :root-section-name (format "Ement 
Directory: %s" server)
+                                     :revert-function revert-function)))
+    (ement-message "Listing rooms on %s..." server)))
+
+(cl-defun ement-directory-search (query &key server session)
+  "View public rooms on SERVER matching QUERY.
+QUERY is a string used to filter results."
+  (interactive (let* ((session (ement-complete-session :prompt "Search on 
session: "))
+                      (server (if current-prefix-arg
+                                  (read-string "Search on server: ")
+                                (ement-server-name (ement-session-server 
session))))
+                      (query (read-string (format "Search for rooms on %s: " 
server))))
+                 (list query :server server :session session)))
+  ;; TODO: Handle "include_all_networks" and "third_party_instance_id".  See § 
10.5.4.
+  (pcase-let* ((revert-function (lambda (&rest _ignore)
+                                  (interactive)
+                                  (ement-directory-search query :server server 
:session session)))
+               (endpoint "publicRooms")
+               (data (ement-alist "limit" 1000
+                                  "filter" (ement-alist "generic_search_term" 
query))))
+    (ement-api session endpoint :method 'post :data (json-encode data)
+      :then (lambda (results)
+              (ement-directory--view results :session session
+                                     :buffer-name (format "*Ement Directory: 
\"%s\" on %s*" query server)
+                                     :root-section-name (format "Ement 
Directory: \"%s\" on %s" query server)
+                                     :revert-function revert-function)))
+    (ement-message "Searching for %S on %s..." query server)))
+
+(defun ement-directory-mouse-1 (event)
+  "Call `ement-directory-RET' at EVENT."
+  (interactive "e")
+  (mouse-set-point event)
+  (call-interactively #'ement-directory-RET))
+
+(defun ement-directory-RET ()
+  "View or join room at point, or cycle section at point."
+  (interactive)
+  (cl-etypecase (oref (magit-current-section) value)
+    (null nil)
+    (list (pcase-let* (((map ('name name) ('room_id room-id)) (oref 
(magit-current-section) value))
+                       (room (cl-find room-id (ement-session-rooms 
ement-directory-session)
+                                      :key #'ement-room-id :test #'equal)))
+            (if room
+                (ement-view-room room ement-directory-session)
+              ;; Room not joined: prompt to join.  (Don't use the alias in the 
prompt,
+              ;; because multiple rooms might have the same alias, e.g. when 
one is
+              ;; upgraded or tombstoned.)
+              (when (yes-or-no-p (format "Join room \"%s\" <%s>? " name 
room-id))
+                (ement-join-room room-id ement-directory-session)))))
+    (taxy-magit-section (call-interactively #'magit-section-cycle))))
+
+;;;; Functions
+
+(cl-defun ement-directory--view (results &key session revert-function
+                                         (buffer-name "*Ement Directory*")
+                                         (root-section-name "Ement Directory")
+                                         (keys ement-directory-default-keys)
+                                         (display-buffer-action 
'(display-buffer-same-window)))
+  "View RESULTS in an `ement-directory-mode' buffer.
+To be called by `ement-directory-search'."
+  (let (format-table column-sizes window-start)
+    (cl-labels ((format-item (item) (gethash item format-table))
+                ;; NOTE: Since these functions take an "item" (which is a 
[room session]
+                ;; vector), they're prefixed "item-" rather than "room-".
+                (size
+                 (item) (pcase-let (((map ('num_joined_members size)) item))
+                          size))
+                (t<nil (a b) (and a (not b)))
+                (t>nil (a b) (and (not a) b))
+                (make-fn (&rest args)
+                         (apply #'make-taxy-magit-section
+                                :make #'make-fn
+                                :format-fn #'format-item
+                                ;; FIXME: Should we reuse 
`ement-taxy-level-indent' here?
+                                :level-indent ement-taxy-level-indent
+                                ;; :visibility-fn #'visible-p
+                                ;; :heading-indent 2
+                                :item-indent 2
+                                ;; :heading-face-fn #'heading-face
+                                args)))
+      (unless ement-sessions
+        (error "Ement: Not connected.  Use `ement-connect' to connect"))
+      (with-current-buffer (get-buffer-create buffer-name)
+        (ement-directory-mode)
+        (setf ement-directory-session session)
+        (setq-local revert-buffer-function revert-function)
+        (pcase-let* (((map ('chunk rooms)) results)
+                     (taxy (cl-macrolet ((first-item
+                                          (pred) `(lambda (taxy)
+                                                    (when (taxy-items taxy)
+                                                      (,pred (car (taxy-items 
taxy)))))))
+                             (thread-last
+                               (make-fn
+                                :name root-section-name
+                                :take (taxy-make-take-function keys 
ement-directory-keys))
+                               (taxy-fill (cl-coerce rooms 'list))
+                               (taxy-sort #'> #'size)
+                               (taxy-sort* #'string> #'taxy-name))))
+                     (taxy-magit-section-insert-indent-items nil)
+                     (inhibit-read-only t)
+                     (format-cons (taxy-magit-section-format-items
+                                   ement-directory-columns 
ement-directory-column-formatters taxy))
+                     (pos (point))
+                     (section-ident (when (magit-current-section)
+                                      (magit-section-ident 
(magit-current-section)))))
+          (setf format-table (car format-cons)
+                column-sizes (cdr format-cons)
+                header-line-format (taxy-magit-section-format-header
+                                    column-sizes 
ement-directory-column-formatters)
+                window-start (if (get-buffer-window buffer-name)
+                                 (window-start (get-buffer-window buffer-name))
+                               0))
+          (delete-all-overlays)
+          (erase-buffer)
+          (save-excursion
+            (taxy-magit-section-insert taxy :items 'first
+              ;; :blank-between-depth bufler-taxy-blank-between-depth
+              :initial-depth 0))
+          (goto-char pos)
+          (when (and section-ident (magit-get-section section-ident))
+            (goto-char (oref (magit-get-section section-ident) start)))))
+      (display-buffer buffer-name display-buffer-action)
+      (when (get-buffer-window buffer-name)
+        (set-window-start (get-buffer-window buffer-name) window-start))
+      ;; NOTE: In order for `bookmark--jump-via' to work properly, the 
restored buffer
+      ;; must be set as the current buffer, so we have to do this explicitly 
here.
+      (set-buffer buffer-name))))
+
+;;;; Footer
+
+(provide 'ement-directory)