emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 3c70e85d362 11/15: Add preset styles to erc-status-sidebar


From: F. Jason Park
Subject: master 3c70e85d362 11/15: Add preset styles to erc-status-sidebar
Date: Thu, 13 Jul 2023 21:50:42 -0400 (EDT)

branch: master
commit 3c70e85d362262d096301e7663a11ca8c392f526
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Add preset styles to erc-status-sidebar
    
    * lisp/erc/erc-networks.el (erc-networks--rename-server-buffer): Store
    `erc-networks--id' in process object's plist.
    * lisp/erc/erc-status-sidebar.el (erc-status-sidebar): Change group
    parent from `convenience' to `erc'.
    (erc-status-sidebar-channel-format): Mention in doc string that it
    depends on new option `erc-status-sidebar-style'.
    (erc-status-sidebar-highlight-active-buffer): New option to control
    whether the current window's target is highlighted in the status bar.
    (erc-status-sidebar-style): New option to determine whether servers
    and queries also appear in the sidebar.
    (erc-status-sidebar-click-display-action,
    erc-status-sidebar-singular): New options.
    (erc-status-sidebar-get-window): Consider
    `erc-status-sidebar-singular'.
    (erc-status-sidebar-open): Fix toggle functionality that somehow fell
    through the cracks after the adoption of the package into ERC proper.
    (erc-bufbar-mode, erc-bufbar-enable, erc-bufbar-disable): New module
    named `bufbar' instead of `sidebar', which is more easily confusable
    with `speedbar'.  The preferred name, `status-sidebar' was unavailable
    because its minor-mode would have been `erc-status-sidebar-mode',
    which is already taken by the major mode used for status-bar buffers
    themselves.
    (erc-status-sidebar-toggle): Ignore `erc-status-sidebar-singular'.
    (erc-status-sidebar--trimpat, erc-status-sidebar--prechan): Add helper
    vars for new sorting function, allowing it to honor the existing
    interface, which only expects one argument.
    (erc-status-sidebar-prefer-target-as-name): New function for
    determining buffer name, preferring targets for target buffers.
    (erc-status-sidebar-get-channame): Use internal API to help determine
    name of buffer in sidebar.
    (erc-status-sidebar-prefer-target-as-name,
    erc-status-sidebar--show-disconnected,
    erc-status-sidebar-all-target-buffers,
    erc-status-sidebar-default-allsort): Add new naming and sorting
    functions and associated helper functions and variables.
    (erc-status-sidebar--active-marker,
    erc-status-sidebar--set-active-line): New variable and function for
    highlighting the active target in the status bar.
    (erc-status-sidebar-default-insert,
    erc-status-sidebar-pad-hierarchy): New functions for visiting various
    stages of buffer modification when rendering sidebar.
    (erc-status-sidebar-refresh): Consider presets and new options when
    rendering sidebar.
    (erc-status-sidebar-kill):  Disable `erc-bufbar-mode' when active.
    (erc-status-sidebar-click): Appeal to option
    `erc-status-sidebar-display-action' for `pop-to-buffer' action.
    (erc-status-sidebar-scroll-up, erc-status-sidebar-scroll-down,
    erc-status-sidebar-recenter): Add commands to scroll and
    recenter sidebar from a target buffer's window.
    (erc-status-sidebar-set-window-preserve-size): Ignore
    `erc-status-sidebar-singular'.
    (erc-status-sidebar-mode): Make non-interactive to avoid confusion
    when folks run "M-x erc-status-sidebar-mode" expecting a module
    toggle.
    * test/lisp/erc/erc-scenarios-status-sidebar.el: New file.
    * test/lisp/erc/resources/base/gapless-connect/foonet.eld: Fix wrong
    manifest for channel and extend PASS timeout.  (Bug#63595)
---
 lisp/erc/erc-networks.el                           |   1 +
 lisp/erc/erc-status-sidebar.el                     | 329 +++++++++++++++++++--
 test/lisp/erc/erc-scenarios-status-sidebar.el      |  93 ++++++
 .../erc/resources/base/gapless-connect/foonet.eld  |   8 +-
 4 files changed, 401 insertions(+), 30 deletions(-)

diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 7cc64614573..bf4ef1d35a9 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1469,6 +1469,7 @@ to be a false alarm.  If `erc-reuse-buffers' is nil, let
          ;; When this ends up being the current buffer, either we have
          ;; a "given" ID or the buffer was reused on reconnecting.
          (existing (get-buffer name)))
+    (process-put new-proc 'erc-networks--id erc-networks--id)
     (cond ((or (not existing)
                (erc-networks--id-given erc-networks--id)
                (eq existing (current-buffer)))
diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el
index f11faa3db10..b8bd7b0065e 100644
--- a/lisp/erc/erc-status-sidebar.el
+++ b/lisp/erc/erc-status-sidebar.el
@@ -45,6 +45,13 @@
 ;; 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)
@@ -53,8 +60,15 @@
 (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."
@@ -80,9 +94,78 @@
 
 (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
@@ -94,7 +177,8 @@
   "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))
@@ -144,22 +228,51 @@ containing it on the current frame is closed.  See
   "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."
@@ -174,6 +287,98 @@ containing it on the current frame is closed.  See
                    (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.
@@ -193,43 +398,111 @@ name stand out."
 (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)))
@@ -268,13 +541,17 @@ hooks that invoke it with arguments."
 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)
diff --git a/test/lisp/erc/erc-scenarios-status-sidebar.el 
b/test/lisp/erc/erc-scenarios-status-sidebar.el
new file mode 100644
index 00000000000..5144069ec0e
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-status-sidebar.el
@@ -0,0 +1,93 @@
+;;; 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
diff --git a/test/lisp/erc/resources/base/gapless-connect/foonet.eld 
b/test/lisp/erc/resources/base/gapless-connect/foonet.eld
index 4ac4a3e5968..10b742fdb34 100644
--- a/test/lisp/erc/resources/base/gapless-connect/foonet.eld
+++ b/test/lisp/erc/resources/base/gapless-connect/foonet.eld
@@ -1,7 +1,7 @@
 ;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :foonet:changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((pass 10 "PASS :foonet:changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
  (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
  (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version 
oragono-2.6.0-7481bf0385b95b16")
  (0 ":irc.foonet.org 003 tester :This server was created Sun, 25 Apr 2021 
11:28:28 UTC")
@@ -21,7 +21,7 @@
  ;; No mode answer
  (0 ":irc.znc.in 306 tester :You have been marked as being away")
  (0 ":tester!~u@xrir8fpe4d7ak.irc JOIN #foo")
- (0 ":irc.foonet.org 353 tester = #foo :joe @mike tester")
+ (0 ":irc.foonet.org 353 tester = #foo :alice @bob tester")
  (0 ":irc.foonet.org 366 tester #foo :End of /NAMES list.")
  (0 ":***!znc@znc.in PRIVMSG #foo :Buffer Playback...")
  (0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :[07:02:41] bob: To-morrow is 
the joyful day, Audrey; to-morrow will we be married.")



reply via email to

[Prev in Thread] Current Thread [Next in Thread]