;;; 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 .
;;; Commentary:
;; FIXME these fixtures (and tests) are now largely useless. Due to
;; the author's ignorance regarding display properties, the "space"
;; specs of prefix props on different lines didn't initially leverage
;; a common variable (`erc-fill--wrap-value'), so the column twiddling
;; was more laborious. See decades-old comment above
;; calc_pixel_width_or_height in in xdisp.c for examples.
;;
;; TODO maybe use erts files instead of own snapshots.
;;; Code:
(require 'ert-x)
(require 'erc-fill)
(defvar erc-fill-tests--buffers nil)
(defun erc-fill-tests--wrap-populate (test)
(cl-letf (((symbol-function 'erc-stamp--current-time)
(lambda () '(0 1))))
(let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
(erc-stamp--tz t)
(id (erc-networks--id-create 'foonet))
(erc-insert-modify-hook '(erc-fill erc-add-timestamp))
(erc-server-users (make-hash-table :test 'equal))
(erc-fill-function 'erc-fill-wrap)
(pre-command-hook pre-command-hook)
(erc-modules '(fill stamp))
(msg "Hello World")
(inhibit-message noninteractive)
erc-insert-post-hook
extended-command-history
erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
(when (bound-and-true-p erc-button-mode)
(push 'erc-button-add-buttons erc-insert-modify-hook))
(erc-mode)
(setq erc-server-process proc erc-networks--id id)
(set-process-query-on-exit-flag erc-server-process nil)
(with-current-buffer (get-buffer-create "#chan")
(erc-mode)
(erc-munge-invisibility-spec)
(setq erc-server-process proc
erc-networks--id id
erc-channel-users (make-hash-table :test 'equal)
erc--target (erc--target-from-string "#chan")
erc-default-recipients (list "#chan"))
(erc--initialize-markers (point) nil)
(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)
(setq msg "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-display-message nil 'notice (current-buffer) msg)
(setq msg "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.")
(erc-display-message nil nil (current-buffer)
(erc-format-privmessage "alice" msg nil t))
;; 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 "? ")
(remove-text-properties (1- (point)) (point)
'(line-prefix t wrap-prefix t)))
(setq msg "alice: Either your unparagoned mistress is dead,\
or she's outprized by a trifle.")
(erc-display-message nil nil (current-buffer)
(erc-format-privmessage "bob" msg nil t))
(let ((original-window-buffer (window-buffer (selected-window))))
(set-window-buffer (selected-window) (current-buffer))
;; Defend against non-local exits from `ert-skip'
(unwind-protect
(funcall test)
(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-props (speaker)
;; Prefix props are applied properly and faces are accounted
;; for when determining widths.
(should (search-forward speaker nil t))
(should (get-text-property (pos-bol) 'line-prefix))
(should (get-text-property (pos-eol) 'line-prefix))
(should (equal (get-text-property (pos-bol) 'wrap-prefix)
'(space :width erc-fill--wrap-value)))
(should (equal (get-text-property (pos-eol) 'wrap-prefix)
'(space :width erc-fill--wrap-value)))
;; The last elt in the `:width' value is a singleton (NUM) when
;; figuring pixels. Otherwise, it's just NUM. See EXPR in the
;; prod rules table under (info "(elisp) Pixel Specification").
(should (pcase (get-text-property (point) 'line-prefix)
((and (guard (fboundp 'string-pixel-width))
`(space :width (- erc-fill--wrap-value (,w))))
(= w (string-pixel-width speaker)))
(`(space :width (- erc-fill--wrap-value ,w))
(= w (length speaker))))))
(defun erc-fill-tests--wrap-check-prefixes ()
(save-excursion
(goto-char (point-min))
(erc-fill-tests--wrap-check-props "*** ")
(erc-fill-tests--wrap-check-props " ")
;; Ensure the loop is not visited twice due to the gap.
(erc-fill-tests--wrap-check-props " ")))
;; Set this variable to t to generate new snapshots after carefully
;; reviewing the output of each.
(defvar erc-fill-tests--save-p nil)
(defun erc-fill-tests--compare (name)
(let* ((dir (expand-file-name "fill/snapshots/" (ert-resource-directory)))
(expect-file (file-name-with-extension (expand-file-name name dir)
"eld"))
(erc--own-property-names
(seq-difference `(erc-timestamp font-lock-face
,@erc--own-property-names)
'(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))
(with-temp-buffer
(insert-file-contents-literally expect-file)
(should (equal got (read (current-buffer))))))))
(ert-deftest erc-fill-wrap--monospace ()
:tags '(:unstable)
(erc-fill-tests--wrap-populate
(lambda ()
(set-window-buffer (selected-window) (current-buffer))
(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)")
(ert-with-message-capture messages
(execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +"))
(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")
(execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----"))
(should (= erc-fill--wrap-value 25))
(erc-fill-tests--wrap-check-prefixes)
(erc-fill-tests--compare "monospace-03-left"))
(ert-info ("Reset")
(execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0"))
(should (= erc-fill--wrap-value 27))
(erc-fill-tests--wrap-check-prefixes)
(erc-fill-tests--compare "monospace-04-reset")))))
(ert-deftest erc-fill-wrap--variable-pitch ()
:tags '(:unstable)
(unless (and (fboundp 'string-pixel-width)
(not noninteractive)
(display-graphic-p))
(ert-skip "Test needs interactive graphical Emacs"))
(with-selected-frame (make-frame '((name . "other")))
(set-face-attribute 'default (selected-frame)
:family "Sans Serif"
:foundry 'unspecified
:font 'unspecified)
(erc-fill-tests--wrap-populate
(lambda ()
(should (= erc-fill--wrap-value 27))
(erc-fill-tests--wrap-check-prefixes)
(erc-fill--wrap-nudge 2)
(should (= erc-fill--wrap-value 29))
(erc-fill-tests--wrap-check-prefixes)
(erc-fill--wrap-nudge -6)
(should (= erc-fill--wrap-value 25))
(erc-fill-tests--wrap-check-prefixes)
(erc-fill--wrap-nudge 0)
(should (= erc-fill--wrap-value 27))
(erc-fill-tests--wrap-check-prefixes)
;; FIXME get rid of this "void variable `erc--results-ewoc'"
;; error, which seems related to operating in a non-default
;; frame.
;;
;; As a kludge, checking if point made it to the prompt can
;; serve as visual confirmation that the test passed.
(goto-char (point-max))))))
(ert-deftest erc-fill-wrap-visual-keys--body ()
:tags '(:unstable)
(erc-fill-tests--wrap-populate
(lambda ()
(set-window-buffer (selected-window) (current-buffer))
(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 " ")))
(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 " ")))
(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 " ")))))))
(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")))))
;;; erc-fill-tests.el ends here