Add erc-status-sidebar integration to erc-speedbar

* lisp/erc/erc-speedbar.el: Require `erc-button' atop file and don't
bother loading `dframe', which `speedbar' handles for us.
(erc-speedbar): Explain that `nickbar' is the module for this group
and library for the benefit of those who run M-x customize-group.
(erc-speedbar-nicknames-window-width): New option.
(erc-speedbar-hide-mode-topic): New option determining whether to hide
the mode and topic.
(erc-speedbar-my-nick-face): New option for determining face to use
when displaying user's current nick.
(erc-speedbar-browser): Call `erc-install-speedbar-variables'
explicitly and remove top-level `with-eval-after-load'.
(erc-speedbar-insert-target): Add parenthesized channel count after
channel name in server and channel views.
(erc-speedbar-expand-channel): Hide mode and topic depending on option
`erc-speedbar-hide-mode-topic' and pass buffer to
`erc-speedbar-insert-user'.
(erc-speedbar--nick-face-function): New internal function-valued
variable.
(erc-speedbar--highlight-self-and-ops): New function to serve as
default value for `erc-speedbar--nick-face-function'.
(erc-speedbar--on-click): Dispatch `erc-nick-popup' after trimming
status chars.
(erc-speedbar-insert-user): Revise doc string.  Call
`erc-speedbar--nick-face-function' to determine face.  Change
token for both expansion and on-click text props.  Assign
`erc-speedbar--on-click' as the mouse handler for nick items.
(erc-speedbar--buffer-options): Variable to override options locally
in speedbar buffer.
(erc-speedbar--hidden-speedbar-frame): Add variable to hold original
`speedbar-frame' before spoofing by setting to selected frame
containing window showing ERC buffer.
(erc-speedbar--emulate-sidebar-set-window-preserve-size,
erc-speedbar--status-sidebar-mode--unhook): Add function
to ensure status sidebar is showing correctly and helper to
unregister from hook on teardown.
(erc-speedbar--emulate-sidebar): Add function to control sidebar
nicknames setup.
(erc-speedbar--toggle-nicknames-sidebar): Add toggle function
for speedbar or emulated sidebar.
(erc-speedbar--ensure): Add helper function to show speedbar if it's
hidden or create one if none exists.
(erc-nickbar-mode, erc-nickbar-enable, erc-nickbar-disable):
Add new mini module.
(erc-speedbar--dframe-controlled) Add function to overwrite
`speedbar-frame-mode' as `dframe-controlled' in speedbar buffer.
(erc-speedbar-toggle-nicknames-window-lock,
erc-speedbar-close-nicknames-window): Add commands to close speedbar
window and toggle its cyclability.
(erc-speedbar--compose-nicks-face): Add helper for nicks integration.
* test/lisp/erc/erc-scenarios-status-sidebar.el
(erc-scenarios-status-sidebar--nickbar): New test.  (Bug#63595)

lisp/erc/erc-speedbar.el

@@ -32,20 +32,31 @@
 ;;   update-channel, update-nick, remove-nick-from-channel, ...
 ;; * Use indicator-strings for op/voice
 ;; * Extract/convert face notes field from bbdb if available
+;; * Write tests that run in a term-mode subprocess
 ;;
 ;;; Code:
 
 (require 'erc)
 (require 'erc-goodies)
+(require 'erc-button)
 (require 'speedbar)
-(condition-case nil (require 'dframe) (error nil))
 
 ;;; Customization:
 
 (defgroup erc-speedbar nil
-  "Integration of ERC in the Speedbar."
+  "Speedbar integration for ERC.
+To open an ERC-flavored speedbar in a separate frame, run the
+command `erc-speedbar-browser'.  To use a window-based proxy
+instead, run \\[erc-nickbar-mode] in a connected ERC buffer or
+put `nickbar' in `erc-modules' before connecting.  See Info
+node `(speedbar) Top' for more about the underlying integration."
   :group 'erc)
 
+(defcustom erc-speedbar-nicknames-window-width 18
+  "Default width of the nicknames sidebar (in columns)."
+  :package-version '(ERC . "5.6") ; FIXME sync on release
+  :type 'integer)
+
 (defcustom erc-speedbar-sort-users-type 'activity
   "How channel nicknames are sorted.
 
@@ -56,6 +67,23 @@ nil            - Do not sort users"
 		 (const :tag "Sort users alphabetically" alphabetical)
 		 (const :tag "Do not sort users" nil)))
 
+(defcustom erc-speedbar-hide-mode-topic 'headerline
+  "Hide mode and topic lines."
+  :package-version '(ERC . "5.6") ; FIXME sync on release
+  :type '(choice (const :tag "Always show" nil)
+                 (const :tag "Always hide" t)
+                 (const :tag "Omit when headerline visible" headerline)))
+
+(defcustom erc-speedbar-my-nick-face t
+  "A face to use for your nickname.
+When the value is t, ERC uses `erc-current-nick-face' if
+`erc-match' has been loaded and `erc-my-nick-face' otherwise.
+When using the `nicks' module, you can see your nick as it
+appears to others by coordinating with the option
+`erc-nicks-skip-faces'."
+  :package-version '(ERC . "5.6") ; FIXME sync on release
+  :type '(choice face (const :tag "Current nick or own speaker face" t)))
+
 (defvar erc-speedbar-key-map nil
   "Keymap used when in erc display mode.")
 
@@ -88,10 +116,6 @@ nil            - Do not sort users"
 		     (looking-at "[0-9]+: *.-. "))])
   "Additional menu-items to add to speedbar frame.")
 
-;; Make sure our special speedbar major mode is loaded
-(with-eval-after-load 'speedbar
-  (erc-install-speedbar-variables))
-
 ;;; ERC hierarchy display method
 ;;;###autoload
 (defun erc-speedbar-browser ()
@@ -99,6 +123,7 @@ nil            - Do not sort users"
 This will add a speedbar major display mode."
   (interactive)
   (require 'speedbar)
+  (erc-install-speedbar-variables)
   ;; Make sure that speedbar is active
   (speedbar-frame-mode 1)
   ;; Now, throw us into Info mode on speedbar.
@@ -169,12 +194,18 @@ This will add a speedbar major display mode."
 	  t)))))
 
 (defun erc-speedbar-insert-target (buffer depth)
-  (if (with-current-buffer buffer
-	(erc-channel-p (erc-default-target)))
-      (speedbar-make-tag-line
-       'bracket ?+ 'erc-speedbar-expand-channel buffer
-       (buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil
-       depth)
+  (if (erc--target-channel-p (buffer-local-value 'erc--target buffer))
+      (progn
+        (speedbar-make-tag-line
+         'bracket ?+ 'erc-speedbar-expand-channel buffer
+         (erc--target-string (buffer-local-value 'erc--target buffer))
+         'erc-speedbar-goto-buffer buffer nil
+         depth)
+        (save-excursion
+          (forward-line -1)
+          (let ((table (buffer-local-value 'erc-channel-users buffer)))
+            (speedbar-add-indicator (format "(%d)" (hash-table-count table)))
+            (rx "(" (+ (any "0-9")) ")"))))
     ;; Query target
     (speedbar-make-tag-line
      nil nil nil nil
@@ -220,6 +251,13 @@ INDENT is the current indentation level."
 	    'angle ?i nil nil
 	    (concat "Topic: " topic) nil nil nil
 	    (1+ indent)))
+         (unless (pcase erc-speedbar-hide-mode-topic
+                   ('nil 'show)
+                   ('headerline (null erc-header-line-format)))
+           (save-excursion
+             (goto-char (point-max))
+             (forward-line (if (string= topic "") -1 -2))
+             (put-text-property (pos-bol) (point-max) 'invisible t)))
 	 (let ((names (cond ((eq erc-speedbar-sort-users-type 'alphabetical)
 			     (erc-sort-channel-users-alphabetically
 			      (with-current-buffer channel
@@ -233,17 +271,52 @@ INDENT is the current indentation level."
 	   (when names
 	     (speedbar-with-writable
 	      (dolist (entry names)
-		(erc-speedbar-insert-user entry ?+ (1+ indent))))))))))
+                (erc-speedbar-insert-user entry ?+ (1+ indent) channel)))))))))
    ((string-search "-" text)
     (speedbar-change-expand-button-char ?+)
     (speedbar-delete-subblock indent))
    (t (error "Ooops... not sure what to do")))
   (speedbar-center-buffer-smartly))
 
-(defun erc-speedbar-insert-user (entry exp-char indent)
+(defvar erc-speedbar--nick-face-function #'erc-speedbar--highlight-self-and-ops
+  "Function called when finding a face for fontifying nicks.
+Called with the proposed nick, the `erc-server-user', and the
+`erc-channel-user'.  Should return any valid face, possibly
+composed or anonymous, or nil.")
+
+(defun erc-speedbar--highlight-self-and-ops (buffer user cuser)
+  "Highlight own nick and op'd users in the speedbar."
+  (with-current-buffer buffer
+    (if (erc-current-nick-p (erc-server-user-nickname user))
+        (pcase erc-speedbar-my-nick-face
+          ('t (if (facep 'erc-current-nick-face)
+                  'erc-current-nick-face
+                'erc-my-nick-face))
+          (v v))
+      ;; FIXME overload `erc-channel-user-owner-p' and friends to
+      ;; accept an `erc-channel-user' object and replace this unrolled
+      ;; stuff with a single call to `erc-get-user-mode-prefix'.
+      (and cuser (or (erc-channel-user-owner cuser)
+                     (erc-channel-user-admin cuser)
+                     (erc-channel-user-op cuser)
+                     (erc-channel-user-halfop cuser)
+                     (erc-channel-user-voice cuser))
+           erc-button-nickname-face))))
+
+(defun erc-speedbar--on-click (nick sbtoken _indent)
+  ;; 0: finger, 1: name, 2: info, 3: buffer-name
+  (with-current-buffer (nth 3 sbtoken)
+    (erc-nick-popup (string-trim-left nick "[~&@%+]+"))))
+
+(defun erc-speedbar-insert-user (entry exp-char indent &optional buffer)
   "Insert one user based on the channel member list ENTRY.
-EXP-CHAR is the expansion character to use.
-INDENT is the current indentation level."
+Expect EXP-CHAR to be the expansion character to use, INDENT the
+current indentation level, and BUFFER the associated channel or
+query buffer.  Set the `speedbar-function' text property to
+`erc-speedbar--on-click', which is called with the formatted
+nick, a so-called \"token\", and the indent level.  The token is
+a list of four items: the userhost, the GECOS, the current
+`erc-server-user' info slot, and the associated buffer."
   (let* ((user (car entry))
 	 (cuser (cdr entry))
 	 (nick (erc-server-user-nickname user))
@@ -255,11 +328,12 @@ INDENT is the current indentation level."
 	 (op (and cuser (erc-channel-user-op cuser)))
 	 (nick-str (concat (if op "@" "") (if voice "+" "") nick))
 	 (finger (concat login (when (or login host) "@") host))
-	 (sbtoken (list finger name info)))
+         (sbtoken (list finger name info (buffer-name buffer))))
     (if (or login host name info) ; we want to be expandable
 	(speedbar-make-tag-line
 	 'bracket ?+ 'erc-speedbar-expand-user sbtoken
-	 nick-str nil sbtoken nil
+         nick-str #'erc-speedbar--on-click sbtoken
+         (funcall erc-speedbar--nick-face-function buffer user cuser)
 	 indent)
       (when (equal exp-char ?-)
 	(forward-line -1)
@@ -357,6 +431,183 @@ The INDENT level is ignored."
 	  (t
 	   (message "%s" txt)))))
 
+
+;;;; Status-sidebar integration
+
+(defvar erc-track-mode)
+(defvar erc-track--switch-fallback-blockers)
+(defvar erc-status-sidebar-buffer-name)
+(declare-function erc-status-sidebar-set-window-preserve-size
+                  "erc-status-sidebar" nil)
+(declare-function erc-status-sidebar-mode--unhook "erc-status-sidebar" nil)
+
+(defvar erc-speedbar--buffer-options
+  '((speedbar-update-flag . t)
+    (speedbar-use-images . nil)
+    (speedbar-hide-button-brackets-flag . t)))
+
+(defvar erc-speedbar--hidden-speedbar-frame nil)
+
+(defun erc-speedbar--emulate-sidebar-set-window-preserve-size ()
+  (let ((erc-status-sidebar-buffer-name (buffer-name speedbar-buffer))
+        (display-buffer-overriding-action
+         `(display-buffer-in-side-window
+           . ((side . right)
+              (window-width . ,erc-speedbar-nicknames-window-width)))))
+    (erc-status-sidebar-set-window-preserve-size)
+    (when-let ((window (get-buffer-window speedbar-buffer)))
+      (set-window-parameter window 'no-other-window nil)
+      (internal-show-cursor window t))))
+
+(defun erc-speedbar--status-sidebar-mode--unhook ()
+  "Remove hooks installed by `erc-status-sidebar-mode'."
+  (remove-hook 'window-configuration-change-hook
+               #'erc-speedbar--emulate-sidebar-set-window-preserve-size))
+
+(defun erc-speedbar--emulate-sidebar ()
+  (require 'erc-status-sidebar)
+  (cl-assert speedbar-frame)
+  (cl-assert (eq speedbar-buffer (current-buffer)))
+  (cl-assert (eq speedbar-frame (selected-frame)))
+  (setq erc-speedbar--hidden-speedbar-frame speedbar-frame
+        dframe-controlled #'erc-speedbar--dframe-controlled)
+  (add-hook 'window-configuration-change-hook
+            #'erc-speedbar--emulate-sidebar-set-window-preserve-size nil t)
+  (add-hook 'kill-buffer-hook
+            #'erc-speedbar--status-sidebar-mode--unhook nil t)
+  (with-current-buffer speedbar-buffer
+    (pcase-dolist (`(,var . ,val) erc-speedbar--buffer-options)
+      (set (make-local-variable var) val)))
+  (when (memq 'nicks erc-modules)
+    (with-current-buffer speedbar-buffer
+      (add-function :around (local 'erc-speedbar--nick-face-function)
+                    #'erc-speedbar--compose-nicks-face))))
+
+(defun erc-speedbar--toggle-nicknames-sidebar (arg)
+  (let ((force (numberp arg)))
+    (if speedbar-buffer
+        (progn
+          (cl-assert (buffer-live-p speedbar-buffer))
+          (if (or (and force (< arg 0))
+                  (and (not force) (get-buffer-window speedbar-buffer nil)))
+              (erc-speedbar-close-nicknames-window nil)
+            (when (or (not force) (>= arg 0))
+              (with-selected-frame speedbar-frame
+                (erc-speedbar--emulate-sidebar-set-window-preserve-size)))))
+      (when (or (not force) (>= arg 0))
+        (let ((speedbar-frame-parameters (backquote-list*
+                                          '(visibility . nil)
+                                          '(no-other-frame . t)
+                                          speedbar-frame-parameters))
+              (speedbar-after-create-hook #'erc-speedbar--emulate-sidebar))
+          (erc-speedbar-browser)
+          ;; If we put the remaining parts in the "create hook" along
+          ;; with everything else, the frame with `window-main-window'
+          ;; gets raised and steals focus if you've switched away from
+          ;; Emacs in the meantime.
+          (make-frame-invisible speedbar-frame)
+          (select-frame (setq speedbar-frame (previous-frame)))
+          (erc-speedbar--emulate-sidebar-set-window-preserve-size))))))
+
+(defun erc-speedbar--ensure (&optional force)
+  (when (or (erc-server-buffer) force)
+    (when erc-track-mode
+      (cl-pushnew '(derived-mode . speedbar-mode)
+                  erc-track--switch-fallback-blockers :test #'equal))
+    (erc-speedbar--toggle-nicknames-sidebar +1)
+    (speedbar-enable-update)))
+
+;;;###autoload(autoload 'erc-nickbar-mode "erc-speedbar" nil t)
+(define-erc-module nickbar nil
+  "Show nicknames in a side window.
+When enabling, create a speedbar session if one doesn't exist and
+show its buffer in an `erc-status-sidebar' window instead of a
+separate frame.  When disabling, close the window or, with a
+negative prefix arg, destroy the session.
+
+WARNING: this module may produce unwanted side effects, like the
+raising of frames or the stealing of input focus.  If you witness
+such an occurrence, and can reproduce it, please file a bug
+report with \\[erc-bug]."
+  ((add-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure)
+   (erc-speedbar--ensure)
+   (unless (or erc--updating-modules-p
+               (and-let* ((speedbar-buffer)
+                          (win (get-buffer-window speedbar-buffer 'all-frames))
+                          ((eq speedbar-frame (window-frame win))))))
+     (if speedbar-buffer
+         (erc-speedbar--ensure 'force)
+       (setq erc-nickbar-mode nil)
+       (when (derived-mode-p 'erc-mode)
+         (erc-error "Not initializing `erc-nickbar-mode' in %s"
+                    (current-buffer))))))
+  ((remove-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure)
+   (speedbar-disable-update)
+   (when erc-track-mode
+     (setq erc-track--switch-fallback-blockers
+           (remove '(derived-mode . speedbar-mode)
+                   erc-track--switch-fallback-blockers)))
+   (erc-speedbar--toggle-nicknames-sidebar -1)
+   (when-let ((arg erc--module-toggle-prefix-arg)
+              ((numberp arg))
+              ((< arg 0)))
+     (erc-speedbar-close-nicknames-window 'kill))))
+
+(defun erc-speedbar--dframe-controlled (arg)
+  (when (and erc-speedbar--hidden-speedbar-frame (numberp arg) (< arg 0))
+    (when erc-nickbar-mode
+      (erc-nickbar-mode -1))
+    (setq speedbar-frame erc-speedbar--hidden-speedbar-frame
+          erc-speedbar--hidden-speedbar-frame nil)
+    ;; It's unknown whether leaving the frame invisible interferes
+    ;; with the upstream teardown procedure.
+    (when (display-graphic-p)
+      (make-frame-visible speedbar-frame))
+    (speedbar-frame-mode arg)
+    (when speedbar-buffer
+      (kill-buffer speedbar-buffer)
+      (setq speedbar-buffer nil))))
+
+(defun erc-speedbar-toggle-nicknames-window-lock ()
+  "Toggle whether nicknames window is selectable with \\[other-window]."
+  (interactive)
+  (unless erc-nickbar-mode
+    (user-error "`erc-nickbar-mode' inactive"))
+  (when-let ((window (get-buffer-window speedbar-buffer)))
+    (let ((val (window-parameter window 'no-other-window)))
+      (set-window-parameter window 'no-other-window (not val))
+      (message "nick-window: %s" (if val "selectable" "protected")))))
+
+(defun erc-speedbar-close-nicknames-window (kill)
+  (interactive "P")
+  (if kill
+      (with-current-buffer speedbar-buffer
+        (dframe-close-frame)
+        (cl-assert (not erc-nickbar-mode))
+        (setq erc-speedbar--hidden-speedbar-frame nil))
+    (dolist (window (get-buffer-window-list speedbar-buffer nil t))
+      (unless (frame-root-window-p window)
+        (when erc-speedbar--hidden-speedbar-frame
+          (cl-assert (not (eq (window-frame window)
+                              erc-speedbar--hidden-speedbar-frame))))
+        (delete-window window)))))
+
+
+;;;; Nicks integration
+
+(declare-function erc-nicks--highlight "erc-nicks" (nickname &optional face))
+
+(defun erc-speedbar--compose-nicks-face (orig buffer user cuser)
+  (require 'erc-nicks)
+  (let ((rv (funcall orig buffer user cuser)))
+    (if-let ((nick (erc-server-user-nickname user))
+             (face (with-current-buffer buffer
+                     (erc-nicks--highlight nick rv)))
+             ((not (eq face erc-button-nickname-face))))
+        (cons face (ensure-list rv))
+      rv)))
+
+
 (provide 'erc-speedbar)
 ;;; erc-speedbar.el ends here
 ;;

test/lisp/erc/erc-scenarios-status-sidebar.el

@@ -90,4 +90,80 @@
         (erc-status-sidebar-kill)
         (should-not (get-buffer "*ERC Status*"))))))
 
+;; We can't currently run this on EMBA because it needs a usable
+;; terminal, and we lack a fixture for that.  Please try running this
+;; test interactively with both graphical Emacs and non.
+(declare-function erc-nickbar-mode "erc-speedbar" (arg))
+(declare-function erc-speedbar-close-nicknames-window "erc-speedbar" (kill))
+(declare-function speedbar-timer-fn "speedbar" nil)
+(defvar erc-nickbar-mode)
+(defvar speedbar-buffer)
+
+(ert-deftest erc-scenarios-status-sidebar--nickbar ()
+  :tags '(:unstable :expensive-test)
+  (when noninteractive (ert-skip "Interactive only"))
+
+  (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 `(nickbar ,@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")))
+
+    (erc-d-t-wait-for 20 (get-buffer "#bar"))
+    (with-current-buffer (pop-to-buffer "#bar")
+      (funcall expect 10 "was created on")
+      (funcall expect 2 "his second fit")
+      (erc-d-t-wait-for 10 (and speedbar-buffer (get-buffer speedbar-buffer)))
+      (speedbar-timer-fn)
+      (with-current-buffer speedbar-buffer
+        (funcall expect 10 "#bar (3)")
+        (funcall expect 10 '(| "@mike" "joe"))
+        (funcall expect 10 '(| "@mike" "joe"))
+        (funcall expect 10 "tester")))
+
+    (erc-d-t-wait-for 20 (get-buffer "#foo"))
+    (with-current-buffer (pop-to-buffer "#foo")
+      (delete-other-windows)
+      (funcall expect 10 "was created on")
+      (funcall expect 2 "no use of him")
+      (speedbar-timer-fn)
+      (with-current-buffer speedbar-buffer
+        (funcall expect 10 "#foo (3)")
+        (funcall expect 10 '(| "alice" "@bob"))
+        (funcall expect 10 '(| "alice" "@bob"))
+        (funcall expect 10 "tester")))
+
+    (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.
+        (erc-nickbar-mode -1)
+        (should-not (and speedbar-buffer
+                         (get-buffer-window speedbar-buffer)))
+        (erc-nickbar-mode +1)
+        (should (and speedbar-buffer
+                     (get-buffer-window speedbar-buffer)))
+        (should (get-buffer " SPEEDBAR"))
+        (erc-speedbar-close-nicknames-window 'kill)
+        (should-not (get-buffer " SPEEDBAR"))
+        (should-not erc-nickbar-mode)
+        (should-not (cdr (frame-list)))))))
+
 ;;; erc-scenarios-status-sidebar.el ends here