goes for ERC's imenu integration, which has 'imenu' now appearing in
the default value of 'erc-modules'.
+*** Hidden messages contain a preceding rather than trailing newline.
+ERC has traditionally only offered to hide messages involving fools,
+but plans are to make hiding more powerful. Anyone depending on the
+existing behavior should be aware that hidden messages now start and
+end one character earlier, so that hidden line endings precede rather
+than follow accompanying text. However, an escape hatch is available
+in the variable 'erc-legacy-invisible-bounds-p'. It reinstates the
+old behavior, which is unsupported by newer modules and features.
+
*** 'erc-display-message' optionally combines faces.
Users may notice that ERC now inserts some important error messages in
a combination of 'erc-error-face' and 'erc-notice-face'. This is
;; Not sure if this is problematic because `erc-bol' takes no args.
"<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
-(defvar erc-match-mode)
(defvar erc-button-mode)
-(defvar erc-match--hide-fools-offset-bounds)
+(defvar erc-legacy-invisible-bounds-p)
(defun erc-fill--wrap-ensure-dependencies ()
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (when erc-legacy-invisible-bounds-p
+ (erc--warn-once-before-connect 'erc-fill-wrap-mode
+ "Module `fill-wrap' is incompatible with the obsolete compatibility"
+ " flag `erc-legacy-invisible-bounds-p'. Disabling locally in %s."
+ (current-buffer))
+ (setq-local erc-legacy-invisible-bounds-p nil)))
(let (missing-deps)
(unless erc-fill-mode
(push 'fill missing-deps)
(setq erc-fill--function #'erc-fill-wrap)
(add-function :after (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
- (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules))
- (require 'erc-match)
- (setq erc-match--hide-fools-offset-bounds t))
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
-(defvar-local erc-match--hide-fools-offset-bounds nil)
-
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide comments from designated fools."
(when (eq match-type 'fool)
- (erc-match--hide-message)))
-
-(defun erc-match--hide-message ()
- (progn ; FIXME raise sexp
- (if erc-match--hide-fools-offset-bounds
- (let ((beg (point-min))
- (end (point-max)))
- (save-restriction
- (widen)
- (erc--merge-prop (1- beg) (1- end) 'invisible 'erc-match)))
- ;; Before ERC 5.6, this also used to add an `intangible'
- ;; property, but the docs say it's now obsolete.
- (erc--merge-prop (point-min) (point-max) 'invisible 'erc-match))))
+ (erc--hide-message 'match-fools)))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
(defun erc-match--modify-invisibility-spec ()
"Add an `erc-match' property to the local spec."
+ ;; Hopefully, this will be extended to do the same for other
+ ;; invisible properties managed by this module.
(if erc-match-mode
- (add-to-invisibility-spec 'erc-match)
+ (erc-match-toggle-hidden-fools +1)
(erc-with-all-buffers-of-server nil nil
- (remove-from-invisibility-spec 'erc-match))))
+ (erc-match-toggle-hidden-fools -1))))
-(defun erc-match-toggle-hidden-fools ()
+(defun erc-match-toggle-hidden-fools (arg)
"Toggle fool visibility.
-Expect `erc-hide-fools' or a function that does something similar
-to be in `erc-text-matched-hook'."
- (interactive)
- (if (memq 'erc-match (ensure-list buffer-invisibility-spec))
- (remove-from-invisibility-spec 'erc-match)
- (add-to-invisibility-spec 'erc-match)))
+Expect the function `erc-hide-fools' or similar to be present in
+`erc-text-matched-hook'."
+ (interactive "P")
+ (erc-match--toggle-hidden 'match-fools arg))
+
+(defun erc-match--toggle-hidden (prop arg)
+ "Toggle invisibility for spec member PROP.
+Treat ARG in a manner similar to mode toggles defined by
+`define-minor-mode'."
+ (when arg
+ (setq arg (prefix-numeric-value arg)))
+ (if (memq prop (ensure-list buffer-invisibility-spec))
+ (unless (natnump arg)
+ (remove-from-invisibility-spec prop))
+ (when (or (not arg) (natnump arg))
+ (add-to-invisibility-spec prop))))
(provide 'erc-match)
(defvar erc--compose-text-properties nil
"Non-nil when `erc-put-text-property' defers to `erc--merge-prop'.")
+;; To save space, we could maintain a map of all readable property
+;; values and optionally dispense archetypal constants in their place
+;; in order to ensure all occurrences of some list (a b) across all
+;; text-properties in all ERC buffers are actually the same object.
(defun erc--merge-prop (from to prop val &optional object)
- "Compose existing PROP values with VAL between FROM and TO in OBJECT.
+ "Combine existing PROP values with VAL between FROM and TO in OBJECT.
For spans where PROP is non-nil, cons VAL onto the existing
value, ensuring a proper list. Otherwise, just set PROP to VAL.
-See also `erc-button-add-face'."
+When VAL is itself a list, prepend its members onto an existing
+value. See also `erc-button-add-face'."
(let ((old (get-text-property from prop object))
(pos from)
(end (next-single-property-change from prop object to))
new)
(while (< pos to)
- (setq new (if old (cons val (ensure-list old)) val))
+ (setq new (if old
+ (if (listp val)
+ (append val (ensure-list old))
+ (cons val (ensure-list old)))
+ val))
(put-text-property pos end prop new object)
(setq pos end
old (get-text-property pos prop object)
end (next-single-property-change pos prop object to)))))
+(defvar erc-legacy-invisible-bounds-p nil
+ "Whether to hide trailing rather than preceding newlines.
+Beginning in ERC 5.6, invisibility extends from a message's
+preceding newline to its last non-newline character.")
+(make-obsolete-variable 'erc-legacy-invisible-bounds-p
+ "decremented interval now permanent" "30.1")
+
+(defun erc--hide-message (value)
+ "Apply `invisible' text-property with VALUE to current message.
+Expect to run in a narrowed buffer during message insertion."
+ (if erc-legacy-invisible-bounds-p
+ ;; Before ERC 5.6, this also used to add an `intangible'
+ ;; property, but the docs say it's now obsolete.
+ (erc--merge-prop (point-min) (point-max) 'invisible value)
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (erc--merge-prop (1- beg) (1- end) 'invisible value)))))
+
(defun erc-display-message-highlight (type string)
"Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
'erc-current-nick-face))))))
;; When hacking on tests that use this fixture, it's best to run it
-;; interactively, and check for wierdness before and after doing
-;; M-: (remove-from-invisibility-spec 'erc-match) RET.
+;; interactively, and visually inspect the output with various
+;; combinations of:
+;;
+;; M-x erc-match-toggle-hidden-fools RET
+;; M-x erc-toggle-timestamps RET
+;;
(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep)
(unless noninteractive
- (kill-new "(remove-from-invisibility-spec 'erc-match)"))
+ (kill-new "erc-match-toggle-hidden-fools"))
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/legacy")
;; Leading stamp has combined `invisible' property value.
(should (equal (get-text-property (pos-bol) 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
- ;; Message proper has the `invisible' property `erc-match'.
+ ;; Message proper has the `invisible' property `match-fools'.
(let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
- (should (eq (get-text-property msg-beg 'invisible) 'erc-match))
+ (should (eq (get-text-property msg-beg 'invisible) 'match-fools))
(should (>= (next-single-property-change msg-beg 'invisible nil)
(pos-eol)))))
(= (next-single-property-change msg-beg 'invisible nil (pos-eol))
(pos-eol))))))))
+(defun erc-scenarios-match--find-bol ()
+ (save-excursion
+ (should (get-text-property (1- (point)) 'erc-command))
+ (goto-char (should (previous-single-property-change (point) 'erc-command)))
+ (pos-bol)))
+
(defun erc-scenarios-match--find-eol ()
(save-excursion
- (goto-char (next-single-property-change (point) 'erc-command))
+ (if-let ((next (next-single-property-change (point) 'erc-command)))
+ (goto-char next)
+ ;; We're already at the end of the message.
+ (should (get-text-property (1- (point)) 'erc-command)))
(pos-eol)))
;; In most cases, `erc-hide-fools' makes line endings invisible.
-(ert-deftest erc-scenarios-match--stamp-right-fools-invisible ()
+(defun erc-scenarios-match--stamp-right-fools-invisible ()
:tags '(:expensive-test)
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-right))
(erc-scenarios-match--invisible-stamp
(lambda ()
- (let ((end (erc-scenarios-match--find-eol)))
+ (let ((beg (erc-scenarios-match--find-bol))
+ (end (erc-scenarios-match--find-eol)))
;; The end of the message is a newline.
(should (= ?\n (char-after end)))
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- end) 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
;; The final newline is hidden by `match', not `stamps'
- (should (equal (get-text-property end 'invisible) 'erc-match))
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (if erc-legacy-invisible-bounds-p
+ (should (eq (get-text-property end 'invisible) 'match-fools))
+ (should (eq (get-text-property beg 'invisible) 'match-fools))
+ (should-not (get-text-property end 'invisible))))
- ;; The message proper has the `invisible' property `erc-match',
+ ;; The message proper has the `invisible' property `match-fools',
;; and it starts after the preceding newline.
- (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match))
+ (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
;; It ends just before the timestamp.
(let ((msg-end (next-single-property-change (pos-bol) 'invisible)))
(should (equal (get-text-property msg-end 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
;; Stamp's `invisible' property extends throughout the stamp
;; and ends before the trailing newline.
(should (eq (get-text-property inv-beg 'invisible)
'timestamp))))))))
+(ert-deftest erc-scenarios-match--stamp-right-fools-invisible ()
+ :tags '(:expensive-test)
+ (erc-scenarios-match--stamp-right-fools-invisible))
+
+(ert-deftest erc-scenarios-match--stamp-right-fools-invisible--nooffset ()
+ :tags '(:expensive-test)
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (should-not erc-legacy-invisible-bounds-p)
+ (let ((erc-legacy-invisible-bounds-p t))
+ (erc-scenarios-match--stamp-right-fools-invisible))))
+
;; This asserts that when `erc-fill-wrap-mode' is enabled, ERC hides
;; the preceding message's line ending.
(ert-deftest erc-scenarios-match--stamp-right-invisible-fill-wrap ()
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- (pos-eol)) 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
- ;; The message proper has the `invisible' property `erc-match',
+ ;; The message proper has the `invisible' property `match-fools',
;; which starts at the preceding newline...
- (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match))
+ (should (eq (get-text-property (1- (pos-bol)) 'invisible) 'match-fools))
;; ... and ends just before the timestamp.
(let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible)))
(should (equal (get-text-property msgend 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
;; The newline before `erc-insert-marker' is still visible.
(should-not (get-text-property (pos-eol) 'invisible))
(let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible)))
(should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))
-(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
- :tags '(:expensive-test)
+(defun erc-scenarios-match--stamp-both-invisible-fill-static ()
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
(search-forward "[23:59]"))))
(ert-info ("Line endings in Bob's messages are invisible")
- ;; The message proper has the `invisible' property `erc-match'.
- (should (eq (get-text-property (pos-bol) 'invisible) 'erc-match))
+ ;; The message proper has the `invisible' property `match-fools'.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
(let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
(mend (next-single-property-change mbeg 'erc-command)))
(should (= (next-single-property-change (pos-bol) 'erc-timestamp)
mend))
- ;; Line ending has the `invisible' property `erc-match'.
+ ;; Line ending has the `invisible' property `match-fools'.
(should (= (char-after mend) ?\n))
- (should (eq (get-text-property mend'invisible) 'erc-match))))
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (if erc-legacy-invisible-bounds-p
+ (should (eq (get-text-property mend 'invisible) 'match-fools))
+ (should (eq (get-text-property mbeg 'invisible) 'match-fools))
+ (should-not (get-text-property mend 'invisible))))))
;; Only the message right after Alice speaks contains stamps.
(when (= 1 bob-utterance-counter)
;; Date stamp has a combined `invisible' property value
;; that extends until the start of the message proper.
(should (equal (get-text-property (point) 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
(should (= (next-single-property-change (point) 'invisible)
(1+ (pos-eol))))))
(let ((msgend (next-single-property-change (pos-bol) 'invisible)))
;; Stamp has a combined `invisible' property value.
(should (equal (get-text-property msgend 'invisible)
- '(timestamp erc-match)))
+ '(timestamp match-fools)))
;; Combined `invisible' property spans entire timestamp.
(should (= (next-single-property-change msgend 'invisible)
(should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
(should-not (next-single-property-change (pos-bol) 'invisible))))))
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
+ :tags '(:expensive-test)
+ (erc-scenarios-match--stamp-both-invisible-fill-static))
+
+(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset ()
+ :tags '(:expensive-test)
+ (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+ (should-not erc-legacy-invisible-bounds-p)
+ (let ((erc-legacy-invisible-bounds-p t))
+ (erc-scenarios-match--stamp-both-invisible-fill-static))))
+
;;; erc-scenarios-match.el ends here
(should-not calls))))))
+(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
+ (buffer-substring 1 4) #("abc" 0 2 (erc-test x))))
+ (erc--merge-prop 1 3 'erc-test 'y)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 0 2 (erc-test (y x)))))
+
+ ;; Multiple intervals.
+ (goto-char (point-min))
+ (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
+ (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
+ (buffer-substring 1 4)
+ #("def" 0 1 (erc-test (z x)) 1 2 (erc-test (z y)))))
+
+ ;; New val as list.
+ (goto-char (point-min))
+ (insert "ghi\n")
+ (erc--merge-prop 2 3 'erc-test '(y z))
+ (should (erc-tests--equal-including-properties
+ (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
+ (buffer-substring 1 4)
+ #("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z)))))
+
+ (when noninteractive
+ (kill-buffer))))
+
(ert-deftest erc--split-string-shell-cmd ()
;; Leading and trailing space
(kill-buffer "ExampleNet")
(kill-buffer "#chan")))
-(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-format-privmessage ()
;; Basic PRIVMSG
(should (erc-tests--equal-including-properties
projects / emacs.git / commitdiff