Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Respect existing invisibility props in erc-stamp

Browse source 
* etc/ERC-NEWS: mention `erc-match-toggle-hidden-fools' and new
merging behavior when handling `invisible' text property.
* lisp/erc/erc-match.el (erc-hide-fools): change `invisible' property
to `erc-match' for all messages, not just those with offset bounds.
(erc-match--modify-invisibility-spec): Fix error in doc string.
(erc-match-toggle-hidden-fools): New command.
* lisp/erc/erc-stamp.el (erc-stamp--invisible-property): Add new
internal variable to hold existing `invisible' property merged with
the one registered by this module, the non-namespaced `timestamp'.
(erc-stamp--skip-when-invisible): Add new internal variable, an escape
hatch for pre-ERC-5.6 behavior in which timestamps were not applied at
all to invisible messages.  This led to strange-looking, uneven logs,
and it prevented other modules from offering toggle functionality for
invisibility-spec members registered to them.
(erc-add-timestamp): Merge with existing `invisible' property, when
present, instead of clobbering, but only when escape hatch
`erc-stamp--skip-when-invisible' is nil.
(erc-insert-timestamp-left, erc-format-timestamp): Use possibly merged
`invisible' prop value.  Don't bother with `isearch-open-invisible',
which only affects overlays.
(erc-insert-timestamp-right): Bind `buffer-invisibility-spec' to nil
when figuring `current-column'.  Apply `invisible' text prop to white
space around stamp.
* test/lisp/erc/erc-scenarios-match.el: Require `erc-fill' and
`erc-stamp'.
(erc-scenarios-match--invisible-stamp): Move common setup and core
assertions for some stamp and invisibility-related tests into a
fixture-like helper.
(erc-scenarios-match--stamp-left-fools-invisible): Fix temporarily
disabled test and use fixture.
(erc-scenarios-match--find-eol): New helper.
(erc-scenarios-match--stamp-right-fools-invisible,
erc-scenarios-match--stamp-right-invisible-fill-wrap,
erc-scenarios-match--stamp-both-invisible-fill-static): New tests.
(Bug#64301)
This commit is contained in:
F. Jason Park 2023-07-02 20:58:37 -07:00
parent 96785a8037
commit 4d6ed774fe
4 changed files with 272 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
etc/ERC-NEWS
View file

@ -160,11 +160,12 @@ the same effect by issuing a "/CLEAR" at the prompt.
Some minor quality-of-life niceties have finally made their way to
ERC. For example, the function 'erc-echo-timestamp' is now
interactive and can be invoked on any message to view its timestamp in
the echo area. The command 'erc-button-previous' now moves to the
beginning instead of the end of buttons. A new command, 'erc-news',
can now be invoked to visit this very file. And the 'irccontrols'
module now supports additional colors and special handling for
"spoilers" (hidden text).
the echo area. Fool visibility has become togglable with the new
command 'erc-match-toggle-hidden-fools'. The 'button' module's
'erc-button-previous' now moves to the beginning instead of the end of
buttons. A new command, 'erc-news', can be invoked to visit this very
file. And the 'irccontrols' module now supports additional colors and
special handling for "spoilers" (hidden text).
** Changes in the library API.
@ -213,6 +214,9 @@ traversing messages. To compensate, a new property, 'erc-timestamp',
now spans message bodies but not the newlines delimiting them.
Somewhat relatedly, the function 'erc-insert-aligned' has been
deprecated and removed from the primary client code path.
Additionally, the 'stamp' module now merges its 'invisible' property
with existing ones, when present, and it includes all white space
around stamps when doing so.
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library

18
lisp/erc/erc-match.el
View file

@ -669,10 +669,9 @@ This function should be called from `erc-text-matched-hook'."
(save-restriction
(widen)
(put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
;; The docs say `intangible' is deprecated, but this has been
;; like this for ages. Should verify unneeded and remove if so.
(erc-put-text-properties (point-min) (point-max)
'(invisible intangible)))))
;; Before ERC 5.6, this also used to add an `intangible'
;; property, but the docs say it's now obsolete.
(put-text-property (point-min) (point-max) 'invisible 'erc-match))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@ -681,12 +680,21 @@ This function is meant to be called from `erc-text-matched-hook'."
(beep)))
(defun erc-match--modify-invisibility-spec ()
"Add an ellipsis property to the local spec."
"Add an `erc-match' property to the local spec."
(if erc-match-mode
(add-to-invisibility-spec 'erc-match)
(erc-with-all-buffers-of-server nil nil
(remove-from-invisibility-spec 'erc-match))))
(defun erc-match-toggle-hidden-fools ()
"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)))
(provide 'erc-match)
;;; erc-match.el ends here

21
lisp/erc/erc-stamp.el
View file

@ -179,6 +179,12 @@ from entering them and instead jump over them."
(kill-local-variable 'erc-timestamp-last-inserted-left)
(kill-local-variable 'erc-timestamp-last-inserted-right))))
(defvar erc-stamp--invisible-property nil
"Existing `invisible' property value and/or symbol `timestamp'.")
(defvar erc-stamp--skip-when-invisible nil
"Escape hatch for omitting stamps when first char is invisible.")
(defun erc-stamp--recover-on-reconnect ()
(when-let ((priors (or erc--server-reconnecting erc--target-priors)))
(dolist (var '(erc-timestamp-last-inserted
@ -209,8 +215,11 @@ or `erc-send-modify-hook'."
(progn ; remove this `progn' on next major refactor
(let* ((ct (erc-stamp--current-time))
(invisible (get-text-property (point-min) 'invisible))
(erc-stamp--invisible-property
;; FIXME on major version bump, make this `erc-' prefixed.
(if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp))
(erc-stamp--current-time ct))
(unless invisible
(unless (setq invisible (and erc-stamp--skip-when-invisible invisible))
(funcall erc-insert-timestamp-function
(erc-format-timestamp ct erc-timestamp-format)))
;; FIXME this will error when advice has been applied.
@ -380,7 +389,7 @@ message text so that stamps will be visible when yanked."
(s (if ignore-p (make-string len ? ) string)))
(unless ignore-p (setq erc-timestamp-last-inserted string))
(erc-put-text-property 0 len 'field 'erc-timestamp s)
(erc-put-text-property 0 len 'invisible 'timestamp s)
(erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s)
(insert s)))
(defun erc-insert-aligned (string pos)
@ -428,6 +437,7 @@ printed just after each line's text (no alignment)."
(goto-char (point-max))
(forward-char -1) ; before the last newline
(let* ((str-width (string-width string))
(buffer-invisibility-spec nil) ; `current-column' > 0
window ; used in computation of `pos' only
(pos (cond
(erc-timestamp-right-column erc-timestamp-right-column)
@ -477,6 +487,8 @@ printed just after each line's text (no alignment)."
(put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(erc-put-text-property from (point) 'invisible
erc-stamp--invisible-property)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
@ -520,9 +532,8 @@ Return the empty string if FORMAT is nil."
(let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
(erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
(erc-put-text-property 0 (length ts)
'isearch-open-invisible 'timestamp ts)
(erc-put-text-property 0 (length ts) 'invisible
erc-stamp--invisible-property ts)
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible

257
test/lisp/erc/erc-scenarios-match.el
View file

@ -24,8 +24,12 @@
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-scenarios-common)))
(eval-when-compile
(require 'erc-join)
(require 'erc-match))
(require 'erc-stamp)
(require 'erc-match)
(require 'erc-fill)
;; This defends against a regression in which all matching by the
;; `erc-match-message' fails when `erc-add-timestamp' precedes it in
@ -57,28 +61,23 @@
(should (eq (get-text-property (1- (point)) 'font-lock-face)
'erc-current-nick-face))))))
;; This asserts that when stamps appear before a message,
;; some non-nil invisibility property spans the entire message.
(ert-deftest erc-scenarios-match--stamp-left-fools-invisible ()
:tags '(:expensive-test)
(ert-skip "WIP: fix included in bug#64301")
;; 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.
(defun erc-scenarios-match--invisible-stamp (hiddenp visiblep)
(unless noninteractive
(kill-new "(remove-from-invisibility-spec 'erc-match)"))
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "join/legacy")
(dumb-server (erc-d-run "localhost" t 'foonet))
(port (process-contact dumb-server :service))
(erc-server-flood-penalty 0.1)
(erc-insert-timestamp-function 'erc-insert-timestamp-left)
(erc-timestamp-only-if-changed-flag nil)
(erc-fools '("bob"))
(erc-text-matched-hook '(erc-hide-fools))
(erc-autojoin-channels-alist '((FooNet "#chan")))
(expect (erc-d-t-make-expecter))
(hiddenp (lambda ()
(and (eq (field-at-pos (pos-bol)) 'erc-timestamp)
(get-text-property (pos-bol) 'invisible)
(>= (next-single-property-change (pos-bol)
'invisible nil)
(pos-eol))))))
(expect (erc-d-t-make-expecter)))
(ert-info ("Connect")
(with-current-buffer (erc :server "127.0.0.1"
@ -94,30 +93,242 @@
(ert-info ("Ensure lines featuring \"bob\" are invisible")
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(should (funcall expect 10 "<bob> tester, welcome!"))
(should (funcall hiddenp))
(ert-info ("<bob> tester, welcome!") (funcall hiddenp))
;; Alice's is the only one visible.
(should (funcall expect 10 "<alice> tester, welcome!"))
(should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
(should (get-text-property (pos-bol) 'invisible))
(should-not (get-text-property (point) 'invisible))
(ert-info ("<alice> tester, welcome!") (funcall visiblep))
(should (funcall expect 10 "<bob> alice: But, as it seems"))
(should (funcall hiddenp))
(ert-info ("<bob> alice: But, as it seems") (funcall hiddenp))
(should (funcall expect 10 "<alice> bob: Well, this is the forest"))
(should (funcall hiddenp))
(ert-info ("<alice> bob: Well, this is the forest") (funcall hiddenp))
(should (funcall expect 10 "<alice> bob: And will you"))
(should (funcall hiddenp))
(ert-info ("<alice> bob: And will you") (funcall hiddenp))
(should (funcall expect 10 "<bob> alice: Live, and be prosperous"))
(should (funcall hiddenp))
(ert-info ("<bob> alice: Live, and be prosperous") (funcall hiddenp))
(should (funcall expect 10 "ERC>"))
(should-not (get-text-property (pos-bol) 'invisible))
(should-not (get-text-property (point) 'invisible))))))
(eval-when-compile (require 'erc-join))
;; This asserts that when stamps appear before a message, registered
;; invisibility properties owned by modules span the entire message.
(ert-deftest erc-scenarios-match--stamp-left-fools-invisible ()
:tags '(:expensive-test)
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-left))
(erc-scenarios-match--invisible-stamp
(lambda ()
;; This is a time-stamped message.
(should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
;; Leading stamp has combined `invisible' property value.
(should (equal (get-text-property (pos-bol) 'invisible)
'(timestamp erc-match)))
;; Message proper has the `invisible' property `erc-match'.
(let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
(should (eq (get-text-property msg-beg 'invisible) 'erc-match))
(should (>= (next-single-property-change msg-beg 'invisible nil)
(pos-eol)))))
(lambda ()
;; This is a time-stamped message.
(should (eq (field-at-pos (pos-bol)) 'erc-timestamp))
(should (get-text-property (pos-bol) 'invisible))
;; The entire message proper is visible.
(let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
(should
(= (next-single-property-change msg-beg 'invisible nil (pos-eol))
(pos-eol))))))))
(defun erc-scenarios-match--find-eol ()
(save-excursion
(goto-char (next-single-property-change (point) 'erc-command))
(pos-eol)))
;; In most cases, `erc-hide-fools' makes line endings invisible.
(ert-deftest 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)))
;; The end of the message is a newline.
(should (= ?\n (char-after end)))
;; Every message has a trailing time stamp.
(should (eq (field-at-pos (1- end)) 'erc-timestamp))
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- end) 'invisible)
'(timestamp erc-match)))
;; The final newline is hidden by `match', not `stamps'
(should (equal (get-text-property end 'invisible) 'erc-match))
;; The message proper has the `invisible' property `erc-match',
;; and it starts after the preceding newline.
(should (eq (get-text-property (pos-bol) 'invisible) 'erc-match))
;; 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)))
;; Stamp's `invisible' property extends throughout the stamp
;; and ends before the trailing newline.
(should (= (next-single-property-change msg-end 'invisible) end)))))
(lambda ()
(let ((end (erc-scenarios-match--find-eol)))
;; This message has a time stamp like all the others.
(should (eq (field-at-pos (1- end)) 'erc-timestamp))
;; The entire message proper is visible.
(should-not (get-text-property (pos-bol) 'invisible))
(let ((inv-beg (next-single-property-change (pos-bol) 'invisible)))
(should (eq (get-text-property inv-beg 'invisible)
'timestamp))))))))
;; 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 ()
:tags '(:expensive-test)
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-right)
(erc-fill-function #'erc-fill-wrap))
(erc-scenarios-match--invisible-stamp
(lambda ()
;; Every message has a trailing time stamp.
(should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
;; Stamps appear in the right margin.
(should (equal (car (get-text-property (1- (pos-eol)) 'display))
'(margin right-margin)))
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- (pos-eol)) 'invisible)
'(timestamp erc-match)))
;; The message proper has the `invisible' property `erc-match',
;; which starts at the preceding newline...
(should (eq (get-text-property (1- (pos-bol)) 'invisible) 'erc-match))
;; ... 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)))
;; The newline before `erc-insert-marker' is still visible.
(should-not (get-text-property (pos-eol) 'invisible))
(should (= (next-single-property-change msgend 'invisible)
(pos-eol)))))
(lambda ()
;; This message has a time stamp like all the others.
(should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
;; Unlike hidden messages, the preceding newline is visible.
(should-not (get-text-property (1- (pos-bol)) 'invisible))
;; The entire message proper is visible.
(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)
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
;; Rewind the clock to known date artificially.
(let ((erc-stamp--current-time 704591940)
(erc-stamp--tz t)
(erc-fill-function #'erc-fill-static)
(bob-utterance-counter 0))
(erc-scenarios-match--invisible-stamp
(lambda ()
(ert-info ("Baseline check")
;; False date printed initially before anyone speaks.
(when (zerop bob-utterance-counter)
(save-excursion
(goto-char (point-min))
(search-forward "[Wed Apr 29 1992]")
(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))
(let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
(mend (next-single-property-change mbeg 'erc-command)))
(if (/= 1 bob-utterance-counter)
(should-not (field-at-pos mend))
;; For Bob's stamped message, check newline after stamp.
(should (eq (field-at-pos mend) 'erc-timestamp))
(setq mend (field-end mend)))
;; The `erc-timestamp' property spans entire messages,
;; including stamps and filled text, which makes for
;; convenient traversal when `erc-stamp-mode' is enabled.
(should (get-text-property (pos-bol) 'erc-timestamp))
(should (= (next-single-property-change (pos-bol) 'erc-timestamp)
mend))
;; Line ending has the `invisible' property `erc-match'.
(should (= (char-after mend) ?\n))
(should (eq (get-text-property mend'invisible) 'erc-match))))
;; Only the message right after Alice speaks contains stamps.
(when (= 1 bob-utterance-counter)
(ert-info ("Date stamp occupying previous line is invisible")
(save-excursion
(forward-line -1)
(goto-char (pos-bol))
(should (looking-at (rx "[Mon May 4 1992]")))
;; 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)))
(should (= (next-single-property-change (point) 'invisible)
(1+ (pos-eol))))))
(ert-info ("Folding preserved despite invisibility")
;; Message has a trailing time stamp, but it's been folded
;; over to the next line.
(should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
(save-excursion
(forward-line)
(should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)))
;; Stamp invisibility starts where message's ends.
(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)))
;; Combined `invisible' property spans entire timestamp.
(should (= (next-single-property-change msgend 'invisible)
(save-excursion (forward-line) (pos-eol)))))))
(cl-incf bob-utterance-counter))
;; Alice.
(lambda ()
;; Set clock ahead a week or so.
(setq erc-stamp--current-time 704962800)
;; This message has no time stamp and is completely visible.
(should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
(should-not (next-single-property-change (pos-bol) 'invisible))))))
;;; erc-scenarios-match.el ends here