hiro/ement.el
1
0
Fork 0
mirror of https://github.com/vale981/ement.el synced 2025-03-04 08:51:39 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add: ement-directory

Browse source
This commit is contained in:
Adam Porter 2022-09-22 14:30:00 -05:00
parent 489a683f64
commit a48e55d655
2 changed files with 300 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
README.org
View file

@ -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

295
ement-directory.el Normal file
View file

@ -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)