summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorF. Jason Park <jp@neverwas.me>2023-12-28 20:20:55 -0800
committerF. Jason Park <jp@neverwas.me>2023-12-31 06:56:32 -0800
commit4939f4139391c13c34387ac0c05a5c7db39bf9d5 (patch)
treef05e0de4a8c38816f55a6a21b029c36c452f17f4
parent2534a4737f711e12318fdc50af8d608a81414ebf (diff)
downloademacs-4939f4139391c13c34387ac0c05a5c7db39bf9d5.tar.gz
Use advertised PREFIX when formatting nicks in ERC
* lisp/erc/erc-speedbar.el (erc-speedbar-insert-user): Run `erc-get-channel-membership-prefix' in associated buffer if possible. * lisp/erc/erc.el (erc-get-channel-membership-prefix): Use known prefix mappings when determining status chars. * test/lisp/erc/erc-tests.el (erc--parsed-prefix): Use common helpers for initializing buffers, and use a more realistic example for PREFIX value. (erc--update-channel-modes): Add current buffer to `erc-server-user' object to maintain essential invariant, even though this doesn't affect the test's outcome. (erc-tests--equal-including-properties): Move to `erc-tests-common' and rename `erc-tests-common-equal-with-props'. (erc--merge-prop, erc--remove-from-prop-value-list, erc--remove-from-prop-value-list/many): Use new name for `erc-tests-common-equal-with-props'. (erc-get-channel-membership-prefix): New test. (erc--determine-speaker-message-format-args, erc--determine-speaker-message-format-args/queries-as-channel, erc--determine-speaker-message-format-args/queries): Use new name for `erc-tests-common-equal-with-props'. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-equal-with-props): New macro, originally `erc-tests--equal-including-properties' from erc-tests.el. (erc-tests-common-make-server-buf): Initialize tables and make NAME argument optional. (Bug#67677)
-rw-r--r--lisp/erc/erc-speedbar.el4
-rw-r--r--lisp/erc/erc.el64
-rw-r--r--test/lisp/erc/erc-tests.el179
-rw-r--r--test/lisp/erc/resources/erc-tests-common.el16
4 files changed, 179 insertions, 84 deletions
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index 91806f47e01..6207da49ecc 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -319,7 +319,9 @@ a list of four items: the userhost, the GECOS, the current
(info (erc-server-user-info user))
(login (erc-server-user-login user))
(name (erc-server-user-full-name user))
- (nick-str (concat (erc-get-channel-membership-prefix cuser) nick))
+ (nick-str (concat (with-current-buffer (or buffer (current-buffer))
+ (erc-get-channel-membership-prefix cuser))
+ nick))
(finger (concat login (when (or login host) "@") host))
(sbtoken (list finger name info (buffer-name buffer))))
(if (or login host name info) ; we want to be expandable
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index b4937c23f5b..5b3d0d66941 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6130,27 +6130,53 @@ returned name, see `erc-show-speaker-membership-status'."
(define-obsolete-function-alias 'erc-get-user-mode-prefix
#'erc-get-channel-membership-prefix "30.1")
-(defun erc-get-channel-membership-prefix (user)
- "Return channel membership prefix for USER as a string.
+(defun erc-get-channel-membership-prefix (nick-or-cusr)
+ "Return channel membership prefix for NICK-OR-CUSR as a string.
Ensure returned string has a `help-echo' text property with the
corresponding verbose membership type, like \"voice\", as its
-value. Expect USER to be an `erc-channel-user' object or a
-string nickname, not necessarily downcased."
- (when user
- (when (stringp user)
- (setq user (and erc-channel-users (cdr (erc-get-channel-user user)))))
- (cond ((null user) "")
- ((erc-channel-user-owner user)
- (propertize "~" 'help-echo "owner"))
- ((erc-channel-user-admin user)
- (propertize "&" 'help-echo "admin"))
- ((erc-channel-user-op user)
- (propertize "@" 'help-echo "operator"))
- ((erc-channel-user-halfop user)
- (propertize "%" 'help-echo "half-op"))
- ((erc-channel-user-voice user)
- (propertize "+" 'help-echo "voice"))
- (t ""))))
+value. Expect NICK-OR-CUSR to be an `erc-channel-user' object or
+a string nickname, not necessarily downcased. When called in a
+logically connected ERC buffer, use advertised prefix mappings.
+For compatibility reasons, don't error when NICK-OR-CUSR is null,
+but return nil instead of the empty string. Otherwise, always
+return a possibly empty string."
+ (when nick-or-cusr
+ (when (stringp nick-or-cusr)
+ (setq nick-or-cusr (and erc-channel-members
+ (cdr (erc-get-channel-member nick-or-cusr)))))
+ (cond
+ ((null nick-or-cusr) "")
+ ;; Special-case most common value.
+ ((zerop (erc-channel-user-status nick-or-cusr)) "")
+ ;; For compatibility, first check whether a parsed prefix exists.
+ ((and-let* ((pfx-obj (erc--parsed-prefix)))
+ (catch 'done
+ (pcase-dolist (`(,letter . ,pfx)
+ (erc--parsed-prefix-alist pfx-obj))
+ (pcase letter
+ ((and ?q (guard (erc-channel-user-owner nick-or-cusr)))
+ (throw 'done (propertize (string pfx) 'help-echo "owner")))
+ ((and ?a (guard (erc-channel-user-admin nick-or-cusr)))
+ (throw 'done (propertize (string pfx) 'help-echo "admin")))
+ ((and ?o (guard (erc-channel-user-op nick-or-cusr)))
+ (throw 'done (propertize (string pfx) 'help-echo "operator")))
+ ((and ?h (guard (erc-channel-user-halfop nick-or-cusr)))
+ (throw 'done (propertize (string pfx) 'help-echo "half-op")))
+ ((and ?v (guard (erc-channel-user-voice nick-or-cusr)))
+ (throw 'done (propertize (string pfx) 'help-echo "voice")))))
+ "")))
+ (t
+ (cond ((erc-channel-user-owner nick-or-cusr)
+ (propertize "~" 'help-echo "owner"))
+ ((erc-channel-user-admin nick-or-cusr)
+ (propertize "&" 'help-echo "admin"))
+ ((erc-channel-user-op nick-or-cusr)
+ (propertize "@" 'help-echo "operator"))
+ ((erc-channel-user-halfop nick-or-cusr)
+ (propertize "%" 'help-echo "half-op"))
+ ((erc-channel-user-voice nick-or-cusr)
+ (propertize "+" 'help-echo "voice"))
+ (t ""))))))
(defun erc-format-@nick (&optional user channel-data)
"Format the nickname of USER showing if USER has a voice, is an
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 2d6eda6a24c..bf93379b117 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -667,9 +667,7 @@
(should-not (erc--parse-nuh "abc\nde!fg@xy")))
(ert-deftest erc--parsed-prefix ()
- (erc-mode)
- (erc-tests-common-init-server-proc "sleep" "1")
- (setq erc--isupport-params (make-hash-table))
+ (erc-tests-common-make-server-buf (buffer-name))
;; Uses fallback values when no PREFIX parameter yet received, thus
;; ensuring caller can use slot accessors immediately instead of
@@ -683,11 +681,10 @@
(should (eq (erc--parsed-prefix) cached)))
;; Cache broken. (Notice not setting `erc--parsed-prefix' to nil).
- (setq erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+")))
+ (setq erc-server-parameters '(("PREFIX" . "(ov)@+")))
(let ((proc erc-server-process)
- (expected '((?Y . ?!) (?q . ?~) (?a . ?&)
- (?o . ?@) (?h . ?%) (?v . ?+)))
+ (expected '((?o . ?@) (?v . ?+)))
cached)
(with-temp-buffer
@@ -699,9 +696,8 @@
(should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix)))
(setq cached erc--parsed-prefix)
(should (equal cached
- #s(erc--parsed-prefix ("(Yqaohv)!~&@%+") "Yqaohv" "!~&@%+"
- ((?Y . ?!) (?q . ?~) (?a . ?&)
- (?o . ?@) (?h . ?%) (?v . ?+)))))
+ #s(erc--parsed-prefix ("(ov)@+") "ov" "@+"
+ ((?o . ?@) (?v . ?+)))))
;; Second target buffer reuses cached value.
(with-temp-buffer
(erc-mode)
@@ -709,14 +705,14 @@
(should (eq cached (erc--parsed-prefix))))
;; New value computed when cache broken.
- (puthash 'PREFIX (list "(Yqaohv)!~&@%+") erc--isupport-params)
+ (puthash 'PREFIX (list "(qh)~%") erc--isupport-params)
(with-temp-buffer
(erc-mode)
(setq erc-server-process proc)
(should-not (eq cached (erc--parsed-prefix)))
(should (equal (erc--parsed-prefix-alist
(erc-with-server-buffer erc--parsed-prefix))
- expected)))))
+ '((?q . ?~) (?h . ?%)))))))
;; This exists as a reference to assert legacy behavior in order to
;; preserve and incorporate it as a fallback in the 5.6+ replacement.
@@ -760,7 +756,9 @@
(ert-info ("Status updated when user known")
(puthash "bob" (cons (erc-add-server-user
- "bob" (make-erc-server-user :nickname "bob"))
+ "bob" (make-erc-server-user
+ :nickname "bob"
+ :buffers (list (current-buffer))))
(make-erc-channel-user))
erc-channel-users)
;; Also asserts fallback behavior for traditional prefixes.
@@ -1852,21 +1850,15 @@
(let ((v '(42 y)))
(should-not (erc--check-msg-prop 'b v)))))
-(defmacro erc-tests--equal-including-properties (a b)
- (list (if (< emacs-major-version 29)
- 'ert-equal-including-properties
- 'equal-including-properties)
- a b))
-
(ert-deftest erc--merge-prop ()
(with-current-buffer (get-buffer-create "*erc-test*")
;; Baseline.
(insert "abc\n")
(erc--merge-prop 1 3 'erc-test 'x)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("abc" 0 2 (erc-test x))))
(erc--merge-prop 1 3 'erc-test 'y)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("abc" 0 2 (erc-test (y x)))))
;; Multiple intervals.
@@ -1874,11 +1866,11 @@
(insert "def\n")
(erc--merge-prop 1 2 'erc-test 'x)
(erc--merge-prop 2 3 'erc-test 'y)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4)
#("def" 0 1 (erc-test x) 1 2 (erc-test y))))
(erc--merge-prop 1 3 'erc-test 'z)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4)
#("def" 0 1 (erc-test (z x)) 1 2 (erc-test (z y)))))
@@ -1886,10 +1878,10 @@
(goto-char (point-min))
(insert "ghi\n")
(erc--merge-prop 2 3 'erc-test '(y z))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("ghi" 1 2 (erc-test (y z)))))
(erc--merge-prop 1 3 'erc-test '(w x))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4)
#("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z)))))
@@ -1897,11 +1889,11 @@
(goto-char (point-min))
(insert "jkl\n")
(erc--merge-prop 2 3 'erc-test '(y z))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("jkl" 1 2 (erc-test (y z)))))
(let ((erc--merge-prop-behind-p t))
(erc--merge-prop 1 3 'erc-test '(w x)))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4)
#("jkl" 0 1 (erc-test (w x)) 1 2 (erc-test (y z w x)))))
@@ -1915,22 +1907,22 @@
(put-text-property 1 2 'erc-test 'a)
(put-text-property 2 3 'erc-test 'b)
(put-text-property 3 4 'erc-test 'c)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("abc"
0 1 (erc-test a)
1 2 (erc-test b)
2 3 (erc-test c))))
(erc--remove-from-prop-value-list 1 4 'erc-test 'b)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("abc"
0 1 (erc-test a)
2 3 (erc-test c))))
(erc--remove-from-prop-value-list 1 4 'erc-test 'a)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
(erc--remove-from-prop-value-list 1 4 'erc-test 'c)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) "abc"))
;; List match.
@@ -1939,20 +1931,20 @@
(put-text-property 1 2 'erc-test '(d x))
(put-text-property 2 3 'erc-test '(e y))
(put-text-property 3 4 'erc-test '(f z))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("def"
0 1 (erc-test (d x))
1 2 (erc-test (e y))
2 3 (erc-test (f z)))))
(erc--remove-from-prop-value-list 1 4 'erc-test 'y)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("def"
0 1 (erc-test (d x))
1 2 (erc-test e)
2 3 (erc-test (f z)))))
(erc--remove-from-prop-value-list 1 4 'erc-test 'd)
(erc--remove-from-prop-value-list 1 4 'erc-test 'f)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("def"
0 1 (erc-test x)
1 2 (erc-test e)
@@ -1960,7 +1952,7 @@
(erc--remove-from-prop-value-list 1 4 'erc-test 'e)
(erc--remove-from-prop-value-list 1 4 'erc-test 'z)
(erc--remove-from-prop-value-list 1 4 'erc-test 'x)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) "def"))
;; List match.
@@ -1969,20 +1961,20 @@
(put-text-property 1 2 'erc-test '(g x))
(put-text-property 2 3 'erc-test '(h x))
(put-text-property 3 4 'erc-test '(i y))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("ghi"
0 1 (erc-test (g x))
1 2 (erc-test (h x))
2 3 (erc-test (i y)))))
(erc--remove-from-prop-value-list 1 4 'erc-test 'x)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("ghi"
0 1 (erc-test g)
1 2 (erc-test h)
2 3 (erc-test (i y)))))
(erc--remove-from-prop-value-list 1 2 'erc-test 'g) ; narrowed
(erc--remove-from-prop-value-list 3 4 'erc-test 'i) ; narrowed
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("ghi"
1 2 (erc-test h)
2 3 (erc-test y))))
@@ -1994,7 +1986,7 @@
(put-text-property 2 3 'erc-test '(k))
(put-text-property 3 4 'erc-test '(k))
(erc--remove-from-prop-value-list 1 4 'erc-test 'k)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("jkl" 0 1 (erc-test (j x)))))
(when noninteractive
@@ -2007,20 +1999,20 @@
(put-text-property 1 2 'erc-test 'a)
(put-text-property 2 3 'erc-test 'b)
(put-text-property 3 4 'erc-test 'c)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("abc"
0 1 (erc-test a)
1 2 (erc-test b)
2 3 (erc-test c))))
(erc--remove-from-prop-value-list 1 4 'erc-test '(a b))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
(erc--remove-from-prop-value-list 1 4 'erc-test 'a)
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
(erc--remove-from-prop-value-list 1 4 'erc-test '(c))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) "abc"))
;; List match.
@@ -2029,19 +2021,19 @@
(put-text-property 1 2 'erc-test '(d x y))
(put-text-property 2 3 'erc-test '(e y))
(put-text-property 3 4 'erc-test '(f z))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("def"
0 1 (erc-test (d x y))
1 2 (erc-test (e y))
2 3 (erc-test (f z)))))
(erc--remove-from-prop-value-list 1 4 'erc-test '(d y f))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("def"
0 1 (erc-test x)
1 2 (erc-test e)
2 3 (erc-test z))))
(erc--remove-from-prop-value-list 1 4 'erc-test '(e z x))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) "def"))
;; Narrowed beg.
@@ -2050,13 +2042,13 @@
(put-text-property 1 2 'erc-test '(g x))
(put-text-property 2 3 'erc-test '(h x))
(put-text-property 3 4 'erc-test '(i x))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("ghi"
0 1 (erc-test (g x))
1 2 (erc-test (h x))
2 3 (erc-test (i x)))))
(erc--remove-from-prop-value-list 1 3 'erc-test '(x g i))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("ghi"
1 2 (erc-test h)
2 3 (erc-test (i x)))))
@@ -2068,7 +2060,7 @@
(put-text-property 2 3 'erc-test '(k))
(put-text-property 3 4 'erc-test '(l y z))
(erc--remove-from-prop-value-list 3 4 'erc-test '(k x y z))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(buffer-substring 1 4) #("jkl"
0 1 (erc-test (j x))
1 2 (erc-test (k))
@@ -2296,6 +2288,67 @@
(kill-buffer "ExampleNet")
(kill-buffer "#chan")))
+(ert-deftest erc-get-channel-membership-prefix ()
+ (ert-info ("Uses default prefixes when `erc--parsed-prefix' not available")
+ (should-not (erc--parsed-prefix))
+ ;; Baseline.
+ (should-not (erc-get-channel-membership-prefix nil))
+ (should (equal (erc-get-channel-membership-prefix "Bob") ""))
+ (should (equal (erc-get-channel-membership-prefix (make-erc-channel-user))
+ ""))
+ ;; Defaults.
+ (should
+ (erc-tests-common-equal-with-props
+ (erc-get-channel-membership-prefix (make-erc-channel-user :owner t))
+ #("~" 0 1 (help-echo "owner"))))
+ (should
+ (erc-tests-common-equal-with-props
+ (erc-get-channel-membership-prefix (make-erc-channel-user :admin t))
+ #("&" 0 1 (help-echo "admin"))))
+ (should
+ (erc-tests-common-equal-with-props
+ (erc-get-channel-membership-prefix (make-erc-channel-user :op t))
+ #("@" 0 1 (help-echo "operator"))))
+ (should
+ (erc-tests-common-equal-with-props
+ (erc-get-channel-membership-prefix (make-erc-channel-user :halfop t))
+ #("%" 0 1 (help-echo "half-op"))))
+ (should
+ (erc-tests-common-equal-with-props
+ (erc-get-channel-membership-prefix (make-erc-channel-user :voice t))
+ #("+" 0 1 (help-echo "voice")))))
+
+ (ert-info ("Uses advertised prefixes when `erc--parsed-prefix' is available")
+ (erc-tests-common-make-server-buf (buffer-name))
+ (push '("PREFIX" . "(ov)@+") erc-server-parameters)
+ (should (erc--parsed-prefix))
+
+ (with-current-buffer (erc--open-target "#chan")
+ (erc-update-current-channel-member "Bob" nil t nil nil 'on)
+
+ ;; Baseline.
+ (should-not (erc-get-channel-membership-prefix nil))
+ (should (string-empty-p (erc-get-channel-membership-prefix
+ (make-erc-channel-user))))
+
+ ;; Defaults.
+ (should (string-empty-p (erc-get-channel-membership-prefix
+ (make-erc-channel-user :owner t))))
+ (should (string-empty-p (erc-get-channel-membership-prefix
+ (make-erc-channel-user :admin t))))
+ (should (string-empty-p (erc-get-channel-membership-prefix
+ (make-erc-channel-user :halfop t))))
+
+ (should (erc-tests-common-equal-with-props
+ (erc-get-channel-membership-prefix "Bob")
+ #("@" 0 1 (help-echo "operator"))))
+ (should (erc-tests-common-equal-with-props
+ (erc-get-channel-membership-prefix
+ (make-erc-channel-user :voice t))
+ #("+" 0 1 (help-echo "voice"))))
+
+ (kill-buffer))))
+
;; This is an adapter that uses formatting templates from the
;; `-speaker' catalog to mimic `erc-format-privmessage', for testing
;; purposes.
@@ -2315,10 +2368,10 @@
1 4 (erc--speaker "bob" font-lock-face erc-nick-default-face)
4 11 (font-lock-face erc-default-face)))
(args (list (concat "bob") (concat "oh my") nil 'msgp)))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(apply #'erc-format-privmessage args)
expect))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(apply #'erc-tests--format-privmessage args)
expect)))
@@ -2328,10 +2381,10 @@
1 4 (erc--speaker "bob" font-lock-face erc-nick-default-face)
4 11 (font-lock-face erc-default-face)))
(args (list (copy-sequence "bob") (copy-sequence "oh my") nil nil)))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(apply #'erc-format-privmessage args)
expect))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(apply #'erc-tests--format-privmessage args)
expect)))
@@ -2348,17 +2401,17 @@
(puthash "bob" (cons user cuser) erc-channel-users)
(with-suppressed-warnings ((obsolete erc-format-@nick))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(erc-format-privmessage (erc-format-@nick user cuser)
(copy-sequence "oh my")
nil 'msgp)
expect)))
(let ((nick "Bob")
(msg "oh my"))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(erc-tests--format-privmessage nick msg nil 'msgp nil cuser)
expect)) ; overloaded on PREFIX arg
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
(erc-tests--format-privmessage nick msg nil 'msgp nil t)
expect))
;; The new version makes a copy instead of adding properties to
@@ -2377,7 +2430,7 @@
(insert "PRIVMSG\n"
(erc-tests--format-privmessage "bob" "oh my" 'queryp 'msgp))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
#("<bob> oh my"
0 1 (font-lock-face erc-default-face)
1 4 (erc--speaker "bob" font-lock-face erc-nick-default-face)
@@ -2386,7 +2439,7 @@
(insert "\nNOTICE\n"
(erc-tests--format-privmessage "bob" "oh my" 'queryp nil))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
#("-bob- oh my"
0 1 (font-lock-face erc-default-face)
1 4 (erc--speaker "bob" font-lock-face erc-nick-default-face)
@@ -2396,7 +2449,7 @@
(insert "\nInput PRIVMSG\n"
(erc-tests--format-privmessage "bob" "oh my"
'queryp 'privmsgp 'inputp))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
#("<bob> oh my"
0 1 (font-lock-face erc-default-face)
1 4 (erc--speaker "bob" font-lock-face erc-my-nick-face)
@@ -2406,7 +2459,7 @@
(insert "\nInput NOTICE\n"
(erc-tests--format-privmessage "bob" "oh my" 'queryp nil 'inputp))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
#("-bob- oh my"
0 1 (font-lock-face erc-default-face)
1 4 (erc--speaker "bob" font-lock-face erc-my-nick-face)
@@ -2426,7 +2479,7 @@
(insert "PRIVMSG\n"
(erc-tests--format-privmessage "bob" "oh my" 'queryp 'msgp))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
#("*bob* oh my"
0 1 (font-lock-face erc-direct-msg-face)
1 4 (erc--speaker "bob" font-lock-face erc-nick-msg-face)
@@ -2435,7 +2488,7 @@
(insert "\nNOTICE\n"
(erc-tests--format-privmessage "bob" "oh my" 'queryp nil))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
#("-bob- oh my"
0 1 (font-lock-face erc-direct-msg-face)
1 4 (erc--speaker "bob" font-lock-face erc-nick-msg-face)
@@ -2445,7 +2498,7 @@
(insert "\nInput PRIVMSG\n"
(erc-tests--format-privmessage "bob" "oh my"
'queryp 'privmsgp 'inputp))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
#("*bob* oh my"
0 1 (font-lock-face erc-direct-msg-face)
1 4 (erc--speaker "bob" font-lock-face erc-my-nick-face)
@@ -2455,7 +2508,7 @@
(insert "\nInput NOTICE\n"
(erc-tests--format-privmessage "bob" "oh my" 'queryp nil 'inputp))
- (should (erc-tests--equal-including-properties
+ (should (erc-tests-common-equal-with-props
#("-bob- oh my"
0 1 (font-lock-face erc-direct-msg-face)
1 4 (erc--speaker "bob" font-lock-face erc-my-nick-face)
diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el
index 9d9cc4294bb..20b3a56facc 100644
--- a/test/lisp/erc/resources/erc-tests-common.el
+++ b/test/lisp/erc/resources/erc-tests-common.el
@@ -40,6 +40,15 @@
(require 'ert-x)
(require 'erc)
+
+(defmacro erc-tests-common-equal-with-props (a b)
+ "Compare strings A and B for equality including text props.
+Use `ert-equal-including-properties' on older Emacsen."
+ (list (if (< emacs-major-version 29)
+ 'ert-equal-including-properties
+ 'equal-including-properties)
+ a b))
+
;; Caller should probably shadow `erc-insert-modify-hook' or populate
;; user tables for erc-button.
;; FIXME explain this comment ^ in more detail or delete.
@@ -98,14 +107,19 @@ recently passed to the mocked `erc-process-input-line'. Make
(funcall test-fn (lambda () (pop calls)))))
(when noninteractive (kill-buffer))))
-(defun erc-tests-common-make-server-buf (name)
+(defun erc-tests-common-make-server-buf (&optional name)
"Return a server buffer named NAME, creating it if necessary.
Use NAME for the network and the session server as well."
+ (unless name
+ (cl-assert (string-prefix-p " *temp*" (setq name (buffer-name)))))
(with-current-buffer (get-buffer-create name)
(erc-tests-common-prep-for-insertion)
(erc-tests-common-init-server-proc "sleep" "1")
(setq erc-session-server (concat "irc." name ".org")
erc-server-announced-name (concat "west." name ".org")
+ erc-server-users (make-hash-table :test #'equal)
+ erc-server-parameters nil
+ erc--isupport-params (make-hash-table)
erc-session-port 6667
erc-network (intern name)
erc-networks--id (erc-networks--id-create nil))