From 15f2e73c4022edc1d5ba0ad9c2dea69bbabe3a97 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 19 Oct 2023 06:20:30 -0700 Subject: [PATCH 0/4] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (4): ; Mark erc-log test as :unstable [5.6] Restore missing metadata props in erc-display-line [5.6] Fix right stamps commingling with erc-prompt [5.6] Respect user markers in erc--insert-timestamp-left etc/ERC-NEWS | 23 +++ lisp/erc/erc-fill.el | 3 +- lisp/erc/erc-stamp.el | 20 ++- lisp/erc/erc.el | 146 +++++++++++------- test/lisp/erc/erc-fill-tests.el | 57 +++---- test/lisp/erc/erc-networks-tests.el | 2 +- .../lisp/erc/erc-scenarios-display-message.el | 64 ++++++++ test/lisp/erc/erc-scenarios-log.el | 2 +- test/lisp/erc/erc-scenarios-stamp.el | 90 +++++++++++ test/lisp/erc/erc-tests.el | 63 ++++++++ .../base/display-message/multibuf.eld | 45 ++++++ .../resources/base/renick/queries/solo.eld | 2 +- .../base/reuse-buffers/channel/barnet.eld | 2 +- .../base/reuse-buffers/channel/foonet.eld | 2 +- .../erc/resources/erc-scenarios-common.el | 4 +- .../fill/snapshots/merge-01-start.eld | 2 +- .../fill/snapshots/merge-02-right.eld | 2 +- .../fill/snapshots/merge-wrap-01.eld | 2 +- .../fill/snapshots/monospace-01-start.eld | 2 +- .../fill/snapshots/monospace-02-right.eld | 2 +- .../fill/snapshots/monospace-03-left.eld | 2 +- .../fill/snapshots/monospace-04-reset.eld | 2 +- .../fill/snapshots/spacing-01-mono.eld | 2 +- .../fill/snapshots/stamps-left-01.eld | 2 +- 24 files changed, 437 insertions(+), 106 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-display-message.el create mode 100644 test/lisp/erc/erc-scenarios-stamp.el create mode 100644 test/lisp/erc/resources/base/display-message/multibuf.eld Interdiff: diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 57fd7f39e50..b515513dcb7 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -492,8 +492,11 @@ erc--conceal-prompt (put-text-property erc-insert-marker (1- erc-input-marker) 'display `((margin left-margin) ,prompt)))) -(cl-defmethod erc-insert-timestamp-left (string) +(defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." + (erc--insert-timestamp-left string)) + +(cl-defmethod erc--insert-timestamp-left (string) (goto-char (point-min)) (let* ((ignore-p (and erc-timestamp-only-if-changed-flag (string-equal string erc-timestamp-last-inserted))) @@ -504,13 +507,12 @@ erc-insert-timestamp-left (erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s) (insert s))) -(cl-defmethod erc-insert-timestamp-left +(cl-defmethod erc--insert-timestamp-left (string &context (erc-stamp--display-margin-mode (eql t))) (unless (and erc-timestamp-only-if-changed-flag (string-equal string erc-timestamp-last-inserted)) (goto-char (point-min)) - (insert-before-markers-and-inherit - (setq erc-timestamp-last-inserted string)) + (insert-and-inherit (setq erc-timestamp-last-inserted string)) (dolist (p erc-stamp--inherited-props) (when-let ((v (get-text-property (point) p))) (put-text-property (point-min) (point) p v))) @@ -704,10 +706,12 @@ erc-insert-timestamp-left-and-right (unless erc-stamp--date-format-end (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t) (add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t) - (let ((erc--insert-marker (point-min-marker))) + (let ((erc--insert-marker (point-min-marker)) + (end-marker (point-max-marker))) (set-marker-insertion-type erc--insert-marker t) (erc-stamp--lr-date-on-pre-modify nil) - (narrow-to-region erc--insert-marker (point-max)) + (narrow-to-region erc--insert-marker end-marker) + (set-marker end-marker nil) (set-marker erc--insert-marker nil))) (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time))) (ts-right (with-suppressed-warnings diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index f6c4c268017..80f5fd22ac6 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -203,36 +203,39 @@ erc-fill-wrap--monospace (unless (>= emacs-major-version 29) (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'")) - (erc-fill-tests--wrap-populate - - (lambda () - (should (= erc-fill--wrap-value 27)) - (erc-fill-tests--wrap-check-prefixes "*** " " " " ") - (erc-fill-tests--compare "monospace-01-start") - - (ert-info ("Shift right by one (plus)") - ;; Args are all `erc-fill-wrap-nudge' +1 because interactive "p" - (ert-with-message-capture messages - ;; M-x erc-fill-wrap-nudge RET = - (ert-simulate-command '(erc-fill-wrap-nudge 2)) - (should (string-match (rx "for further adjustment") messages))) - (should (= erc-fill--wrap-value 29)) - (erc-fill-tests--wrap-check-prefixes "*** " " " " ") - (erc-fill-tests--compare "monospace-02-right")) - - (ert-info ("Shift left by five") - ;; "M-x erc-fill-wrap-nudge RET -----" - (ert-simulate-command '(erc-fill-wrap-nudge -4)) - (should (= erc-fill--wrap-value 25)) - (erc-fill-tests--wrap-check-prefixes "*** " " " " ") - (erc-fill-tests--compare "monospace-03-left")) + (let ((erc-prompt (lambda () "ABC>"))) + (erc-fill-tests--wrap-populate - (ert-info ("Reset") - ;; M-x erc-fill-wrap-nudge RET 0 - (ert-simulate-command '(erc-fill-wrap-nudge 0)) + (lambda () (should (= erc-fill--wrap-value 27)) (erc-fill-tests--wrap-check-prefixes "*** " " " " ") - (erc-fill-tests--compare "monospace-04-reset"))))) + (erc-fill-tests--compare "monospace-01-start") + + (ert-info ("Shift right by one (plus)") + ;; Args are all `erc-fill-wrap-nudge' +1 because interactive "p" + (ert-with-message-capture messages + ;; M-x erc-fill-wrap-nudge RET = + (ert-simulate-command '(erc-fill-wrap-nudge 2)) + (should (string-match (rx "for further adjustment") messages))) + (should (= erc-fill--wrap-value 29)) + (erc-fill-tests--wrap-check-prefixes "*** " " " " ") + (erc-fill-tests--compare "monospace-02-right")) + + (ert-info ("Shift left by five") + ;; "M-x erc-fill-wrap-nudge RET -----" + (ert-simulate-command '(erc-fill-wrap-nudge -4)) + (should (= erc-fill--wrap-value 25)) + (erc-fill-tests--wrap-check-prefixes "*** " " " " ") + (erc-fill-tests--compare "monospace-03-left")) + + (ert-info ("Reset") + ;; M-x erc-fill-wrap-nudge RET 0 + (ert-simulate-command '(erc-fill-wrap-nudge 0)) + (should (= erc-fill--wrap-value 27)) + (erc-fill-tests--wrap-check-prefixes "*** " " " " ") + (erc-fill-tests--compare "monospace-04-reset")) + + (erc--assert-input-bounds))))) (defun erc-fill-tests--simulate-refill () ;; Simulate `erc-fill-wrap-refill-buffer' synchronously and without diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el new file mode 100644 index 00000000000..d6b5d868ce5 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-stamp.el @@ -0,0 +1,90 @@ +;;; erc-scenarios-stamp.el --- Misc `erc-stamp' scenarios -*- 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 . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-stamp) + +(defvar erc-scenarios-stamp--user-marker nil) + +(defun erc-scenarios-stamp--on-post-modify () + (when-let (((erc--check-msg-prop 'erc-cmd 4))) + (set-marker erc-scenarios-stamp--user-marker (point-max)) + (ert-info ("User marker correctly placed at `erc-insert-marker'") + (should (= ?\n (char-before erc-scenarios-stamp--user-marker))) + (should (= erc-scenarios-stamp--user-marker erc-insert-marker)) + (save-excursion + (goto-char erc-scenarios-stamp--user-marker) + ;; The raw message ends in " Iabefhkloqv". However, + ;; `erc-server-004' only prints up to the 5th parameter. + (should (looking-back "CEIMRUabefhiklmnoqstuv\n")))))) + +(ert-deftest erc-scenarios-stamp--left/display-margin-mode () + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/reconnect") + (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect)) + (port (process-contact dumb-server :service)) + (erc-scenarios-stamp--user-marker (make-marker)) + (erc-stamp--current-time 704591940) + (erc-stamp--tz t) + (erc-server-flood-penalty 0.1) + (erc-timestamp-only-if-changed-flag nil) + (erc-insert-timestamp-function #'erc-insert-timestamp-left) + (erc-modules (cons 'fill-wrap erc-modules)) + (erc-timestamp-only-if-changed-flag nil) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :nick "tester") + + (add-hook 'erc-insert-post-hook #'erc-scenarios-stamp--on-post-modify + nil t) + (funcall expect 5 "This server is in debug mode") + + (ert-info ("Stamps appear in left margin and are invisible") + (should (eq 'erc-timestamp (field-at-pos (pos-bol)))) + (should (= (pos-bol) (field-beginning (pos-bol)))) + (should (eq 'msg (get-text-property (pos-bol) 'erc-msg))) + (should (eq 'NOTICE (get-text-property (pos-bol) 'erc-cmd))) + (should (= ?- (char-after (field-end (pos-bol))))) + (should (equal (get-text-property (1+ (field-end (pos-bol))) + 'erc-speaker) + "irc.foonet.org")) + (should (pcase (get-text-property (pos-bol) 'display) + (`((margin left-margin) ,s) + (eq 'timestamp (get-text-property 0 'invisible s)))))) + + ;; We set a third-party marker at the end of 004's message (on + ;; then "\n"), post-insertion. + (ert-info ("User markers untouched by subsequent message left stamp") + (save-excursion + (goto-char erc-scenarios-stamp--user-marker) + (should (looking-back "CEIMRUabefhiklmnoqstuv\n")) + (should (looking-at (rx "["))))))))) + +;;; erc-scenarios-stamp.el ends here -- 2.41.0