Add/Change: (ement-complete-room) Complete in room list buffers

And use keyword args.
This commit is contained in:
Adam Porter 2022-04-08 11:09:56 -05:00
parent 163d26243e
commit 8430e1c813
2 changed files with 43 additions and 11 deletions

View file

@ -840,6 +840,8 @@ Interactively, set the current buffer's ROOM's TOPIC."
:then (apply-partially #'ement-room-send-event-callback :then (apply-partially #'ement-room-send-event-callback
:room room :session session :content content :data)))))))) :room room :session session :content content :data))))))))
(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 () (defun ement-room-scroll-up-mark-read ()
"Scroll buffer up, marking read and burying when at end." "Scroll buffer up, marking read and burying when at end."
(interactive) (interactive)
@ -930,7 +932,7 @@ Interactively, set the current buffer's ROOM's TOPIC."
"Leave ROOM on SESSION. "Leave ROOM on SESSION.
ROOM may be an `ement-room' struct, or a room ID or alias ROOM may be an `ement-room' struct, or a room ID or alias
string." string."
(interactive (ement-complete-room (ement-complete-session))) (interactive (ement-complete-room :session (ement-complete-session)))
(cl-assert room) (cl-assert session) (cl-assert room) (cl-assert session)
(cl-etypecase room (cl-etypecase room
(ement-room) (ement-room)

View file

@ -49,6 +49,8 @@
;; Third-party. ;; Third-party.
(require 'magit-section)
;; This package. ;; This package.
(require 'ement-api) (require 'ement-api)
(require 'ement-macros) (require 'ement-macros)
@ -56,6 +58,13 @@
(require 'ement-room) (require 'ement-room)
(require 'ement-notify) (require 'ement-notify)
;;;;; Compilation
;; To avoid compilation warnings.
(eval-when-compile
(require 'taxy-magit-section))
;;;; Variables ;;;; Variables
(defvar ement-sessions nil (defvar ement-sessions nil
@ -273,7 +282,7 @@ in them won't work."
"Switch to a buffer showing ROOM on SESSION. "Switch to a buffer showing ROOM on SESSION.
Calls `pop-to-buffer-same-window'. Interactively, with prefix, Calls `pop-to-buffer-same-window'. Interactively, with prefix,
call `pop-to-buffer'." call `pop-to-buffer'."
(interactive (ement-complete-room (ement-complete-session) nil)) (interactive (ement-complete-room :session (ement-complete-session) :suggest nil))
(pcase-let* (((cl-struct ement-room (local (map buffer))) room)) (pcase-let* (((cl-struct ement-room (local (map buffer))) room))
(unless (buffer-live-p buffer) (unless (buffer-live-p buffer)
(setf buffer (ement-room--buffer session room (setf buffer (ement-room--buffer session room
@ -419,7 +428,7 @@ new one automatically if necessary."
(interactive (interactive
(let* ((session (ement-complete-session)) (let* ((session (ement-complete-session))
(user-id (ement-complete-user-id)) (user-id (ement-complete-user-id))
(room (car (ement-complete-room session)))) (room (car (ement-complete-room :session session))))
(list user-id room session))) (list user-id room session)))
(pcase-let* ((endpoint (format "rooms/%s/invite" (pcase-let* ((endpoint (format "rooms/%s/invite"
(url-hexify-string (ement-room-id room)))) (url-hexify-string (ement-room-id room))))
@ -546,12 +555,17 @@ If no URI is found, prompt the user for the hostname."
(alist-get selected-id ement-sessions nil nil #'equal))) (alist-get selected-id ement-sessions nil nil #'equal)))
(otherwise (user-error "No active sessions. Call `ement-connect' to log in")))) (otherwise (user-error "No active sessions. Call `ement-connect' to log in"))))
(cl-defun ement-complete-room (&optional session (suggest t)) (cl-defun ement-complete-room (&key session predicate
(prompt "Room: ") (suggest t))
"Return a (room session) list selected from SESSION with completion. "Return a (room session) list selected from SESSION with completion.
If SESSION is nil, select from rooms in all of `ement-sessions'. If SESSION is nil, select from rooms in all of `ement-sessions'.
When SUGGEST, suggest current buffer's room as initial When SUGGEST, suggest current buffer's room (or a room at point
input (i.e. it should be set to nil when switching from one room in a room list buffer) as initial input (i.e. it should be set to
buffer to another)." nil when switching from one room buffer to another). PROMPT may
override the default prompt. PREDICATE may be a function to
select which rooms are offered; it is also applied to the
suggested room."
(declare (indent defun))
(pcase-let* ((sessions (if session (pcase-let* ((sessions (if session
(list session) (list session)
(mapcar #'cdr ement-sessions))) (mapcar #'cdr ement-sessions)))
@ -561,12 +575,28 @@ buffer to another)."
collect (cons (ement--format-room room) collect (cons (ement--format-room room)
(list room session))))) (list room session)))))
(names (mapcar #'car name-to-room-session)) (names (mapcar #'car name-to-room-session))
(selected-name (completing-read "Room: " names nil t (selected-name (completing-read
(when (and suggest (equal major-mode 'ement-room-mode)) prompt names nil t
;; Suggest current buffer's room. (when suggest
(ement--format-room ement-room))))) (when-let ((suggestion (ement--room-at-point)))
(when (or (not predicate)
(funcall predicate suggestion))
suggestion))))))
(alist-get selected-name name-to-room-session nil nil #'string=))) (alist-get selected-name name-to-room-session nil nil #'string=)))
(defun ement--room-at-point ()
"Return room at point.
Works in major-modes `ement-room-mode', `ement-room-list-mode',
and `ement-taxy-mode'."
(pcase major-mode
('ement-room-mode (ement--format-room ement-room))
('ement-room-list-mode (ement--format-room (tabulated-list-get-id)))
('ement-taxy-mode
(cl-typecase (oref (magit-current-section) value)
(taxy-magit-section nil)
(t (pcase (oref (magit-current-section) value)
(`[,room ,_session] (ement--format-room room))))))))
(defun ement--format-room (room) (defun ement--format-room (room)
"Return ROOM formatted with name, alias, ID, and topic. "Return ROOM formatted with name, alias, ID, and topic.
Suitable for use in completion, etc." Suitable for use in completion, etc."