From a48e55d65541ecc6e72931e4105ed61370f773ed Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 22 Sep 2022 14:30:00 -0500 Subject: [PATCH] Add: ement-directory --- README.org | 6 +- ement-directory.el | 295 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 300 insertions(+), 1 deletion(-) create mode 100644 ement-directory.el diff --git a/README.org b/README.org index de17fc7..7861e1a 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 0000000..ab21f4f --- /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 +;; Maintainer: Adam Porter + +;; 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 . + +;;; 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)) + (tnil (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)