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.
In the rare instance the stamps module isn't loaded, the new
`erc-command' property can be used for this purpose 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.)

diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index d1a1507f700b2fec0455dcc9d6bd6c227f8734c6..ce6e558aa4fe633dcc7bb89a81ed1c536775e8ae 100644 (file)
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -166,7 +166,7 @@ from entering them and instead jump over them."
 
 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
@@ -178,12 +178,12 @@ or `erc-send-modify-hook'."
                 (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.
@@ -404,11 +404,16 @@ enabled when the message was inserted."
 
 (defun erc-echo-timestamp (dir stamp)
   "Print timestamp text-property of an IRC message."
-  (when (and erc-echo-timestamps (eq 'entered dir))
+  ;; Could also pass an &optional `zone' arg to `format-time-string'.
+  (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 (file)
index 0000000..935b9e6
--- /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 <https://www.gnu.org/licenses/>.
+
+;;; 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