From fd2ec89c40dd52322c8196c3653e06c937176bc7 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 4 May 2023 00:01:11 -0700 Subject: [PATCH 4/5] [5.6] 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-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-interface 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-emulated-sidebar-width): New option to control width of nicknames list window. (erc-speedbar): Mention `erc-nickbar-mode' in group doc string. (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--dframe-controlled) Add function to overwrite `speedbar-frame-mode' as `dframe-controlled' in speedbar 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 sidebar or speedbar. (erc-speedbar--ensure): Add helper function to show speedbar if its hidden or create one if none exists. (erc-nickbar-mode, erc-nickbar-enable, erc-nickbar-disable): Add new module. (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, unfortunately only runs in terminals. --- lisp/erc/erc-speedbar.el | 284 ++++++++++++++++-- test/lisp/erc/erc-scenarios-status-sidebar.el | 76 +++++ 2 files changed, 342 insertions(+), 18 deletions(-) diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index a9443e0ea17..21ad4c6f97a 100644 --- a/lisp/erc/erc-speedbar.el +++ b/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.7") + :type 'integer) + (defcustom erc-speedbar-sort-users-type 'activity "How channel nicknames are sorted. @@ -56,6 +67,23 @@ erc-speedbar-sort-users-type (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.7") ; 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.7") + :type '(choice face (const :tag "Match or own input face" t))) + (defvar erc-speedbar-key-map nil "Keymap used when in erc display mode.") @@ -88,10 +116,6 @@ erc-speedbar-menu-items (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 @@ erc-speedbar-browser 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 @@ erc-speedbar-channel-buttons 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 @@ erc-speedbar-expand-channel '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 @@ erc-speedbar-expand-channel (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 (featurep 'erc-match) + '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 @@ erc-speedbar-insert-user (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,180 @@ erc-speedbar-item-info (t (message "%s" txt))))) + +;;;; Status-sidebar integration + +(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) + (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: it's suspected that this module may perform unwanted +side effects like raising frames and/or stealing 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) + (cl-assert (not (derived-mode-p 'erc-mode))) + (setq erc-nickbar-mode nil) + (user-error "Cannot initialize `%s' in a non-ERC buffer" + 'erc-nickbar-mode)))) + ((remove-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) + (speedbar-disable-update) + (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 + +(defvar erc-nicks--phony-face) +(declare-function erc-nicks--highlight "erc-nicks" (nick-object)) + +(defun erc-speedbar--compose-nicks-face (orig buffer user cuser) + (require 'erc-nicks) + (let ((rv (funcall orig buffer user cuser))) + (if-let* ((nobj (make-erc-button--nick + :downcased (erc-downcase (erc-server-user-nickname user)) + :user user + :cuser cuser)) + (erc-nicks--phony-face (or rv t)) + (nobj (with-current-buffer buffer + (erc-nicks--highlight nobj))) + (face (erc-button--nick-erc-button-nickname-face nobj)) + ((not (eq face erc-button-nickname-face)))) + (cons face (ensure-list rv)) + rv))) + + (provide 'erc-speedbar) ;;; erc-speedbar.el ends here ;; diff --git a/test/lisp/erc/erc-scenarios-status-sidebar.el b/test/lisp/erc/erc-scenarios-status-sidebar.el index aec61333e0b..6ac1821ebb7 100644 --- a/test/lisp/erc/erc-scenarios-status-sidebar.el +++ b/test/lisp/erc/erc-scenarios-status-sidebar.el @@ -90,4 +90,80 @@ erc-scenarios-status-sidebar--bufbar (erc-status-sidebar-kill) (should-not (get-buffer "*ERC Status*")))))) +;; No need to pollute the global obarray since we can't currently run +;; this on EMBA (it requires a terminal). 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 -- 2.40.0