diff options
author | F. Jason Park <jp@neverwas.me> | 2023-04-10 17:58:05 -0700 |
---|---|---|
committer | F. Jason Park <jp@neverwas.me> | 2023-05-05 17:18:01 -0700 |
commit | 2e18ba6302f3e4aa5485eeaca39c747beb55ca8f (patch) | |
tree | e8d2172243a5e3f03d70f11e428a893fbbaf5687 /test | |
parent | 2641dfd4b4334942282358b50d74f75424ebf4fa (diff) | |
download | emacs-2e18ba6302f3e4aa5485eeaca39c747beb55ca8f.tar.gz |
Simplify erc-button movement commands
* etc/ERC-NEWS: Mention TAB being bound to new command `erc-tab' and
`erc-previous-button' now stopping at the start of buttons.
* lisp/erc/erc-button.el (erc-button-mode, erc-button-enable,
erc-button-disable): Add and remove `erc-button-next' to
`erc--tab-functions' hook, which is tantamount to binding the command
in the read-only area of an ERC buffer.
(erc-button-next-function): Deprecate and remove from client code path
because this module doesn't concern itself with prompt input and thus
no longer needs to conform to the `completion-at-point-functions'
interface.
(erc-button--prev-next-predicate-functions): New variable, a hook to
determine whether to continue searching for a button. Other modules
should utilize this as needed.
(erc-button--end-of-button-p): Add function to serve as default value
for `erc-button--continue-predicate'.
(erc--button-next): Add generalized button-movement function.
(erc-button-next, erc-button-previous): Make `erc-button-previous'
behave more predictably by having it land at the beginning of buttons.
And remove roundabout appeal to HOF in `erc-button-next'.
(erc-button-previous-of-nick): New command to jump to previous
appearance of nick at point.
* lisp/erc/erc-fill.el (erc-fill-wrap, erc-fill-wrap-enable,
erc-fill-wrap-disable): Add and remove merge-related hookee from
`erc-button--prev-next-predicate-functions'.
(erc-fill--wrap-merged-button-p): New function to detect redundant
speakers.
* lisp/erc/erc.el (erc-complete-functions): Quote TAB in doc string.
(erc-mode-map): Bind `erc-tab' to TAB.
(erc--tab-functions, erc-tab): Add new command and hook to serve as
unified dispatch for TAB-related operations. It calls `c-a-p' in the
input area and defers to module code in the read-only message area.
* test/lisp/erc/erc-button-tests.el: New file.
* test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate): Run
finalizer for transient keymap timer.
* test/lisp/erc/erc-tests.el
(erc-button--display-error-notice-with-keys): Move to new dedicated
test file for erc-button and fix expected behavior of
`erc-button-previous'. (Bug#62834)
Diffstat (limited to 'test')
-rw-r--r-- | test/lisp/erc/erc-button-tests.el | 177 | ||||
-rw-r--r-- | test/lisp/erc/erc-fill-tests.el | 2 | ||||
-rw-r--r-- | test/lisp/erc/erc-tests.el | 61 |
3 files changed, 179 insertions, 61 deletions
diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el new file mode 100644 index 00000000000..ced08d117bc --- /dev/null +++ b/test/lisp/erc/erc-button-tests.el @@ -0,0 +1,177 @@ +;;; erc-button-tests.el --- Tests for erc-button -*- lexical-binding:t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'erc-button) + +(defun erc-button-tests--insert-privmsg (speaker &rest msg-parts) + (declare (indent 1)) + (let ((msg (erc-format-privmessage speaker + (apply #'concat msg-parts) nil t))) + (erc-display-message nil nil (current-buffer) msg))) + +(defun erc-button-tests--populate (test) + (let ((inhibit-message noninteractive) + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + + (with-current-buffer + (cl-letf + (((symbol-function 'erc-server-connect) + (lambda (&rest _) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil)))) + + (erc-open "localhost" 6667 "tester" "Tester" 'connect + nil nil nil nil nil "tester" 'foonet)) + + (with-current-buffer (erc--open-target "#chan") + (erc-update-channel-member + "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t) + + (erc-update-channel-member + "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t) + + (erc-display-message + nil 'notice (current-buffer) + (concat "This server is in debug mode and is logging all user I/O. " + "Blah alice (1) bob (2) blah.")) + + (funcall test)) + + (when noninteractive + (kill-buffer "#chan") + (kill-buffer))))) + +(ert-deftest erc-button-next () + (erc-button-tests--populate + (lambda () + (erc-button-tests--insert-privmsg "alice" + "(3) bob (4) come, you are a tedious fool: to the purpose.") + + (erc-button-tests--insert-privmsg "bob" + "(5) alice (6) Come me to what was done to her.") + + (should (= erc-input-marker (point))) + + ;; Break out of input area + (erc-button-previous 1) + (should (looking-at (rx "alice (6)"))) + + ;; No next button + (should-error (erc-button-next 1) :type 'user-error) + (should (looking-at (rx "alice (6)"))) + + ;; Next with negative arg is equivalent to previous + (erc-button-next -1) + (should (looking-at (rx "bob> (5)"))) + + ;; One past end of button + (forward-char 3) + (should (looking-at (rx "> (5)"))) + (should-not (get-text-property (point) 'erc-callback)) + (erc-button-previous 1) + (should (looking-at (rx "bob> (5)"))) + + ;; At end of button + (forward-char 2) + (should (looking-at (rx "b> (5)"))) + (erc-button-previous 1) + (should (looking-at (rx "bob (4)"))) + + ;; Skip multiple buttons back + (erc-button-previous 2) + (should (looking-at (rx "bob (2)"))) + + ;; Skip multiple buttons forward + (erc-button-next 2) + (should (looking-at (rx "bob (4)"))) + + ;; No error as long as some progress made + (erc-button-previous 100) + (should (looking-at (rx "alice (1)"))) + + ;; Error when no progress made + (should-error (erc-button-previous 1) :type 'user-error) + (should (looking-at (rx "alice (1)")))))) + +;; See also `erc-scenarios-networks-announced-missing' in +;; erc-scenarios-misc.el for a more realistic example. +(ert-deftest erc-button--display-error-notice-with-keys () + (with-current-buffer (get-buffer-create "*fake*") + (let ((mode erc-button-mode) + (inhibit-message noninteractive) + erc-modules + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (erc-mode) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + (erc--initialize-markers (point) nil) + (erc-button-mode +1) + (should (equal (erc-button--display-error-notice-with-keys + "If \\[erc-bol] fails, " + "see \\[erc-bug] or `erc-mode-map'.") + "*** If C-a fails, see M-x erc-bug or `erc-mode-map'.")) + (goto-char (point-min)) + + (ert-info ("Keymap substitution succeeds") + (erc-button-next 1) + (should (looking-at "C-a")) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (erc-button-press-button) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward "erc-bol" nil t))) + (erc-button-next 1) + ;; End of interval correct + (erc-button-previous 1) + (should (looking-at "C-a fails"))) + + (ert-info ("Extended command mapping succeeds") + (erc-button-next 1) + (should (looking-at "M-x erc-bug")) + (erc-button-press-button) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward "erc-bug" nil t)))) + + (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k + (erc-button-next 1) + (should (equal (get-text-property (point) 'font-lock-face) + '(erc-button erc-error-face))) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (should (eq erc-button-face 'erc-button))) ; extent evaporates + + (ert-info ("Format when trailing args include non-strings") + (should (equal (erc-button--display-error-notice-with-keys + "abc" " %d def" " 45%s" 123 '\6) + "*** abc 123 def 456"))) + + (when noninteractive + (unless mode + (erc-button-mode -1)) + (kill-buffer "*Help*") + (kill-buffer))))) + +;;; erc-button-tests.el ends here diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index e8dd25e8ea1..170436ffbaa 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -94,6 +94,8 @@ ;; Defend against non-local exits from `ert-skip' (unwind-protect (funcall test) + (when set-transient-map-timer + (timer-event-handler set-transient-map-timer)) (set-window-buffer (selected-window) original-window-buffer) (when noninteractive (while-let ((buf (pop erc-fill-tests--buffers))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 88b9babf206..5aaf7e499e3 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2110,65 +2110,4 @@ connection." (put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-disable 'definition-name 'mname)))))) - -;; XXX move erc-button tests to new file if more added. -(require 'erc-button) - -;; See also `erc-scenarios-networks-announced-missing' in -;; erc-scenarios-misc.el for a more realistic example. -(ert-deftest erc-button--display-error-notice-with-keys () - (with-current-buffer (get-buffer-create "*fake*") - (let ((mode erc-button-mode) - (inhibit-message noninteractive) - erc-modules - erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) - (erc-mode) - (erc-tests--set-fake-server-process "sleep" "1") - (erc--initialize-markers (point) nil) - (erc-button-mode +1) - (should (equal (erc-button--display-error-notice-with-keys - "If \\[erc-bol] fails, " - "see \\[erc-bug] or `erc-mode-map'.") - "*** If C-a fails, see M-x erc-bug or `erc-mode-map'.")) - (goto-char (point-min)) - - (ert-info ("Keymap substitution succeeds") - (erc-button-next) - (should (looking-at "C-a")) - (should (eq (get-text-property (point) 'mouse-face) 'highlight)) - (erc-button-press-button) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward "erc-bol" nil t))) - (erc-button-next) - (erc-button-previous) ; end of interval correct - (should (looking-at "a fails"))) - - (ert-info ("Extended command mapping succeeds") - (erc-button-next) - (should (looking-at "M-x erc-bug")) - (erc-button-press-button) - (should (eq (get-text-property (point) 'mouse-face) 'highlight)) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward "erc-bug" nil t)))) - - (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k - (erc-button-next) - (should (equal (get-text-property (point) 'font-lock-face) - '(erc-button erc-error-face))) - (should (eq (get-text-property (point) 'mouse-face) 'highlight)) - (should (eq erc-button-face 'erc-button))) ; extent evaporates - - (ert-info ("Format when trailing args include non-strings") - (should (equal (erc-button--display-error-notice-with-keys - "abc" " %d def" " 45%s" 123 '\6) - "*** abc 123 def 456"))) - - (when noninteractive - (unless mode - (erc-button-mode -1)) - (kill-buffer "*Help*") - (kill-buffer))))) - ;;; erc-tests.el ends here |