mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-03 08:30:09 +00:00
Decouple keep-place-indicator from global ERC module
* etc/ERC-NEWS: Let users know that `keep-place-indicator' is a wholly separate module from `keep-place'. * lisp/erc/erc-goodies.el (erc-keep-place-indicator-setup): Perform some housekeeping on `erc-keep-place-mode'. (erc-keep-place-indicator-mode, erc-keep-place-indicator-enable, erc-keep-place-indicator-disable): Take precautions to work around the activation state of global module `keep-place', but no longer depend on it. (erc--keep-place-indicator-on-global-module): New function to ensure `erc-keep-place' runs exactly once on `erc-insert-pre-hook', regardless of whether module `keep-place' is active. * test/lisp/erc/erc-goodies-tests.el (erc-goodies-tests--assert-kp-indicator-on, erc-goodies-tests--assert-kp-indicator-off, erc-goodies-tests--kp-indicator-populate, erc-goodies-tests--keep-place-indicator): New helper functions. (erc-keep-place-indicator-mode, erc-keep-place-indicator-mode--no-global): Factor out some common logic and rename former to latter. (erc-keep-place-indicator-mode--global): New test. (Bug#59943)
This commit is contained in:
parent
80e5e9ddc8
commit
2716dd13ce
@ -14,13 +14,12 @@ GNU Emacs since Emacs version 22.1.
|
||||
|
||||
* Changes in ERC 5.6
|
||||
|
||||
** Module 'keep-place' now offers a visual indicator.
|
||||
** Module 'keep-place' has gained a more flamboyant cousin.
|
||||
Remember your place in ERC buffers a bit more easily while retaining
|
||||
the freedom to look around. Optionally sync the indicator to any
|
||||
progress made when you haven't yet caught up to the live stream. See
|
||||
options 'erc-keep-place-indicator-style' and friends and new module
|
||||
'keep-place-indicator', which for now must be added manually to
|
||||
'erc-modules'.
|
||||
options 'erc-keep-place-indicator-style' and friends, and try M-x
|
||||
keep-place-indicator-mode to see it in action.
|
||||
|
||||
** Module 'fill' now offers a style based on 'visual-line-mode'.
|
||||
This fill style mimics the "hanging indent" look of 'erc-fill-static'
|
||||
|
@ -208,6 +208,8 @@ the active frame."
|
||||
(require 'fringe)
|
||||
(erc--restore-initialize-priors erc-keep-place-indicator-mode
|
||||
erc--keep-place-indicator-overlay (make-overlay 0 0))
|
||||
(add-hook 'erc-keep-place-mode-hook
|
||||
#'erc--keep-place-indicator-on-global-module nil t)
|
||||
(add-hook 'window-configuration-change-hook
|
||||
#'erc--keep-place-indicator-on-window-configuration-change nil t)
|
||||
(when-let* (((memq erc-keep-place-indicator-style '(t arrow)))
|
||||
@ -223,27 +225,39 @@ the active frame."
|
||||
|
||||
;;;###autoload(put 'keep-place-indicator 'erc--feature 'erc-goodies)
|
||||
(define-erc-module keep-place-indicator nil
|
||||
"`keep-place' with a fringe arrow and/or highlighted face."
|
||||
((unless erc-keep-place-mode
|
||||
(unless (memq 'keep-place erc-modules)
|
||||
(erc--warn-once-before-connect 'erc-keep-place-mode
|
||||
"Local module `keep-place-indicator' needs module `keep-place'."
|
||||
" Enabling now. This will affect \C-]all\C-] ERC sessions."
|
||||
" Add `keep-place' to `erc-modules' to silence this message."))
|
||||
(erc-keep-place-mode +1))
|
||||
"Buffer-local `keep-place' with fringe arrow and/or highlighted face.
|
||||
Play nice with global module `keep-place' but don't depend on it.
|
||||
Expect that users may want different combinations of `keep-place'
|
||||
and `keep-place-indicator' in different buffers."
|
||||
((cond (erc-keep-place-mode)
|
||||
((memq 'keep-place erc-modules)
|
||||
(erc-keep-place-mode +1))
|
||||
;; Enable a local version of `keep-place-mode'.
|
||||
(t (add-hook 'erc-insert-pre-hook #'erc-keep-place 90 t)))
|
||||
(if (pcase erc-keep-place-indicator-buffer-type
|
||||
('target erc--target)
|
||||
('server (not erc--target))
|
||||
('t t))
|
||||
(erc--keep-place-indicator-setup)
|
||||
(setq erc-keep-place-indicator-mode nil)))
|
||||
(erc-keep-place-indicator-mode -1)))
|
||||
((when erc--keep-place-indicator-overlay
|
||||
(delete-overlay erc--keep-place-indicator-overlay)
|
||||
(remove-hook 'window-configuration-change-hook
|
||||
#'erc--keep-place-indicator-on-window-configuration-change t)
|
||||
(kill-local-variable 'erc--keep-place-indicator-overlay)))
|
||||
(delete-overlay erc--keep-place-indicator-overlay))
|
||||
(remove-hook 'window-configuration-change-hook
|
||||
#'erc--keep-place-indicator-on-window-configuration-change t)
|
||||
(remove-hook 'erc-keep-place-mode-hook
|
||||
#'erc--keep-place-indicator-on-global-module t)
|
||||
(remove-hook 'erc-insert-pre-hook #'erc-keep-place t)
|
||||
(kill-local-variable 'erc--keep-place-indicator-overlay))
|
||||
'local)
|
||||
|
||||
(defun erc--keep-place-indicator-on-global-module ()
|
||||
"Ensure `keep-place-indicator' can cope with `erc-keep-place-mode'.
|
||||
That is, ensure the local module can survive a user toggling the
|
||||
global one."
|
||||
(if erc-keep-place-mode
|
||||
(remove-hook 'erc-insert-pre-hook #'erc-keep-place t)
|
||||
(add-hook 'erc-insert-pre-hook #'erc-keep-place 90 t)))
|
||||
|
||||
(defun erc-keep-place-move (pos)
|
||||
"Move keep-place indicator to current line or POS.
|
||||
For use with `keep-place-indicator' module. When called
|
||||
|
@ -245,81 +245,179 @@
|
||||
;; minor-mode toggle is allowed to disable its mode variable as
|
||||
;; needed.
|
||||
|
||||
(ert-deftest erc-keep-place-indicator-mode ()
|
||||
(defun erc-goodies-tests--assert-kp-indicator-on ()
|
||||
(should erc--keep-place-indicator-overlay)
|
||||
(should (local-variable-p 'window-configuration-change-hook))
|
||||
(should window-configuration-change-hook)
|
||||
(should (memq 'erc-keep-place erc-insert-pre-hook))
|
||||
(should (eq erc-keep-place-mode
|
||||
(not (local-variable-p 'erc-insert-pre-hook)))))
|
||||
|
||||
(defun erc-goodies-tests--assert-kp-indicator-off ()
|
||||
(should-not (local-variable-p 'erc-insert-pre-hook))
|
||||
(should-not (local-variable-p 'window-configuration-change-hook))
|
||||
(should-not erc--keep-place-indicator-overlay))
|
||||
|
||||
(defun erc-goodies-tests--kp-indicator-populate ()
|
||||
(erc-display-message nil 'notice (current-buffer)
|
||||
"This buffer is for text that is not saved")
|
||||
(erc-display-message nil 'notice (current-buffer)
|
||||
"and for lisp evaluation")
|
||||
(should (search-forward "saved" nil t))
|
||||
(erc-keep-place-move nil)
|
||||
(goto-char erc-input-marker))
|
||||
|
||||
(defun erc-goodies-tests--keep-place-indicator (test)
|
||||
(with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*")
|
||||
(erc-mode)
|
||||
(erc--initialize-markers (point) nil)
|
||||
(setq erc-server-process
|
||||
(start-process "sleep" (current-buffer) "sleep" "1"))
|
||||
(set-process-query-on-exit-flag erc-server-process nil)
|
||||
(let ((assert-off
|
||||
(lambda ()
|
||||
(should-not erc-keep-place-indicator-mode)
|
||||
(should-not (local-variable-p 'window-configuration-change-hook))
|
||||
(should-not erc--keep-place-indicator-overlay)))
|
||||
(assert-on
|
||||
(lambda ()
|
||||
(should erc--keep-place-indicator-overlay)
|
||||
(should (local-variable-p 'window-configuration-change-hook))
|
||||
(should window-configuration-change-hook)
|
||||
(should erc-keep-place-mode)))
|
||||
;;
|
||||
erc-insert-pre-hook
|
||||
erc-connect-pre-hook
|
||||
(let (erc-connect-pre-hook
|
||||
erc-modules)
|
||||
|
||||
(funcall assert-off)
|
||||
(ert-info ("Clean slate")
|
||||
(erc-goodies-tests--assert-kp-indicator-off)
|
||||
(should-not erc-keep-place-mode)
|
||||
(should-not (memq 'keep-place erc-modules)))
|
||||
|
||||
(ert-info ("Value t")
|
||||
(should (eq erc-keep-place-indicator-buffer-type t))
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(funcall assert-on)
|
||||
(goto-char (point-min))
|
||||
(should (search-forward "Enabling" nil t))
|
||||
(should (memq 'keep-place erc-modules)))
|
||||
|
||||
(erc-keep-place-indicator-mode -1)
|
||||
(funcall assert-off)
|
||||
|
||||
(ert-info ("Value `target'")
|
||||
(let ((erc-keep-place-indicator-buffer-type 'target))
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(funcall assert-off)
|
||||
(setq erc--target (erc--target-from-string "#chan"))
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(funcall assert-on)))
|
||||
|
||||
(erc-keep-place-indicator-mode -1)
|
||||
(funcall assert-off)
|
||||
|
||||
(ert-info ("Value `server'")
|
||||
(let ((erc-keep-place-indicator-buffer-type 'server))
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(funcall assert-off)
|
||||
(setq erc--target nil)
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(funcall assert-on)))
|
||||
|
||||
;; Populate buffer
|
||||
(erc-display-message nil 'notice (current-buffer)
|
||||
"This buffer is for text that is not saved")
|
||||
(erc-display-message nil 'notice (current-buffer)
|
||||
"and for lisp evaluation")
|
||||
(should (search-forward "saved" nil t))
|
||||
(erc-keep-place-move nil)
|
||||
(goto-char erc-input-marker)
|
||||
|
||||
(ert-info ("Indicator survives reconnect")
|
||||
(let ((erc--server-reconnecting (buffer-local-variables)))
|
||||
(cl-letf (((symbol-function 'erc-server-connect) #'ignore))
|
||||
(erc-open "localhost" 6667 "tester" "Tester" 'connect
|
||||
nil nil nil nil nil "tester" nil)))
|
||||
(funcall assert-on)
|
||||
(should (= (point) erc-input-marker))
|
||||
(goto-char (overlay-start erc--keep-place-indicator-overlay))
|
||||
(should (looking-at (rx "*** This buffer is for text")))))
|
||||
(funcall test))
|
||||
|
||||
(when noninteractive
|
||||
(erc-keep-place-indicator-mode -1)
|
||||
(erc-keep-place-mode -1)
|
||||
(should-not (member 'erc-keep-place
|
||||
(default-value 'erc-insert-pre-hook)))
|
||||
(should-not (local-variable-p 'erc-insert-pre-hook))
|
||||
(kill-buffer))))
|
||||
|
||||
(ert-deftest erc-keep-place-indicator-mode--no-global ()
|
||||
(erc-goodies-tests--keep-place-indicator
|
||||
(lambda ()
|
||||
|
||||
(ert-info ("Value t")
|
||||
(should (eq erc-keep-place-indicator-buffer-type t))
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(erc-goodies-tests--assert-kp-indicator-on)
|
||||
(goto-char (point-min)))
|
||||
|
||||
(erc-keep-place-indicator-mode -1)
|
||||
(erc-goodies-tests--assert-kp-indicator-off)
|
||||
|
||||
(ert-info ("Value `target'")
|
||||
(let ((erc-keep-place-indicator-buffer-type 'target))
|
||||
;; No-op because server buffer.
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(erc-goodies-tests--assert-kp-indicator-off)
|
||||
;; Spoof target buffer (no longer no-op).
|
||||
(setq erc--target (erc--target-from-string "#chan"))
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(erc-goodies-tests--assert-kp-indicator-on)))
|
||||
|
||||
(erc-keep-place-indicator-mode -1)
|
||||
(erc-goodies-tests--assert-kp-indicator-off)
|
||||
|
||||
(ert-info ("Value `server'")
|
||||
(let ((erc-keep-place-indicator-buffer-type 'server))
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(erc-goodies-tests--assert-kp-indicator-off)
|
||||
(setq erc--target nil)
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(erc-goodies-tests--assert-kp-indicator-on)))
|
||||
|
||||
;; Populate buffer
|
||||
(erc-goodies-tests--kp-indicator-populate)
|
||||
|
||||
(ert-info ("Indicator survives reconnect")
|
||||
(let ((erc--server-reconnecting (buffer-local-variables)))
|
||||
(cl-letf (((symbol-function 'erc-server-connect) #'ignore))
|
||||
(erc-open "localhost" 6667 "tester" "Tester" 'connect
|
||||
nil nil nil nil nil "tester" nil)))
|
||||
(erc-goodies-tests--assert-kp-indicator-on)
|
||||
(should (= (point) erc-input-marker))
|
||||
(goto-char (overlay-start erc--keep-place-indicator-overlay))
|
||||
(should (looking-at (rx "*** This buffer is for text")))))))
|
||||
|
||||
(ert-deftest erc-keep-place-indicator-mode--global ()
|
||||
(erc-goodies-tests--keep-place-indicator
|
||||
(lambda ()
|
||||
|
||||
(push 'keep-place erc-modules)
|
||||
|
||||
(ert-info ("Value t")
|
||||
(should (eq erc-keep-place-indicator-buffer-type t))
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(erc-goodies-tests--assert-kp-indicator-on)
|
||||
;; Local module activates global `keep-place'.
|
||||
(should erc-keep-place-mode)
|
||||
;; Does not register local version of hook (otherwise would run
|
||||
;; twice).
|
||||
(should-not (local-variable-p 'erc-insert-pre-hook))
|
||||
(goto-char (point-min)))
|
||||
|
||||
(erc-keep-place-indicator-mode -1)
|
||||
(erc-goodies-tests--assert-kp-indicator-off)
|
||||
(should erc-keep-place-mode)
|
||||
(should (member 'erc-keep-place erc-insert-pre-hook))
|
||||
|
||||
(ert-info ("Value `target'")
|
||||
(let ((erc-keep-place-indicator-buffer-type 'target))
|
||||
;; No-op because server buffer.
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(erc-goodies-tests--assert-kp-indicator-off)
|
||||
;; Does not interfere with global activation state.
|
||||
(should erc-keep-place-mode)
|
||||
(should (member 'erc-keep-place erc-insert-pre-hook))
|
||||
;; Morph into a target buffer (no longer no-op).
|
||||
(setq erc--target (erc--target-from-string "#chan"))
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(erc-goodies-tests--assert-kp-indicator-on)
|
||||
;; Does not register local version of hook.
|
||||
(should-not (local-variable-p 'erc-insert-pre-hook))))
|
||||
|
||||
(erc-keep-place-indicator-mode -1)
|
||||
(erc-goodies-tests--assert-kp-indicator-off)
|
||||
(should erc-keep-place-mode)
|
||||
(should (member 'erc-keep-place erc-insert-pre-hook))
|
||||
|
||||
(ert-info ("Value `server'")
|
||||
(let ((erc-keep-place-indicator-buffer-type 'server))
|
||||
;; No-op because we're now a target buffer.
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(erc-goodies-tests--assert-kp-indicator-off)
|
||||
(should erc-keep-place-mode)
|
||||
(should (member 'erc-keep-place erc-insert-pre-hook))
|
||||
;; Back to server.
|
||||
(setq erc--target nil)
|
||||
(erc-keep-place-indicator-mode +1)
|
||||
(erc-goodies-tests--assert-kp-indicator-on)
|
||||
(should-not (local-variable-p 'erc-insert-pre-hook))))
|
||||
|
||||
(ert-info ("Local adapts to global toggle")
|
||||
(erc-keep-place-mode -1)
|
||||
(should-not (member 'erc-keep-place
|
||||
(default-value 'erc-insert-pre-hook)))
|
||||
(should (member 'erc-keep-place erc-insert-pre-hook))
|
||||
(erc-goodies-tests--assert-kp-indicator-on)
|
||||
(erc-keep-place-mode +1)
|
||||
(should (member 'erc-keep-place (default-value 'erc-insert-pre-hook)))
|
||||
(should-not (local-variable-p 'erc-insert-pre-hook))
|
||||
(erc-goodies-tests--assert-kp-indicator-on))
|
||||
|
||||
;; Populate buffer
|
||||
(erc-goodies-tests--kp-indicator-populate)
|
||||
|
||||
(ert-info ("Indicator survives reconnect")
|
||||
(let ((erc--server-reconnecting (buffer-local-variables)))
|
||||
(cl-letf (((symbol-function 'erc-server-connect) #'ignore))
|
||||
(erc-open "localhost" 6667 "tester" "Tester" 'connect
|
||||
nil nil nil nil nil "tester" nil)))
|
||||
(erc-goodies-tests--assert-kp-indicator-on)
|
||||
(should erc-keep-place-mode)
|
||||
(should (member 'erc-keep-place erc-insert-pre-hook))
|
||||
(should (= (point) erc-input-marker))
|
||||
(goto-char (overlay-start erc--keep-place-indicator-overlay))
|
||||
(should (looking-at (rx "*** This buffer is for text")))))))
|
||||
|
||||
;;; erc-goodies-tests.el ends here
|
||||
|
Loading…
Reference in New Issue
Block a user