;;; erc-stamp-tests.el --- Tests for erc-stamp.  -*- lexical-binding:t -*-

;; Copyright (C) 2023-2025 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 'erc-stamp)
(require 'erc-goodies) ; for `erc-make-read-only'

(require 'ert-x)
(eval-and-compile
  (let ((load-path (cons (ert-resource-directory) load-path)))
    (require 'erc-tests-common)))

;; 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-stamp--manage-local-options-state)
      (erc--initialize-markers (point) nil)
      (erc-tests-common-init-server-proc "sleep" "1")

      (funcall test)

      (when noninteractive
        (kill-buffer)))

    (advice-remove 'erc-format-timestamp
                   'ert-deftest--erc-timestamp-use-align-to)))

(defun erc-stamp-tests--use-align-to--nil (compat)
  (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 includes leading whitespace.
       (should (eql (if compat ?\[ ?\n)
                    (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--nil ()
  (ert-info ("Field starts on stamp text (compat)")
    (let ((erc-stamp--omit-properties-on-folded-lines t))
      (erc-stamp-tests--use-align-to--nil 'compat)))
  (ert-info ("Field includes leaidng white space")
    (erc-stamp-tests--use-align-to--nil nil)))

(defun erc-stamp-tests--use-align-to--t (compat)
  (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 includes leading space.
       (should (eql (if compat ?\[ ?\n) (char-after (field-beginning (point)))))
       (should (eql ?\n (char-after (field-end (point)))))))))

(ert-deftest erc-timestamp-use-align-to--t ()
  (ert-info ("Field starts on stamp text (compat)")
    (let ((erc-stamp--omit-properties-on-folded-lines t))
      (erc-stamp-tests--use-align-to--t 'compat)))
  (ert-info ("Field includes leaidng white space")
    (erc-stamp-tests--use-align-to--t nil)))

(ert-deftest erc-timestamp-use-align-to--integer ()
  (erc-stamp-tests--insert-right
   (lambda ()

     (ert-info ("integer, normal")
       (let ((erc-timestamp-use-align-to 1))
         (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
           (erc-display-message nil nil (current-buffer) msg)))
       (goto-char (point-min))
       ;; Space not added because included in format string.
       (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 ("integer, overlong (hard wrap)")
       (let ((erc-timestamp-use-align-to 1)
             (erc-timestamp-right-column 20))
         (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
           (erc-display-message nil nil (current-buffer) msg)))
       ;; No hard wrap
       (should (search-forward "oooo [" nil t))
       ;; Field starts at leading space.
       (should (eql ?\s (char-after (field-beginning (point)))))
       (should (eql ?\n (char-after (field-end (point)))))))))

(ert-deftest erc-stamp--display-margin-mode--right ()
  (erc-stamp-tests--insert-right
   (lambda ()
     (erc-stamp--display-margin-mode +1)

     (ert-info ("margin, normal")
       (let ((erc-timestamp-use-align-to 'margin))
         (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
           (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
           (erc-display-message nil nil (current-buffer) msg)))
       (goto-char (point-min))
       ;; Leading space added as part of the stamp's field.
       (should (search-forward "msg one [" nil t))
       ;; Field covers stamp and space.
       (should (eql ?e (char-before (field-beginning (point)))))
       ;; Vanity props extended.
       (should (get-text-property (field-beginning (point)) 'wrap-prefix))
       (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
       (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
       (should (eql ?\n (char-after (field-end (point))))))

     (ert-info ("margin, overlong (hard wrap)")
       (let ((erc-timestamp-use-align-to 'margin)
             (erc-timestamp-right-column 20))
         (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
           (erc-display-message nil nil (current-buffer) msg)))
       ;; No hard wrap.
       (should (search-forward "oooo [" nil t))
       ;; Field starts at managed space before format string.
       (should (eql ?\s (char-after (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-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))

    (erc-mode)
    (erc-tests-common-init-server-proc "true")
    (with-current-buffer (get-buffer-create "*erc-timestamp-intangible*")
      (erc-mode)
      (erc--initialize-markers (point) nil)
      (erc-stamp--manage-local-options-state)
      (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)))))

(ert-deftest erc-echo-timestamp ()
  :tags (and (null (getenv "CI")) '(:unstable))

  (should-not erc-echo-timestamps)
  (should-not erc-stamp--last-stamp)
  (insert (propertize "a" 'erc--ts 433483200 'erc--msg 'msg) "bc")
  (goto-char (point-min))
  (let ((inhibit-message t)
        (erc-echo-timestamp-format "%Y-%m-%d %H:%M:%S %Z")
        (erc-echo-timestamp-zone (list (* 60 60 -4) "EDT")))

    ;; No-op when non-interactive and option is nil
    (should-not (erc--echo-ts-csf nil nil 'entered))
    (should-not erc-stamp--last-stamp)

    ;; Non-interactive (cursor sensor function)
    (let ((erc-echo-timestamps t))
      (should (equal (erc--echo-ts-csf nil nil 'entered)
                     "1983-09-27 00:00:00 EDT")))
    (should (= 433483200 erc-stamp--last-stamp))

    ;; Interactive
    (should (equal (call-interactively #'erc-echo-timestamp)
                   "1983-09-27 00:00:00 EDT"))
    ;; Interactive with zone
    (let ((current-prefix-arg '(4)))
      (should (member (call-interactively #'erc-echo-timestamp)
                      '("1983-09-27 04:00:00 GMT"
                        "1983-09-27 04:00:00 UTC"))))
    (let ((current-prefix-arg -7))
      (should (equal (call-interactively #'erc-echo-timestamp)
                     "1983-09-26 21:00:00 -07")))))

(defun erc-stamp-tests--assert-get-inserted-msg/stamp (test-fn)
  (let ((erc-insert-modify-hook erc-insert-modify-hook)
        (erc-insert-timestamp-function 'erc-insert-timestamp-right)
        (erc-timestamp-use-align-to 0)
        (erc-timestamp-format "[00:00]"))
    (cl-pushnew 'erc-add-timestamp erc-insert-modify-hook)
    (erc-tests-common-get-inserted-msg-setup))
  (goto-char 19)
  (should (looking-back (rx "<bob> hi [00:00]")))
  (erc-tests-common-assert-get-inserted-msg 3 19 test-fn))

(ert-deftest erc--get-inserted-msg-beg/stamp ()
  (erc-stamp-tests--assert-get-inserted-msg/stamp
   (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))

(ert-deftest erc--get-inserted-msg-beg/readonly/stamp ()
  (erc-tests-common-assert-get-inserted-msg-readonly-with
   #'erc-stamp-tests--assert-get-inserted-msg/stamp
   (lambda (arg) (should (= 3 (erc--get-inserted-msg-beg arg))))))

(ert-deftest erc--get-inserted-msg-end/stamp ()
  (erc-stamp-tests--assert-get-inserted-msg/stamp
   (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg))))))

(ert-deftest erc--get-inserted-msg-end/readonly/stamp ()
  (erc-tests-common-assert-get-inserted-msg-readonly-with
   #'erc-stamp-tests--assert-get-inserted-msg/stamp
   (lambda (arg) (should (= 19 (erc--get-inserted-msg-end arg))))))

(ert-deftest erc--get-inserted-msg-bounds/stamp ()
  (erc-stamp-tests--assert-get-inserted-msg/stamp
   (lambda (arg)
     (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg))))))

(ert-deftest erc--get-inserted-msg-bounds/readonly/stamp ()
  (erc-tests-common-assert-get-inserted-msg-readonly-with
   #'erc-stamp-tests--assert-get-inserted-msg/stamp
   (lambda (arg)
     (should (equal '(3 . 19) (erc--get-inserted-msg-bounds arg))))))

(ert-deftest erc-stamp--dedupe-date-stamps-from-target-buffer ()
  (unless (>= emacs-major-version 29)
    (ert-skip "Requires hz-ticks lisp time format"))
  (let ((erc-modules erc-modules)
        (erc-stamp--tz t))
    (erc-tests-common-make-server-buf)
    (erc-stamp-mode +1)

    ;; Create two buffers with an overlapping date stamp.
    (with-current-buffer (erc--open-target "#chan@old")
      (let ((erc-stamp--current-time '(1690761600001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer)
                                          "2023-07-31T00:00:00.001Z"))
      (let ((erc-stamp--current-time '(1690761601001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer) "0.0"))

      (let ((erc-stamp--current-time '(1690848000001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer)
                                          "2023-08-01T00:00:00.001Z"))
      (let ((erc-stamp--current-time '(1690848001001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer) "1.0"))
      (let ((erc-stamp--current-time '(1690848060001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer) "1.1"))

      (let ((erc-stamp--current-time '(1690934400001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer)
                                          "2023-08-02T00:00:00.001Z"))
      (let ((erc-stamp--current-time '(1690934401001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer) "2.0"))
      (let ((erc-stamp--current-time '(1690956000001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer) "2.6")))

    (with-current-buffer (erc--open-target "#chan@new")
      (let ((erc-stamp--current-time '(1690956001001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer)
                                          "2023-08-02T06:00:01.001Z"))
      (let ((erc-stamp--current-time '(1690963200001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer) "2.8"))

      (let ((erc-stamp--current-time '(1691020800001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer)
                                          "2023-08-03T00:00:00.001Z"))
      (let ((erc-stamp--current-time '(1691020801001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer) "3.0"))
      (let ((erc-stamp--current-time '(1691053200001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer) "3.9"))

      (let ((erc-stamp--current-time '(1691107200001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer)
                                          "2023-08-04T00:00:00.001Z"))
      (let ((erc-stamp--current-time '(1691107201001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer) "4.0"))
      (let ((erc-stamp--current-time '(1691110800001 . 1000)))
        (erc-tests-common-display-message nil 'notice (current-buffer) "4.1")))

    (erc-stamp--dedupe-date-stamps-from-target-buffer
     #'erc-networks--transplant-buffer-content
     (get-buffer "#chan@old")
     (get-buffer "#chan@new"))

    ;; Ensure the "model", `erc-stamp--date-stamps', matches reality
    ;; in the buffer's contents.
    (with-current-buffer "#chan@new"
      (let ((stamps erc-stamp--date-stamps))
        (goto-char 3)
        (should (looking-at (rx "\n[Mon Jul 31 2023]")))
        (should (= (erc--get-inserted-msg-beg (point))
                   (erc-stamp--date-marker (pop stamps))))
        (goto-char (1+ (match-end 0)))
        (should (looking-at (rx "*** 2023-07-31T00:00:00.001Z")))
        (forward-line 1)
        (should (looking-at (rx "*** 0.0")))
        (forward-line 1)

        (should (looking-at (rx "\n[Tue Aug  1 2023]")))
        (should (= (erc--get-inserted-msg-beg (point))
                   (erc-stamp--date-marker (pop stamps))))
        (goto-char (1+ (match-end 0)))
        (should (looking-at (rx "*** 2023-08-01T00:00:00.001Z")))
        (forward-line 1)
        (should (looking-at (rx "*** 1.0")))
        (forward-line 1)
        (should (looking-at (rx "*** 1.1")))
        (forward-line 1)

        (should (looking-at (rx "\n[Wed Aug  2 2023]")))
        (should (= (erc--get-inserted-msg-beg (point))
                   (erc-stamp--date-marker (pop stamps))))
        (goto-char (1+ (match-end 0)))
        (should (looking-at (rx "*** 2023-08-02T00:00:00.001Z")))
        (forward-line 1)
        (should (looking-at (rx "*** 2.0")))
        (forward-line 1)
        (should (looking-at (rx "*** 2.6")))
        (forward-line 1)
        (should (looking-at
                 (rx "*** Grafting buffer `#chan@new' onto `#chan@old'")))
        (forward-line 1)
        (should (looking-at (rx "*** 2023-08-02T06:00:01.001Z")))
        (forward-line 1)
        (should (looking-at (rx "*** 2.8")))
        (forward-line 1)

        (should (looking-at (rx "\n[Thu Aug  3 2023]")))
        (should (= (erc--get-inserted-msg-beg (point))
                   (erc-stamp--date-marker (pop stamps))))
        (goto-char (1+ (match-end 0)))
        (should (looking-at (rx "*** 2023-08-03T00:00:00.001Z")))
        (forward-line 3) ; ...

        (should (looking-at (rx "\n[Fri Aug  4 2023]")))
        (should (= (erc--get-inserted-msg-beg (point))
                   (erc-stamp--date-marker (pop stamps))))
        (should-not stamps))))

  (when noninteractive
    (erc-tests-common-kill-buffers)))

;;; erc-stamp-tests.el ends here