mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-06 03:40:56 -08: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:
F. Jason Park
parent
80e5e9ddc8
commit
2716dd13ce
3 changed files with 192 additions and 81 deletions
|
|
@ -14,13 +14,12 @@ GNU Emacs since Emacs version 22.1.
|
||||||
|
|
||||||
* Changes in ERC 5.6
|
* 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
|
Remember your place in ERC buffers a bit more easily while retaining
|
||||||
the freedom to look around. Optionally sync the indicator to any
|
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
|
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
|
options 'erc-keep-place-indicator-style' and friends, and try M-x
|
||||||
'keep-place-indicator', which for now must be added manually to
|
keep-place-indicator-mode to see it in action.
|
||||||
'erc-modules'.
|
|
||||||
|
|
||||||
** Module 'fill' now offers a style based on 'visual-line-mode'.
|
** Module 'fill' now offers a style based on 'visual-line-mode'.
|
||||||
This fill style mimics the "hanging indent" look of 'erc-fill-static'
|
This fill style mimics the "hanging indent" look of 'erc-fill-static'
|
||||||
|
|
|
||||||
|
|
@ -208,6 +208,8 @@ the active frame."
|
||||||
(require 'fringe)
|
(require 'fringe)
|
||||||
(erc--restore-initialize-priors erc-keep-place-indicator-mode
|
(erc--restore-initialize-priors erc-keep-place-indicator-mode
|
||||||
erc--keep-place-indicator-overlay (make-overlay 0 0))
|
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
|
(add-hook 'window-configuration-change-hook
|
||||||
#'erc--keep-place-indicator-on-window-configuration-change nil t)
|
#'erc--keep-place-indicator-on-window-configuration-change nil t)
|
||||||
(when-let* (((memq erc-keep-place-indicator-style '(t arrow)))
|
(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)
|
;;;###autoload(put 'keep-place-indicator 'erc--feature 'erc-goodies)
|
||||||
(define-erc-module keep-place-indicator nil
|
(define-erc-module keep-place-indicator nil
|
||||||
"`keep-place' with a fringe arrow and/or highlighted face."
|
"Buffer-local `keep-place' with fringe arrow and/or highlighted face.
|
||||||
((unless erc-keep-place-mode
|
Play nice with global module `keep-place' but don't depend on it.
|
||||||
(unless (memq 'keep-place erc-modules)
|
Expect that users may want different combinations of `keep-place'
|
||||||
(erc--warn-once-before-connect 'erc-keep-place-mode
|
and `keep-place-indicator' in different buffers."
|
||||||
"Local module `keep-place-indicator' needs module `keep-place'."
|
((cond (erc-keep-place-mode)
|
||||||
" Enabling now. This will affect \C-]all\C-] ERC sessions."
|
((memq 'keep-place erc-modules)
|
||||||
" Add `keep-place' to `erc-modules' to silence this message."))
|
(erc-keep-place-mode +1))
|
||||||
(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
|
(if (pcase erc-keep-place-indicator-buffer-type
|
||||||
('target erc--target)
|
('target erc--target)
|
||||||
('server (not erc--target))
|
('server (not erc--target))
|
||||||
('t t))
|
('t t))
|
||||||
(erc--keep-place-indicator-setup)
|
(erc--keep-place-indicator-setup)
|
||||||
(setq erc-keep-place-indicator-mode nil)))
|
(erc-keep-place-indicator-mode -1)))
|
||||||
((when erc--keep-place-indicator-overlay
|
((when erc--keep-place-indicator-overlay
|
||||||
(delete-overlay erc--keep-place-indicator-overlay)
|
(delete-overlay erc--keep-place-indicator-overlay))
|
||||||
(remove-hook 'window-configuration-change-hook
|
(remove-hook 'window-configuration-change-hook
|
||||||
#'erc--keep-place-indicator-on-window-configuration-change t)
|
#'erc--keep-place-indicator-on-window-configuration-change t)
|
||||||
(kill-local-variable 'erc--keep-place-indicator-overlay)))
|
(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)
|
'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)
|
(defun erc-keep-place-move (pos)
|
||||||
"Move keep-place indicator to current line or POS.
|
"Move keep-place indicator to current line or POS.
|
||||||
For use with `keep-place-indicator' module. When called
|
For use with `keep-place-indicator' module. When called
|
||||||
|
|
|
||||||
|
|
@ -245,81 +245,179 @@
|
||||||
;; minor-mode toggle is allowed to disable its mode variable as
|
;; minor-mode toggle is allowed to disable its mode variable as
|
||||||
;; needed.
|
;; 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*")
|
(with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*")
|
||||||
(erc-mode)
|
(erc-mode)
|
||||||
(erc--initialize-markers (point) nil)
|
(erc--initialize-markers (point) nil)
|
||||||
(setq erc-server-process
|
(setq erc-server-process
|
||||||
(start-process "sleep" (current-buffer) "sleep" "1"))
|
(start-process "sleep" (current-buffer) "sleep" "1"))
|
||||||
(set-process-query-on-exit-flag erc-server-process nil)
|
(set-process-query-on-exit-flag erc-server-process nil)
|
||||||
(let ((assert-off
|
(let (erc-connect-pre-hook
|
||||||
(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
|
|
||||||
erc-modules)
|
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")
|
(funcall test))
|
||||||
(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")))))
|
|
||||||
|
|
||||||
(when noninteractive
|
(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))))
|
(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
|
;;; erc-goodies-tests.el ends here
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue