(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)))
;;;###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
;; 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