[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/ement 8a0248b13d 13/14: Merge: ement-taxy-room-list ->
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/ement 8a0248b13d 13/14: Merge: ement-taxy-room-list -> ement-room-list |
|
Date: |
Sat, 22 Oct 2022 11:57:39 -0400 (EDT) |
branch: externals/ement
commit 8a0248b13df2b35747eedcc84d73116abfde7d87
Merge: 89e91b8364 293fb58ad5
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>
Merge: ement-taxy-room-list -> ement-room-list
And ement-room-list -> ement-tabulated-room-list.
---
ement-directory.el | 10 +-
ement-lib.el | 8 +-
ement-room-list.el | 890 ++++++++++++++-------
ement-room.el | 12 +-
ement-room-list.el => ement-tabulated-room-list.el | 145 ++--
ement-taxy.el | 622 --------------
ement.el | 8 +-
7 files changed, 673 insertions(+), 1022 deletions(-)
diff --git a/ement-directory.el b/ement-directory.el
index 87e390a552..af9aa24a8b 100644
--- a/ement-directory.el
+++ b/ement-directory.el
@@ -30,7 +30,7 @@
;;;; Requirements
(require 'ement)
-(require 'ement-taxy)
+(require 'ement-room-list)
(require 'taxy)
(require 'taxy-magit-section)
@@ -118,8 +118,8 @@
(ement-directory-define-column "Name" (:max-width 25)
(pcase-let* (((map name ('room_type type)) item)
(face (pcase type
- ("m.space" 'ement-room-list-space)
- (_ 'ement-room-list-name))))
+ ("m.space" 'ement-tabulated-room-list-space)
+ (_ 'ement-tabulated-room-list-name))))
(propertize (or name "[unnamed]")
'face face)))
@@ -307,8 +307,8 @@ contents. To be called by `ement-directory-search'."
(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
+ ;; FIXME: Should we reuse
`ement-room-list-level-indent' here?
+ :level-indent ement-room-list-level-indent
;; :visibility-fn #'visible-p
;; :heading-indent 2
:item-indent 2
diff --git a/ement-lib.el b/ement-lib.el
index 974ee3a0c7..fc45a9bff3 100644
--- a/ement-lib.el
+++ b/ement-lib.el
@@ -1223,12 +1223,12 @@ IMAGE should be one as created by, e.g. `create-image'."
(declare-function eieio-oref "eieio-core")
(defun ement--room-at-point ()
"Return room at point.
-Works in major-modes `ement-room-mode', `ement-room-list-mode',
-and `ement-taxy-mode'."
+Works in major-modes `ement-room-mode',
+`ement-tabulated-room-list-mode', and `ement-room-list-mode'."
(pcase major-mode
('ement-room-mode (ement--format-room ement-room 'topic))
- ('ement-room-list-mode (ement--format-room (tabulated-list-get-id) 'topic))
- ('ement-taxy-mode
+ ('ement-tabulated-room-list-mode (ement--format-room
(tabulated-list-get-id) 'topic))
+ ('ement-room-list-mode
(cl-typecase (oref (magit-current-section) value)
(taxy-magit-section nil)
(t (pcase (oref (magit-current-section) value)
diff --git a/ement-room-list.el b/ement-room-list.el
index 0669bc59ce..aa85be54a9 100644
--- a/ement-room-list.el
+++ b/ement-room-list.el
@@ -1,4 +1,4 @@
-;;; ement-room-list.el --- Ement room list buffer -*- lexical-binding: t;
-*-
+;;; ement-room-list.el --- List Ement rooms -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Free Software Foundation, Inc.
@@ -20,84 +20,57 @@
;;; Commentary:
-;; This library implements a room list buffer.
-
-;; NOTE: It doesn't appear that there is a way to get the number of
-;; members in a room other than by retrieving the list of members and
-;; counting them. For a large room (e.g. the Spacemacs Gitter room or
-;; #debian:matrix.org), that means thousands of users, none of the
-;; details of which we care about. So it seems impractical to know
-;; the number of members when using lazy-loading. So I guess we just
-;; won't show the number of members.
-
-;; TODO: (Or maybe there is, see m.joined_member_count).
-
-;; NOTE: The tabulated-list API is awkward here. When the
-;; `tabulated-list-format' is changed, we have to make the change in 4
-;; or 5 other places, and if one forgets to, bugs with non-obvious
-;; causes happen. I think library using EIEIO or structs would be
-;; very helpful.
+;; This library implements a room list view using `taxy' and
`taxy-magit-section' for
+;; dynamic, programmable grouping.
;;; Code:
-;;;; Requirements
+(require 'button)
+(require 'rx)
-(require 'cl-lib)
-(require 'tabulated-list)
+(require 'svg-lib)
+(require 'taxy)
+(require 'taxy-magit-section)
-(require 'ement)
+(defgroup ement-room-list nil
+ "Group Ement rooms with Taxy."
+ :group 'ement)
;;;; Variables
-(declare-function ement-notify-switch-to-mentions-buffer "ement-notify")
-(declare-function ement-notify-switch-to-notifications-buffer "ement-notify")
(defvar ement-room-list-mode-map
(let ((map (make-sparse-keymap)))
- ;; (define-key map (kbd "g") #'tabulated-list-revert)
- ;; (define-key map (kbd "q") #'bury-buffer)
+ (define-key map (kbd "RET") #'ement-room-list-RET)
(define-key map (kbd "SPC") #'ement-room-list-next-unread)
- (define-key map (kbd "M-g M-m") #'ement-notify-switch-to-mentions-buffer)
- (define-key map (kbd "M-g M-n")
#'ement-notify-switch-to-notifications-buffer)
- ;; (define-key map (kbd "S") #'tabulated-list-sort)
+ (define-key map [tab] #'ement-room-list-section-toggle)
+ (define-key map [mouse-1] #'ement-room-list-mouse-1)
map))
(defvar ement-room-list-timestamp-colors nil
"List of colors used for timestamps.
Set automatically when `ement-room-list-mode' is activated.")
-(defvar ement-sessions)
-
;;;; Customization
-(defgroup ement-room-list nil
- "Options for the room list buffer."
- :group 'ement)
-
(defcustom ement-room-list-auto-update t
- "Automatically update the room list buffer."
+ "Automatically update the taxy-based room list buffer."
:type 'boolean)
(defcustom ement-room-list-avatars (display-images-p)
"Show room avatars in the room list."
:type 'boolean)
-(defcustom ement-room-list-simplify-timestamps t
- "Only show the largest unit of time in a timestamp.
-For example, \"1h54m3s\" becomes \"1h\"."
- :type 'boolean)
-
;;;;; Faces
-(defface ement-room-list-name
- '((t (:inherit font-lock-function-name-face button)))
- "Non-direct rooms.")
-
(defface ement-room-list-direct
;; In case `font-lock-constant-face' is bold, we set the weight to normal,
so it can be
;; made bold for unread rooms only.
'((t (:weight normal :inherit (font-lock-constant-face
ement-room-list-name))))
"Direct rooms.")
+(defface ement-room-list-favourite '((t (:inherit (font-lock-doc-face
ement-room-list-name))))
+ "Favourite rooms.")
+
(defface ement-room-list-invited
'((t (:inherit italic ement-room-list-name)))
"Invited rooms.")
@@ -106,29 +79,349 @@ For example, \"1h54m3s\" becomes \"1h\"."
'((t (:strike-through t :inherit ement-room-list-name)))
"Left rooms.")
+(defface ement-room-list-low-priority '((t (:inherit (font-lock-comment-face
ement-room-list-name))))
+ "Low-priority rooms.")
+
+(defface ement-room-list-name
+ '((t (:inherit font-lock-function-name-face button)))
+ "Non-direct rooms.")
+
+(defface ement-room-list-space '((t (:inherit
(font-lock-regexp-grouping-backslash ement-room-list-name))))
+ "Space rooms."
+ :group 'ement-room-list)
+
(defface ement-room-list-unread
'((t (:inherit bold ement-room-list-name)))
"Unread rooms.")
-(defface ement-room-list-favourite '((t (:inherit (font-lock-doc-face
ement-room-list-name))))
- "Favourite rooms.")
-
-(defface ement-room-list-low-priority '((t (:inherit (font-lock-comment-face
ement-room-list-name))))
- "Low-priority rooms.")
-
-(defface ement-room-list-recent
- '((t (:inherit font-lock-warning-face)))
+(defface ement-room-list-recent '((t (:inherit font-lock-warning-face)))
"Latest timestamp of recently updated rooms.
The foreground color is used to generate a gradient of colors
from recent to non-recent for rooms updated in the past 24
hours but at least one hour ago.")
-(defface ement-room-list-very-recent
- '((t (:inherit error)))
+(defface ement-room-list-very-recent '((t (:inherit error)))
"Latest timestamp of very recently updated rooms.
The foreground color is used to generate a gradient of colors
from recent to non-recent for rooms updated in the past hour.")
+;;;; Keys
+
+;; Since some of these keys need access to the session, and room
+;; structs don't include the session, we use a two-element vector in
+;; which the session is the second element.
+
+(eval-and-compile
+ (taxy-define-key-definer ement-room-list-define-key
+ ement-room-list-keys "ement-room-list-key" "FIXME: Docstring."))
+
+(ement-room-list-define-key membership (&key name status)
+ ;; FIXME: Docstring: status should be a symbol of either `invite', `join',
`leave'.
+ (cl-labels ((format-membership (membership)
+ (pcase membership
+ ('join "Joined")
+ ('invite "Invited")
+ ('leave "[Left]"))))
+ (pcase-let ((`[,(cl-struct ement-room (status membership)) ,_session]
item))
+ (if status
+ (when (equal status membership)
+ (or name (format-membership membership)))
+ (format-membership membership)))))
+
+(ement-room-list-define-key alias (&key name regexp)
+ (pcase-let ((`[,(cl-struct ement-room canonical-alias) ,_session] item))
+ (when canonical-alias
+ (when (string-match-p regexp canonical-alias)
+ name))))
+
+(ement-room-list-define-key buffer ()
+ (pcase-let ((`[,(cl-struct ement-room (local (map buffer))) ,_session] item))
+ (when buffer
+ #("Buffers" 0 7 (help-echo "Rooms with open buffers")))))
+
+(ement-room-list-define-key direct ()
+ (pcase-let ((`[,room ,session] item))
+ (when (ement--room-direct-p room session)
+ "Direct")))
+
+(ement-room-list-define-key people ()
+ (pcase-let ((`[,room ,session] item))
+ (when (ement--room-direct-p room session)
+ (propertize "People" 'face 'ement-room-list-direct))))
+
+(ement-room-list-define-key space (&key name id)
+ (pcase-let* ((`[,room ,session] item)
+ ((cl-struct ement-session rooms) session)
+ ((cl-struct ement-room type (local (map parents))) room))
+ (cl-labels ((format-space
+ (id) (let* ((parent-room (cl-find id rooms :key
#'ement-room-id :test #'equal))
+ (space-name (if parent-room
+ (ement-room-display-name
parent-room)
+ id)))
+ (concat "Space: " space-name))))
+ (when-let ((key (if id
+ ;; ID specified.
+ (cond ((or (member id parents)
+ (equal id (ement-room-id room)))
+ ;; Room is in specified space.
+ (or name (format-space id)))
+ ((and (equal type "m.space")
+ (equal id (ement-room-id room)))
+ ;; Room is a specified space.
+ (or name (concat "Space: "
(ement-room-display-name room)))
+ ))
+ ;; ID not specified.
+ (pcase (length parents)
+ (0 nil)
+ (1
+ ;; TODO: Make the rooms list a hash table to avoid
this lookup.
+ (format-space (car parents)))
+ (_
+ ;; TODO: How to handle this better? (though it
should be very rare)
+ (string-join (mapcar #'format-space parents) ",
"))))))
+ (propertize key 'face 'ement-room-list-space)))))
+
+(ement-room-list-define-key space-p ()
+ "Groups rooms that are themselves spaces."
+ (pcase-let* ((`[,room ,_session] item)
+ ((cl-struct ement-room type) room))
+ (when (equal "m.space" type)
+ "Spaces")))
+
+(ement-room-list-define-key name (&key name regexp)
+ (pcase-let* ((`[,room ,_session] item)
+ (display-name (ement--room-display-name room)))
+ (when display-name
+ (when (string-match-p regexp display-name)
+ (or name regexp)))))
+
+(ement-room-list-define-key latest (&key name newer-than older-than)
+ (pcase-let* ((`[,room ,_session] item)
+ ((cl-struct ement-room latest-ts) room)
+ (age))
+ (when latest-ts
+ (setf age (- (time-convert nil 'integer) (/ latest-ts 1000)))
+ (cond (newer-than
+ (when (<= age newer-than)
+ (or name (format "Newer than %s seconds" newer-than))))
+ (older-than
+ (when (>= age older-than)
+ (or name (format "Older than %s seconds" newer-than))))
+ (t
+ ;; Default to rooms with traffic in the last day.
+ (if (<= age 86400)
+ "Last 24 hours"
+ "Older than 24 hours"))))))
+
+(ement-room-list-define-key freshness
+ (&key (intervals '((86400 . "Past 24h")
+ (604800 . "Past week")
+ (2419200 . "Past month")
+ (31536000 . "Past year"))))
+ (pcase-let* ((`[,room ,_session] item)
+ ((cl-struct ement-room latest-ts) room)
+ (age))
+ (when latest-ts
+ (setf age (- (time-convert nil 'integer) (/ latest-ts 1000)))
+ (or (alist-get age intervals nil nil #'>)
+ "Older than a year"))))
+
+(ement-room-list-define-key session (&optional user-id)
+ (pcase-let ((`[,_room ,(cl-struct ement-session
+ (user (cl-struct ement-user id)))]
+ item))
+ (pcase user-id
+ (`nil id)
+ (_ (when (equal user-id id)
+ user-id)))))
+
+(ement-room-list-define-key topic (&key name regexp)
+ (pcase-let ((`[,(cl-struct ement-room topic) ,_session] item))
+ (when topic
+ (when (string-match-p regexp topic)
+ name))))
+
+(ement-room-list-define-key unread ()
+ (pcase-let ((`[,room ,session] item))
+ (when (ement--room-unread-p room session)
+ "Unread")))
+
+(ement-room-list-define-key favourite ()
+ :then #'identity
+ (pcase-let ((`[,room ,_session] item))
+ (when (ement--room-favourite-p room)
+ (propertize "Favourite" 'face 'ement-room-list-favourite))))
+
+(ement-room-list-define-key low-priority ()
+ :then #'identity
+ (pcase-let ((`[,room ,_session] item))
+ (when (ement--room-low-priority-p room)
+ "Low-priority")))
+
+(defcustom ement-room-list-default-keys
+ '((space-p space)
+ ((membership :status 'invite))
+ (favourite)
+ (buffer)
+ ((membership :status 'leave))
+ (low-priority)
+ (unread)
+ ((latest :name "Last 24h" :newer-than 86400))
+ (latest :name "Older than 90d" :older-than (* 86400 90))
+ people
+ freshness
+ (space))
+ "Default keys."
+ :type 'sexp)
+
+;;;; Columns
+
+(defvar-local ement-room-list-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-room-list' room list.")
+
+(eval-and-compile
+ (taxy-magit-section-define-column-definer "ement-room-list"))
+
+(ement-room-list-define-column #("š±" 0 1 (help-echo "Avatar")) (:align 'right)
+ (pcase-let* ((`[,room ,_session] item)
+ ((cl-struct ement-room avatar display-name) room))
+ (if ement-room-list-avatars
+ (or (gethash room ement-room-list-room-avatar-cache)
+ (let ((new-avatar
+ (if avatar
+ ;; NOTE: We resize every avatar to be suitable for this
buffer, rather than using
+ ;; the one cached in the room's struct. If the
buffer's faces change height, this
+ ;; will need refreshing, but it should be worth it to
avoid resizing the images on
+ ;; every update.
+ (propertize " " 'display
+ (ement--resize-image (get-text-property 0
'display avatar)
+ nil
(frame-char-height)))
+ ;; Room has no avatar: make one.
+ (let* ((string (or display-name (ement--room-display-name
room)))
+ (ement-room-prism-minimum-contrast 1)
+ (color (ement--prism-color string :contrast-with
"white")))
+ (when (string-match (rx bos (or "#" "!" "@")) string)
+ (setf string (substring string 1)))
+ (propertize " " 'display (svg-lib-tag (substring string
0 1) nil
+ :background color
:foreground "white"
+ :stroke 0))))))
+ (puthash room new-avatar ement-room-list-room-avatar-cache)))
+ ;; Avatars disabled: use a two-space string.
+ " ")))
+
+(ement-room-list-define-column "Name" (:max-width 25)
+ (pcase-let* ((`[,room ,session] item)
+ ((cl-struct ement-room type) room)
+ (display-name (ement--room-display-name room))
+ (face))
+ (or (when display-name
+ ;; TODO: Use code from ement-room-list and put in a dedicated
function.
+ (setf face (cl-copy-list '(:inherit (ement-room-list-name))))
+ ;; In concert with the "Unread" column, this is roughly equivalent
to the
+ ;; "red/gray/bold/idle" states listed in
<https://github.com/matrix-org/matrix-react-sdk/blob/b0af163002e8252d99b6d7075c83aadd91866735/docs/room-list-store.md#list-ordering-algorithm-importance>.
+ (when (ement--room-unread-p room session)
+ ;; For some reason, `push' doesn't work with `map-elt'...or does
it?
+ (push 'ement-room-list-unread (map-elt face :inherit)))
+ (when (equal "m.space" type)
+ (push 'ement-room-list-space (map-elt face :inherit)))
+ (when (ement--room-direct-p room session)
+ (push 'ement-room-list-direct (map-elt face :inherit)))
+ (when (ement--room-favourite-p room)
+ (push 'ement-room-list-favourite (map-elt face :inherit)))
+ (when (ement--room-low-priority-p room)
+ (push 'ement-room-list-low-priority (map-elt face :inherit)))
+ (pcase (ement-room-status room)
+ ('invite
+ (push 'ement-room-list-invited (map-elt face :inherit)))
+ ('leave
+ (push 'ement-room-list-left (map-elt face :inherit))))
+ (propertize (ement--button-buttonize display-name
#'ement-room-list-mouse-1)
+ 'face face
+ 'mouse-face 'highlight))
+ "")))
+
+(ement-room-list-define-column #("Unread" 0 6 (help-echo "Unread events
(Notifications:Highlights)")) (:align 'right)
+ (pcase-let* ((`[,(cl-struct ement-room unread-notifications) ,_session] item)
+ ((map notification_count highlight_count) unread-notifications))
+ (if (or (not unread-notifications)
+ (and (equal 0 notification_count)
+ (equal 0 highlight_count)))
+ ""
+ (concat (propertize (number-to-string notification_count)
+ 'face (if (zerop highlight_count)
+ 'default
+ 'ement-room-mention))
+ ":"
+ (propertize (number-to-string highlight_count)
+ 'face 'highlight)))))
+
+(ement-room-list-define-column "Latest" ()
+ (pcase-let ((`[,(cl-struct ement-room latest-ts) ,_session] item))
+ (if latest-ts
+ (let* ((difference-seconds (- (float-time) (/ latest-ts 1000)))
+ (n (cl-typecase difference-seconds
+ ((number 0 3599) ;; <1 hour: 10-minute periods.
+ (truncate (/ difference-seconds 600)))
+ ((number 3600 86400) ;; 1 hour to 1 day: 24 1-hour periods.
+ (+ 6 (truncate (/ difference-seconds 3600))))
+ (otherwise ;; Difference in weeks.
+ (min (/ (length ement-room-list-timestamp-colors) 2)
+ (+ 24 (truncate (/ difference-seconds 86400 7)))))))
+ (face (list :foreground (elt ement-room-list-timestamp-colors
n)))
+ (formatted-ts (ement--human-format-duration difference-seconds
'abbreviate)))
+ (string-match (rx (1+ digit) (repeat 1 alpha)) formatted-ts)
+ (propertize (match-string 0 formatted-ts) 'face face
+ 'help-echo formatted-ts))
+ "")))
+
+(ement-room-list-define-column "Topic" (:max-width 35)
+ (pcase-let ((`[,(cl-struct ement-room topic status) ,_session] item))
+ ;; FIXME: Can the status and type unified, or is this inherent to the spec?
+ (when topic
+ (setf topic (replace-regexp-in-string "\n" " " topic 'fixedcase
'literal)))
+ (pcase status
+ ('invite (concat (propertize "[invited]"
+ 'face 'ement-room-list-invited)
+ " " topic))
+ ('leave (concat (propertize "[left]"
+ 'face 'ement-room-list-left)
+ " " topic))
+ (_ (or topic "")))))
+
+(ement-room-list-define-column "Members" (:align 'right)
+ (pcase-let ((`[,(cl-struct ement-room
+ (summary (map ('m.joined_member_count
member-count))))
+ ,_session]
+ item))
+ (if member-count
+ (number-to-string member-count)
+ "")))
+
+(ement-room-list-define-column #("Notifications" 0 5 (help-echo "Notification
state")) ()
+ (pcase-let* ((`[,room ,session] item))
+ (pcase (ement-room-notification-state room session)
+ ('nil "default")
+ ('all-loud "all (loud)")
+ ('all "all")
+ ('mentions-and-keywords "mentions")
+ ('none "none"))))
+
+(ement-room-list-define-column #("B" 0 1 (help-echo "Buffer exists for room"))
()
+ (pcase-let ((`[,(cl-struct ement-room (local (map buffer))) ,_session] item))
+ (if buffer
+ #("B" 0 1 (help-echo "Buffer exists for room"))
+ " ")))
+
+(ement-room-list-define-column "Session" ()
+ (pcase-let ((`[,_room ,(cl-struct ement-session (user (cl-struct ement-user
id)))] item))
+ id))
+
+(unless ement-room-list-columns
+ ;; TODO: Automate this or document it
+ (setq-default ement-room-list-columns
+ (get 'ement-room-list-columns 'standard-value)))
+
;;;; Bookmark support
;; Especially useful with Burly: <https://github.com/alphapapa/burly.el>
@@ -137,59 +430,268 @@ from recent to non-recent for rooms updated in the past
hour.")
(defun ement-room-list-bookmark-make-record ()
"Return a bookmark record for the `ement-room-list' buffer."
- (pcase-let* (((cl-struct ement-session user) ement-session)
- ((cl-struct ement-user (id session-id)) user))
- ;; MAYBE: Support bookmarking specific events in a room.
- (list (concat "Ement room list (" session-id ")")
- (cons 'session-id session-id)
- (cons 'handler #'ement-room-list-bookmark-handler))))
+ (list "*Ement Room List*"
+ (cons 'handler #'ement-room-list-bookmark-handler)))
(defun ement-room-list-bookmark-handler (bookmark)
- "Show Ement room list buffer for BOOKMARK."
- (pcase-let* (((map session-id) bookmark))
- (unless (alist-get session-id ement-sessions nil nil #'equal)
+ "Show `ement-room-list' room list buffer for BOOKMARK."
+ (pcase-let* ((`(,_bookmark-name . ,_) bookmark))
+ (unless ement-sessions
;; MAYBE: Automatically connect.
- (user-error "Session %s not connected: call `ement-connect' first"
session-id))
+ (user-error "No sessions connected: call `ement-connect' first"))
(ement-room-list)))
;;;; Commands
+(defun ement-room-list-section-toggle ()
+ "Toggle the section at point."
+ ;; HACK: For some reason, when a section's body is hidden, then the buffer
is refreshed,
+ ;; and then the section's body is shown again, the body is empty--but then,
refreshing
+ ;; the buffer shows its body. So we work around that by refreshing the
buffer when a
+ ;; section is toggled. In a way, it makes sense to do this anyway, so the
user has the
+ ;; most up-to-date information in the buffer. This hack also works around a
minor
+ ;; visual bug that sometimes causes room avatars to be displayed in a
section heading
+ ;; when a section is hidden.
+ (interactive)
+ (call-interactively #'magit-section-toggle)
+ (revert-buffer))
+
+;;;###autoload
+(defun ement-room-list--after-initial-sync (&rest _ignore)
+ "Call `ement-room-list', ignoring arguments.
+To be called from `ement-after-initial-sync-hook'."
+ (ement-room-list))
+
+;;;###autoload
+(defalias 'ement-list-rooms 'ement-room-list)
+
+;;;###autoload
+(cl-defun ement-room-list (&key (buffer-name "*Ement Room List*")
+ (keys ement-room-list-default-keys)
+ (display-buffer-action
'(display-buffer-same-window))
+ ;; visibility-fn
+ )
+ "Show a buffer listing Ement rooms, grouped with Taxy KEYS.
+The buffer is named BUFFER-NAME and is shown with
+DISPLAY-BUFFER-ACTION."
+ (interactive)
+ (let (format-table column-sizes window-start)
+ (cl-labels (;; (heading-face
+ ;; (depth) (list :inherit (list 'bufler-group
(bufler-level-face depth))))
+ (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-".
+ (item-latest-ts
+ (item) (or (ement-room-latest-ts (elt item 0))
+ ;; Room has no latest timestamp. FIXME: This
shouldn't
+ ;; happen, but it can, maybe due to oversights
elsewhere.
+ 0))
+ (item-unread-p
+ (item) (pcase-let ((`[,room ,session] item))
+ (ement--room-unread-p room session)))
+ (item-left-p
+ (item) (pcase-let ((`[,(cl-struct ement-room status)
,_session] item))
+ (equal 'leave status)))
+ (item-buffer-p
+ (item) (pcase-let ((`[,(cl-struct ement-room (local (map
buffer))) ,_session] item))
+ (buffer-live-p buffer)))
+ (taxy-unread-p
+ (taxy) (or (cl-some #'item-unread-p (taxy-items taxy))
+ (cl-some #'taxy-unread-p (taxy-taxys taxy))))
+ (item-space-p
+ (item) (pcase-let ((`[,(cl-struct ement-room type) ,_session]
item))
+ (equal "m.space" type)))
+ (item-favourite-p
+ (item) (pcase-let ((`[,room ,_session] item))
+ (ement--room-favourite-p room)))
+ (item-low-priority-p
+ (item) (pcase-let ((`[,room ,_session] item))
+ (ement--room-low-priority-p room)))
+ (visible-p
+ ;; This is very confusing and doesn't currently work.
+ (section) (let ((value (oref section value)))
+ (if (cl-typecase value
+ (taxy-magit-section (item-unread-p value))
+ (ement-room nil))
+ 'show
+ 'hide)))
+ (item-invited-p
+ (item) (pcase-let ((`[,(cl-struct ement-room status)
,_session] item))
+ (equal 'invite status)))
+ (taxy-latest-ts
+ (taxy) (apply #'max most-negative-fixnum
+ (delq nil
+ (list
+ (when (taxy-items taxy)
+ (item-latest-ts (car (taxy-items
taxy))))
+ (when (taxy-taxys taxy)
+ (cl-loop for sub-taxy in (taxy-taxys
taxy)
+ maximizing (taxy-latest-ts
sub-taxy)))))))
+ (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
+ :level-indent ement-room-list-level-indent
+ ;; :visibility-fn #'visible-p
+ ;; :heading-indent 2
+ :item-indent 2
+ ;; :heading-face-fn #'heading-face
+ args)))
+ ;; (when (get-buffer buffer-name)
+ ;; (kill-buffer buffer-name))
+ (unless ement-sessions
+ (error "Ement: Not connected. Use `ement-connect' to connect"))
+ (with-current-buffer (get-buffer-create buffer-name)
+ (ement-room-list-mode)
+ (let* ((room-session-vectors
+ (cl-loop for (_id . session) in ement-sessions
+ append (cl-loop for room in (ement-session-rooms
session)
+ collect (vector room session))))
+ (taxy (cl-macrolet ((first-item
+ (pred) `(lambda (taxy)
+ (when (taxy-items taxy)
+ (,pred (car (taxy-items
taxy)))))))
+ (thread-last
+ (make-fn
+ :name "Ement Rooms"
+ :take (taxy-make-take-function keys
ement-room-list-keys))
+ (taxy-fill room-session-vectors)
+ (taxy-sort #'> #'item-latest-ts)
+ (taxy-sort #'t<nil #'item-invited-p)
+ (taxy-sort #'t<nil #'item-favourite-p)
+ (taxy-sort #'t>nil #'item-low-priority-p)
+ (taxy-sort #'t<nil #'item-unread-p)
+ (taxy-sort #'t<nil #'item-space-p)
+ ;; Within each taxy, left rooms should be sorted last
so that one
+ ;; can never be the first room in the taxy (unless
it's the taxy
+ ;; of left rooms), which would cause the taxy to be
incorrectly
+ ;; sorted last.
+ (taxy-sort #'t>nil #'item-left-p)
+ (taxy-sort* #'string< #'taxy-name)
+ (taxy-sort* #'> #'taxy-latest-ts)
+ (taxy-sort* #'t<nil (first-item item-unread-p))
+ (taxy-sort* #'t<nil (first-item item-favourite-p))
+ (taxy-sort* #'t<nil (first-item item-invited-p))
+ (taxy-sort* #'t<nil (first-item item-buffer-p))
+ (taxy-sort* #'t>nil (first-item item-space-p))
+ (taxy-sort* #'t>nil (first-item item-low-priority-p))
+ (taxy-sort* #'t>nil (first-item item-left-p)))))
+ (taxy-magit-section-insert-indent-items nil)
+ (inhibit-read-only t)
+ (format-cons (taxy-magit-section-format-items
+ ement-room-list-columns
ement-room-list-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-room-list-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))))
+
+(cl-defun ement-room-list-side-window (&key (side 'left))
+ "Show room list in side window on SIDE.
+Interactively, with prefix, show on right side; otherwise, on
+left."
+ (interactive (when current-prefix-arg
+ (list :side 'right)))
+ (let ((display-buffer-mark-dedicated t))
+ ;; Not sure if binding `display-buffer-mark-dedicated' is still necessary.
+ (ement-room-list
+ :display-buffer-action `(display-buffer-in-side-window
+ (dedicated . t)
+ (side . ,side)
+ (window-parameters
+ (no-delete-other-windows . t))))))
+
+(defun ement-room-list-revert (_ignore-auto _noconfirm)
+ "Revert current Ement-Room-List buffer."
+ (interactive)
+ (ement-room-list :display-buffer-action '(display-buffer-no-window
(allow-no-window . t))))
+
+(defun ement-room-list-mouse-1 (event)
+ "Call `ement-room-list-RET' at EVENT."
+ (interactive "e")
+ (mouse-set-point event)
+ (call-interactively #'ement-room-list-RET))
+
+(defun ement-room-list-RET ()
+ "View room at point, or cycle section at point."
+ (interactive)
+ (cl-etypecase (oref (magit-current-section) value)
+ (vector (pcase-let ((`[,room ,session] (oref (magit-current-section)
value)))
+ (ement-view-room room session)))
+ (taxy-magit-section (call-interactively #'ement-room-list-section-toggle))
+ (null nil)))
+
(defun ement-room-list-next-unread ()
"Show next unread room."
(interactive)
(unless (button-at (point))
(call-interactively #'forward-button))
(unless (cl-loop with starting-line = (line-number-at-pos)
- if (equal "U" (elt (tabulated-list-get-entry) 0))
+ for value = (oref (magit-current-section) value)
+ for room = (elt value 0)
+ for session = (elt value 1)
+ if (ement--room-unread-p room session)
do (progn
(goto-char (button-end (button-at (point))))
(push-button (1- (point)))
+ (ement-room-goto-fully-read-marker)
(cl-return t))
else do (call-interactively #'forward-button)
while (> (line-number-at-pos) starting-line))
;; No more unread rooms.
(message "No more unread rooms")))
-;;;###autoload
-(defun ement-room-list (&rest _ignore)
- "Show buffer listing joined rooms.
-Calls `pop-to-buffer-same-window'. Interactively, with prefix,
-call `pop-to-buffer'."
- (interactive)
- (with-current-buffer (get-buffer-create "*Ement Rooms*")
- (ement-room-list-mode)
- (setq-local bookmark-make-record-function
#'ement-room-list-bookmark-make-record)
- ;; FIXME: There must be a better way to handle this.
- (funcall (if current-prefix-arg
- #'pop-to-buffer #'pop-to-buffer-same-window)
- (current-buffer))))
+(define-derived-mode ement-room-list-mode magit-section-mode "Ement-Room-List"
+ :global nil
+ (setq-local bookmark-make-record-function
#'ement-room-list-bookmark-make-record
+ revert-buffer-function #'ement-room-list-revert
+ ement-room-list-timestamp-colors
(ement-room-list--timestamp-colors)))
+
+;;;; Functions
;;;###autoload
-(defalias 'ement-list-rooms 'ement-room-list)
+(defun ement-room-list-auto-update (_session)
+ "Automatically update the Taxy room list buffer.
++Does so when variable `ement-room-list-auto-update' is non-nil.
++To be called in `ement-sync-callback-hook'."
+ (when (and ement-room-list-auto-update
+ (buffer-live-p (get-buffer "*Ement Room List*")))
+ (with-current-buffer (get-buffer "*Ement Room List*")
+ (unless (region-active-p)
+ ;; Don't refresh the list if the region is active (e.g. if the user is
trying to
+ ;; operate on multiple rooms).
+
+ ;; FIXME: This seems to redisplay the buffer even when it's buried.
But it
+ ;; shouldn't, because the revert function uses
`display-buffer-no-window'. But it
+ ;; doesn't always happen; it only seems to in certain circumstances,
e.g. when the
+ ;; minibuffer is open, which should be unrelated to this.
+ (revert-buffer)))))
(defun ement-room-list--timestamp-colors ()
"Return a vector of generated latest-timestamp colors for rooms.
-Used in `ement-room-list' and `ement-taxy-room-list'."
+Used in `ement-tabulated-room-list' and `ement-room-list'."
(if (or (equal "unspecified-fg" (face-foreground 'default nil 'default))
(equal "unspecified-bg" (face-background 'default nil 'default)))
;; NOTE: On a TTY, the default face's foreground and background colors
may be the
@@ -230,232 +732,6 @@ Used in `ement-room-list' and `ement-taxy-room-list'."
104)))
'vector)))
-(define-derived-mode ement-room-list-mode tabulated-list-mode
- "Ement-Room-List"
- :group 'ement
- (setf tabulated-list-format (vector
- '("U" 1 t)
- '(#("P" 0 1 (help-echo "Priority
(favorite/low)")) 1 t)
- '("B" 1 t)
- ;; '("U" 1 t)
- '("d" 1 t) ; Direct
- (list (propertize "š±"
- 'help-echo "Avatar")
- 4 t) ; Avatar
- '("Name" 25 t) '("Topic" 35 t)
- (list "Latest"
- (if ement-room-list-simplify-timestamps
- 6 20)
- #'ement-room-list-latest<
- :right-align t)
- '("Members" 7 ement-room-list-members<)
- ;; '("P" 1 t) '("Tags" 15 t)
- '("Session" 15 t))
- tabulated-list-sort-key '("Latest" . t)
- ement-room-list-timestamp-colors (ement-room-list--timestamp-colors))
- (add-hook 'tabulated-list-revert-hook #'ement-room-list--set-entries nil
'local)
- (tabulated-list-init-header)
- (ement-room-list--set-entries)
- (tabulated-list-revert))
-
-(defun ement-room-list-action (event)
- "Show buffer for room at EVENT or point."
- (interactive "e")
- (mouse-set-point event)
- (pcase-let* ((room (tabulated-list-get-id))
- (`[,_unread ,_priority ,_buffer ,_direct ,_avatar ,_name
,_topic ,_latest ,_members ,user-id]
- (tabulated-list-get-entry))
- (session (alist-get user-id ement-sessions nil nil #'equal)))
- (ement-view-room room session)))
-
-;;;; Functions
-
-;;;###autoload
-(defun ement-room-list-auto-update (_session)
- "Automatically update the room list buffer.
-Does so when variable `ement-room-list-auto-update' is non-nil.
-To be called in `ement-sync-callback-hook'."
- (when (and ement-room-list-auto-update
- (buffer-live-p (get-buffer "*Ement Rooms*")))
- (with-current-buffer (get-buffer "*Ement Rooms*")
- (revert-buffer))))
-
-(defun ement-room-list--set-entries ()
- "Set `tabulated-list-entries'."
- ;; Reset avatar size in case default font size has changed.
- ;; TODO: After implementing avatars.
- ;; (customize-set-variable 'ement-room-avatar-in-buffer-name-size
ement-room-avatar-in-buffer-name-size)
-
- ;; NOTE: From Emacs docs:
-
- ;; This buffer-local variable specifies the entries displayed in the
- ;; Tabulated List buffer. Its value should be either a list, or a
- ;; function.
- ;;
- ;; If the value is a list, each list element corresponds to one entry,
- ;; and should have the form ā(ID CONTENTS)ā, where
- ;;
- ;; ā¢ ID is either ānilā, or a Lisp object that identifies the
- ;; entry. If the latter, the cursor stays on the same entry when
- ;; re-sorting entries. Comparison is done with āequalā.
- ;;
- ;; ā¢ CONTENTS is a vector with the same number of elements as
- ;; ātabulated-list-formatā. Each vector element is either a
- ;; string, which is inserted into the buffer as-is, or a list
- ;; ā(LABEL . PROPERTIES)ā, which means to insert a text button by
- ;; calling āinsert-text-buttonā with LABEL and PROPERTIES as
- ;; arguments (*note Making Buttons::).
- ;;
- ;; There should be no newlines in any of these strings.
- (let ((entries (cl-loop for (_id . session) in ement-sessions
- append (mapcar (lambda (room)
- (ement-room-list--entry session
room))
- (ement-session-rooms session)))))
- (setf tabulated-list-entries
- ;; Pre-sort by latest event so that, when the list is sorted by
other columns,
- ;; the rooms will be secondarily sorted by latest event.
- (cl-sort entries #'> :key (lambda (entry)
- ;; In case a room has no latest event
(not sure if
- ;; this may obscure a bug, but this has
happened, so
- ;; we need to handle it), we fall back
to 0.
- (or (ement-room-latest-ts (car entry))
0))))))
-
-(defun ement-room-list--entry (session room)
- "Return entry for ROOM in SESSION for `tabulated-list-entries'."
- (pcase-let* (((cl-struct ement-room id canonical-alias display-name avatar
topic latest-ts summary
- (local (map buffer room-list-avatar)))
- room)
- ((map ('m.joined_member_count member-count)) summary)
- (e-alias (or canonical-alias
- (setf (ement-room-canonical-alias room)
- (ement--room-alias room))
- id))
- ;; FIXME: Figure out how to track unread status cleanly.
- (e-unread (if (and buffer (buffer-modified-p buffer))
- (propertize "U" 'help-echo "Unread") ""))
- (e-buffer (if buffer (propertize "B" 'help-echo "Room has
buffer") ""))
- (e-avatar (if (and ement-room-list-avatars avatar)
- (or room-list-avatar
- (if-let* ((avatar-image (get-text-property 0
'display avatar))
- (new-avatar-string (propertize " "
'display
-
(ement--resize-image avatar-image
-
nil (frame-char-height)))))
- (progn
- ;; alist-get doesn't seem to return the
new value when used with setf?
- (setf (alist-get 'room-list-avatar
(ement-room-local room))
- new-avatar-string)
- new-avatar-string)
- ;; If a room avatar image fails to download
or decode
- ;; and ends up nil, we return the empty
string.
- (ement-debug "nil avatar for room: "
(ement-room-display-name room) (ement-room-canonical-alias room))
- ""))
- ;; Room avatars disabled.
- ""))
- ;; We have to copy the list, otherwise using `setf' on it
- ;; later causes its value to be mutated for every entry.
- (name-face (cl-copy-list '(:inherit (ement-room-list-name))))
- (e-name (list (propertize (or display-name
- (ement--room-display-name room))
- ;; HACK: Apply face here, otherwise
tabulated-list overrides it.
- 'face name-face
- 'help-echo e-alias)
- 'action #'ement-room-list-action))
- (e-topic (if topic
- ;; Remove newlines from topic. Yes, this can
happen.
- (replace-regexp-in-string "\n" "" topic t t)
- ""))
- (formatted-timestamp (if latest-ts
- (ement--human-format-duration (-
(time-convert nil 'integer) (/ latest-ts 1000))
- t)
- ""))
- (latest-face (when latest-ts
- (let* ((difference-seconds (- (float-time) (/
latest-ts 1000)) )
- (n (cl-typecase difference-seconds
- ((number 0 3599) ;; 1 hour to 1 day:
24 1-hour periods.
- (truncate (/ difference-seconds
600)))
- ((number 3600 86400) ;; 1 day
- (+ 6 (truncate (/
difference-seconds 3600))))
- (otherwise ;; Difference in weeks.
- (min (/ (length
ement-room-list-timestamp-colors) 2)
- (+ 24 (truncate (/
difference-seconds 86400 7))))))))
- (list :foreground (elt
ement-room-list-timestamp-colors n)))))
- (e-latest (or (when formatted-timestamp
- (propertize formatted-timestamp
- 'value latest-ts
- 'face latest-face))
- ;; Invited rooms don't have a latest-ts.
- ""))
- (e-session (propertize (ement-user-id (ement-session-user
session))
- 'value session))
- ;; ((e-tags favorite-p low-priority-p) (ement-room-list--tags
room))
- (e-direct-p (if (ement--room-direct-p room session)
- (propertize "d" 'help-echo "Direct room")
- ""))
- (e-priority (cond ((ement--room-favourite-p room) "F")
- ((ement--room-low-priority-p room) "l")
- (" ")))
- (e-members (if member-count (number-to-string member-count)
"")))
- (when ement-room-list-simplify-timestamps
- (setf e-latest (replace-regexp-in-string
- (rx bos (1+ digit) (1+ alpha) (group (1+ (1+ digit) (1+
alpha))))
- "" e-latest t t 1)))
- ;; Add face modifiers.
- (when (and buffer (buffer-modified-p buffer))
- ;; For some reason, `push' doesn't work with `map-elt'.
- (setf (map-elt name-face :inherit)
- (cons 'ement-room-list-unread (map-elt name-face :inherit))))
- (when (ement--room-direct-p room session)
- (setf (map-elt name-face :inherit)
- (cons 'ement-room-list-direct (map-elt name-face :inherit))))
- (when (ement--room-favourite-p room)
- (push 'ement-room-list-favourite (map-elt name-face :inherit)))
- (when (ement--room-low-priority-p room)
- (push 'ement-room-list-low-priority (map-elt name-face :inherit)))
- (pcase (ement-room-type room)
- ('invite
- (setf e-topic (concat (propertize "[invited]"
- 'face 'ement-room-list-invited)
- " " e-topic)
- (map-elt name-face :inherit) (cons 'ement-room-list-invited
- (map-elt name-face :inherit))))
- ('leave
- (setf e-topic (concat (propertize "[left]"
- 'face 'ement-room-list-left)
- " " e-topic)
- (map-elt name-face :inherit) (cons (map-elt name-face :inherit)
- 'ement-room-list-left))))
- (list room (vector e-unread e-priority e-buffer e-direct-p
- e-avatar e-name e-topic e-latest e-members
- ;; e-tags
- e-session
- ;; e-avatar
- ))))
-
-;; TODO: Define sorters with a macro? This gets repetitive and hard to update.
-
-(defun ement-room-list-members< (a b)
- "Return non-nil if entry A has fewer members than room B.
-A and B should be entries from `tabulated-list-mode'."
- (pcase-let* ((`(,_room [,_unread ,_priority ,_buffer ,_direct ,_avatar
,_name-for-list ,_topic ,_latest ,a-members ,_session]) a)
- (`(,_room [,_unread ,_priority ,_buffer ,_direct ,_avatar
,_name-for-list ,_topic ,_latest ,b-members ,_session]) b))
- (when (and a-members b-members)
- ;; Invited rooms may have no member count (I think).
- (< (string-to-number a-members) (string-to-number b-members)))))
-
-(defun ement-room-list-latest< (a b)
- "Return non-nil if entry A has fewer members than room B.
-A and B should be entries from `tabulated-list-mode'."
- (pcase-let* ((`(,_room-a [,_unread ,_priority ,_buffer ,_direct ,_avatar
,_name-for-list ,_topic ,a-latest ,_a-members ,_session]) a)
- (`(,_room-b [,_unread ,_priority ,_buffer ,_direct ,_avatar
,_name-for-list ,_topic ,b-latest ,_b-members ,_session]) b)
- (a-latest (get-text-property 0 'value a-latest))
- (b-latest (get-text-property 0 'value b-latest)))
- (cond ((and a-latest b-latest)
- (< a-latest b-latest))
- (b-latest
- ;; Invited rooms have no latest timestamp, and we want to sort them
first.
- nil)
- (t t))))
-
;;;; Footer
(provide 'ement-room-list)
diff --git a/ement-room.el b/ement-room.el
index 388d77b191..72fcde02e8 100644
--- a/ement-room.el
+++ b/ement-room.el
@@ -1206,8 +1206,8 @@ Interactively, set the current buffer's ROOM's TOPIC."
"m.image"
"m.file"))))
+(declare-function ement-tabulated-room-list-next-unread
"ement-tabulated-room-list")
(declare-function ement-room-list-next-unread "ement-room-list")
-(declare-function ement-taxy-next-unread "ement-taxy")
(defun ement-room-scroll-up-mark-read ()
"Scroll buffer up, marking read and burying when at end."
(interactive)
@@ -1229,12 +1229,12 @@ Interactively, set the current buffer's ROOM's TOPIC."
(progn
(select-window rooms-window)
(funcall (pcase-exhaustive major-mode
- ('ement-room-list-mode #'ement-room-list-next-unread)
- ('ement-taxy-mode #'ement-taxy-next-unread))))
+ ('ement-tabulated-room-list-mode
#'ement-tabulated-room-list-next-unread)
+ ('ement-room-list-mode
#'ement-room-list-next-unread))))
;; Rooms buffer not displayed: bury this room buffer, which should
usually
;; result in another room buffer or the rooms list buffer being
displayed.
(bury-buffer))
- (when (member major-mode '(ement-room-list-mode
ement-taxy-room-list-mode))
+ (when (member major-mode '(ement-tabulated-room-list-mode
ement-room-list-mode))
;; Back in the room-list buffer: revert it.
(revert-buffer)))
;; Not at the bottom of the buffer: scroll.
@@ -1477,7 +1477,7 @@ sync requests. Also, update any room list buffers."
(ement--sync session :force force)
(cl-loop for buffer in (buffer-list)
when (member (buffer-local-value 'major-mode buffer)
- '(ement-taxy-mode ement-room-list-mode))
+ '(ement-room-list-mode ement-tabulated-room-list-mode))
do (with-current-buffer buffer
(revert-buffer))))
@@ -4117,7 +4117,7 @@ For use in `completion-at-point-functions'."
("S-SPC" "Scroll down" ement-room-scroll-down-command)
("M-SPC" "Jump to fully-read marker"
ement-room-goto-fully-read-marker)]
["Switching"
- ("M-g M-l" "List rooms" ement-taxy-room-list)
+ ("M-g M-l" "List rooms" ement-room-list)
("M-g M-r" "Switch to other room" ement-view-room)
("M-g M-m" "Switch to mentions buffer"
ement-notify-switch-to-mentions-buffer)
("M-g M-n" "Switch to notifications buffer"
ement-notify-switch-to-notifications-buffer)
diff --git a/ement-room-list.el b/ement-tabulated-room-list.el
similarity index 80%
copy from ement-room-list.el
copy to ement-tabulated-room-list.el
index 0669bc59ce..047852b364 100644
--- a/ement-room-list.el
+++ b/ement-tabulated-room-list.el
@@ -1,4 +1,4 @@
-;;; ement-room-list.el --- Ement room list buffer -*- lexical-binding: t;
-*-
+;;; ement-tabulated-room-list.el --- Ement tabulated room list buffer -*-
lexical-binding: t; -*-
;; Copyright (C) 2022 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;;; Commentary:
-;; This library implements a room list buffer.
+;; This library implements a room list buffer with `tabulated-list-mode'.
;; NOTE: It doesn't appear that there is a way to get the number of
;; members in a room other than by retrieving the list of members and
@@ -51,79 +51,79 @@
(declare-function ement-notify-switch-to-mentions-buffer "ement-notify")
(declare-function ement-notify-switch-to-notifications-buffer "ement-notify")
-(defvar ement-room-list-mode-map
+(defvar ement-tabulated-room-list-mode-map
(let ((map (make-sparse-keymap)))
;; (define-key map (kbd "g") #'tabulated-list-revert)
;; (define-key map (kbd "q") #'bury-buffer)
- (define-key map (kbd "SPC") #'ement-room-list-next-unread)
+ (define-key map (kbd "SPC") #'ement-tabulated-room-list-next-unread)
(define-key map (kbd "M-g M-m") #'ement-notify-switch-to-mentions-buffer)
(define-key map (kbd "M-g M-n")
#'ement-notify-switch-to-notifications-buffer)
;; (define-key map (kbd "S") #'tabulated-list-sort)
map))
-(defvar ement-room-list-timestamp-colors nil
+(defvar ement-tabulated-room-list-timestamp-colors nil
"List of colors used for timestamps.
-Set automatically when `ement-room-list-mode' is activated.")
+Set automatically when `ement-tabulated-room-list-mode' is activated.")
(defvar ement-sessions)
;;;; Customization
-(defgroup ement-room-list nil
+(defgroup ement-tabulated-room-list nil
"Options for the room list buffer."
:group 'ement)
-(defcustom ement-room-list-auto-update t
+(defcustom ement-tabulated-room-list-auto-update t
"Automatically update the room list buffer."
:type 'boolean)
-(defcustom ement-room-list-avatars (display-images-p)
+(defcustom ement-tabulated-room-list-avatars (display-images-p)
"Show room avatars in the room list."
:type 'boolean)
-(defcustom ement-room-list-simplify-timestamps t
+(defcustom ement-tabulated-room-list-simplify-timestamps t
"Only show the largest unit of time in a timestamp.
For example, \"1h54m3s\" becomes \"1h\"."
:type 'boolean)
;;;;; Faces
-(defface ement-room-list-name
+(defface ement-tabulated-room-list-name
'((t (:inherit font-lock-function-name-face button)))
"Non-direct rooms.")
-(defface ement-room-list-direct
+(defface ement-tabulated-room-list-direct
;; In case `font-lock-constant-face' is bold, we set the weight to normal,
so it can be
;; made bold for unread rooms only.
- '((t (:weight normal :inherit (font-lock-constant-face
ement-room-list-name))))
+ '((t (:weight normal :inherit (font-lock-constant-face
ement-tabulated-room-list-name))))
"Direct rooms.")
-(defface ement-room-list-invited
- '((t (:inherit italic ement-room-list-name)))
+(defface ement-tabulated-room-list-invited
+ '((t (:inherit italic ement-tabulated-room-list-name)))
"Invited rooms.")
-(defface ement-room-list-left
- '((t (:strike-through t :inherit ement-room-list-name)))
+(defface ement-tabulated-room-list-left
+ '((t (:strike-through t :inherit ement-tabulated-room-list-name)))
"Left rooms.")
-(defface ement-room-list-unread
- '((t (:inherit bold ement-room-list-name)))
+(defface ement-tabulated-room-list-unread
+ '((t (:inherit bold ement-tabulated-room-list-name)))
"Unread rooms.")
-(defface ement-room-list-favourite '((t (:inherit (font-lock-doc-face
ement-room-list-name))))
+(defface ement-tabulated-room-list-favourite '((t (:inherit
(font-lock-doc-face ement-tabulated-room-list-name))))
"Favourite rooms.")
-(defface ement-room-list-low-priority '((t (:inherit (font-lock-comment-face
ement-room-list-name))))
+(defface ement-tabulated-room-list-low-priority '((t (:inherit
(font-lock-comment-face ement-tabulated-room-list-name))))
"Low-priority rooms.")
-(defface ement-room-list-recent
+(defface ement-tabulated-room-list-recent
'((t (:inherit font-lock-warning-face)))
"Latest timestamp of recently updated rooms.
The foreground color is used to generate a gradient of colors
from recent to non-recent for rooms updated in the past 24
hours but at least one hour ago.")
-(defface ement-room-list-very-recent
+(defface ement-tabulated-room-list-very-recent
'((t (:inherit error)))
"Latest timestamp of very recently updated rooms.
The foreground color is used to generate a gradient of colors
@@ -135,26 +135,26 @@ from recent to non-recent for rooms updated in the past
hour.")
(require 'bookmark)
-(defun ement-room-list-bookmark-make-record ()
- "Return a bookmark record for the `ement-room-list' buffer."
+(defun ement-tabulated-room-list-bookmark-make-record ()
+ "Return a bookmark record for the `ement-tabulated-room-list' buffer."
(pcase-let* (((cl-struct ement-session user) ement-session)
((cl-struct ement-user (id session-id)) user))
;; MAYBE: Support bookmarking specific events in a room.
(list (concat "Ement room list (" session-id ")")
(cons 'session-id session-id)
- (cons 'handler #'ement-room-list-bookmark-handler))))
+ (cons 'handler #'ement-tabulated-room-list-bookmark-handler))))
-(defun ement-room-list-bookmark-handler (bookmark)
+(defun ement-tabulated-room-list-bookmark-handler (bookmark)
"Show Ement room list buffer for BOOKMARK."
(pcase-let* (((map session-id) bookmark))
(unless (alist-get session-id ement-sessions nil nil #'equal)
;; MAYBE: Automatically connect.
(user-error "Session %s not connected: call `ement-connect' first"
session-id))
- (ement-room-list)))
+ (ement-tabulated-room-list)))
;;;; Commands
-(defun ement-room-list-next-unread ()
+(defun ement-tabulated-room-list-next-unread ()
"Show next unread room."
(interactive)
(unless (button-at (point))
@@ -171,25 +171,22 @@ from recent to non-recent for rooms updated in the past
hour.")
(message "No more unread rooms")))
;;;###autoload
-(defun ement-room-list (&rest _ignore)
+(defun ement-tabulated-room-list (&rest _ignore)
"Show buffer listing joined rooms.
Calls `pop-to-buffer-same-window'. Interactively, with prefix,
call `pop-to-buffer'."
(interactive)
(with-current-buffer (get-buffer-create "*Ement Rooms*")
- (ement-room-list-mode)
- (setq-local bookmark-make-record-function
#'ement-room-list-bookmark-make-record)
+ (ement-tabulated-room-list-mode)
+ (setq-local bookmark-make-record-function
#'ement-tabulated-room-list-bookmark-make-record)
;; FIXME: There must be a better way to handle this.
(funcall (if current-prefix-arg
#'pop-to-buffer #'pop-to-buffer-same-window)
(current-buffer))))
-;;;###autoload
-(defalias 'ement-list-rooms 'ement-room-list)
-
-(defun ement-room-list--timestamp-colors ()
+(defun ement-tabulated-room-list--timestamp-colors ()
"Return a vector of generated latest-timestamp colors for rooms.
-Used in `ement-room-list' and `ement-taxy-room-list'."
+Used in `ement-tabulated-room-list' and `ement-room-list'."
(if (or (equal "unspecified-fg" (face-foreground 'default nil 'default))
(equal "unspecified-bg" (face-background 'default nil 'default)))
;; NOTE: On a TTY, the default face's foreground and background colors
may be the
@@ -203,9 +200,9 @@ Used in `ement-room-list' and `ement-taxy-room-list'."
(lambda (rgb)
(pcase-let ((`(,r ,g ,b) rgb))
(color-rgb-to-hex r g b 2)))
- (color-gradient (color-name-to-rgb (face-foreground
'ement-room-list-very-recent
+ (color-gradient (color-name-to-rgb (face-foreground
'ement-tabulated-room-list-very-recent
nil
'default))
- (color-name-to-rgb (face-foreground
'ement-room-list-recent
+ (color-name-to-rgb (face-foreground
'ement-tabulated-room-list-recent
nil
'default))
6))
(mapcar
@@ -213,7 +210,7 @@ Used in `ement-room-list' and `ement-taxy-room-list'."
(lambda (rgb)
(pcase-let ((`(,r ,g ,b) rgb))
(color-rgb-to-hex r g b 2)))
- (color-gradient (color-name-to-rgb (face-foreground
'ement-room-list-recent
+ (color-gradient (color-name-to-rgb (face-foreground
'ement-tabulated-room-list-recent
nil
'default))
(color-name-to-rgb (face-foreground 'default nil
'default))
24))
@@ -230,8 +227,8 @@ Used in `ement-room-list' and `ement-taxy-room-list'."
104)))
'vector)))
-(define-derived-mode ement-room-list-mode tabulated-list-mode
- "Ement-Room-List"
+(define-derived-mode ement-tabulated-room-list-mode tabulated-list-mode
+ "Ement-Tabulated-Room-List"
:group 'ement
(setf tabulated-list-format (vector
'("U" 1 t)
@@ -244,21 +241,21 @@ Used in `ement-room-list' and `ement-taxy-room-list'."
4 t) ; Avatar
'("Name" 25 t) '("Topic" 35 t)
(list "Latest"
- (if ement-room-list-simplify-timestamps
+ (if
ement-tabulated-room-list-simplify-timestamps
6 20)
- #'ement-room-list-latest<
+ #'ement-tabulated-room-list-latest<
:right-align t)
- '("Members" 7 ement-room-list-members<)
+ '("Members" 7
ement-tabulated-room-list-members<)
;; '("P" 1 t) '("Tags" 15 t)
'("Session" 15 t))
tabulated-list-sort-key '("Latest" . t)
- ement-room-list-timestamp-colors (ement-room-list--timestamp-colors))
- (add-hook 'tabulated-list-revert-hook #'ement-room-list--set-entries nil
'local)
+ ement-tabulated-room-list-timestamp-colors
(ement-tabulated-room-list--timestamp-colors))
+ (add-hook 'tabulated-list-revert-hook
#'ement-tabulated-room-list--set-entries nil 'local)
(tabulated-list-init-header)
- (ement-room-list--set-entries)
+ (ement-tabulated-room-list--set-entries)
(tabulated-list-revert))
-(defun ement-room-list-action (event)
+(defun ement-tabulated-room-list-action (event)
"Show buffer for room at EVENT or point."
(interactive "e")
(mouse-set-point event)
@@ -271,16 +268,16 @@ Used in `ement-room-list' and `ement-taxy-room-list'."
;;;; Functions
;;;###autoload
-(defun ement-room-list-auto-update (_session)
+(defun ement-tabulated-room-list-auto-update (_session)
"Automatically update the room list buffer.
-Does so when variable `ement-room-list-auto-update' is non-nil.
+Does so when variable `ement-tabulated-room-list-auto-update' is non-nil.
To be called in `ement-sync-callback-hook'."
- (when (and ement-room-list-auto-update
+ (when (and ement-tabulated-room-list-auto-update
(buffer-live-p (get-buffer "*Ement Rooms*")))
(with-current-buffer (get-buffer "*Ement Rooms*")
(revert-buffer))))
-(defun ement-room-list--set-entries ()
+(defun ement-tabulated-room-list--set-entries ()
"Set `tabulated-list-entries'."
;; Reset avatar size in case default font size has changed.
;; TODO: After implementing avatars.
@@ -309,7 +306,7 @@ To be called in `ement-sync-callback-hook'."
;; There should be no newlines in any of these strings.
(let ((entries (cl-loop for (_id . session) in ement-sessions
append (mapcar (lambda (room)
- (ement-room-list--entry session
room))
+ (ement-tabulated-room-list--entry
session room))
(ement-session-rooms session)))))
(setf tabulated-list-entries
;; Pre-sort by latest event so that, when the list is sorted by
other columns,
@@ -320,7 +317,7 @@ To be called in `ement-sync-callback-hook'."
;; we need to handle it), we fall back
to 0.
(or (ement-room-latest-ts (car entry))
0))))))
-(defun ement-room-list--entry (session room)
+(defun ement-tabulated-room-list--entry (session room)
"Return entry for ROOM in SESSION for `tabulated-list-entries'."
(pcase-let* (((cl-struct ement-room id canonical-alias display-name avatar
topic latest-ts summary
(local (map buffer room-list-avatar)))
@@ -334,7 +331,7 @@ To be called in `ement-sync-callback-hook'."
(e-unread (if (and buffer (buffer-modified-p buffer))
(propertize "U" 'help-echo "Unread") ""))
(e-buffer (if buffer (propertize "B" 'help-echo "Room has
buffer") ""))
- (e-avatar (if (and ement-room-list-avatars avatar)
+ (e-avatar (if (and ement-tabulated-room-list-avatars avatar)
(or room-list-avatar
(if-let* ((avatar-image (get-text-property 0
'display avatar))
(new-avatar-string (propertize " "
'display
@@ -353,13 +350,13 @@ To be called in `ement-sync-callback-hook'."
""))
;; We have to copy the list, otherwise using `setf' on it
;; later causes its value to be mutated for every entry.
- (name-face (cl-copy-list '(:inherit (ement-room-list-name))))
+ (name-face (cl-copy-list '(:inherit
(ement-tabulated-room-list-name))))
(e-name (list (propertize (or display-name
(ement--room-display-name room))
;; HACK: Apply face here, otherwise
tabulated-list overrides it.
'face name-face
'help-echo e-alias)
- 'action #'ement-room-list-action))
+ 'action #'ement-tabulated-room-list-action))
(e-topic (if topic
;; Remove newlines from topic. Yes, this can
happen.
(replace-regexp-in-string "\n" "" topic t t)
@@ -376,9 +373,9 @@ To be called in `ement-sync-callback-hook'."
((number 3600 86400) ;; 1 day
(+ 6 (truncate (/
difference-seconds 3600))))
(otherwise ;; Difference in weeks.
- (min (/ (length
ement-room-list-timestamp-colors) 2)
+ (min (/ (length
ement-tabulated-room-list-timestamp-colors) 2)
(+ 24 (truncate (/
difference-seconds 86400 7))))))))
- (list :foreground (elt
ement-room-list-timestamp-colors n)))))
+ (list :foreground (elt
ement-tabulated-room-list-timestamp-colors n)))))
(e-latest (or (when formatted-timestamp
(propertize formatted-timestamp
'value latest-ts
@@ -387,7 +384,7 @@ To be called in `ement-sync-callback-hook'."
""))
(e-session (propertize (ement-user-id (ement-session-user
session))
'value session))
- ;; ((e-tags favorite-p low-priority-p) (ement-room-list--tags
room))
+ ;; ((e-tags favorite-p low-priority-p)
(ement-tabulated-room-list--tags room))
(e-direct-p (if (ement--room-direct-p room session)
(propertize "d" 'help-echo "Direct room")
""))
@@ -395,7 +392,7 @@ To be called in `ement-sync-callback-hook'."
((ement--room-low-priority-p room) "l")
(" ")))
(e-members (if member-count (number-to-string member-count)
"")))
- (when ement-room-list-simplify-timestamps
+ (when ement-tabulated-room-list-simplify-timestamps
(setf e-latest (replace-regexp-in-string
(rx bos (1+ digit) (1+ alpha) (group (1+ (1+ digit) (1+
alpha))))
"" e-latest t t 1)))
@@ -403,27 +400,27 @@ To be called in `ement-sync-callback-hook'."
(when (and buffer (buffer-modified-p buffer))
;; For some reason, `push' doesn't work with `map-elt'.
(setf (map-elt name-face :inherit)
- (cons 'ement-room-list-unread (map-elt name-face :inherit))))
+ (cons 'ement-tabulated-room-list-unread (map-elt name-face
:inherit))))
(when (ement--room-direct-p room session)
(setf (map-elt name-face :inherit)
- (cons 'ement-room-list-direct (map-elt name-face :inherit))))
+ (cons 'ement-tabulated-room-list-direct (map-elt name-face
:inherit))))
(when (ement--room-favourite-p room)
- (push 'ement-room-list-favourite (map-elt name-face :inherit)))
+ (push 'ement-tabulated-room-list-favourite (map-elt name-face :inherit)))
(when (ement--room-low-priority-p room)
- (push 'ement-room-list-low-priority (map-elt name-face :inherit)))
+ (push 'ement-tabulated-room-list-low-priority (map-elt name-face
:inherit)))
(pcase (ement-room-type room)
('invite
(setf e-topic (concat (propertize "[invited]"
- 'face 'ement-room-list-invited)
+ 'face
'ement-tabulated-room-list-invited)
" " e-topic)
- (map-elt name-face :inherit) (cons 'ement-room-list-invited
+ (map-elt name-face :inherit) (cons
'ement-tabulated-room-list-invited
(map-elt name-face :inherit))))
('leave
(setf e-topic (concat (propertize "[left]"
- 'face 'ement-room-list-left)
+ 'face 'ement-tabulated-room-list-left)
" " e-topic)
(map-elt name-face :inherit) (cons (map-elt name-face :inherit)
- 'ement-room-list-left))))
+
'ement-tabulated-room-list-left))))
(list room (vector e-unread e-priority e-buffer e-direct-p
e-avatar e-name e-topic e-latest e-members
;; e-tags
@@ -433,7 +430,7 @@ To be called in `ement-sync-callback-hook'."
;; TODO: Define sorters with a macro? This gets repetitive and hard to update.
-(defun ement-room-list-members< (a b)
+(defun ement-tabulated-room-list-members< (a b)
"Return non-nil if entry A has fewer members than room B.
A and B should be entries from `tabulated-list-mode'."
(pcase-let* ((`(,_room [,_unread ,_priority ,_buffer ,_direct ,_avatar
,_name-for-list ,_topic ,_latest ,a-members ,_session]) a)
@@ -442,7 +439,7 @@ A and B should be entries from `tabulated-list-mode'."
;; Invited rooms may have no member count (I think).
(< (string-to-number a-members) (string-to-number b-members)))))
-(defun ement-room-list-latest< (a b)
+(defun ement-tabulated-room-list-latest< (a b)
"Return non-nil if entry A has fewer members than room B.
A and B should be entries from `tabulated-list-mode'."
(pcase-let* ((`(,_room-a [,_unread ,_priority ,_buffer ,_direct ,_avatar
,_name-for-list ,_topic ,a-latest ,_a-members ,_session]) a)
@@ -458,6 +455,6 @@ A and B should be entries from `tabulated-list-mode'."
;;;; Footer
-(provide 'ement-room-list)
+(provide 'ement-tabulated-room-list)
-;;; ement-room-list.el ends here
+;;; ement-tabulated-room-list.el ends here
diff --git a/ement-taxy.el b/ement-taxy.el
deleted file mode 100644
index 507678253c..0000000000
--- a/ement-taxy.el
+++ /dev/null
@@ -1,622 +0,0 @@
-;;; ement-taxy.el --- List Ement rooms with Taxy -*- 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:
-
-;;
-
-;;; Code:
-
-(require 'button)
-(require 'rx)
-
-(require 'svg-lib)
-(require 'taxy)
-(require 'taxy-magit-section)
-
-(require 'ement-room-list)
-
-(defgroup ement-taxy nil
- "Group Ement rooms with Taxy."
- :group 'ement)
-
-;;;; Variables
-
-(defvar ement-taxy-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "RET") #'ement-taxy-RET)
- (define-key map (kbd "SPC") #'ement-taxy-next-unread)
- (define-key map [mouse-1] #'ement-taxy-mouse-1)
- map))
-
-;;;; Customization
-
-(defcustom ement-taxy-auto-update t
- "Automatically update the taxy-based room list buffer."
- :type 'boolean)
-
-;;;;; Faces
-
-(defface ement-room-list-space '((t (:inherit
(font-lock-regexp-grouping-backslash ement-room-list-name))))
- "Space rooms."
- :group 'ement-room-list)
-
-;;;; Keys
-
-;; Since some of these keys need access to the session, and room
-;; structs don't include the session, we use a two-element vector in
-;; which the session is the second element.
-
-(eval-and-compile
- (taxy-define-key-definer ement-taxy-define-key
- ement-taxy-keys "ement-taxy-key" "FIXME: Docstring."))
-
-(ement-taxy-define-key membership (&key name status)
- ;; FIXME: Docstring: status should be a symbol of either `invite', `join',
`leave'.
- (cl-labels ((format-membership (membership)
- (pcase membership
- ('join "Joined")
- ('invite "Invited")
- ('leave "[Left]"))))
- (pcase-let ((`[,(cl-struct ement-room (status membership)) ,_session]
item))
- (if status
- (when (equal status membership)
- (or name (format-membership membership)))
- (format-membership membership)))))
-
-(ement-taxy-define-key alias (&key name regexp)
- (pcase-let ((`[,(cl-struct ement-room canonical-alias) ,_session] item))
- (when canonical-alias
- (when (string-match-p regexp canonical-alias)
- name))))
-
-(ement-taxy-define-key buffer ()
- (pcase-let ((`[,(cl-struct ement-room (local (map buffer))) ,_session] item))
- (when buffer
- "Buffer")))
-
-(ement-taxy-define-key direct ()
- (pcase-let ((`[,room ,session] item))
- (when (ement--room-direct-p room session)
- "Direct")))
-
-(ement-taxy-define-key people ()
- (pcase-let ((`[,room ,session] item))
- (when (ement--room-direct-p room session)
- (propertize "People" 'face 'ement-room-list-direct))))
-
-(ement-taxy-define-key space (&key name id)
- (pcase-let* ((`[,room ,session] item)
- ((cl-struct ement-session rooms) session)
- ((cl-struct ement-room type (local (map parents))) room))
- (cl-labels ((format-space
- (id) (let* ((parent-room (cl-find id rooms :key
#'ement-room-id :test #'equal))
- (space-name (if parent-room
- (ement-room-display-name
parent-room)
- id)))
- (concat "Space: " space-name))))
- (when-let ((key (if id
- ;; ID specified.
- (cond ((or (member id parents)
- (equal id (ement-room-id room)))
- ;; Room is in specified space.
- (or name (format-space id)))
- ((and (equal type "m.space")
- (equal id (ement-room-id room)))
- ;; Room is a specified space.
- (or name (concat "Space: "
(ement-room-display-name room)))
- ))
- ;; ID not specified.
- (pcase (length parents)
- (0 nil)
- (1
- ;; TODO: Make the rooms list a hash table to avoid
this lookup.
- (format-space (car parents)))
- (_
- ;; TODO: How to handle this better? (though it
should be very rare)
- (string-join (mapcar #'format-space parents) ",
"))))))
- (propertize key 'face 'ement-room-list-space)))))
-
-(ement-taxy-define-key space-p ()
- "Groups rooms that are themselves spaces."
- (pcase-let* ((`[,room ,_session] item)
- ((cl-struct ement-room type) room))
- (when (equal "m.space" type)
- "Spaces")))
-
-(ement-taxy-define-key name (&key name regexp)
- (pcase-let* ((`[,room ,_session] item)
- (display-name (ement--room-display-name room)))
- (when display-name
- (when (string-match-p regexp display-name)
- (or name regexp)))))
-
-(ement-taxy-define-key latest (&key name newer-than older-than)
- (pcase-let* ((`[,room ,_session] item)
- ((cl-struct ement-room latest-ts) room)
- (age))
- (when latest-ts
- (setf age (- (time-convert nil 'integer) (/ latest-ts 1000)))
- (cond (newer-than
- (when (<= age newer-than)
- (or name (format "Newer than %s seconds" newer-than))))
- (older-than
- (when (>= age older-than)
- (or name (format "Older than %s seconds" newer-than))))
- (t
- ;; Default to rooms with traffic in the last day.
- (if (<= age 86400)
- "Last 24 hours"
- "Older than 24 hours"))))))
-
-(ement-taxy-define-key freshness
- (&key (intervals '((86400 . "Past 24h")
- (604800 . "Past week")
- (2419200 . "Past month")
- (31536000 . "Past year"))))
- (pcase-let* ((`[,room ,_session] item)
- ((cl-struct ement-room latest-ts) room)
- (age))
- (when latest-ts
- (setf age (- (time-convert nil 'integer) (/ latest-ts 1000)))
- (or (alist-get age intervals nil nil #'>)
- "Older than a year"))))
-
-(ement-taxy-define-key session (&optional user-id)
- (pcase-let ((`[,_room ,(cl-struct ement-session
- (user (cl-struct ement-user id)))]
- item))
- (pcase user-id
- (`nil id)
- (_ (when (equal user-id id)
- user-id)))))
-
-(ement-taxy-define-key topic (&key name regexp)
- (pcase-let ((`[,(cl-struct ement-room topic) ,_session] item))
- (when topic
- (when (string-match-p regexp topic)
- name))))
-
-(ement-taxy-define-key unread ()
- (pcase-let ((`[,room ,session] item))
- (when (ement--room-unread-p room session)
- "Unread")))
-
-(ement-taxy-define-key favourite ()
- :then #'identity
- (pcase-let ((`[,room ,_session] item))
- (when (ement--room-favourite-p room)
- (propertize "Favourite" 'face 'ement-room-list-favourite))))
-
-(ement-taxy-define-key low-priority ()
- :then #'identity
- (pcase-let ((`[,room ,_session] item))
- (when (ement--room-low-priority-p room)
- "Low-priority")))
-
-(defcustom ement-taxy-default-keys
- '((space-p space)
- ((membership :status 'invite))
- (favourite)
- ((membership :status 'leave))
- (low-priority)
- (unread)
- people
- ((latest :name "Last 24h" :newer-than 86400))
- (latest :name "Older than 90d" :older-than (* 86400 90))
- freshness
- (space))
- "Default keys."
- :type 'sexp)
-
-;;;; Columns
-
-(defvar-local ement-taxy-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-taxy' room list.")
-
-(eval-and-compile
- (taxy-magit-section-define-column-definer "ement-taxy"))
-
-(ement-taxy-define-column #("š±" 0 1 (help-echo "Avatar")) (:align 'right)
- (pcase-let* ((`[,room ,_session] item)
- ((cl-struct ement-room avatar display-name) room))
- (if ement-room-list-avatars
- (or (gethash room ement-taxy-room-avatar-cache)
- (let ((new-avatar
- (if avatar
- ;; NOTE: We resize every avatar to be suitable for this
buffer, rather than using
- ;; the one cached in the room's struct. If the
buffer's faces change height, this
- ;; will need refreshing, but it should be worth it to
avoid resizing the images on
- ;; every update.
- (propertize " " 'display
- (ement--resize-image (get-text-property 0
'display avatar)
- nil
(frame-char-height)))
- ;; Room has no avatar: make one.
- (let* ((string (or display-name (ement--room-display-name
room)))
- (ement-room-prism-minimum-contrast 1)
- (color (ement--prism-color string :contrast-with
"white")))
- (when (string-match (rx bos (or "#" "!" "@")) string)
- (setf string (substring string 1)))
- (propertize " " 'display (svg-lib-tag (substring string
0 1) nil
- :background color
:foreground "white"
- :stroke 0))))))
- (puthash room new-avatar ement-taxy-room-avatar-cache)))
- ;; Avatars disabled: use a two-space string.
- " ")))
-
-(ement-taxy-define-column "Name" (:max-width 25)
- (pcase-let* ((`[,room ,session] item)
- ((cl-struct ement-room type) room)
- (display-name (ement--room-display-name room))
- (face))
- (or (when display-name
- ;; TODO: Use code from ement-room-list and put in a dedicated
function.
- (setf face (cl-copy-list '(:inherit (ement-room-list-name))))
- ;; In concert with the "Unread" column, this is roughly equivalent
to the
- ;; "red/gray/bold/idle" states listed in
<https://github.com/matrix-org/matrix-react-sdk/blob/b0af163002e8252d99b6d7075c83aadd91866735/docs/room-list-store.md#list-ordering-algorithm-importance>.
- (when (ement--room-unread-p room session)
- ;; For some reason, `push' doesn't work with `map-elt'...or does
it?
- (push 'ement-room-list-unread (map-elt face :inherit)))
- (when (equal "m.space" type)
- (push 'ement-room-list-space (map-elt face :inherit)))
- (when (ement--room-direct-p room session)
- (push 'ement-room-list-direct (map-elt face :inherit)))
- (when (ement--room-favourite-p room)
- (push 'ement-room-list-favourite (map-elt face :inherit)))
- (when (ement--room-low-priority-p room)
- (push 'ement-room-list-low-priority (map-elt face :inherit)))
- (pcase (ement-room-status room)
- ('invite
- (push 'ement-room-list-invited (map-elt face :inherit)))
- ('leave
- (push 'ement-room-list-left (map-elt face :inherit))))
- (propertize (ement--button-buttonize display-name
#'ement-taxy-mouse-1)
- 'face face
- 'mouse-face 'highlight))
- "")))
-
-(ement-taxy-define-column #("Unread" 0 6 (help-echo "Unread events
(Notifications:Highlights)")) (:align 'right)
- (pcase-let* ((`[,(cl-struct ement-room unread-notifications) ,_session] item)
- ((map notification_count highlight_count) unread-notifications))
- (if (or (not unread-notifications)
- (and (equal 0 notification_count)
- (equal 0 highlight_count)))
- ""
- (concat (propertize (number-to-string notification_count)
- 'face (if (zerop highlight_count)
- 'default
- 'ement-room-mention))
- ":"
- (propertize (number-to-string highlight_count)
- 'face 'highlight)))))
-
-(ement-taxy-define-column "Latest" ()
- (pcase-let ((`[,(cl-struct ement-room latest-ts) ,_session] item))
- (if latest-ts
- (let* ((difference-seconds (- (float-time) (/ latest-ts 1000)))
- (n (cl-typecase difference-seconds
- ((number 0 3599) ;; <1 hour: 10-minute periods.
- (truncate (/ difference-seconds 600)))
- ((number 3600 86400) ;; 1 hour to 1 day: 24 1-hour periods.
- (+ 6 (truncate (/ difference-seconds 3600))))
- (otherwise ;; Difference in weeks.
- (min (/ (length ement-room-list-timestamp-colors) 2)
- (+ 24 (truncate (/ difference-seconds 86400 7)))))))
- (face (list :foreground (elt ement-room-list-timestamp-colors
n)))
- (formatted-ts (ement--human-format-duration difference-seconds
'abbreviate)))
- (string-match (rx (1+ digit) (repeat 1 alpha)) formatted-ts)
- (propertize (match-string 0 formatted-ts) 'face face
- 'help-echo formatted-ts))
- "")))
-
-(ement-taxy-define-column "Topic" (:max-width 35)
- (pcase-let ((`[,(cl-struct ement-room topic status) ,_session] item))
- ;; FIXME: Can the status and type unified, or is this inherent to the spec?
- (when topic
- (setf topic (replace-regexp-in-string "\n" " " topic 'fixedcase
'literal)))
- (pcase status
- ('invite (concat (propertize "[invited]"
- 'face 'ement-room-list-invited)
- " " topic))
- ('leave (concat (propertize "[left]"
- 'face 'ement-room-list-left)
- " " topic))
- (_ (or topic "")))))
-
-(ement-taxy-define-column "Members" (:align 'right)
- (pcase-let ((`[,(cl-struct ement-room
- (summary (map ('m.joined_member_count
member-count))))
- ,_session]
- item))
- (if member-count
- (number-to-string member-count)
- "")))
-
-(ement-taxy-define-column #("Notifications" 0 5 (help-echo "Notification
state")) ()
- (pcase-let* ((`[,room ,session] item))
- (pcase (ement-room-notification-state room session)
- ('nil "default")
- ('all-loud "all (loud)")
- ('all "all")
- ('mentions-and-keywords "mentions")
- ('none "none"))))
-
-(ement-taxy-define-column #("B" 0 1 (help-echo "Buffer exists for room")) ()
- (pcase-let ((`[,(cl-struct ement-room (local (map buffer))) ,_session] item))
- (if buffer
- #("B" 0 1 (help-echo "Buffer exists for room"))
- " ")))
-
-(ement-taxy-define-column "Session" ()
- (pcase-let ((`[,_room ,(cl-struct ement-session (user (cl-struct ement-user
id)))] item))
- id))
-
-(unless ement-taxy-columns
- ;; TODO: Automate this or document it
- (setq-default ement-taxy-columns
- (get 'ement-taxy-columns 'standard-value)))
-
-;;;; Bookmark support
-
-;; Especially useful with Burly: <https://github.com/alphapapa/burly.el>
-
-(require 'bookmark)
-
-(defun ement-taxy-bookmark-make-record ()
- "Return a bookmark record for the `ement-taxy' buffer."
- (list "*Ement Taxy*"
- (cons 'handler #'ement-taxy-bookmark-handler)))
-
-(defun ement-taxy-bookmark-handler (bookmark)
- "Show `ement-taxy' room list buffer for BOOKMARK."
- (pcase-let* ((`(,_bookmark-name . ,_) bookmark))
- (unless ement-sessions
- ;; MAYBE: Automatically connect.
- (user-error "No sessions connected: call `ement-connect' first"))
- (ement-taxy-room-list)))
-
-;;;; Commands
-
-;;;###autoload
-(cl-defun ement-taxy-room-list (&key (buffer-name "*Ement Taxy*")
- (keys ement-taxy-default-keys)
- (display-buffer-action
'(display-buffer-same-window))
- ;; visibility-fn
- )
- "Show a buffer listing Ement rooms, grouped with Taxy KEYS.
-The buffer is named BUFFER-NAME and is shown with
-DISPLAY-BUFFER-ACTION."
- (interactive)
- (let (format-table column-sizes window-start)
- (cl-labels (;; (heading-face
- ;; (depth) (list :inherit (list 'bufler-group
(bufler-level-face depth))))
- (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-".
- (item-latest-ts
- (item) (or (ement-room-latest-ts (elt item 0))
- ;; Room has no latest timestamp. FIXME: This
shouldn't
- ;; happen, but it can, maybe due to oversights
elsewhere.
- 0))
- (item-unread-p
- (item) (pcase-let ((`[,room ,session] item))
- (ement--room-unread-p room session)))
- (item-left-p
- (item) (pcase-let ((`[,(cl-struct ement-room status)
,_session] item))
- (equal 'leave status)))
- (taxy-unread-p
- (taxy) (or (cl-some #'item-unread-p (taxy-items taxy))
- (cl-some #'taxy-unread-p (taxy-taxys taxy))))
- (item-space-p
- (item) (pcase-let ((`[,(cl-struct ement-room type) ,_session]
item))
- (equal "m.space" type)))
- (item-favourite-p
- (item) (pcase-let ((`[,room ,_session] item))
- (ement--room-favourite-p room)))
- (item-low-priority-p
- (item) (pcase-let ((`[,room ,_session] item))
- (ement--room-low-priority-p room)))
- (visible-p
- ;; This is very confusing and doesn't currently work.
- (section) (let ((value (oref section value)))
- (if (cl-typecase value
- (taxy-magit-section (item-unread-p value))
- (ement-room nil))
- 'show
- 'hide)))
- (item-invited-p
- (item) (pcase-let ((`[,(cl-struct ement-room status)
,_session] item))
- (equal 'invite status)))
- (taxy-latest-ts
- (taxy) (apply #'max most-negative-fixnum
- (delq nil
- (list
- (when (taxy-items taxy)
- (item-latest-ts (car (taxy-items
taxy))))
- (when (taxy-taxys taxy)
- (cl-loop for sub-taxy in (taxy-taxys
taxy)
- maximizing (taxy-latest-ts
sub-taxy)))))))
- (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
- :level-indent ement-taxy-level-indent
- ;; :visibility-fn #'visible-p
- ;; :heading-indent 2
- :item-indent 2
- ;; :heading-face-fn #'heading-face
- args)))
- ;; (when (get-buffer buffer-name)
- ;; (kill-buffer buffer-name))
- (unless ement-sessions
- (error "Ement: Not connected. Use `ement-connect' to connect"))
- (with-current-buffer (get-buffer-create buffer-name)
- (ement-taxy-mode)
- (let* ((room-session-vectors
- (cl-loop for (_id . session) in ement-sessions
- append (cl-loop for room in (ement-session-rooms
session)
- collect (vector room session))))
- (taxy (cl-macrolet ((first-item
- (pred) `(lambda (taxy)
- (when (taxy-items taxy)
- (,pred (car (taxy-items
taxy)))))))
- (thread-last
- (make-fn
- :name "Ement Rooms"
- :take (taxy-make-take-function keys ement-taxy-keys))
- (taxy-fill room-session-vectors)
- (taxy-sort #'> #'item-latest-ts)
- (taxy-sort #'t<nil #'item-invited-p)
- (taxy-sort #'t<nil #'item-favourite-p)
- (taxy-sort #'t>nil #'item-low-priority-p)
- (taxy-sort #'t<nil #'item-unread-p)
- (taxy-sort #'t<nil #'item-space-p)
- ;; Within each taxy, left rooms should be sorted last
so that one
- ;; can never be the first room in the taxy (unless
it's the taxy
- ;; of left rooms), which would cause the taxy to be
incorrectly
- ;; sorted last.
- (taxy-sort #'t>nil #'item-left-p)
- (taxy-sort* #'string< #'taxy-name)
- (taxy-sort* #'> #'taxy-latest-ts)
- (taxy-sort* #'t<nil (first-item item-unread-p))
- (taxy-sort* #'t<nil (first-item item-favourite-p))
- (taxy-sort* #'t<nil (first-item item-invited-p))
- (taxy-sort* #'t>nil (first-item item-space-p))
- (taxy-sort* #'t>nil (first-item item-low-priority-p))
- (taxy-sort* #'t>nil (first-item item-left-p)))))
- (taxy-magit-section-insert-indent-items nil)
- (inhibit-read-only t)
- (format-cons (taxy-magit-section-format-items
- ement-taxy-columns ement-taxy-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-taxy-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))))
-
-(cl-defun ement-taxy-side-window (&key (side 'left))
- "Show room list in side window on SIDE.
-Interactively, with prefix, show on right side; otherwise, on
-left."
- (interactive (when current-prefix-arg
- (list :side 'right)))
- (let ((display-buffer-mark-dedicated t))
- ;; Not sure if binding `display-buffer-mark-dedicated' is still necessary.
- (ement-taxy-room-list
- :display-buffer-action `(display-buffer-in-side-window
- (dedicated . t)
- (side . ,side)
- (window-parameters
- (no-delete-other-windows . t))))))
-
-(defun ement-taxy-revert (_ignore-auto _noconfirm)
- "Revert current Ement-Taxy buffer."
- (interactive)
- (ement-taxy-room-list :display-buffer-action '(display-buffer-no-window
(allow-no-window . t))))
-
-(defun ement-taxy-mouse-1 (event)
- "Call `ement-taxy-RET' at EVENT."
- (interactive "e")
- (mouse-set-point event)
- (call-interactively #'ement-taxy-RET))
-
-(defun ement-taxy-RET ()
- "View room at point, or cycle section at point."
- (interactive)
- (cl-etypecase (oref (magit-current-section) value)
- (vector (pcase-let ((`[,room ,session] (oref (magit-current-section)
value)))
- (ement-view-room room session)))
- (taxy-magit-section (call-interactively #'magit-section-cycle))
- (null nil)))
-
-(defun ement-taxy-next-unread ()
- "Show next unread room."
- (interactive)
- (unless (button-at (point))
- (call-interactively #'forward-button))
- (unless (cl-loop with starting-line = (line-number-at-pos)
- for value = (oref (magit-current-section) value)
- for room = (elt value 0)
- for session = (elt value 1)
- if (ement--room-unread-p room session)
- do (progn
- (goto-char (button-end (button-at (point))))
- (push-button (1- (point)))
- (ement-room-goto-fully-read-marker)
- (cl-return t))
- else do (call-interactively #'forward-button)
- while (> (line-number-at-pos) starting-line))
- ;; No more unread rooms.
- (message "No more unread rooms")))
-
-(define-derived-mode ement-taxy-mode magit-section-mode "Ement-Taxy"
- :global nil
- ;; FIXME: Initialize `ement-room-list-timestamp-colors' here.
- (setq-local bookmark-make-record-function #'ement-taxy-bookmark-make-record
- revert-buffer-function #'ement-taxy-revert))
-
-;;;; Functions
-
-;;;###autoload
-(defun ement-taxy-auto-update (_session)
- "Automatically update the Taxy room list buffer.
-+Does so when variable `ement-taxy-auto-update' is non-nil.
-+To be called in `ement-sync-callback-hook'."
- (when (and ement-taxy-auto-update
- (buffer-live-p (get-buffer "*Ement Taxy*")))
- (with-current-buffer (get-buffer "*Ement Taxy*")
- (unless (region-active-p)
- ;; Don't refresh the list if the region is active (e.g. if the user is
trying to
- ;; operate on multiple rooms).
-
- ;; FIXME: This seems to redisplay the buffer even when it's buried.
But it
- ;; shouldn't, because the revert function uses
`display-buffer-no-window'. But it
- ;; doesn't always happen; it only seems to in certain circumstances,
e.g. when the
- ;; minibuffer is open, which should be unrelated to this.
- (revert-buffer)))))
-
-;;;; Footer
-
-(provide 'ement-taxy)
-
-;;; ement-taxy.el ends here
diff --git a/ement.el b/ement.el
index 53d5bed5ec..8661fe65c4 100644
--- a/ement.el
+++ b/ement.el
@@ -6,7 +6,7 @@
;; Maintainer: Adam Porter <adam@alphapapa.net>
;; URL: https://github.com/alphapapa/ement.el
;; Version: 0.5-pre
-;; Package-Requires: ((emacs "27.1") (map "2.1") (plz "0.2") (taxy "0.9")
(taxy-magit-section "0.9") (svg-lib "0.2.5") (transient "0.3.7"))
+;; Package-Requires: ((emacs "27.1") (map "2.1") (plz "0.2") (taxy "0.12.1")
(taxy-magit-section "0.9") (svg-lib "0.2.5") (transient "0.3.7"))
;; Keywords: comm
;; This program is free software; you can redistribute it and/or modify
@@ -82,8 +82,8 @@
"Used to report progress while processing sync events.")
(defvar ement-sync-callback-hook
- '(ement--update-room-buffers ement--auto-sync ement-room-list-auto-update
- ement-taxy-auto-update)
+ '(ement--update-room-buffers ement--auto-sync
ement-tabulated-room-list-auto-update
+ ement-room-list-auto-update)
"Hook run after `ement--sync-callback'.
Hooks are called with one argument, the session that was
synced.")
@@ -136,7 +136,7 @@ Writes the session file when Emacs is killed."
:type 'boolean)
(defcustom ement-after-initial-sync-hook
- '(ement-list-rooms ement-view-initial-rooms ement--link-children
ement--run-idle-timer)
+ '(ement-room-list--after-initial-sync ement-view-initial-rooms
ement--link-children ement--run-idle-timer)
"Hook run after initial sync.
Run with one argument, the session synced."
:type 'hook)
- [elpa] externals/ement 8edc2ddc1e 01/14: Change: ement-room-list -> ement-tabulated-room-list, (continued)
- [elpa] externals/ement 8edc2ddc1e 01/14: Change: ement-room-list -> ement-tabulated-room-list, ELPA Syncer, 2022/10/22
- [elpa] externals/ement 91620925db 04/14: Add: (ement-room-list-section-toggle), ELPA Syncer, 2022/10/22
- [elpa] externals/ement 04235dc443 11/14: Add: (ement-room-list-avatars), ELPA Syncer, 2022/10/22
- [elpa] externals/ement 74d10eb130 10/14: Tidy: Faces, timestamp-colors variable, etc., ELPA Syncer, 2022/10/22
- [elpa] externals/ement 46a2a75fbe 08/14: Change: (ement-room-list-define-key "Buffer") Key and help-echo, ELPA Syncer, 2022/10/22
- [elpa] externals/ement 11f5a9c91c 07/14: Change: (ement-room-list) Grouping and sorting of rooms with buffers, ELPA Syncer, 2022/10/22
- [elpa] externals/ement 529c6b21e7 05/14: Change: Require taxy-magit-section 0.12.1, ELPA Syncer, 2022/10/22
- [elpa] externals/ement 560411fe3f 06/14: Fix: (ement-room-list-auto-update) Buffer name, ELPA Syncer, 2022/10/22
- [elpa] externals/ement e9cec7bb5f 14/14: Fix: (ement-room-list) Require ement-lib, ELPA Syncer, 2022/10/22
- [elpa] externals/ement 293fb58ad5 12/14: Tidy: Commentary, ELPA Syncer, 2022/10/22
- [elpa] externals/ement 8a0248b13d 13/14: Merge: ement-taxy-room-list -> ement-room-list,
ELPA Syncer <=
- [elpa] externals/ement 90f22138ba 09/14: Fix: Declarations, ELPA Syncer, 2022/10/22