mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 22:41:06 -08:00
d45770e8d0
* etc/ERC-NEWS: Tell module authors that `erc-display-message' can now combine faces. * lisp/erc/erc-button.el (erc-button--display-error-notice-with-keys): Ask `erc-display-message' to compose `erc-notice-face' and `erc-error-face'. * lisp/erc/erc-match.el (erc-hide-fools): Merge `invisible' prop `erc-match' with existing, if present, and move body to helper for hiding matched messages. (erc-match--hide-message): New helper function to hide messages regardless of match type. * lisp/erc/erc-track.el: (erc-track-faces-priority-list): Note in doc string that faces reserved for critical messages are always prioritized. Wrap :type declaration in macro helper to ensure `erc-button' is loaded beforehand. Otherwise calling `setopt' with the option's default value fails. (erc-track--attn-faces): Add new internal variable for faces that should always appear in the mode line, at least in the default client. (erc-track-modified-channels, erc-track-face-priority): Prepend `erc-track--attn-faces' to `erc-track-faces-priority-list'. * lisp/erc/erc.el (erc-send-action): Ask `erc-display-message' to apply both `erc-input-face' and `erc-action-face' to messages. (erc--compose-text-properties): New internal variable to act as flag for altering behavior of `erc-put-text-property'. (erc--merge-prop): New function copied from `erc-button-add-face' for general internal use with any text property by all of ERC. (erc-display-message-highlight): Set fallback face to `erc-default-face' the symbol instead of the string. For this to break third-party code, callers would have to supply erroneous types for nonexistent or undefined handlers and then explicitly check for and depend on such misuse, which seems unlikely and therefore not worth mentioning in etc/ERC-NEWS. (erc-display-message): Explain how `type' param works when it's a list. Fix code in type-as-list branch so that it optionally combines faces instead of clobbers them. (erc-put-text-property): Unalias from `put-text-property', but fall back to the latter unless caller wants to combine faces, in which case, defer to `erc--merge-prop'. * test/lisp/erc/erc-button-tests.el (erc-button--display-error-notice-with-keys): Expect a combined "error notice" face. (Bug#64301)
283 lines
10 KiB
EmacsLisp
283 lines
10 KiB
EmacsLisp
;;; 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)
|
|
|
|
(ert-deftest erc-button-alist--url ()
|
|
(setq erc-server-process
|
|
(start-process "sleep" (current-buffer) "sleep" "1"))
|
|
(set-process-query-on-exit-flag erc-server-process nil)
|
|
(with-current-buffer (erc--open-target "#chan")
|
|
(let ((verify
|
|
(lambda (p url)
|
|
(should (equal (get-text-property p 'erc-data) (list url)))
|
|
(should (equal (get-text-property p 'mouse-face) 'highlight))
|
|
(should (eq (get-text-property p 'font-lock-face) 'erc-button))
|
|
(should (eq (get-text-property p 'erc-callback)
|
|
'browse-url-button-open-url)))))
|
|
(goto-char (point-min))
|
|
|
|
;; Most common (unbracketed)
|
|
(erc-display-message nil nil (current-buffer)
|
|
"Foo https://example.com bar.")
|
|
(search-forward "https")
|
|
(funcall verify (point) "https://example.com")
|
|
|
|
;; The <URL: form> still works despite being removed in ERC 5.6.
|
|
(erc-display-message nil nil (current-buffer)
|
|
"Foo <URL: https://gnu.org> bar.")
|
|
(search-forward "https")
|
|
(funcall verify (point) "https://gnu.org")
|
|
|
|
;; Bracketed
|
|
(erc-display-message nil nil (current-buffer) "Foo <ftp://gnu.org> bar.")
|
|
(search-forward "ftp")
|
|
(funcall verify (point) "ftp://gnu.org"))
|
|
|
|
(when noninteractive
|
|
(kill-buffer))))
|
|
|
|
(defvar erc-button-tests--form nil)
|
|
(defvar erc-button-tests--some-var nil)
|
|
|
|
(defun erc-button-tests--form (&rest rest)
|
|
(push rest erc-button-tests--form)
|
|
(apply #'erc-button-add-button rest))
|
|
|
|
(defun erc-button-tests--erc-button-alist--function-as-form (func)
|
|
(setq erc-server-process
|
|
(start-process "sleep" (current-buffer) "sleep" "1"))
|
|
(set-process-query-on-exit-flag erc-server-process nil)
|
|
|
|
(with-current-buffer (erc--open-target "#chan")
|
|
(let* ((erc-button-tests--form nil)
|
|
(entry (list (rx "+1") 0 func #'ignore 0))
|
|
(erc-button-alist (cons entry erc-button-alist)))
|
|
|
|
(erc-display-message nil 'notice (current-buffer) "Foo bar baz")
|
|
(erc-display-message nil nil (current-buffer) "+1")
|
|
(erc-display-message nil 'notice (current-buffer) "Spam")
|
|
(should (equal (pop erc-button-tests--form)
|
|
'(53 55 ignore nil ("+1") "\\+1")))
|
|
(should-not erc-button-tests--form)
|
|
(goto-char (point-min))
|
|
(search-forward "+")
|
|
(should (equal (get-text-property (point) 'erc-data) '("+1")))
|
|
(should (equal (get-text-property (point) 'mouse-face) 'highlight))
|
|
(should (eq (get-text-property (point) 'font-lock-face) 'erc-button))
|
|
(should (eq (get-text-property (point) 'erc-callback) 'ignore)))
|
|
|
|
(when noninteractive
|
|
(kill-buffer))))
|
|
|
|
(ert-deftest erc-button-alist--function-as-form ()
|
|
(erc-button-tests--erc-button-alist--function-as-form
|
|
#'erc-button-tests--form)
|
|
|
|
(erc-button-tests--erc-button-alist--function-as-form
|
|
(symbol-function #'erc-button-tests--form))
|
|
|
|
(erc-button-tests--erc-button-alist--function-as-form
|
|
(lambda (&rest r) (push r erc-button-tests--form)
|
|
(apply #'erc-button-add-button r))))
|
|
|
|
(defun erc-button-tests--erc-button-alist--nil-form (form)
|
|
(setq erc-server-process
|
|
(start-process "sleep" (current-buffer) "sleep" "1"))
|
|
(set-process-query-on-exit-flag erc-server-process nil)
|
|
|
|
(with-current-buffer (erc--open-target "#chan")
|
|
(let* ((erc-button-tests--form nil)
|
|
(entry (list (rx "+1") 0 form #'ignore 0))
|
|
(erc-button-alist (cons entry erc-button-alist)))
|
|
|
|
(erc-display-message nil 'notice (current-buffer) "Foo bar baz")
|
|
(erc-display-message nil nil (current-buffer) "+1")
|
|
(erc-display-message nil 'notice (current-buffer) "Spam")
|
|
(should-not erc-button-tests--form)
|
|
(goto-char (point-min))
|
|
(search-forward "+")
|
|
(should-not (get-text-property (point) 'erc-data))
|
|
(should-not (get-text-property (point) 'mouse-face))
|
|
(should-not (get-text-property (point) 'font-lock-face))
|
|
(should-not (get-text-property (point) 'erc-callback)))
|
|
|
|
(when noninteractive
|
|
(kill-buffer))))
|
|
|
|
(ert-deftest erc-button-alist--nil-form ()
|
|
(erc-button-tests--erc-button-alist--nil-form nil)
|
|
(erc-button-tests--erc-button-alist--nil-form 'erc-button-tests--some-var))
|
|
|
|
(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 erc-notice-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
|