2023-01-13 00:00:56 -08:00
|
|
|
;;; erc-fill-tests.el --- Tests for erc-fill -*- 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:
|
|
|
|
|
|
|
|
|
|
;; FIXME these tests are brittle and error prone. Replace with
|
|
|
|
|
;; scenarios.
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
(require 'ert-x)
|
|
|
|
|
(require 'erc-fill)
|
|
|
|
|
|
|
|
|
|
(defvar erc-fill-tests--buffers nil)
|
|
|
|
|
(defvar erc-fill-tests--time-vals (lambda () 0))
|
|
|
|
|
|
|
|
|
|
(defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts)
|
|
|
|
|
(declare (indent 1))
|
|
|
|
|
(let ((msg (erc-format-privmessage speaker
|
|
|
|
|
(apply #'concat msg-parts) nil t)))
|
|
|
|
|
(put-text-property 0 (length msg) 'erc-command 'PRIVMSG msg)
|
|
|
|
|
(erc-display-message nil nil (current-buffer) msg)))
|
|
|
|
|
|
|
|
|
|
(defun erc-fill-tests--wrap-populate (test)
|
|
|
|
|
(let ((original-window-buffer (window-buffer (selected-window)))
|
|
|
|
|
(erc-stamp--tz t)
|
|
|
|
|
(erc-fill-function 'erc-fill-wrap)
|
|
|
|
|
(pre-command-hook pre-command-hook)
|
|
|
|
|
(inhibit-message noninteractive)
|
|
|
|
|
erc-insert-post-hook
|
|
|
|
|
extended-command-history
|
|
|
|
|
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
|
|
|
|
|
(cl-letf (((symbol-function 'erc-stamp--current-time)
|
|
|
|
|
(lambda () (funcall erc-fill-tests--time-vals)))
|
|
|
|
|
((symbol-function 'erc-server-connect)
|
|
|
|
|
(lambda (&rest _)
|
|
|
|
|
(setq erc-server-process
|
|
|
|
|
(start-process "sleep" (current-buffer) "sleep" "1"))
|
|
|
|
|
(set-process-query-on-exit-flag erc-server-process nil))))
|
|
|
|
|
(with-current-buffer
|
|
|
|
|
(car (push (erc-open "localhost" 6667 "tester" "Tester" 'connect
|
|
|
|
|
nil nil nil nil nil "tester" 'foonet)
|
|
|
|
|
erc-fill-tests--buffers))
|
|
|
|
|
(setq erc-network 'foonet
|
|
|
|
|
erc-server-connected t)
|
|
|
|
|
(with-current-buffer (erc--open-target "#chan")
|
|
|
|
|
(set-window-buffer (selected-window) (current-buffer))
|
|
|
|
|
|
|
|
|
|
(erc-update-channel-member
|
|
|
|
|
"#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
|
|
|
|
|
|
|
|
|
|
(erc-update-channel-member
|
|
|
|
|
"#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
|
|
|
|
|
|
|
|
|
|
(erc-display-message
|
|
|
|
|
nil 'notice (current-buffer)
|
|
|
|
|
(concat "This server is in debug mode and is logging all user I/O. "
|
|
|
|
|
"If you do not wish for everything you send to be readable "
|
|
|
|
|
"by the server owner(s), please disconnect."))
|
|
|
|
|
|
|
|
|
|
(erc-fill-tests--insert-privmsg "alice"
|
|
|
|
|
"bob: come, you are a tedious fool: to the purpose. "
|
|
|
|
|
"What was done to Elbow's wife, that he hath cause to complain of? "
|
|
|
|
|
"Come me to what was done to her.")
|
|
|
|
|
|
|
|
|
|
;; Introduce an artificial gap in properties `line-prefix' and
|
|
|
|
|
;; `wrap-prefix' and later ensure they're not incremented twice.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(forward-line -1)
|
|
|
|
|
(search-forward "? ")
|
|
|
|
|
(with-silent-modifications
|
|
|
|
|
(remove-text-properties (1- (point)) (point)
|
|
|
|
|
'(line-prefix t wrap-prefix t))))
|
|
|
|
|
|
|
|
|
|
(erc-fill-tests--insert-privmsg "bob"
|
|
|
|
|
"alice: Either your unparagoned mistress is dead, "
|
|
|
|
|
"or she's outprized by a trifle.")
|
|
|
|
|
|
|
|
|
|
;; Defend against non-local exits from `ert-skip'
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(funcall test)
|
2023-04-10 17:58:05 -07:00
|
|
|
(when set-transient-map-timer
|
|
|
|
|
(timer-event-handler set-transient-map-timer))
|
2023-01-13 00:00:56 -08:00
|
|
|
(set-window-buffer (selected-window) original-window-buffer)
|
|
|
|
|
(when noninteractive
|
|
|
|
|
(while-let ((buf (pop erc-fill-tests--buffers)))
|
|
|
|
|
(kill-buffer buf))
|
|
|
|
|
(kill-buffer))))))))
|
|
|
|
|
|
|
|
|
|
(defun erc-fill-tests--wrap-check-prefixes (&rest prefixes)
|
|
|
|
|
;; Check that prefix props are applied over correct intervals.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(dolist (prefix prefixes)
|
|
|
|
|
(should (search-forward prefix nil t))
|
|
|
|
|
(should (get-text-property (pos-bol) 'line-prefix))
|
2023-06-05 02:35:53 -07:00
|
|
|
(should (get-text-property (1- (pos-eol)) 'line-prefix))
|
|
|
|
|
(should-not (get-text-property (pos-eol) 'line-prefix))
|
2023-01-13 00:00:56 -08:00
|
|
|
(should (equal (get-text-property (pos-bol) 'wrap-prefix)
|
|
|
|
|
'(space :width erc-fill--wrap-value)))
|
2023-06-05 02:35:53 -07:00
|
|
|
(should-not (get-text-property (pos-eol) 'wrap-prefix))
|
|
|
|
|
(should (equal (get-text-property (1- (pos-eol)) 'wrap-prefix)
|
2023-01-13 00:00:56 -08:00
|
|
|
'(space :width erc-fill--wrap-value))))))
|
|
|
|
|
|
|
|
|
|
;; Set this variable to t to generate new snapshots after carefully
|
|
|
|
|
;; reviewing the output of *each* snapshot (not just first and last).
|
|
|
|
|
;; Obviously, only run one test at a time.
|
|
|
|
|
(defvar erc-fill-tests--save-p nil)
|
|
|
|
|
|
2023-05-07 07:28:56 -07:00
|
|
|
;; On graphical displays, echo .graphic >> .git/info/exclude
|
|
|
|
|
(defvar erc-fill-tests--graphic-dir "fill/snapshots/.graphic")
|
|
|
|
|
|
2023-01-13 00:00:56 -08:00
|
|
|
(defun erc-fill-tests--compare (name)
|
2023-05-07 07:28:56 -07:00
|
|
|
(let* ((dir (expand-file-name (if (display-graphic-p)
|
|
|
|
|
erc-fill-tests--graphic-dir
|
|
|
|
|
"fill/snapshots/")
|
|
|
|
|
(ert-resource-directory)))
|
2023-01-13 00:00:56 -08:00
|
|
|
(expect-file (file-name-with-extension (expand-file-name name dir)
|
|
|
|
|
"eld"))
|
|
|
|
|
(erc--own-property-names
|
|
|
|
|
(seq-difference `(font-lock-face ,@erc--own-property-names)
|
|
|
|
|
'(field display wrap-prefix line-prefix)
|
|
|
|
|
#'eq))
|
|
|
|
|
(print-circle t)
|
|
|
|
|
(print-escape-newlines t)
|
|
|
|
|
(print-escape-nonascii t)
|
|
|
|
|
(got (erc--remove-text-properties
|
|
|
|
|
(buffer-substring (point-min) erc-insert-marker)))
|
|
|
|
|
(repr (string-replace "erc-fill--wrap-value"
|
|
|
|
|
(number-to-string erc-fill--wrap-value)
|
|
|
|
|
(prin1-to-string got))))
|
|
|
|
|
(with-current-buffer (generate-new-buffer name)
|
|
|
|
|
(push name erc-fill-tests--buffers)
|
|
|
|
|
(with-silent-modifications
|
|
|
|
|
(insert (setq got (read repr))))
|
|
|
|
|
(erc-mode))
|
|
|
|
|
(if erc-fill-tests--save-p
|
|
|
|
|
(with-temp-file expect-file
|
|
|
|
|
(insert repr))
|
|
|
|
|
(if (file-exists-p expect-file)
|
2023-06-24 18:33:20 -07:00
|
|
|
;; Compare set-equal over intervals. This comparison is
|
|
|
|
|
;; less useful for messages treated by other modules because
|
|
|
|
|
;; it doesn't compare "nested" props belonging to
|
|
|
|
|
;; string-valued properties, like timestamps.
|
2023-01-13 00:00:56 -08:00
|
|
|
(should (equal-including-properties
|
|
|
|
|
(read repr)
|
|
|
|
|
(read (with-temp-buffer
|
|
|
|
|
(insert-file-contents-literally expect-file)
|
|
|
|
|
(buffer-string)))))
|
|
|
|
|
(message "Snapshot file missing: %S" expect-file)))))
|
|
|
|
|
|
|
|
|
|
;; To inspect variable pitch, set `erc-mode-hook' to
|
|
|
|
|
;;
|
|
|
|
|
;; (lambda () (face-remap-add-relative 'default :family "Sans Serif"))
|
|
|
|
|
;;
|
|
|
|
|
;; or similar.
|
|
|
|
|
|
|
|
|
|
(ert-deftest erc-fill-wrap--monospace ()
|
|
|
|
|
:tags '(:unstable)
|
|
|
|
|
(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 "*** " "<alice> " "<bob> ")
|
|
|
|
|
(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 "*** " "<alice> " "<bob> ")
|
|
|
|
|
(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 "*** " "<alice> " "<bob> ")
|
|
|
|
|
(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 "*** " "<alice> " "<bob> ")
|
|
|
|
|
(erc-fill-tests--compare "monospace-04-reset")))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest erc-fill-wrap--merge ()
|
|
|
|
|
:tags '(:unstable)
|
|
|
|
|
(unless (>= emacs-major-version 29)
|
|
|
|
|
(ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
|
|
|
|
|
|
|
|
|
|
(erc-fill-tests--wrap-populate
|
|
|
|
|
|
|
|
|
|
(lambda ()
|
2023-04-28 07:01:14 -07:00
|
|
|
(erc-update-channel-member
|
|
|
|
|
"#chan" "Dummy" "Dummy" t nil nil nil nil nil "fake" "~u" nil nil t)
|
|
|
|
|
|
2023-01-13 00:00:56 -08:00
|
|
|
;; Set this here so that the first few messages are from 1970
|
|
|
|
|
(let ((erc-fill-tests--time-vals (lambda () 1680332400)))
|
|
|
|
|
(erc-fill-tests--insert-privmsg "bob" "zero.")
|
|
|
|
|
(erc-fill-tests--insert-privmsg "alice" "one.")
|
|
|
|
|
(erc-fill-tests--insert-privmsg "alice" "two.")
|
|
|
|
|
(erc-fill-tests--insert-privmsg "bob" "three.")
|
2023-04-28 07:01:14 -07:00
|
|
|
(erc-fill-tests--insert-privmsg "bob" "four.")
|
|
|
|
|
(erc-fill-tests--insert-privmsg "Dummy" "five.")
|
|
|
|
|
(erc-fill-tests--insert-privmsg "Dummy" "six."))
|
2023-01-13 00:00:56 -08:00
|
|
|
|
|
|
|
|
(should (= erc-fill--wrap-value 27))
|
|
|
|
|
(erc-fill-tests--wrap-check-prefixes
|
|
|
|
|
"*** " "<alice> " "<bob> "
|
2023-04-28 07:01:14 -07:00
|
|
|
"<bob> " "<alice> " "<alice> " "<bob> " "<bob> " "<Dummy> " "<Dummy> ")
|
2023-01-13 00:00:56 -08:00
|
|
|
(erc-fill-tests--compare "merge-01-start")
|
|
|
|
|
|
|
|
|
|
(ert-info ("Shift right by one (plus)")
|
|
|
|
|
(ert-simulate-command '(erc-fill-wrap-nudge 2))
|
|
|
|
|
(should (= erc-fill--wrap-value 29))
|
|
|
|
|
(erc-fill-tests--wrap-check-prefixes
|
|
|
|
|
"*** " "<alice> " "<bob> "
|
2023-04-28 07:01:14 -07:00
|
|
|
"<bob> " "<alice> " "<alice> " "<bob> " "<bob> " "<Dummy> " "<Dummy> ")
|
2023-01-13 00:00:56 -08:00
|
|
|
(erc-fill-tests--compare "merge-02-right")))))
|
|
|
|
|
|
2023-07-22 14:07:38 -07:00
|
|
|
(ert-deftest erc-fill-wrap--merge-action ()
|
|
|
|
|
:tags '(:unstable)
|
|
|
|
|
(unless (>= emacs-major-version 29)
|
|
|
|
|
(ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
|
|
|
|
|
|
|
|
|
|
(erc-fill-tests--wrap-populate
|
|
|
|
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
;; Set this here so that the first few messages are from 1970
|
|
|
|
|
(let ((erc-fill-tests--time-vals (lambda () 1680332400)))
|
|
|
|
|
(erc-fill-tests--insert-privmsg "bob" "zero.")
|
|
|
|
|
|
|
|
|
|
(erc-process-ctcp-query
|
|
|
|
|
erc-server-process
|
|
|
|
|
(make-erc-response
|
|
|
|
|
:unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION one\1"
|
|
|
|
|
:sender "bob!~u@fake" :command "PRIVMSG"
|
|
|
|
|
:command-args '("#chan" "\1ACTION one\1") :contents "\1ACTION one\1")
|
|
|
|
|
"bob" "~u" "fake")
|
|
|
|
|
|
|
|
|
|
(erc-fill-tests--insert-privmsg "bob" "two.")
|
|
|
|
|
|
|
|
|
|
;; Compat switch to opt out of overhanging speaker.
|
|
|
|
|
(let (erc-fill--wrap-action-dedent-p)
|
|
|
|
|
(erc-process-ctcp-query
|
|
|
|
|
erc-server-process
|
|
|
|
|
(make-erc-response
|
|
|
|
|
:unparsed ":bob!~u@fake PRIVMSG #chan :\1ACTION three\1"
|
|
|
|
|
:sender "bob!~u@fake" :command "PRIVMSG"
|
|
|
|
|
:command-args '("#chan" "\1ACTION three\1")
|
|
|
|
|
:contents "\1ACTION three\1")
|
|
|
|
|
"bob" "~u" "fake"))
|
|
|
|
|
|
|
|
|
|
(erc-fill-tests--insert-privmsg "bob" "four."))
|
|
|
|
|
|
|
|
|
|
(should (= erc-fill--wrap-value 27))
|
|
|
|
|
(erc-fill-tests--wrap-check-prefixes
|
|
|
|
|
"*** " "<alice> " "<bob> " "<bob> " "* bob " "<bob> " "* " "<bob> ")
|
|
|
|
|
(erc-fill-tests--compare "merge-wrap-01"))))
|
|
|
|
|
|
2023-05-07 07:28:56 -07:00
|
|
|
(ert-deftest erc-fill-line-spacing ()
|
|
|
|
|
:tags '(:unstable)
|
|
|
|
|
(unless (>= emacs-major-version 29)
|
|
|
|
|
(ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
|
|
|
|
|
|
|
|
|
|
(let ((erc-fill-line-spacing 0.5))
|
|
|
|
|
(erc-fill-tests--wrap-populate
|
|
|
|
|
(lambda ()
|
|
|
|
|
(erc-fill-tests--insert-privmsg "bob" "This buffer is for text.")
|
|
|
|
|
(erc-display-message nil 'notice (current-buffer) "one two three")
|
|
|
|
|
(erc-display-message nil 'notice (current-buffer) "four five six")
|
|
|
|
|
(erc-fill-tests--insert-privmsg "bob" "Somebody stop me")
|
|
|
|
|
(erc-fill-tests--compare "spacing-01-mono")))))
|
|
|
|
|
|
2023-01-13 00:00:56 -08:00
|
|
|
(ert-deftest erc-fill-wrap-visual-keys--body ()
|
|
|
|
|
:tags '(:unstable)
|
|
|
|
|
(erc-fill-tests--wrap-populate
|
|
|
|
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
(ert-info ("Value: non-input")
|
|
|
|
|
(should (eq erc-fill--wrap-visual-keys 'non-input))
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(should (search-forward "that he hath" nil t))
|
|
|
|
|
(execute-kbd-macro "\C-a")
|
|
|
|
|
(should-not (looking-at (rx "<alice> ")))
|
|
|
|
|
(execute-kbd-macro "\C-e")
|
|
|
|
|
(should (search-backward "tedious fool" nil t))
|
|
|
|
|
(should-not (looking-back "done to her\\."))
|
|
|
|
|
(forward-char)
|
|
|
|
|
(execute-kbd-macro "\C-e")
|
|
|
|
|
(should (search-forward "done to her." nil t)))
|
|
|
|
|
|
|
|
|
|
(ert-info ("Value: nil")
|
|
|
|
|
(execute-kbd-macro "\C-ca")
|
|
|
|
|
(should-not erc-fill--wrap-visual-keys)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(should (search-forward "in debug mode" nil t))
|
|
|
|
|
(execute-kbd-macro "\C-a")
|
|
|
|
|
(should (looking-at (rx "*** ")))
|
|
|
|
|
(execute-kbd-macro "\C-e")
|
|
|
|
|
(should (eql ?\] (char-before (point)))))
|
|
|
|
|
|
|
|
|
|
(ert-info ("Value: t")
|
|
|
|
|
(execute-kbd-macro "\C-ca")
|
|
|
|
|
(should (eq erc-fill--wrap-visual-keys t))
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(should (search-forward "that he hath" nil t))
|
|
|
|
|
(execute-kbd-macro "\C-a")
|
|
|
|
|
(should-not (looking-at (rx "<alice> ")))
|
|
|
|
|
(should (search-backward "tedious fool" nil t))
|
|
|
|
|
(execute-kbd-macro "\C-e")
|
|
|
|
|
(should-not (looking-back (rx "done to her\\.")))
|
|
|
|
|
(should (search-forward "done to her." nil t))
|
|
|
|
|
(execute-kbd-macro "\C-a")
|
|
|
|
|
(should-not (looking-at (rx "<alice> ")))))))
|
|
|
|
|
|
|
|
|
|
(ert-deftest erc-fill-wrap-visual-keys--prompt ()
|
|
|
|
|
:tags '(:unstable)
|
|
|
|
|
(erc-fill-tests--wrap-populate
|
|
|
|
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
(set-window-buffer (selected-window) (current-buffer))
|
|
|
|
|
(goto-char erc-input-marker)
|
|
|
|
|
(insert "This buffer is for text that is not saved, and for Lisp "
|
|
|
|
|
"evaluation. To create a file, visit it with C-x C-f and "
|
|
|
|
|
"enter text in its buffer.")
|
|
|
|
|
|
|
|
|
|
(ert-info ("Value: non-input")
|
|
|
|
|
(should (eq erc-fill--wrap-visual-keys 'non-input))
|
|
|
|
|
(execute-kbd-macro "\C-a")
|
|
|
|
|
(should (looking-at "This buffer"))
|
|
|
|
|
(execute-kbd-macro "\C-e")
|
|
|
|
|
(should (looking-back "its buffer\\."))
|
|
|
|
|
(execute-kbd-macro "\C-a")
|
|
|
|
|
(execute-kbd-macro "\C-k")
|
|
|
|
|
(should (eobp)))
|
|
|
|
|
|
|
|
|
|
(ert-info ("Value: nil") ; same
|
|
|
|
|
(execute-kbd-macro "\C-ca")
|
|
|
|
|
(should-not erc-fill--wrap-visual-keys)
|
|
|
|
|
(execute-kbd-macro "\C-y")
|
|
|
|
|
(should (looking-back "its buffer\\."))
|
|
|
|
|
(execute-kbd-macro "\C-a")
|
|
|
|
|
(should (looking-at "This buffer"))
|
|
|
|
|
(execute-kbd-macro "\C-k")
|
|
|
|
|
(should (eobp)))
|
|
|
|
|
|
|
|
|
|
(ert-info ("Value: non-input")
|
|
|
|
|
(execute-kbd-macro "\C-ca")
|
|
|
|
|
(should (eq erc-fill--wrap-visual-keys t))
|
|
|
|
|
(execute-kbd-macro "\C-y")
|
|
|
|
|
(execute-kbd-macro "\C-a")
|
|
|
|
|
(should-not (looking-at "This buffer"))
|
|
|
|
|
(execute-kbd-macro "\C-p")
|
|
|
|
|
(should-not (looking-back "its buffer\\."))
|
|
|
|
|
(should (search-forward "its buffer." nil t))
|
|
|
|
|
(should (search-backward "ERC> " nil t))
|
|
|
|
|
(execute-kbd-macro "\C-a")))))
|
|
|
|
|
|
Make erc-fill-wrap work with left-sided stamps
* etc/ERC-NEWS: Remove all mention of option `erc-timestamp-align-to'
supporting a value of `margin', which has been abandoned. Do mention
leading white space before stamps now having stamp-related properties.
* lisp/erc/erc-backend.el (erc--reveal-prompt, erc--conceal-prompt):
New generic functions with default implementations factored out from
`erc--unhide-prompt' and `erc--hide-prompt'.
(erc--prompt-hidden-p): New internal predicate function.
(erc--unhide-prompt): Defer to `erc--reveal-prompt', and set
`erc-prompt' text property to t.
(erc--hide-prompt): Defer to `erc--conceal-prompt', and set
`erc-prompt' text property to `hidden'.
* lisp/erc/erc-compat.el (erc-compat--29-browse-url-irc): Don't
use `function-equal'.
* lisp/erc/erc-fill.el (erc-fill-wrap-margin-width,
erc-fill-wrap-margin-side): New options to control side and initial
width of `fill-wrap' margin.
(erc-fill--wrap-beginning-of-line): Fix bug involving non-string
valued `display' props.
(erc-fill-wrap-toggle-truncate-lines): New command to re-enable
`visual-line-mode' when toggling off `truncate-lines'.
(erc-fill-wrap-mode-map): Remap `toggle-truncate-lines' to
`erc-fill-wrap-toggle-truncate-lines'.
(erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable):
Update doc string, persist a few local vars, and conditionally set
`erc-stamp--margin-left-p'. When deactivating, disable
`visual-line-mode' first.
(erc-fill--wrap-continued-message-p): Use `erc-speaker' instead of
heuristics when comparing nicks between consecutive messages.
(erc-fill-wrap-nudge): Update doc string and account for left-sided
stamps.
(erc-timestamp-offset): Add comment regarding conditional guard based
on function-valued option.
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Remove value
variant `margin', which was originally intended to be new in ERC 5.6.
This functionality was all but useless without the internal minor mode
`erc-stamp--display-margin-mode' active.
(erc-stamp-right-margin-width): Remove unused option new in 5.6.
(erc-stamp--display-margin-force): Remove unused function.
(erc-stamp--margin-width, erc-stamp--margin-left-p): New internal
variables.
(erc-stamp--init-margins-on-connect): New function for initializing
mode-managed margin after connecting.
(erc-stamp--adjust-right-margin, erc-stamp--adjust-margin): Rename
function to latter and accommodate left-hand stamps.
(erc-stamp--inherited-props): Move definition higher up in same file.
(erc-stamp--display-margin-mode): Update function name, and adjust
setup and teardown to accommodate left-handed stamps. Don't add
advice around `erc-insert-timestamp-function'.
(erc-stamp--last-prompt, erc-stamp--display-prompt-in-left-margin):
New function and helper var to convert a normal inserted prompt so
that it appears in the left margin.
(erc-stamp--refresh-left-margin-prompt): Helper for other modules to
quickly refresh prompt outside of insert hooks.
(erc--reveal-prompt, erc--conceal-prompt): New implementations for
when `erc-stamp--display-margin-mode' is active.
(erc-insert-timestamp-left): Convert to generic function and provide
implementation for `erc-stamp--display-margin-mode'.
(erc-stamp--omit-properties-on-folded-lines): New variable, an escape
hatch for propertizing white space before right-side stamps folded
over onto another line.
(erc-insert-timestamp-right): Don't expect `erc-timestamp-align-to' to
ever be the symbol `margin'. Move handling for that case to one
contingent on the internal minor mode `erc-stamp--display-margin-mode'
being active. Add text properties preceding stamps that occupy a line
by their lonesome. See related news entry for rationale. This is
arguably a breaking change.
* lisp/erc/erc.el (erc--refresh-prompt-hook): New hook variable for
modules to adjust prompt properties whenever it's refreshed.
(erc--refresh-prompt): Fix bug in which user-defined prompt functions
failed to hide when quitting in server buffers. Run new hook
`erc--refresh-prompt-hook'.
(erc-display-prompt): Add comment noting that the text property
`erc-prompt' now actually matters: it's t while a session is running
and `hidden' when disconnected.
* test/lisp/erc/erc-fill-tests.el (erc-fill--left-hand-stamps): New
test.
* test/lisp/erc/erc-stamp-tests.el
(erc-stamp-tests--use-align-to--nil,
erc-stamp-tests--use-align-to--t): New functions forged from old test
bodies to allow optionally asserting pre-5.6 behavior regarding
leading white space on right-hand stamps that exist on their own line.
(erc-timestamp-use-align-to--nil, erc-timestamp-use-align-to--t):
Parameterize with compatibility flag.
(erc-timestamp-use-align-to--margin,
erc-stamp--display-margin-mode--right): Rename test to latter.
* test/lisp/erc/erc-tests.el (erc-hide-prompt): Add some assertions
for new possible value of `erc-prompt' text property.
* test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: New test
data file. (Bug#60936)
2023-07-14 06:12:30 -07:00
|
|
|
(ert-deftest erc-fill--left-hand-stamps ()
|
|
|
|
|
:tags '(:unstable)
|
|
|
|
|
(unless (>= emacs-major-version 29)
|
|
|
|
|
(ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
|
|
|
|
|
|
|
|
|
|
(let ((erc-timestamp-only-if-changed-flag nil)
|
|
|
|
|
(erc-insert-timestamp-function #'erc-insert-timestamp-left))
|
|
|
|
|
(erc-fill-tests--wrap-populate
|
|
|
|
|
(lambda ()
|
|
|
|
|
(should (= 8 left-margin-width))
|
|
|
|
|
(pcase-let ((`((margin left-margin) ,displayed)
|
|
|
|
|
(get-text-property erc-insert-marker 'display)))
|
|
|
|
|
(should (equal-including-properties
|
|
|
|
|
displayed #(" ERC>" 4 8
|
|
|
|
|
( read-only t
|
|
|
|
|
front-sticky t
|
|
|
|
|
field erc-prompt
|
|
|
|
|
erc-prompt t
|
|
|
|
|
rear-nonsticky t
|
|
|
|
|
font-lock-face erc-prompt-face)))))
|
|
|
|
|
(erc-fill-tests--compare "stamps-left-01")
|
|
|
|
|
|
|
|
|
|
(ert-info ("Shrink left margin by 1 col")
|
|
|
|
|
(erc-stamp--adjust-margin -1)
|
|
|
|
|
(with-silent-modifications (erc--refresh-prompt))
|
|
|
|
|
(should (= 7 left-margin-width))
|
|
|
|
|
(pcase-let ((`((margin left-margin) ,displayed)
|
|
|
|
|
(get-text-property erc-insert-marker 'display)))
|
|
|
|
|
(should (equal-including-properties
|
|
|
|
|
displayed #(" ERC>" 3 7
|
|
|
|
|
( read-only t
|
|
|
|
|
front-sticky t
|
|
|
|
|
field erc-prompt
|
|
|
|
|
erc-prompt t
|
|
|
|
|
rear-nonsticky t
|
|
|
|
|
font-lock-face erc-prompt-face))))))))))
|
|
|
|
|
|
2023-01-13 00:00:56 -08:00
|
|
|
;;; erc-fill-tests.el ends here
|