From d94753dac3648daebf6e645c6f0e6df041770b81 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 21 May 2024 05:37:39 -0700 Subject: [PATCH 2/7] [5.6] Delete original speedbar frame in erc-nickbar-mode * lisp/erc/erc-speedbar.el (erc-speedbar-buttons): Disable `erc-nickbar-mode' when it's not displayed in a window. (erc-speedbar--hidden-speedbar-frame) (erc-speedbar--emulate-speedbar): Add doc string. (erc-speedbar--handle-delete-frame): New function. (erc-speedbar--toggle-nicknames-sidebar): Remove function because these changes obviate the need for such overly complicated conditional logic. (erc-speedbar--ensure): Create `speedbar-buffer' when needed, and delete the original frame. Set `dframe-delete-frame-function' to own handler. (erc-speedbar--run-timer-on-post-insert) (erc-speedbar--prod-dframe-timer): Rename former to latter. Return nil, and accept any number of args. (erc-nickbar-mode, erc-nickbar-disable): Tear down completely when disabling, regardless of universal argument. Also run `erc-speedbar--prod-dframe-timer' on `erc-server-PONG-functions'. (erc-speedbar--shutting-down-p): Remove unused variable. (erc-speedbar--dframe-controlled): Don't bother making frame visible because it's been deleted. * test/lisp/erc/erc-scenarios-status-sidebar.el (erc-scenarios-status-sidebar--nickbar): Update assertions. --- lisp/erc/erc-speedbar.el | 203 +++++++++--------- test/lisp/erc/erc-scenarios-status-sidebar.el | 16 +- 2 files changed, 110 insertions(+), 109 deletions(-) diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index b156f61d5d9..9cde452be58 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -146,7 +146,10 @@ erc-speedbar-buttons (setq serverp (erc--server-buffer-p)) (setq chanp (erc-channel-p (erc-default-target))) (setq queryp (erc-query-buffer-p))) - (cond (serverp + (defvar erc-nickbar-mode) + (cond ((and erc-nickbar-mode (null (get-buffer-window speedbar-buffer))) + (run-at-time 0 nil #'erc-nickbar-mode -1)) + (serverp (erc-speedbar-channel-buttons nil 0 buffer)) (chanp (erc-speedbar-insert-target buffer 0) @@ -288,15 +291,9 @@ erc-speedbar--highlight-self-and-ops '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)))) + (or (and cuser (not (zerop (erc-channel-user-status cuser))) + erc-button-nickname-face) + 'erc-default-face)))) (defun erc-speedbar--on-click (nick sbtoken _indent) ;; 0: finger, 1: name, 2: info, 3: buffer-name @@ -447,7 +444,11 @@ erc-speedbar--buffer-options (speedbar-use-images . nil) (speedbar-hide-button-brackets-flag . t))) -(defvar erc-speedbar--hidden-speedbar-frame nil) +(defvar erc-speedbar--hidden-speedbar-frame nil + "The original `speedbar-frame', which `erc-nickbar-mode' deletes. +It keeps a reference to it in order to run upstream teardown +procedures without having to create a dummy frame for that +purpose.") (defun erc-speedbar--emulate-sidebar-set-window-preserve-size () (let ((erc-status-sidebar-buffer-name (buffer-name speedbar-buffer)) @@ -463,6 +464,7 @@ erc-speedbar--status-sidebar-mode--unhook #'erc-speedbar--emulate-sidebar-set-window-preserve-size)) (defun erc-speedbar--emulate-sidebar () + "Perform local setup for `erc-nickbar-mode' in a new `speedbar-buffer'." (require 'erc-status-sidebar) (cl-assert speedbar-frame) (cl-assert (eq speedbar-buffer (current-buffer))) @@ -482,30 +484,32 @@ erc-speedbar--emulate-sidebar (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))) - ;; Close associated windows and stop updating but leave timer. - (progn - (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))) - (with-current-buffer speedbar-buffer - (setq speedbar-update-flag nil) - (speedbar-set-mode-line-format))) - (when (or (not force) (>= arg 0)) - (with-selected-frame speedbar-frame - (erc-speedbar--emulate-sidebar-set-window-preserve-size) - (erc-speedbar-toggle-nicknames-window-lock -1))))) - (when-let (((or (not force) (>= arg 0))) +(defun erc-speedbar--handle-delete-frame (event) + "Disable the nickbar if EVENT is deleting the proxy frame." + (when (and speedbar-frame + (cdr (frame-list)) + (pcase event + (`(delete-frame (,frame)) (eq frame speedbar-frame)))) + (erc-nickbar-mode -1))) + +(defun erc-speedbar--ensure (&optional forcep) + "Perform common setup for `erc-nickbar-mode'. +Without FORCEP, return early when the calling context isn't +associated with an ERC session." + (save-excursion + (when (or (erc-server-buffer) forcep) + (when erc-track-mode + (cl-pushnew '(derived-mode . speedbar-mode) + erc-track--switch-fallback-blockers :test #'equal)) + (unless speedbar-update-flag + (erc-button--display-error-notice-with-keys + (erc-server-buffer) + "Module `nickbar' needs `speedbar-update-flag' to be non-nil" + (and (not (display-graphic-p)) " in text terminals") + ". Setting to t for the current Emacs session." + " Customize it permanently to avoid this message.") + (setq speedbar-update-flag t)) + (when-let (((null speedbar-buffer)) (speedbar-frame-parameters (backquote-list* '(visibility . nil) '(no-other-frame . t) @@ -516,52 +520,45 @@ erc-speedbar--toggle-nicknames-sidebar ;; created twice. (speedbar-change-initial-expansion-list "ERC") (speedbar-frame-mode 1) - ;; 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))) + ;; The setup steps below can't go in the "create hook" because + ;; the frame with `window-main-window' will be raised and + ;; steal focus if you switch away from Emacs in the meantime. + (let ((frame speedbar-frame)) + (cl-assert (not (eq speedbar-frame (selected-frame)))) + (select-frame (setq speedbar-frame (selected-frame))) + (delete-frame frame)) + ;; Allow deleting (our) `speedbar-frame' with the mouse. + (with-current-buffer speedbar-buffer + (kill-local-variable 'dframe-delete-frame-function) + (setq dframe-delete-frame-function + #'erc-speedbar--handle-delete-frame))) + (with-selected-frame speedbar-frame (erc-speedbar--emulate-sidebar-set-window-preserve-size) - (erc-speedbar-toggle-nicknames-window-lock -1)))) - (cl-assert (not (cdr (erc-speedbar--get-timers))) t)) - -(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)) - (unless speedbar-update-flag - (erc-button--display-error-notice-with-keys - (erc-server-buffer) - "Module `nickbar' needs `speedbar-update-flag' to be non-nil" - (and (not (display-graphic-p)) " in text terminals") - ". Setting to t for the current Emacs session." - " Customize it permanently to avoid this message.") - (setq speedbar-update-flag t)) - (erc-speedbar--toggle-nicknames-sidebar +1) - (with-current-buffer speedbar-buffer - (setq speedbar-update-flag t) - (speedbar-set-mode-line-format)))) + (erc-speedbar-toggle-nicknames-window-lock -1)) + (cl-assert (null (cdr (erc-speedbar--get-timers)))) + (with-current-buffer speedbar-buffer + (setq speedbar-update-flag t) + (speedbar-set-mode-line-format))))) -(defvar erc-speedbar--shutting-down-p nil) -(defvar erc-speedbar--force-update-interval-secs 5 "Speedbar update period.") +(defvar erc-speedbar--force-update-interval-secs 5 + "Speedbar update period.") (defvar-local erc-speedbar--last-ran nil "When non-nil, a lisp timestamp updated when the speedbar timer runs.") -(defun erc-speedbar--run-timer-on-post-insert () - "Refresh speedbar if idle for `erc-speedbar--force-update-interval-secs'." - (when speedbar-buffer +(defun erc-speedbar--prod-dframe-timer (&rest _) + "Refresh speedbar if dormant for `erc-speedbar--force-update-interval-secs'." + (when (buffer-live-p speedbar-buffer) (with-current-buffer speedbar-buffer - (when-let - ((dframe-timer) - ((erc--check-msg-prop 'erc--cmd 'PRIVMSG)) - (interval erc-speedbar--force-update-interval-secs) - ((or (null erc-speedbar--last-ran) - (time-less-p erc-speedbar--last-ran - (time-subtract (current-time) interval))))) - (run-at-time 0 nil #'dframe-timer-fn))))) + (when + (and dframe-timer + (or (null erc-speedbar--last-ran) + (time-less-p erc-speedbar--last-ran + (time-subtract + (current-time) + erc-speedbar--force-update-interval-secs)))) + (run-at-time 0 nil #'dframe-timer-fn)))) + nil) (defun erc-speedbar--reset-last-ran-on-timer () "Reset `erc-speedbar--last-ran'." @@ -574,42 +571,47 @@ nickbar "Show nicknames for current target buffer 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. +separate frame. If ERC doesn't yet have any live connections, +defer activation until such time. This means the variable +`erc-nickbar-mode' may be t even though no actual speedbar yet +exists. When disabling, destroy the speedbar session. For controlling whether the speedbar window is selectable with -`other-window', see `erc-nickbar-toggle-nicknames-window-lock'. -Note that during initialization, this module may produce unwanted -side effects, like the raising of frames or the stealing of input -focus. If you witness such a thing and can reproduce it, please -file a bug report with \\[erc-bug]." +`other-window', see `erc-nickbar-toggle-nicknames-window-lock'." ((add-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) - (add-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert) (add-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer) + (add-hook 'erc-insert-post-hook #'erc-speedbar--prod-dframe-timer) + (add-hook 'erc-server-PONG-functions #'erc-speedbar--prod-dframe-timer) (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)))))) + (and speedbar-buffer + (eq speedbar-frame + (window-frame (get-buffer-window speedbar-buffer t))))) (when-let ((buf (or (and (derived-mode-p 'erc-mode) (current-buffer)) (car (erc-buffer-filter #'erc--server-buffer-p))))) (with-current-buffer buf - (erc-speedbar--ensure 'force))))) + (erc-speedbar--ensure 'forcep))))) ((remove-hook 'erc--setup-buffer-hook #'erc-speedbar--ensure) - (remove-hook 'erc-insert-post-hook #'erc-speedbar--run-timer-on-post-insert) (remove-hook 'speedbar-timer-hook #'erc-speedbar--reset-last-ran-on-timer) + (remove-hook 'erc-insert-post-hook #'erc-speedbar--prod-dframe-timer) + (remove-hook 'erc-server-PONG-functions #'erc-speedbar--prod-dframe-timer) (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 (((not erc-speedbar--shutting-down-p)) - (arg erc--module-toggle-prefix-arg) - ((numberp arg)) - ((< arg 0))) - (with-current-buffer speedbar-buffer - (dframe-close-frame) - (setq erc-speedbar--hidden-speedbar-frame nil))))) + (cl-assert speedbar-buffer) + ;; Close associated windows and stop updating but leave timer. + (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))) + (with-current-buffer speedbar-buffer + (setq speedbar-update-flag nil) + (speedbar-set-mode-line-format) + (unless (eq erc--module-toggle-prefix-arg most-negative-fixnum) + (dframe-close-frame))))) (defun erc-speedbar--get-timers () (cl-remove #'dframe-timer-fn timer-idle-list @@ -621,21 +623,18 @@ erc-speedbar--dframe-controlled (cl-assert (eq speedbar-buffer (current-buffer)))) (when (and erc-speedbar--hidden-speedbar-frame (numberp arg) (< arg 0)) (when erc-nickbar-mode - (let ((erc-speedbar--shutting-down-p t)) - (erc-nickbar-mode -1))) + (erc-nickbar-mode most-negative-fixnum)) (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 sequence. - (when (display-graphic-p) - (make-frame-visible speedbar-frame)) (speedbar-frame-mode arg) ; -1 ;; As of Emacs 29, `dframe-set-timer' can't remove `dframe-timer'. (cl-assert (= 1 (length (erc-speedbar--get-timers))) t) (cancel-function-timers #'dframe-timer-fn) ;; `dframe-close-frame' kills the buffer but no function in ;; erc-speedbar.el resets this to nil. - (setq speedbar-buffer nil))) + (setq erc-speedbar--hidden-speedbar-frame nil + speedbar-buffer nil + speedbar-frame nil))) (defun erc-speedbar-toggle-nicknames-window-lock (arg) "Toggle whether nicknames window is selectable with \\[other-window]. diff --git a/test/lisp/erc/erc-scenarios-status-sidebar.el b/test/lisp/erc/erc-scenarios-status-sidebar.el index 2523ff9ee46..4cec00e2312 100644 --- a/test/lisp/erc/erc-scenarios-status-sidebar.el +++ b/test/lisp/erc/erc-scenarios-status-sidebar.el @@ -98,12 +98,14 @@ erc-scenarios-status-sidebar--bufbar (defvar erc-nickbar-mode) (defvar speedbar-buffer) +;; FIXME move to own file because it takes 20+ seconds, uncompiled. (ert-deftest erc-scenarios-status-sidebar--nickbar () :tags `(:expensive-test :unstable ,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical))) - (when noninteractive (ert-skip "Interactive only")) + (when (and noninteractive (= emacs-major-version 27)) + (ert-skip "Hangs on Emacs 27, asking for input")) - (erc-scenarios-common-with-cleanup + (erc-scenarios-common-with-noninteractive-in-term ((erc-scenarios-common-dialog "base/gapless-connect") (erc-server-flood-penalty 0.1) (erc-server-flood-penalty erc-server-flood-penalty) @@ -156,14 +158,14 @@ erc-scenarios-status-sidebar--nickbar ;; etc. for testing commands that call those same functions. (call-interactively #'erc-nickbar-mode) (should-not erc-nickbar-mode) - (should-not (and speedbar-buffer - (get-buffer-window speedbar-buffer))) - (should speedbar-buffer) + (should-not speedbar-buffer) + (should-not (get-buffer " SPEEDBAR")) (erc-nickbar-mode +1) - (should (and speedbar-buffer - (get-buffer-window speedbar-buffer))) + (should (and speedbar-buffer (get-buffer-window speedbar-buffer))) + (should (eq speedbar-buffer (get-buffer " SPEEDBAR"))) (should (get-buffer " SPEEDBAR")) + (erc-nickbar-mode -1) (should-not (get-buffer " SPEEDBAR")) (should-not erc-nickbar-mode) -- 2.45.1