>From fcc63e5d4ff4c5d3db48e15caee8b11680da9748 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 24 Nov 2021 03:10:20 -0800 Subject: [PATCH 3/8] [5.6] Expose insertion time as text prop in erc-stamp * lisp/erc/erc-stamp.el (erc-add-timestamp): Add new text property `erc-timestamp' to store lisp time object formerly ensconced in a closure. Instead of creating a new lambda for the cursor-sensor function of each message in a buffer, leave a gap between messages to trip the sensor function. The motivation behind this change is to allow third parties access to valuable timestamp data already stored by ERC anyway. Of secondary importance is discouraging the reliance on those lambdas as a means of detecting message bounds. The gap now serves a similar purpose. Basically, the final character in a message, a newline, will not have a timestamp or a sensor function. When the stamps module isn't loaded, the `erc-message' property can be used instead. Also, instead of looking for the `invisible' text property at point, which is normally `point-max' and thus outside the accessible portion of the buffer, look at the beginning of the inserted message. This allows hook members running before this function to opt out of timestamps by marking a message as invisible. (erc-echo-timestamp): Make interactive and show timestamps even when the variable `erc-echo-timestamps' is nil. (erc--echo-ts-csf): Add new function to serve as value of cursor-sensor function text properties. * test/lisp/erc/erc-stamp-tests.el: New file. (Bug#60936.) --- lisp/erc/erc-stamp.el | 14 ++- test/lisp/erc/erc-stamp-tests.el | 207 +++++++++++++++++++++++++++++++ 2 files changed, 216 insertions(+), 5 deletions(-) create mode 100644 test/lisp/erc/erc-stamp-tests.el diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 0aa1590f801..08cdc1c8518 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -162,7 +162,7 @@ erc-add-timestamp This function is meant to be called from `erc-insert-modify-hook' or `erc-send-modify-hook'." - (unless (get-text-property (point) 'invisible) + (unless (get-text-property (point-min) 'invisible) (let ((ct (current-time))) (if (fboundp erc-insert-timestamp-function) (funcall erc-insert-timestamp-function @@ -174,12 +174,12 @@ erc-add-timestamp (not erc-timestamp-format)) (funcall erc-insert-away-timestamp-function (erc-format-timestamp ct erc-away-timestamp-format))) - (add-text-properties (point-min) (point-max) + (add-text-properties (point-min) (1- (point-max)) ;; It's important for the function to ;; be different on different entries (bug#22700). (list 'cursor-sensor-functions - (list (lambda (_window _before dir) - (erc-echo-timestamp dir ct)))))))) + ;; Regions are no longer contiguous ^ + '(erc--echo-ts-csf) 'erc-timestamp ct))))) (defvar-local erc-timestamp-last-window-width nil "The width of the last window that showed the current buffer. @@ -400,11 +400,15 @@ erc-toggle-timestamps (defun erc-echo-timestamp (dir stamp) "Print timestamp text-property of an IRC message." - (when (and erc-echo-timestamps (eq 'entered dir)) + (interactive (list 'entered (get-text-property (point) 'erc-timestamp))) + (when (eq 'entered dir) (when stamp (message "%s" (format-time-string erc-echo-timestamp-format stamp))))) +(defun erc--echo-ts-csf (_window _before dir) + (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp))) + (provide 'erc-stamp) ;;; erc-stamp.el ends here diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el new file mode 100644 index 00000000000..935b9e650b3 --- /dev/null +++ b/test/lisp/erc/erc-stamp-tests.el @@ -0,0 +1,207 @@ +;;; erc-stamp-tests.el --- Tests for erc-stamp. -*- 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 . + +;;; Commentary: + +;;; Code: +(require 'ert-x) +(require 'erc-stamp) +(require 'erc-goodies) ; for `erc-make-read-only' + +;; These display-oriented tests are brittle because many factors +;; influence how text properties are applied. We should just +;; rework these into full scenarios. + +(defun erc-stamp-tests--insert-right (test) + (let ((val (list 0 0)) + (erc-insert-modify-hook '(erc-add-timestamp)) + (erc-insert-post-hook '(erc-make-read-only)) ; see comment above + (erc-timestamp-only-if-changed-flag nil) + ;; + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + + (advice-add 'erc-format-timestamp :filter-args + (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args))) + '((name . ert-deftest--erc-timestamp-use-align-to))) + + (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*") + (erc-mode) + (erc-munge-invisibility-spec) + (setq erc-server-process (start-process "p" (current-buffer) + "sleep" "1") + erc-input-marker (make-marker) + erc-insert-marker (make-marker)) + (set-process-query-on-exit-flag erc-server-process nil) + (set-marker erc-insert-marker (point-max)) + (erc-display-prompt) + + (funcall test) + + (when noninteractive + (kill-buffer))) + + (advice-remove 'erc-format-timestamp + 'ert-deftest--erc-timestamp-use-align-to))) + +(ert-deftest erc-timestamp-use-align-to--nil () + (erc-stamp-tests--insert-right + (lambda () + + (ert-info ("nil, normal") + (let ((erc-timestamp-use-align-to nil)) + (erc-display-message nil 'notice (current-buffer) "begin")) + (goto-char (point-min)) + (should (search-forward-regexp + (rx "begin" (+ "\t") (* " ") " [") nil t)) + ;; Field includes intervening spaces + (should (eql ?n (char-before (field-beginning (point))))) + ;; Timestamp extends to the end of the line + (should (eql ?\n (char-after (field-end (point)))))) + + ;; The option `erc-timestamp-right-column' is normally nil by + ;; default, but it's a convenient stand in for a sufficiently + ;; small `erc-fill-column' (we can force a line break without + ;; involving that module). + (should-not erc-timestamp-right-column) + + (ert-info ("nil, overlong (hard wrap)") + (let ((erc-timestamp-use-align-to nil) + (erc-timestamp-right-column 20)) + (erc-display-message nil 'notice (current-buffer) + "twenty characters")) + (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t)) + ;; Field excludes leading whitespace (arguably undesirable). + (should (eql ?\s (char-after (field-beginning (point))))) + ;; Timestamp extends to the end of the line. + (should (eql ?\n (char-after (field-end (point))))))))) + +(ert-deftest erc-timestamp-use-align-to--t () + (erc-stamp-tests--insert-right + (lambda () + + (ert-info ("t, normal") + (let ((erc-timestamp-use-align-to t)) + (let ((msg (erc-format-privmessage "bob" "msg one" nil t))) + (erc-display-message nil nil (current-buffer) msg))) + (goto-char (point-min)) + ;; Exactly two spaces, one from format, one added by erc-stamp. + (should (search-forward "msg one [" nil t)) + ;; Field covers space between. + (should (eql ?e (char-before (field-beginning (point))))) + (should (eql ?\n (char-after (field-end (point)))))) + + (ert-info ("t, overlong (hard wrap)") + (let ((erc-timestamp-use-align-to t) + (erc-timestamp-right-column 20)) + (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t))) + (erc-display-message nil nil (current-buffer) msg))) + ;; Indented to pos (this is arguably a bug). + (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t)) + ;; Field starts *after* leading space (arguably bad). + (should (eql ?\[ (char-after (1+ (field-beginning (point)))))) + (should (eql ?\n (char-after (field-end (point))))))))) + +;; This concerns a proposed partial reversal of the changes resulting +;; from: +;; +;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706) +;; +;; Perhaps core behavior has changed since this bug was reported, but +;; C-e stopping one char short of EOL no longer seems a problem. +;; However, invoking C-n (`next-line') exhibits a similar effect. +;; When point is in a stamp or near the beginning of a line, issuing a +;; C-n puts point one past the start of the message (i.e., two chars +;; beyond the timestamp's closing "]". Dropping the invisible +;; property when timestamps are hidden does indeed prevent this, but +;; it's also a lasting commitment. The docs mention that it's +;; pointless to pair the old `intangible' property with `invisible' +;; and suggest users look at `cursor-intangible-mode'. Turning off +;; the latter does indeed do the trick as does decrementing the end of +;; the `cursor-intangible' interval so that, in addition to C-n +;; working, a C-f from before the timestamp doesn't overshoot. This +;; appears to be the case whether `erc-hide-timestamps' is enabled or +;; not, but it may be inadvisable for some reason (a hack) and +;; therefore warrants further investigation. +;; +;; Note some striking omissions here: +;; +;; 1. a lack of `fill' module integration (we simulate it by +;; making lines short enough to not wrap) +;; 2. functions like `line-move' behave differently when +;; `noninteractive' +;; 3. no actual test assertions involving `cursor-sensor' movement +;; even though that's a huge ingredient + +(ert-deftest erc-timestamp-intangible--left () + (let ((erc-timestamp-only-if-changed-flag nil) + (erc-timestamp-intangible t) ; default changed to nil in 2014 + (erc-hide-timestamps t) + (erc-insert-timestamp-function 'erc-insert-timestamp-left) + (erc-server-process (start-process "true" (current-buffer) "true")) + (erc-insert-modify-hook '(erc-make-read-only erc-add-timestamp)) + msg + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (should (not cursor-sensor-inhibit)) + (set-process-query-on-exit-flag erc-server-process nil) + (erc-mode) + (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*") + (erc-mode) + (erc--initialize-markers (point) nil) + (erc-munge-invisibility-spec) + (erc-display-message nil 'notice (current-buffer) "Welcome") + ;; + ;; Pretend `fill' is active and that these lines are + ;; folded. Otherwise, there's an annoying issue on wrapped lines + ;; (when visual-line-mode is off and stamps are visible) where + ;; C-e sends you to the end of the previous line. + (setq msg "Lorem ipsum dolor sit amet") + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage "alyssa" msg nil t)) + (erc-display-message nil 'notice (current-buffer) "Home") + (goto-char (point-min)) + + ;; EOL is actually EOL (Bug#11706) + + (ert-info ("Notice before stamp, C-e") ; first line/stamp + (should (search-forward "Welcome" nil t)) + (ert-simulate-command '(erc-bol)) + (should (looking-at (rx "["))) + (let ((end (pos-eol))) ; `line-end-position' fails because fields + (ert-simulate-command '(move-end-of-line 1)) + (should (= end (point))))) + + (ert-info ("Privmsg before stamp, C-e") + (should (search-forward "Lorem" nil t)) + (goto-char (pos-bol)) + (should (looking-at (rx "["))) + (let ((end (pos-eol))) + (ert-simulate-command '(move-end-of-line 1)) + (should (= end (point))))) + + (ert-info ("Privmsg first line, C-e") + (goto-char (pos-bol)) + (should (search-forward "ipsum" nil t)) + (let ((end (pos-eol))) + (ert-simulate-command '(move-end-of-line 1)) + (should (= end (point))))) + + (when noninteractive + (kill-buffer))))) + +;;; erc-stamp-tests.el ends here -- 2.39.1