ement.el/ement-room-list.el
2020-12-04 19:17:58 -06:00

201 lines
8.2 KiB
EmacsLisp
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; ement-room-list.el --- Ement room list buffer -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Adam Porter
;; Author: Adam Porter <adam@alphapapa.net>
;; Keywords:
;; 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 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).
;;; Code:
;;;; Requirements
(require 'cl-lib)
(require 'tabulated-list)
;; FIXME: Depend on ts.
(require 'ts)
(require 'ement)
;;;; Variables
(defvar ement-room-list-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 "S") #'tabulated-list-sort)))
(defvar ement-sessions)
;;;; Customization
;;;; Commands
;;;###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)
;; 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)
(define-derived-mode ement-room-list-mode tabulated-list-mode
"Ement room list"
:group 'ement
(setf tabulated-list-format (vector ;; '("U" 1 t) '("🐱" 4 t)
'("Name" 25 t) '("Topic" 35 t)
;; '("Members" 7 ement-room-list-members<)
'("Latest" 20 ement-room-list-latest<)
;; '("D" 1 t) '("P" 1 t) '("Tags" 15 t)
'("Session" 15 t))
tabulated-list-sort-key '("Latest" . t))
(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))
(`[,_name ,_topic ,_latest ,user-id]
(tabulated-list-get-entry))
(session (cl-loop for session in ement-sessions
when (equal user-id (ement-user-id (ement-session-user session)))
return session)))
(pop-to-buffer-same-window
(ement-room--buffer session room (ement--room-buffer-name room)))))
;;;; Functions
(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.
(setf tabulated-list-entries
(cl-loop for session in ement-sessions
append (mapcar (apply-partially #'ement-room-list--entry session)
(ement-session-rooms session)))))
(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 topic latest-ts) room)
(e-alias (or canonical-alias
(setf (ement-room-canonical-alias room)
(ement--room-alias room))
id))
(topic (or topic
(setf (ement-room-topic room) (ement--room-topic room))))
;; FIXME: Figure out how to track unread status cleanly.
;; (e-unread (if (buffer-modified-p buffer) "U" ""))
;; (e-avatar (if avatar (ement-resize-avatar avatar) ""))
(e-name (list (propertize (or display-name
(setf (ement-room-display-name room)
(ement--room-display-name room)))
'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)
""))
(e-latest (propertize (ts-human-format-duration (- (ts-unix (ts-now)) (/ latest-ts 1000))
t)
'value 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 (matrix-room-direct-p id session) "D" ""))
;; (e-priority (cond (favorite-p "F")
;; (low-priority-p "l")
;; ("N")))
;; (e-members (format "%s" (length members)))
)
(list room (vector ;; e-unread
e-name e-topic ;; e-members
;; e-direct-p e-priority e-tags
e-latest 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 [,_name-for-list ,_topic ,a-members ,_latest ,_session]) a)
;; (`(,_room [,_name-for-list ,_topic ,b-members ,_latest ,_session]) b))
;; (< (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 [,_name-for-list ,_topic ,a-latest ,_session]) a)
(`(,_room [,_name-for-list ,_topic ,b-latest ,_session]) b))
(< (get-text-property 0 'value a-latest)
(get-text-property 0 'value b-latest))))
;;;; Footer
(provide 'ement-room-list)
;;; ement-room-list.el ends here