;; Use M-x erc-status-sidebar-kill RET to kill the sidebar buffer and
;; close the sidebar on all frames.
+;; In addition to the commands above, you can also try the all-in-one,
+;; "DWIM" command, `erc-bufbar-mode'. See its doc string for usage.
+
+;; If you want the status sidebar enabled whenever you use ERC, add
+;; `bufbar' to `erc-modules'. Note that this library also has a major
+;; mode, `erc-status-sidebar-mode', which is for internal use.
+
;;; Code:
(require 'erc)
(require 'seq)
(defgroup erc-status-sidebar nil
- "A sidebar for ERC channel status."
- :group 'convenience)
+ "A responsive side window listing all connected ERC buffers.
+More commonly known as a window list or \"buflist\", this side
+panel displays clickable buffer names for switching to with the
+mouse. By default, ERC highlights the name corresponding to the
+selected window's buffer, if any. In this context, \"connected\"
+just means associated with the same IRC session, even one that
+has ceased communicating with its server. For information on how
+the window itself works, see Info node `(elisp) Side Windows'."
+ :group 'erc)
(defcustom erc-status-sidebar-buffer-name "*ERC Status*"
"Name of the sidebar buffer."
(defcustom erc-status-sidebar-channel-format
'erc-status-sidebar-default-chan-format
- "Function used to format channel names for display in the sidebar."
+ "Function used to format channel names for display in the sidebar.
+Only consulted for certain values of `erc-status-sidebar-style'."
:type 'function)
+(defcustom erc-status-sidebar-highlight-active-buffer t
+ "Whether to highlight the selected window's buffer in the sidebar.
+ERC uses the same instance across all frames. May not be
+compatible with all values of `erc-status-sidebar-style'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type 'boolean)
+
+(defcustom erc-status-sidebar-style 'all-queries-first
+ "Preset style for rendering the sidebar.
+
+When set to `channels-only', ERC limits the items in the
+status bar to uniquified channels. It uses the options
+and functions
+
+ `erc-channel-list',
+ `erc-status-sidebar-channel-sort',
+ `erc-status-sidebar-get-channame',
+ `erc-status-sidebar-channel-format'
+ `erc-status-sidebar-default-insert'
+
+for selecting, formatting, naming, and inserting entries. When
+set to one of the various `all-*' values, such as `all-mixed',
+ERC shows channels and queries under their respective server
+buffers, using the functions
+
+ `erc-status-sidebar-all-target-buffers',
+ `erc-status-sidebar-default-allsort',
+ `erc-status-sidebar-prefer-target-as-name',
+ `erc-status-sidebar-default-chan-format',
+ `erc-status-sidebar-pad-hierarchy'
+
+for the above-mentioned purposes. ERC also accepts a list of
+functions to preform these roles a la carte. See doc strings for
+a description of their expected arguments and return values."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const channels-only)
+ (const all-mixed)
+ (const all-queries-first)
+ (const all-channels-first)
+ (list (function :tag "Buffer lister")
+ (function :tag "Buffer sorter")
+ (function :tag "Name extractor")
+ (function :tag "Name formatter")
+ (function :tag "Name inserter"))))
+
+(defcustom erc-status-sidebar-click-display-action t
+ "How to display a buffer when clicked.
+Values can be anything recognized by `display-buffer' for its
+ACTION parameter."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const :tag "Always use/create other window" t)
+ (const :tag "Let `display-buffer' decide" nil)
+ (const :tag "Same window" (display-buffer-same-window
+ (inhibit-same-window . nil)))
+ (cons :tag "Action"
+ (choice function (repeat function))
+ (alist :tag "Action arguments"
+ :key-type symbol
+ :value-type (sexp :tag "Value")))))
+
+(defcustom erc-status-sidebar-singular t
+ "Whether to show the sidebar on all frames or just one (default)."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type 'boolean)
+
+(defvar hl-line-mode)
+(declare-function hl-line-highlight "hl-line" nil)
+
(defun erc-status-sidebar-display-window ()
"Display the status buffer in a side window. Return the new window."
(display-buffer
"Return the created/existing window displaying the status buffer.
If NO-CREATION is non-nil, the window is not created."
- (let ((sidebar-window (get-buffer-window erc-status-sidebar-buffer-name)))
+ (let ((sidebar-window (get-buffer-window erc-status-sidebar-buffer-name
+ erc-status-sidebar-singular)))
(unless (or sidebar-window no-creation)
(with-current-buffer (erc-status-sidebar-get-buffer)
(setq-local vertical-scroll-bar nil))
"Open or create a sidebar."
(interactive)
(save-excursion
- (let ((sidebar-exists (erc-status-sidebar-buffer-exists-p))
- (sidebar-buffer (erc-status-sidebar-get-buffer))
- ;; (sidebar-window (erc-status-sidebar-get-window))
- )
- (unless sidebar-exists
- (with-current-buffer sidebar-buffer
- (erc-status-sidebar-mode)
- (erc-status-sidebar-refresh))))))
+ (if (erc-status-sidebar-buffer-exists-p)
+ (erc-status-sidebar-get-window)
+ (with-current-buffer (erc-status-sidebar-get-buffer)
+ (erc-status-sidebar-mode)
+ (erc-status-sidebar-refresh)))))
+
+;;;###autoload(autoload 'erc-bufbar-mode "erc-status-sidebar" nil t)
+(define-erc-module bufbar nil
+ "Show `erc-track'-like activity in a side window.
+When enabling, show the sidebar immediately if called from a
+connected ERC buffer. Otherwise, arrange for doing so on connect
+or whenever next displaying a new ERC buffer. When disabling,
+hide the status window if it's showing. With a negative prefix
+arg, also shutdown the session."
+ ((unless erc-track-mode
+ (unless (memq 'track erc-modules)
+ (erc--warn-once-before-connect 'erc-bufbar-mode
+ "Module `bufbar' needs global module `track'. Enabling now."
+ " This will affect \C-]all\C-] ERC sessions."
+ " Add `track' to `erc-modules' to silence this message."))
+ (erc-track-mode +1))
+ (add-hook 'erc--setup-buffer-hook #'erc-status-sidebar-open)
+ (unless erc--updating-modules-p
+ (if (erc-with-server-buffer erc-server-connected)
+ (erc-status-sidebar-open)
+ (setq erc-bufbar-mode nil)
+ (when (derived-mode-p 'erc-mode)
+ (erc-error "Not initializing `erc-bufbar-mode' in %s"
+ (current-buffer))))))
+ ((remove-hook 'erc--setup-buffer-hook #'erc-status-sidebar-open)
+ (erc-status-sidebar-close erc-status-sidebar-singular)
+ (when-let ((arg erc--module-toggle-prefix-arg)
+ ((numberp arg))
+ ((< arg 0)))
+ (erc-status-sidebar-kill))))
;;;###autoload
(defun erc-status-sidebar-toggle ()
- "Toggle the sidebar open/closed on the current frame."
+ "Toggle the sidebar open/closed on the current frame.
+Do this regardless of `erc-status-sidebar-singular'."
(interactive)
(if (get-buffer-window erc-status-sidebar-buffer-name nil)
(erc-status-sidebar-close)
- (erc-status-sidebar-open)))
+ (let (erc-status-sidebar-singular)
+ (erc-status-sidebar-open))))
(defun erc-status-sidebar-get-channame (buffer)
"Return name of BUFFER with all leading \"#\" characters removed."
(string< (erc-status-sidebar-get-channame x)
(erc-status-sidebar-get-channame y)))))
+(defvar erc-status-sidebar--trimpat nil)
+(defvar erc-status-sidebar--prechan nil)
+
+(defun erc-status-sidebar-prefer-target-as-name (buffer)
+ "Return some name to represent buffer in the sidebar."
+ (if-let ((target (buffer-local-value 'erc--target buffer)))
+ (cond ((and erc-status-sidebar--trimpat (erc--target-channel-p target))
+ (string-trim-left (erc--target-string target)
+ erc-status-sidebar--trimpat))
+ ((and erc-status-sidebar--prechan (erc--target-channel-p target))
+ (concat erc-status-sidebar--prechan
+ (erc--target-string target)))
+ (t (erc--target-string target)))
+ (buffer-name buffer)))
+
+;; This could be converted into an option if people want.
+(defvar erc-status-sidebar--show-disconnected t)
+
+(defun erc-status-sidebar-all-target-buffers (process)
+ (erc-buffer-filter (lambda ()
+ (and erc--target
+ (or erc-status-sidebar--show-disconnected
+ (erc-server-process-alive))))
+ process))
+
+;; FIXME profile this. Rebuilding the graph every time track updates
+;; seems wasteful for occasions where server messages are processed
+;; unthrottled, such as during history playback. If it's a problem,
+;; we should look into rewriting this using `ewoc' or some other
+;; solution that maintains a persistent model.
+(defun erc-status-sidebar-default-allsort (target-buffers)
+ "Return a list of servers interspersed with their targets."
+ (mapcan (pcase-lambda (`(,proc . ,chans))
+ (cons (process-buffer proc)
+ (let ((erc-status-sidebar--trimpat
+ (and (eq erc-status-sidebar-style 'all-mixed)
+ (with-current-buffer (process-buffer proc)
+ (when-let ((ch-pfxs (erc--get-isupport-entry
+ 'CHANTYPES 'single)))
+ (regexp-quote ch-pfxs)))))
+ (erc-status-sidebar--prechan
+ (and (eq erc-status-sidebar-style
+ 'all-queries-first)
+ "\C-?")))
+ (sort chans
+ (lambda (x y)
+ (string<
+ (erc-status-sidebar-prefer-target-as-name x)
+ (erc-status-sidebar-prefer-target-as-name y)))))))
+ (sort (seq-group-by (lambda (b)
+ (buffer-local-value 'erc-server-process b))
+ target-buffers)
+ (lambda (a b)
+ (string< (buffer-name (process-buffer (car a)))
+ (buffer-name (process-buffer (car b))))))))
+
+(defvar-local erc-status-sidebar--active-marker nil
+ "Marker indicating currently active buffer.")
+
+(defun erc-status-sidebar--set-active-line (erc-buffer)
+ (when (and erc-status-sidebar-highlight-active-buffer
+ (eq (window-buffer (and (minibuffer-window-active-p
+ (selected-window))
+ (minibuffer-selected-window)))
+ erc-buffer))
+ (set-marker erc-status-sidebar--active-marker (point))))
+
+(defun erc-status-sidebar-default-insert (channame chanbuf _chanlist)
+ "Insert CHANNAME followed by a newline.
+Maybe arrange to highlight line if CHANBUF is showing in the
+focused window."
+ (erc-status-sidebar--set-active-line chanbuf)
+ (insert channame "\n"))
+
+(defun erc-status-sidebar-pad-hierarchy (bufname buffer buflist)
+ "Prefix BUFNAME to emphasize BUFFER's role in BUFLIST."
+ (if (and (buffer-live-p buffer) (buffer-local-value 'erc--target buffer))
+ (insert " ")
+ (unless (eq buffer (car buflist))
+ (insert "\n"))) ; ^L
+ (when bufname
+ (erc-status-sidebar--set-active-line buffer))
+ (insert (or bufname
+ (and-let* (((not (buffer-live-p buffer)))
+ (next (cadr (member buffer buflist)))
+ ((buffer-live-p next))
+ (proc (buffer-local-value 'erc-server-process next))
+ (id (process-get proc 'erc-networks--id)))
+ (symbol-name (erc-networks--id-symbol id)))
+ "???")
+ "\n"))
+
(defun erc-status-sidebar-default-chan-format (channame
&optional num-messages erc-face)
"Format CHANNAME for display in the sidebar.
(defun erc-status-sidebar-refresh ()
"Update the content of the sidebar."
(interactive)
- (let ((chanlist (apply erc-status-sidebar-channel-sort
- (erc-channel-list nil) nil)))
+ (pcase-let* ((`(,list-fn ,sort-fn ,name-fn ,fmt-fn ,insert-fn)
+ (pcase erc-status-sidebar-style
+ ('channels-only (list #'erc-channel-list
+ erc-status-sidebar-channel-sort
+ #'erc-status-sidebar-get-channame
+ erc-status-sidebar-channel-format
+ #'erc-status-sidebar-default-insert))
+ ((or 'all-mixed 'all-queries-first 'all-channels-first)
+ '(erc-status-sidebar-all-target-buffers
+ erc-status-sidebar-default-allsort
+ erc-status-sidebar-prefer-target-as-name
+ erc-status-sidebar-default-chan-format
+ erc-status-sidebar-pad-hierarchy))
+ (v v)))
+ (chanlist (apply sort-fn (funcall list-fn nil) nil))
+ (window nil)
+ (winstart nil))
(with-current-buffer (erc-status-sidebar-get-buffer)
+ (setq window (get-buffer-window nil erc-status-sidebar-singular)
+ winstart (and window (window-start window)))
(erc-status-sidebar-writable
(delete-region (point-min) (point-max))
(goto-char (point-min))
+ (if erc-status-sidebar--active-marker
+ (set-marker erc-status-sidebar--active-marker nil)
+ (setq erc-status-sidebar--active-marker (make-marker)))
(dolist (chanbuf chanlist)
(let* ((tup (seq-find (lambda (tup) (eq (car tup) chanbuf))
erc-modified-channels-alist))
(count (if tup (cadr tup)))
(face (if tup (cddr tup)))
- (channame (apply erc-status-sidebar-channel-format
- (buffer-name chanbuf) count face nil))
+ (face (if (or (not (buffer-live-p chanbuf))
+ (not (erc-server-process-alive chanbuf)))
+ `(shadow ,face)
+ face))
+ (channame (apply fmt-fn
+ (copy-sequence (funcall name-fn chanbuf))
+ count face nil))
(cnlen (length channame)))
(put-text-property 0 cnlen 'erc-buf chanbuf channame)
(put-text-property 0 cnlen 'mouse-face 'highlight channame)
(put-text-property
0 cnlen 'help-echo
"mouse-1: switch to buffer in other window" channame)
- (insert channame "\n")))))))
+ (funcall insert-fn channame chanbuf chanlist)))
+ (when winstart
+ (set-window-point window winstart)
+ (with-selected-window window (recenter 0)))
+ (when (and erc-status-sidebar-highlight-active-buffer
+ (marker-buffer erc-status-sidebar--active-marker))
+ (goto-char erc-status-sidebar--active-marker)
+ (require 'hl-line)
+ (unless hl-line-mode (hl-line-mode +1))
+ (hl-line-highlight))))))
(defun erc-status-sidebar-kill ()
"Close the ERC status sidebar and its buffer."
(interactive)
+ (when (and erc-bufbar-mode (not erc--module-toggle-prefix-arg))
+ (erc-bufbar-mode -1))
(ignore-errors (kill-buffer erc-status-sidebar-buffer-name)))
(defun erc-status-sidebar-click (event)
"Handle click EVENT in `erc-status-sidebar-mode-map'."
(interactive "e")
(save-excursion
- (let ((window (posn-window (event-end event)))
+ (let ((window (posn-window (event-start event)))
(pos (posn-point (event-end event))))
- (set-buffer (window-buffer window))
- (let ((buf (get-text-property pos 'erc-buf)))
- (when buf
- (select-window window)
- (switch-to-buffer-other-window buf))))))
+ ;; Current buffer is "ERC Status" and its window is selected
+ (cl-assert (eq major-mode 'erc-status-sidebar-mode))
+ (cl-assert (eq (selected-window) window))
+ (cl-assert (eq (window-buffer window) (current-buffer)))
+ (when-let ((buf (get-text-property pos 'erc-buf)))
+ ;; Option operates relative to last selected window
+ (select-window (get-mru-window nil nil 'not-selected))
+ (pop-to-buffer buf erc-status-sidebar-click-display-action)))))
+
+(defun erc-status-sidebar-scroll-up (lines)
+ "Scroll sidebar buffer's content LINES linse upward.
+If LINES is nil, scroll up a full screen's worth."
+ (interactive "P")
+ (let ((other-window-scroll-buffer (erc-status-sidebar-get-buffer)))
+ (scroll-other-window lines)))
+
+(defun erc-status-sidebar-scroll-down (lines)
+ "Scroll sidebar buffer's content LINES lines downward.
+If LINES is nil, scroll down a full screen's worth."
+ (interactive "P")
+ (let ((other-window-scroll-buffer (erc-status-sidebar-get-buffer)))
+ (scroll-other-window-down lines)))
+
+(defun erc-status-sidebar-recenter (arg)
+ "Recenter the status sidebar.
+Expect `erc-status-sidebar-highlight-active-buffer' to be non-nil
+and to be invoked in a buffer matching the line currently
+highlighted."
+ (interactive "P")
+ (let* ((buf (erc-status-sidebar-get-buffer))
+ (win (get-buffer-window buf)))
+ (with-current-buffer buf
+ (when (and erc-status-sidebar--active-marker
+ (marker-position erc-status-sidebar--active-marker))
+ (with-selected-window win
+ (goto-char erc-status-sidebar--active-marker)
+ (recenter arg t))))))
(defvar erc-status-sidebar-mode-map
(let ((map (make-sparse-keymap)))
Note that preserve status needs to be reset when the window is
manually resized, so `erc-status-sidebar-mode' adds this function
to the `window-configuration-change-hook'."
- (when (and (eq (selected-window) (erc-status-sidebar-get-window))
+ (when (and (eq (selected-window) (let (erc-status-sidebar-singular)
+ (erc-status-sidebar-get-window)))
(fboundp 'window-preserve-size))
(unless (eq (window-total-width) (window-min-size nil t))
(apply #'window-preserve-size (selected-window) t t nil))))
(define-derived-mode erc-status-sidebar-mode special-mode "ERC Sidebar"
"Major mode for ERC status sidebar."
+ ;; Users invoking M-x erc-status-sidebar-mode most likely expect to
+ ;; summon the module's minor-mode, `erc-bufbar-mode'.
+ :interactive nil
;; Don't scroll the buffer horizontally, if a channel name is
;; obscured then the window can be resized.
(setq-local auto-hscroll-mode nil)
--- /dev/null
+;;; erc-scenarios-status-sidebar.el --- erc-sidebar/speedbar tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-status-sidebar)
+
+
+(ert-deftest erc-scenarios-status-sidebar--bufbar ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/gapless-connect")
+ (erc-server-flood-penalty 0.1)
+ (erc-server-flood-penalty erc-server-flood-penalty)
+ (erc-modules `(bufbar ,@erc-modules))
+ (dumb-server (erc-d-run "localhost" t 'foonet 'barnet))
+ (port (process-contact dumb-server :service))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to two different endpoints")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :password "foonet:changeme"
+ :full-name "tester")
+ (funcall expect 10 "MOTD File is missing"))
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :password "barnet:changeme"
+ :full-name "tester")
+ (funcall expect 10 "marked as being away")))
+
+
+ (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#bar"))
+ (funcall expect 10 "was created on")
+ (funcall expect 2 "his second fit"))
+
+ (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#foo"))
+ (funcall expect 10 "was created on")
+ (funcall expect 2 "no use of him")
+ (ert-info ("Activity marker is in the right spot")
+ (let ((obuf (window-buffer))) ; *scratch*
+ (set-window-buffer (selected-window) "#foo")
+ (erc-d-t-wait-for 5
+ (when noninteractive
+ (erc-status-sidebar-refresh))
+ (with-current-buffer "*ERC Status*"
+ (and (marker-position erc-status-sidebar--active-marker)
+ (goto-char erc-status-sidebar--active-marker)
+ ;; The " [N]" suffix disappears because it's selected
+ (search-forward "#foo" (pos-eol) t))))
+ (set-window-buffer (selected-window) obuf))))
+
+ (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "*ERC Status*"))
+ (ert-info ("Hierarchy printed correctly")
+ (funcall expect 10 "barnet [")
+ (funcall expect 10 "#bar [")
+ (funcall expect 10 "foonet [")
+ (funcall expect 10 "#foo")))
+
+ (with-current-buffer "#foo"
+ (ert-info ("Core toggle and kill commands work")
+ ;; Avoid using API, e.g., `erc-status-sidebar-buffer-exists-p',
+ ;; etc. for testing commands that call those same functions.
+ (should (get-buffer-window "*ERC Status*"))
+ (erc-bufbar-mode -1)
+ (should-not (get-buffer-window "*ERC Status*"))
+ (erc-status-sidebar-kill)
+ (should-not (get-buffer "*ERC Status*"))))))
+
+;;; erc-scenarios-status-sidebar.el ends here
projects / emacs.git / commitdiff