From: "J.P." <jp@neverwas.me>
To: 60936@debbugs.gnu.org
Cc: emacs-erc@gnu.org
Subject: bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
Date: Sun, 19 Feb 2023 07:05:49 -0800 [thread overview]
Message-ID: <87edqlwv8y.fsf__26617.4005389743$1676819257$gmane$org@neverwas.me> (raw)
In-Reply-To: <87tu0nao77.fsf@neverwas.me> (J. P.'s message of "Wed, 18 Jan 2023 06:53:48 -0800")
[-- Attachment #1: Type: text/plain, Size: 58 bytes --]
v8. Fix minor-mode teardown in erc-stamp. Improve tests.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v7-v8.diff --]
[-- Type: text/x-patch, Size: 23024 bytes --]
From 1162cf9dc8e1d6f6a99d99c4c49cae949d2d04d3 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Feb 2023 22:34:26 -0800
Subject: [PATCH 0/8] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (8):
[5.6] Refactor marker initialization in erc-open
[5.6] Adjust some old text properties in ERC buffers
[5.6] Expose insertion time as text prop in erc-stamp
[5.6] Make some erc-stamp functions more limber
[5.6] Put display properties to better use in erc-stamp
[5.6] Convert erc-fill minor mode into a proper module
[5.6] Add variant for erc-match invisibility spec
[5.6] Add erc-fill style based on visual-line-mode
lisp/erc/erc-compat.el | 57 +++
lisp/erc/erc-fill.el | 307 +++++++++++++++--
lisp/erc/erc-match.el | 31 +-
lisp/erc/erc-stamp.el | 210 ++++++++++--
lisp/erc/erc.el | 136 +++++---
test/lisp/erc/erc-fill-tests.el | 324 ++++++++++++++++++
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 ------
test/lisp/erc/erc-stamp-tests.el | 265 ++++++++++++++
test/lisp/erc/erc-tests.el | 79 ++++-
.../fill/snapshots/monospace-01-start.eld | 1 +
.../fill/snapshots/monospace-02-right.eld | 1 +
.../fill/snapshots/monospace-03-left.eld | 1 +
.../fill/snapshots/monospace-04-reset.eld | 1 +
14 files changed, 1506 insertions(+), 217 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
create mode 100644 test/lisp/erc/erc-stamp-tests.el
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
Interdiff:
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index a4367fe4ba5..7d635e5b1af 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -409,6 +409,7 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+;; FIXME remove these after bumping Compat version to 29
(defvar erc-compat--29-set-transient-map-timer nil)
(defun erc-compat--29-set-transient-map
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index ba538a7c152..032206b514a 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -179,7 +179,7 @@ erc-fill-wrap-use-pixels
A value of nil means ERC should use columns, which may happen
regardless, depending on the Emacs version. This option only
matters when `erc-fill-wrap-mode' is enabled."
- :package-version '(ERC . "5.5") ; FIXME sync on release
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type 'boolean)
(defcustom erc-fill-wrap-visual-keys 'non-input
@@ -190,7 +190,7 @@ erc-fill-wrap-visual-keys
never do so. A value of `non-input' tells ERC to act like the
value is nil in the input area and t elsewhere. This option only
plays a role when `erc-fill-wrap-mode' is enabled."
- :package-version '(ERC . "5.5") ; FIXME sync on release
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) (const t) (const non-input)))
(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index c8f6e7c195c..a5e9720bad4 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -650,8 +650,6 @@ erc-go-to-log-matches-buffer
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
-(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
-
(defvar-local erc-match--hide-fools-offset-bounds nil)
(defun erc-hide-fools (match-type _nickuserhost _message)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index d1c2f790bc8..e689caf7b61 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -260,7 +260,7 @@ erc-timestamp-use-align-to
workaround in `erc-stamp-prefix-log-filter', which strips
trailing stamps from messages and puts them before every line."
:type '(choice boolean integer (const margin))
- :package-version '(ERC . "5.5")) ; FIXME sync on release
+ :package-version '(ERC . "5.6")) ; FIXME sync on release
(defcustom erc-stamp-right-margin-width nil
"Width in columns of the right margin.
@@ -268,7 +268,7 @@ erc-stamp-right-margin-width
than the `string-width' of the formatted `erc-timestamp-format'.
This option only matters when `erc-timestamp-use-align-to' is set
to `margin'."
- :package-version '(ERC . "5.5") ; FIXME sync on release
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) integer))
(defun erc-stamp--display-margin-force (orig &rest r)
@@ -315,6 +315,8 @@ erc-stamp-prefix-log-filter
(zerop (forward-line))))
"")
+(declare-function erc--remove-text-properties "erc" (string))
+
;; If people want to use this directly, we can convert it into
;; a local module.
(define-minor-mode erc-stamp--display-margin-mode
@@ -338,8 +340,8 @@ erc-stamp--display-margin-mode
#'erc-stamp--display-margin-force)
(kill-local-variable 'right-margin-width)
(kill-local-variable 'right-fringe-width)
- (set-window-margins left-margin-width nil)
- (set-window-fringes left-fringe-width nil)))
+ (set-window-margins nil left-margin-width nil)
+ (set-window-fringes nil left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -476,12 +478,13 @@ erc-insert-timestamp-left-and-right
(setq erc-timestamp-last-inserted-right ts-right))))
;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
+(defvar erc-stamp--tz nil)
(defun erc-format-timestamp (time format)
"Return TIME formatted as string according to FORMAT.
Return the empty string if FORMAT is nil."
(if format
- (let ((ts (format-time-string format time)))
+ (let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
(erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
@@ -540,6 +543,7 @@ erc-toggle-timestamps
(defun erc-echo-timestamp (dir stamp)
"Print timestamp text-property of an IRC message."
+ ;; 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
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 8e8d585617a..a254d5bbc73 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -25,78 +25,87 @@
;; 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)
- (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
- (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")
+ (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)
- (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.\
+ (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)
+ (erc-display-message nil 'notice (current-buffer) msg)
- (setq msg "bob: come, you are a tedious fool: to the purpose.\
+ (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,\
+ (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
- (kill-buffer)))))))
+ (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
@@ -127,6 +136,39 @@ erc-fill-tests--wrap-check-prefixes
;; Ensure the loop is not visited twice due to the gap.
(erc-fill-tests--wrap-check-props "<bob> ")))
+;; 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)
@@ -136,23 +178,27 @@ erc-fill-wrap--monospace
(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--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--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--wrap-check-prefixes)
+ (erc-fill-tests--compare "monospace-04-reset")))))
(ert-deftest erc-fill-wrap--variable-pitch ()
:tags '(:unstable)
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<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.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
new file mode 100644
index 00000000000..3f5f344cc64
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<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.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 29 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 29 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
new file mode 100644
index 00000000000..3b215936c39
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<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.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 25) line-prefix #3=(space :width (- 25 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 25 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 25 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<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.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Refactor-marker-initialization-in-erc-open.patch --]
[-- Type: text/x-patch, Size: 24887 bytes --]
From 29e533b873d1f061099562944122a31542572470 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 23 Jan 2023 20:48:24 -0800
Subject: [PATCH 1/8] [5.6] Refactor marker initialization in erc-open
* lisp/erc/erc.el (erc--initialize-markers): New helper to ensure
prompt and its associated markers are set up correctly.
(erc-open): When determining whether a session is a logical
continuation, leverage the work already performed by the
`erc-networks' library to that effect. Its verdicts are based on
network context and thus reliable even when a user dials anew from an
entry-point, which is not a simple reconnection because the user
expects a clean slate for everything except an existing buffer's
messages, meaning `erc--server-reconnecting' will be nil and
local-module state variables need resetting. Also remove the check
for `erc-reuse-buffers' and instead trust that `erc-get-buffer-create'
always does the right thing in. Replace all code involving marker and
prompt setup by deferring to a new helper, `erc--initialize markers'.
* test/lisp/erc/erc-tests.el (erc--initialize-markers): New test.
* test/lisp/erc/erc-scenarios-base-local-module-modes.el: New file.
* test/lisp/erc/erc-scenarios-base-local-modules.el
(erc-scenarios-base-local-modules--mode-persistence): Move test to
separate file to help with parallel "-j" runs. (Bug#60936.)
---
lisp/erc/erc.el | 79 ++++---
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 --------
test/lisp/erc/erc-tests.el | 79 ++++++-
4 files changed, 331 insertions(+), 137 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index d35907a1677..8261801ec0d 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1966,6 +1966,45 @@ erc--merge-local-modes
(cons (nreverse (car out)) (nreverse (cdr out))))
(list new-modes)))
+;; This function doubles as a convenient helper for use in unit tests.
+;; Prior to 5.6, its contents lived in `erc-open'.
+
+(defun erc--initialize-markers (old-point continued-session)
+ "Ensure prompt and its bounding markers have been initialized."
+ ;; FIXME erase assertions after code review and additional testing.
+ (setq erc-insert-marker (make-marker)
+ erc-input-marker (make-marker))
+ (if continued-session
+ (progn
+ ;; Respect existing multiline input after prompt. Expect any
+ ;; text preceding it on the same line, including whitespace,
+ ;; to be part of the prompt itself.
+ (goto-char (point-max))
+ (forward-line 0)
+ (while (and (not (get-text-property (point) 'erc-prompt))
+ (zerop (forward-line -1))))
+ (cl-assert (not (= (point) (point-min))))
+ (set-marker erc-insert-marker (point))
+ ;; If the input area is clean, this search should fail and
+ ;; return point max. Otherwise, it should return the position
+ ;; after the last char with the `erc-prompt' property, as per
+ ;; the doc string for `next-single-property-change'.
+ (set-marker erc-input-marker
+ (next-single-property-change (point) 'erc-prompt nil
+ (point-max)))
+ (cl-assert (= (field-end) erc-input-marker))
+ (goto-char old-point)
+ (erc--unhide-prompt))
+ (cl-assert (not (get-text-property (point) 'erc-prompt)))
+ ;; In the original version from `erc-open', the snippet that
+ ;; handled these newline insertions appeared twice close in
+ ;; proximity, which was probably unintended. Nevertheless, we
+ ;; preserve the double newlines here for historical reasons.
+ (insert "\n\n")
+ (set-marker erc-insert-marker (point))
+ (erc-display-prompt)
+ (cl-assert (= (point) (point-max)))))
+
(defun erc-open (&optional server port nick full-name
connect passwd tgt-list channel process
client-certificate user id)
@@ -1999,10 +2038,12 @@ erc-open
(old-recon-count erc-server-reconnect-count)
(old-point nil)
(delayed-modules nil)
- (continued-session (and erc--server-reconnecting
- (with-suppressed-warnings
- ((obsolete erc-reuse-buffers))
- erc-reuse-buffers))))
+ (continued-session (or erc--server-reconnecting
+ erc--target-priors
+ (and-let* (((not target))
+ (m (buffer-local-value
+ 'erc-input-marker buffer))
+ ((marker-position m)))))))
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(set-buffer buffer)
(setq old-point (point))
@@ -2020,21 +2061,6 @@ erc-open
(buffer-local-value 'erc-server-announced-name old-buffer)))
;; connection parameters
(setq erc-server-process process)
- (setq erc-insert-marker (make-marker))
- (setq erc-input-marker (make-marker))
- ;; go to the end of the buffer and open a new line
- ;; (the buffer may have existed)
- (goto-char (point-max))
- (forward-line 0)
- (when (or continued-session (get-text-property (point) 'erc-prompt))
- (setq continued-session t)
- (set-marker erc-input-marker
- (or (next-single-property-change (point) 'erc-prompt)
- (point-max))))
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (set-marker erc-insert-marker (point))
;; stack of default recipients
(setq erc-default-recipients tgt-list)
(when target
@@ -2081,20 +2107,7 @@ erc-open
(get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
(erc-determine-parameters server port nick full-name user passwd)
-
- ;; FIXME consolidate this prompt-setup logic with the pass above.
-
- ;; set up prompt
- (unless continued-session
- (goto-char (point-max))
- (insert "\n"))
- (if continued-session
- (progn (goto-char old-point)
- (erc--unhide-prompt))
- (set-marker erc-insert-marker (point))
- (erc-display-prompt)
- (goto-char (point-max)))
-
+ (erc--initialize-markers old-point continued-session)
(save-excursion (run-mode-hooks)
(dolist (mod (car delayed-modules)) (funcall mod +1))
(dolist (var (cdr delayed-modules)) (set var nil)))
diff --git a/test/lisp/erc/erc-scenarios-base-local-module-modes.el b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
new file mode 100644
index 00000000000..7b91e28dc83
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-local-module-modes.el
@@ -0,0 +1,211 @@
+;;; erc-scenarios-base-local-module-modes.el --- More local-mod ERC tests -*- 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:
+
+;; A local module doubles as a minor mode whose mode variable and
+;; associated local data can withstand service disruptions.
+;; Unfortunately, the current implementation is too unwieldy to be
+;; made public because it doesn't perform any of the boiler plate
+;; needed to save and restore buffer-local and "network-local" copies
+;; of user options. Ultimately, a user-friendly framework must fill
+;; this void if third-party local modules are ever to become
+;; practical.
+;;
+;; The following tests all use `sasl' because, as of ERC 5.5, it's the
+;; only local module.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(require 'erc-sasl)
+
+;; After quitting a session for which `sasl' is enabled, you
+;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
+;; using an alternate nickname. You again disconnect and reconnect,
+;; this time immediately, and the mode stays disabled. Finally, you
+;; once again disconnect, toggle the mode back on, and reconnect. You
+;; are authenticated successfully, just like in the initial session.
+;;
+;; This is meant to show that a user's local mode settings persist
+;; between sessions. It also happens to show (in round four, below)
+;; that a server renicking a user on 001 after a 903 is handled just
+;; like a user-initiated renick, although this is not the main thrust.
+
+(ert-deftest erc-scenarios-base-local-module-modes--reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round two, nick rejected, alternate granted")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode off, reconnect")
+ (erc-sasl-mode -1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Some enigma, some riddle"))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round three, send alternate nick initially")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Keep mode off, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester`")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Let our reciprocal vows be remembered."))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+
+ (ert-info ("Round four, authenticated successfully again")
+ (with-current-buffer "foonet"
+
+ (ert-info ("Toggle mode on, reconnect")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-sasl-mode +1)
+ (erc-cmd-RECONNECT))
+
+ (funcall expect 10 "User modes for tester")
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+ (should (equal (buffer-name) "foonet"))
+ (should-not (cdr (erc-scenarios-common-buflist "#chan")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
+
+ (erc-cmd-QUIT "")))))
+
+;; In contrast to the mode-persistence test above, this one
+;; demonstrates that a user reinvoking an entry point declares their
+;; intention to reset local-module state for the server buffer.
+;; Whether a local-module's state variable is also reset in target
+;; buffers up to the module. That is, by default, they're left alone.
+
+(ert-deftest erc-scenarios-base-local-module-modes--entrypoint ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/local-modules")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'first 'first))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons 'sasl erc-modules))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Round one, initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester"))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
+ (funcall expect 10 "This server is in debug mode")
+ (erc-cmd-JOIN "#chan")
+
+ (ert-info ("Toggle local-module off in target buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (erc-sasl-mode -1)))
+
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")
+
+ (ert-info ("Toggle mode off")
+ (erc-sasl-mode -1)
+ (should (local-variable-p 'erc-sasl-mode)))))
+
+ (ert-info ("Reconnecting via entry point discards `erc-sasl-mode' value.")
+ ;; If you were to /RECONNECT here, no PASS changeme would be
+ ;; sent instead of CAP SASL, resulting in a failure.
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name))
+ (funcall expect 10 "You are now logged in as tester")
+
+ (erc-d-t-wait-for 10 (equal (buffer-name) "foonet"))
+ (funcall expect 10 "User modes for tester")
+ (should erc-sasl-mode)) ; obviously
+
+ ;; No other foonet buffer exists, e.g., foonet<2>
+ (should-not (cdr (erc-scenarios-common-buflist "foonet")))
+
+ (ert-info ("Target buffer retains local-module state")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "She is Lavinia, therefore must")
+ (should-not erc-sasl-mode)
+ (should (local-variable-p 'erc-sasl-mode))
+ (erc-cmd-QUIT ""))))))
+
+;;; erc-scenarios-base-local-module-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el b/test/lisp/erc/erc-scenarios-base-local-modules.el
index 1318207a3bf..d6dbd87c8cc 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -82,105 +82,6 @@ erc-scenarios-base-local-modules--reconnect-let
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))))
-;; After quitting a session for which `sasl' is enabled, you
-;; disconnect and toggle `erc-sasl-mode' off. You then reconnect
-;; using an alternate nickname. You again disconnect and reconnect,
-;; this time immediately, and the mode stays disabled. Finally, you
-;; once again disconnect, toggle the mode back on, and reconnect. You
-;; are authenticated successfully, just like in the initial session.
-;;
-;; This is meant to show that a user's local mode settings persist
-;; between sessions. It also happens to show (in round four, below)
-;; that a server renicking a user on 001 after a 903 is handled just
-;; like a user-initiated renick, although this is not the main thrust.
-
-(ert-deftest erc-scenarios-base-local-modules--mode-persistence ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/local-modules")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'first 'second 'third 'fourth))
- (port (process-contact dumb-server :service))
- (erc-modules (cons 'sasl erc-modules))
- (expect (erc-d-t-make-expecter))
- (server-buffer-name (format "127.0.0.1:%d" port)))
-
- (ert-info ("Round one, initial authentication succeeds as expected")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :user "tester"
- :password "changeme"
- :full-name "tester")
- (should (string= (buffer-name) server-buffer-name))
- (funcall expect 10 "You are now logged in as tester"))
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet"))
- (funcall expect 10 "This server is in debug mode")
- (erc-cmd-JOIN "#chan")
-
- (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
- (funcall expect 20 "She is Lavinia, therefore must"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round two, nick rejected, alternate granted")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode off, reconnect")
- (erc-sasl-mode -1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle"))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round three, send alternate nick initially")
- (with-current-buffer "foonet"
-
- (ert-info ("Keep mode off, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester`")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Let our reciprocal vows be remembered."))
-
- (erc-cmd-QUIT "")
- (funcall expect 10 "finished")))
-
- (ert-info ("Round four, authenticated successfully again")
- (with-current-buffer "foonet"
-
- (ert-info ("Toggle mode on, reconnect")
- (should-not erc-sasl-mode)
- (should (local-variable-p 'erc-sasl-mode))
- (erc-sasl-mode +1)
- (erc-cmd-RECONNECT))
-
- (funcall expect 10 "User modes for tester")
- (should-not (cdr (erc-scenarios-common-buflist "foonet")))
- (should (equal (buffer-name) "foonet"))
- (should-not (cdr (erc-scenarios-common-buflist "#chan")))
-
- (with-current-buffer "#chan"
- (funcall expect 10 "Well met; good morrow, Titus and Hortensius."))
-
- (erc-cmd-QUIT "")))))
-
;; For local modules, the twin toggle commands `erc-FOO-enable' and
;; `erc-FOO-disable' affect all buffers of a connection, whereas
;; `erc-FOO-mode' continues to operate only on the current buffer.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 40a2d2de657..c5a40d9bc72 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -117,11 +117,7 @@ erc-tests--send-prep
;; Caller should probably shadow `erc-insert-modify-hook' or
;; populate user tables for erc-button.
(erc-mode)
- (insert "\n\n")
- (setq erc-input-marker (make-marker)
- erc-insert-marker (make-marker))
- (set-marker erc-insert-marker (point-max))
- (erc-display-prompt)
+ (erc--initialize-markers (point) nil)
(should (= (point) erc-input-marker)))
(defun erc-tests--set-fake-server-process (&rest args)
@@ -257,6 +253,79 @@ erc-hide-prompt
(kill-buffer "bob")
(kill-buffer "ServNet"))))
+(ert-deftest erc--initialize-markers ()
+ (let ((proc (start-process "true" (current-buffer) "true"))
+ erc-modules
+ erc-connect-pre-hook
+ erc-insert-modify-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (set-process-query-on-exit-flag proc nil)
+ (erc-mode)
+ (setq erc-server-process proc
+ erc-networks--id (erc-networks--id-create 'foonet))
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 3 (marker-position erc-insert-marker)))
+ (should (= 8 (marker-position erc-input-marker)))
+ (should (= 8 (point-max)))
+ (should (= 8 (point)))
+ ;; These prompt properties are a continual source of confusion.
+ ;; Including the literal defaults here can hopefully serve as a
+ ;; quick reference for anyone operating in that area.
+ (should (equal (buffer-string)
+ #("\n\nERC> "
+ 2 6 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 6 7 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+
+ ;; Simulate some activity by inserting some text before and
+ ;; after the prompt (multiline).
+ (erc-display-error-notice nil "Welcome")
+ (goto-char (point-max))
+ (insert "Hello\nWorld")
+ (goto-char 3)
+ (should (looking-at-p (regexp-quote "*** Welcome"))))
+
+ (ert-info ("Reconnect")
+ (erc-open "localhost" 6667 "tester" "Tester" nil
+ "fake" nil "#chan" proc nil "user" nil)
+ (should-not (get-buffer "#chan<2>")))
+
+ (ert-info ("Existing prompt respected")
+ (with-current-buffer (should (get-buffer "#chan"))
+ (should (= ?\n (char-after 1)))
+ (should (= ?E (char-after erc-insert-marker)))
+ (should (= 15 (marker-position erc-insert-marker)))
+ (should (= 20 (marker-position erc-input-marker)))
+ (should (= 3 (point))) ; point restored
+ (should (equal (buffer-string)
+ #("\n\n*** Welcome\nERC> Hello\nWorld"
+ 2 13 (font-lock-face erc-error-face)
+ 14 18 ( font-lock-face erc-prompt-face
+ rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ 18 19 ( rear-nonsticky t
+ erc-prompt t
+ field erc-prompt
+ front-sticky t
+ read-only t))))
+ (when noninteractive
+ (kill-buffer))))))
+
(ert-deftest erc--switch-to-buffer ()
(defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 5571 bytes --]
From 8d61af8380bb1589d50434bcddaae14039139dd9 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Jun 2022 01:20:49 -0700
Subject: [PATCH 2/8] [5.6] Adjust some old text properties in ERC buffers
TODO: mention adjustment in ERC-NEWS for 5.6.
* lisp/erc/erc.el (erc-display-message): Replace `rear-sticky' text
property, which has been around since 2002, with more useful
`erc-message' property.
(erc-display-prompt): Make the `field' text property more meaningful
to aid in searching, although this makes the `erc-prompt' property
somewhat redundant.
(erc-put-text-property, erc-list): Alias these to built-in functions.
(erc--own-property-names, erc--remove-text-properties) Add internal
variable and helper function for filtering values returned by
`filter-buffer-substring-function'.
(erc-restore-text-properties): Don't forget tags when restoring.
(erc--get-eq-comparable-cmd): New function to extract commands for use
as easily searchable text-property values. (Bug#60936.)
---
lisp/erc/erc.el | 57 +++++++++++++++++++++++++++++++++++++------------
1 file changed, 43 insertions(+), 14 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 8261801ec0d..95d374b121e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2880,7 +2880,9 @@ erc-display-message
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (erc-put-text-property 0 (length string) 'rear-sticky t string)
+ (put-text-property
+ 0 (length string) 'erc-message
+ (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
string))
@@ -4258,6 +4260,30 @@ erc-ensure-channel-name
channel
(concat "#" channel)))
+(defvar erc--own-property-names
+ '( tags erc-parsed display ; core
+ ;; `erc-display-prompt'
+ rear-nonsticky erc-prompt field front-sticky read-only
+ ;; stamp
+ cursor-intangible cursor-sensor-functions isearch-open-invisible
+ ;; match
+ invisible intangible
+ ;; button
+ erc-callback erc-data mouse-face keymap
+ ;; fill-wrap
+ line-prefix wrap-prefix)
+ "Props added by ERC that should not survive killing.
+Among those left behind by default are `font-lock-face' and
+`erc-secret'.")
+
+(defun erc--remove-text-properties (string)
+ "Remove text properties in STRING added by ERC.
+Specifically, remove any that aren't members of
+`erc--own-property-names'."
+ (remove-list-of-text-properties 0 (length string)
+ erc--own-property-names string)
+ string)
+
(defun erc-grab-region (start end)
"Copy the region between START and END in a recreatable format.
@@ -4309,7 +4335,7 @@ erc-display-prompt
(setq prompt (propertize prompt
'rear-nonsticky t
'erc-prompt t
- 'field t
+ 'field 'erc-prompt
'front-sticky t
'read-only t))
(erc-put-text-property 0 (1- (length prompt))
@@ -5681,7 +5707,7 @@ erc-highlight-error
(erc-put-text-property 0 (length s) 'font-lock-face 'erc-error-face s)
s)
-(defun erc-put-text-property (start end property value &optional object)
+(defalias 'erc-put-text-property 'put-text-property
"Set text-property for an object (usually a string).
START and END define the characters covered.
PROPERTY is the text-property set, usually the symbol `face'.
@@ -5691,14 +5717,9 @@ erc-put-text-property
OBJECT is modified without being copied first.
You can redefine or `defadvice' this function in order to add
-EmacsSpeak support."
- (put-text-property start end property value object))
+EmacsSpeak support.")
-(defun erc-list (thing)
- "Return THING if THING is a list, or a list with THING as its element."
- (if (listp thing)
- thing
- (list thing)))
+(defalias 'erc-list 'ensure-list)
(defun erc-parse-user (string)
"Parse STRING as a user specification (nick!login@host).
@@ -7292,10 +7313,11 @@ erc-find-parsed-property
(defun erc-restore-text-properties ()
"Restore the property `erc-parsed' for the region."
- (let ((parsed-posn (erc-find-parsed-property)))
- (put-text-property
- (point-min) (point-max)
- 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
+ (when-let* ((parsed-posn (erc-find-parsed-property))
+ (found (erc-get-parsed-vector parsed-posn)))
+ (put-text-property (point-min) (point-max) 'erc-parsed found)
+ (when-let ((tags (get-text-property parsed-posn 'tags)))
+ (put-text-property (point-min) (point-max) 'tags tags))))
(defun erc-get-parsed-vector (point)
"Return the whole parsed vector on POINT."
@@ -7315,6 +7337,13 @@ erc-get-parsed-vector-type
(and vect
(erc-response.command vect)))
+(defun erc--get-eq-comparable-cmd (command)
+ "Return a symbol or a fixnum representing a message's COMMAND.
+See also `erc-message-type'."
+ ;; IRC numerics are three-digit numbers, possibly with leading 0s.
+ ;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
+ (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Expose-insertion-time-as-text-prop-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 13060 bytes --]
From d42790326b1ae2c3340113ff979dea309df5097f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 03:10:20 -0800
Subject: [PATCH 3/8] [5.6] 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.
When the stamps module isn't loaded, the `erc-message' property can be
used 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.)
---
lisp/erc/erc-stamp.el | 15 ++-
test/lisp/erc/erc-stamp-tests.el | 207 +++++++++++++++++++++++++++++++
2 files changed, 217 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-stamp-tests.el
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0aa1590f801..051d0702f06 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -162,7 +162,7 @@ erc-add-timestamp
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
@@ -174,12 +174,12 @@ erc-add-timestamp
(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.
@@ -400,11 +400,16 @@ erc-toggle-timestamps
(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
index 00000000000..935b9e650b3
--- /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
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Make-some-erc-stamp-functions-more-limber.patch --]
[-- Type: text/x-patch, Size: 5221 bytes --]
From 890945775a3b0aeb060a66d33590e6b85a25adb7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 4/8] [5.6] Make some erc-stamp functions more limber
TODO: update ERC-NEWS announcing deprecation.
* lisp/erc/erc-stamp.el (erc-timestamp-format-right): Deprecate option
and change meaning of its nil value to fall through to
`erc-timestamp-format'. Do this to allow modules to predict what the
right-hand stamp's final width will be. This also saves
`erc-insert-timestamp-left-and-right' from calling
`erc-format-timestamp' again for no reason.
(erc-stamp--current-time): Add new generic function and method to
return current time. Default to calling `current-time'.
(erc-stamp--current-time): New internal variable to hold time value
used to construct time formatted stamp passed to
`erc-insert-timestamp-function'.
(erc-add-timestamp): Bind `erc-stamp--current-time' when calling
`erc-insert-timestamp-function'.
(erc-insert-timestamp-left-and-right): Use STRING parameter and favor
it over the now deprecated `erc-timestamp-format-right' to avoid
formatting twice. Also extract current time from the variable
`erc-stamp--current-time' for similar reasons. (Bug#60936.)
(erc-stamp--tz): New internal variable.
(erc-format-timestamp): Pass `erc-stamp--tz' as time-zone to
`format-time-string'.
---
lisp/erc/erc-stamp.el | 39 +++++++++++++++++++++++++++++++--------
1 file changed, 31 insertions(+), 8 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 051d0702f06..736aa498803 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,6 +55,9 @@ erc-timestamp-format
:type '(choice (const nil)
(string)))
+;; FIXME remove surrounding whitespace from default value and have
+;; `erc-insert-timestamp-left-and-right' add it before insertion.
+
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
@@ -68,7 +71,7 @@ erc-timestamp-format-left
:type '(choice (const nil)
(string)))
-(defcustom erc-timestamp-format-right " [%H:%M]"
+(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
@@ -77,9 +80,14 @@ erc-timestamp-format-right
screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
-If nil, timestamping is turned off."
+Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if
+the value of this option is nil, it falls back to using the value
+of `erc-timestamp-format'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil)
(string)))
+(make-obsolete-variable 'erc-timestamp-format-right
+ 'erc-timestamp-format "30.1")
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
"Function to use to insert timestamps.
@@ -157,17 +165,31 @@ stamp
(remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
(remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
+(defvar erc-stamp--current-time nil
+ "The current time when calling `erc-insert-timestamp-function'.
+Specifically, this is the same lisp time object used to create
+the stamp passed to `erc-insert-timestamp-function'.")
+
+(cl-defgeneric erc-stamp--current-time ()
+ "Return a lisp time object to associate with an IRC message.
+This becomes the message's `erc-timestamp' text property, which
+may not be unique."
+ (current-time))
+
+(cl-defmethod erc-stamp--current-time :around ()
+ (or erc-stamp--current-time (cl-call-next-method)))
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
(unless (get-text-property (point-min) 'invisible)
- (let ((ct (current-time)))
- (if (fboundp erc-insert-timestamp-function)
- (funcall erc-insert-timestamp-function
- (erc-format-timestamp ct erc-timestamp-format))
- (error "Timestamp function unbound"))
+ (let* ((ct (erc-stamp--current-time))
+ (erc-stamp--current-time ct))
+ (funcall erc-insert-timestamp-function
+ (erc-format-timestamp ct erc-timestamp-format))
+ ;; FIXME this will error when advice has been applied.
(when (and (fboundp erc-insert-away-timestamp-function)
erc-away-timestamp-format
(erc-away-time)
@@ -336,12 +358,13 @@ erc-insert-timestamp-left-and-right
(setq erc-timestamp-last-inserted-right ts-right))))
;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
+(defvar erc-stamp--tz nil)
(defun erc-format-timestamp (time format)
"Return TIME formatted as string according to FORMAT.
Return the empty string if FORMAT is nil."
(if format
- (let ((ts (format-time-string format time)))
+ (let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
(erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-5.6-Put-display-properties-to-better-use-in-erc-stam.patch --]
[-- Type: text/x-patch, Size: 16168 bytes --]
From f3f15873c9e9c0ae90b34becf3f2db23ed11f8aa Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 5/8] [5.6] Put display properties to better use in erc-stamp
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Enhance meaning
of option to accept numeric value for dynamically aligned right-side
stamps. Use `graphic-display-p' to determine default value even
though, as stated in the manual, terminal Emacs also supports the
"space" display spec.
(erc-stamp-right-margin-width): New option to determine width of right
margin when `erc-stamp--display-margin-mode' is active or
`erc-timestamp-use-align-to' is set to `margin'.
(erc-stamp--display-margin-force): Add new helper function for
`erc-stamp--display-margin-mode'.
(erc-stamp--display-margin-mode): Add internal minor mode to help
other modules quickly ensure stamps are showing correctly.
(erc-stamp--inherited-props): Add internal const to hold properties
that should be inherited from message being inserted.
(erc-insert-aligned): Deprecate function and remove from primary
client code path.
(erc-insert-timestamp-right): Account for new display-related values
of `erc-timestamp-use-align-to'.
* test/lisp/erc/erc-stamp-tests.el (erc-timestamp-use-align-to--nil,
erc-timestamp-use-align-to--t): Adjust spacing for new default
right-hand stamp, `erc-format-timestamp', which lacks a leading space.
(erc-timestamp-use-align-to--integer,
erc-timestamp-use-align-to--margin): New tests. (Bug#60936.)
---
lisp/erc/erc-stamp.el | 156 +++++++++++++++++++++++++++----
test/lisp/erc/erc-stamp-tests.el | 70 ++++++++++++--
2 files changed, 202 insertions(+), 24 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 736aa498803..e689caf7b61 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -239,14 +239,109 @@ erc-timestamp-right-column
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
-(defcustom erc-timestamp-use-align-to (eq window-system 'x)
+(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
"If non-nil, use the :align-to display property to align the stamp.
This gives better results when variable-width characters (like
Asian language characters and math symbols) precede a timestamp.
-A side effect of enabling this is that there will only be one
-space before a right timestamp in any saved logs."
- :type 'boolean)
+This option only matters when `erc-insert-timestamp-function' is
+set to `erc-insert-timestamp-right' or that option's default,
+`erc-insert-timestamp-left-and-right'. If the value is a
+positive integer, alignment occurs that many columns from the
+right edge. If the value is `margin', the stamp appears in the
+right margin when visible.
+
+Enabling this option produces a side effect in that stamps aren't
+indented in saved logs. When its value is an integer, this
+option adds a space after the end of a message if the stamp
+doesn't already start with one. And when its value is t, it adds
+a single space, unconditionally. And while this option never
+adds a space when its value is `margin', ERC does offer a
+workaround in `erc-stamp-prefix-log-filter', which strips
+trailing stamps from messages and puts them before every line."
+ :type '(choice boolean integer (const margin))
+ :package-version '(ERC . "5.6")) ; FIXME sync on release
+
+(defcustom erc-stamp-right-margin-width nil
+ "Width in columns of the right margin.
+When this option is nil, pretend its value is one column greater
+than the `string-width' of the formatted `erc-timestamp-format'.
+This option only matters when `erc-timestamp-use-align-to' is set
+to `margin'."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) integer))
+
+(defun erc-stamp--display-margin-force (orig &rest r)
+ (let ((erc-timestamp-use-align-to 'margin))
+ (apply orig r)))
+
+(defun erc-stamp--adjust-right-margin (cols)
+ "Adjust right margin by COLS.
+When COLS is zero, reset width to `erc-stamp-right-margin-width'
+or one col more than the `string-width' of
+`erc-timestamp-format'."
+ (let ((width
+ (if (zerop cols)
+ (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))
+ (+ right-margin-width cols))))
+ (setq right-margin-width width
+ right-fringe-width 0)
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 0)))
+
+(defun erc-stamp-prefix-log-filter (text)
+ "Prefix every message in the buffer with a stamp.
+Remove trailing stamps as well. For now, hard code the format to
+\"ZNC\"-log style, which is [HH:MM:SS]. Expect to be used as a
+`erc-log-filter-function' when `erc-timestamp-use-align-to' is
+non-nil."
+ (insert text)
+ (goto-char (point-min))
+ (while
+ (progn
+ (when-let* (((< (point) (pos-eol)))
+ (end (1- (pos-eol)))
+ ((eq 'erc-timestamp (field-at-pos end)))
+ (beg (field-beginning end))
+ ;; Skip a line that's just a timestamp.
+ ((> beg (point))))
+ (delete-region beg (1+ end)))
+ (when-let (time (get-text-property (point) 'erc-timestamp))
+ (insert (format-time-string "[%H:%M:%S] " time)))
+ (zerop (forward-line))))
+ "")
+
+(declare-function erc--remove-text-properties "erc" (string))
+
+;; If people want to use this directly, we can convert it into
+;; a local module.
+(define-minor-mode erc-stamp--display-margin-mode
+ "Internal minor mode for built-in modules integrating with `stamp'.
+It binds `erc-timestamp-use-align-to' to `margin' around calls to
+`erc-insert-timestamp-function' in the current buffer, and sets
+the right window margin to `erc-stamp-right-margin-width'. It
+also arranges to remove most text properties when a user kills
+message text so that stamps will be visible when yanked."
+ :interactive nil
+ (if erc-stamp--display-margin-mode
+ (progn
+ (erc-stamp--adjust-right-margin 0)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (add-function :around (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force))
+ (remove-function (local 'filter-buffer-substring-function)
+ #'erc--remove-text-properties)
+ (remove-function (local 'erc-insert-timestamp-function)
+ #'erc-stamp--display-margin-force)
+ (kill-local-variable 'right-margin-width)
+ (kill-local-variable 'right-fringe-width)
+ (set-window-margins nil left-margin-width nil)
+ (set-window-fringes nil left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -265,6 +360,7 @@ erc-insert-aligned
If `erc-timestamp-use-align-to' is t, use the :align-to display
property to get to the POSth column."
+ (declare (obsolete "inlined and removed from client code path" "30.1"))
(if (not erc-timestamp-use-align-to)
(indent-to pos)
(insert " ")
@@ -275,6 +371,8 @@ erc-insert-aligned
;; Silence byte-compiler
(defvar erc-fill-column)
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
STRING is the timestamp to insert. This function is a possible
@@ -326,25 +424,47 @@ erc-insert-timestamp-right
;; some margin of error if what is displayed on the line differs
;; from the number of characters on the line.
(setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6))))
- (if (< col pos)
- (erc-insert-aligned string pos)
- (newline)
- (indent-to pos)
- (setq from (point))
- (insert string))
+ ;; For compatibility reasons, the `erc-timestamp' field includes
+ ;; intervening white space unless a hard break is warranted.
+ (pcase erc-timestamp-use-align-to
+ ((and 't (guard (< col pos)))
+ (insert " ")
+ (put-text-property from (point) 'display `(space :align-to ,pos)))
+ ((pred integerp) ; (cl-type (integer 0 *))
+ (insert " ")
+ (when (eq ?\s (aref string 0))
+ (setq string (substring string 1)))
+ (let ((s (+ erc-timestamp-use-align-to (string-width string))))
+ (put-text-property from (point) 'display
+ `(space :align-to (- right ,s)))))
+ ('margin
+ (put-text-property 0 (length string)
+ 'display `((margin right-margin) ,string)
+ string))
+ ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+ (_ (indent-to pos)))
+ (insert string)
+ (dolist (p erc-stamp--inherited-props)
+ (when-let ((v (get-text-property (1- from) p)))
+ (put-text-property from (point) p v)))
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defun erc-insert-timestamp-left-and-right (_string)
- "This is another function that can be used with `erc-insert-timestamp-function'.
-If the date is changed, it will print a blank line, the date, and
-another blank line. If the time is changed, it will then print
-it off to the right."
- (let* ((ct (current-time))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
- (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
+(defun erc-insert-timestamp-left-and-right (string)
+ "Insert a stamp on either side when it changes.
+When the deprecated option `erc-timestamp-format-right' is nil,
+use STRING, which originates from `erc-timestamp-format', for the
+right-hand stamp. Use `erc-timestamp-format-left' for the
+left-hand stamp and expect it to change less frequently."
+ (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
+ (ts-right (with-suppressed-warnings
+ ((obsolete erc-timestamp-format-right))
+ (if erc-timestamp-format-right
+ (erc-format-timestamp ct erc-timestamp-format-right)
+ string))))
;; insert left timestamp
(unless (string-equal ts-left erc-timestamp-last-inserted-left)
(goto-char (point-min))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 935b9e650b3..01e71e348e0 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -68,7 +68,7 @@ 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))
+ (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
@@ -85,9 +85,9 @@ 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))
+ (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field excludes leading whitespace (arguably undesirable).
- (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
;; Timestamp extends to the end of the line.
(should (eql ?\n (char-after (field-end (point)))))))))
@@ -101,7 +101,7 @@ erc-timestamp-use-align-to--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))
+ (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))))))
@@ -112,9 +112,67 @@ erc-timestamp-use-align-to--t
(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))
+ (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 ?\[ (char-after (field-beginning (point)))))
+ (should (eql ?\n (char-after (field-end (point)))))))))
+
+(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-timestamp-use-align-to--margin ()
+ (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))
+ ;; Space not added (treated as opaque string).
+ (should (search-forward "msg one[" nil t))
+ ;; Field covers stamp alone
+ (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 format string (right bracket)
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns a proposed partial reversal of the changes resulting
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0006-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch --]
[-- Type: text/x-patch, Size: 2458 bytes --]
From 5f414800a7f16d990bf2531f9a2dd97fd5c3ff07 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 24 Apr 2022 02:38:12 -0700
Subject: [PATCH 6/8] [5.6] Convert erc-fill minor mode into a proper module
* lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-enable,
erc-fill-disable): Use API to create these.
(erc-fill-static): Save restriction instead of caller's match
data. (Bug#60936.)
---
lisp/erc/erc-fill.el | 34 +++++++++++-----------------------
1 file changed, 11 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e10b7d790f6..caf401bf222 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,30 +38,18 @@ erc-fill
:group 'erc)
;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(define-minor-mode erc-fill-mode
- "Toggle ERC fill mode.
-With a prefix argument ARG, enable ERC fill mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
+(define-erc-module fill nil
+ "Manage filling in ERC buffers.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- :global t
- (if erc-fill-mode
- (erc-fill-enable)
- (erc-fill-disable)))
-
-(defun erc-fill-enable ()
- "Setup hooks for `erc-fill-mode'."
- (interactive)
- (add-hook 'erc-insert-modify-hook #'erc-fill)
- (add-hook 'erc-send-modify-hook #'erc-fill))
-
-(defun erc-fill-disable ()
- "Cleanup hooks, disable `erc-fill-mode'."
- (interactive)
- (remove-hook 'erc-insert-modify-hook #'erc-fill)
- (remove-hook 'erc-send-modify-hook #'erc-fill))
+ ;; FIXME ensure a consistent ordering relative to hook members from
+ ;; other modules. Ideally, this module's processing should happen
+ ;; after "morphological" modifications to a message's text but
+ ;; before superficial decorations.
+ ((add-hook 'erc-insert-modify-hook #'erc-fill)
+ (add-hook 'erc-send-modify-hook #'erc-fill))
+ ((remove-hook 'erc-insert-modify-hook #'erc-fill)
+ (remove-hook 'erc-send-modify-hook #'erc-fill)))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
@@ -130,7 +118,7 @@ erc-fill
(defun erc-fill-static ()
"Fills a text such that messages start at column `erc-fill-static-center'."
- (save-match-data
+ (save-restriction
(goto-char (point-min))
(looking-at "^\\(\\S-+\\)")
(let ((nick (match-string 1)))
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0007-5.6-Add-variant-for-erc-match-invisibility-spec.patch --]
[-- Type: text/x-patch, Size: 3272 bytes --]
From 89ad86dfc004f855344745fccd857edfd70f14cf Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 27 Jan 2023 05:34:56 -0800
Subject: [PATCH 7/8] [5.6] Add variant for erc-match invisibility spec
* lisp/erc/erc-match.el (erc-match-enable, erc-match-disable): Arrange
for possibly adding or removing `erc-match' from
`buffer-invisibility-spec'.
(erc-match--hide-fools-offset-bounds): Add new variable to serve as
switch for activating invisibility on a modified interval that's
offset toward `point-min' by one character.
(erc-hide-fools): Optionally offset start and end of invisible region
by minus one.
(erc-match--modify-invisibility-spec): New housekeeping function to
set up and tear down offset spec. (Bug#60936.)
---
lisp/erc/erc-match.el | 31 ++++++++++++++++++++++++-------
1 file changed, 24 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 52ee5c855f3..a5e9720bad4 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -52,8 +52,11 @@ match
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append))
- ((remove-hook 'erc-insert-modify-hook #'erc-match-message)))
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append)
+ (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec))
+ ((remove-hook 'erc-insert-modify-hook #'erc-match-message)
+ (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
+ (erc-match--modify-invisibility-spec)))
;; Remaining customizations
@@ -647,15 +650,22 @@ erc-go-to-log-matches-buffer
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
-(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
+(defvar-local erc-match--hide-fools-offset-bounds nil)
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
- (when (eq match-type 'fool)
- (erc-put-text-properties (point-min) (point-max)
- '(invisible intangible)
- (current-buffer))))
+ (when (eq match-type 'fool)
+ (if erc-match--hide-fools-offset-bounds
+ (let ((beg (point-min))
+ (end (point-max)))
+ (save-restriction
+ (widen)
+ (put-text-property (1- beg) (1- end) 'invisible 'erc-match)))
+ ;; The docs say `intangible' is deprecated, but this has been
+ ;; like this for ages. Should verify unneeded and remove if so.
+ (erc-put-text-properties (point-min) (point-max)
+ '(invisible intangible)))))
(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
@@ -663,6 +673,13 @@ erc-beep-on-match
(when (member match-type erc-beep-match-types)
(beep)))
+(defun erc-match--modify-invisibility-spec ()
+ "Add an ellipsis property to the local spec."
+ (if erc-match-mode
+ (add-to-invisibility-spec 'erc-match)
+ (erc-with-all-buffers-of-server nil nil
+ (remove-from-invisibility-spec 'erc-match))))
+
(provide 'erc-match)
;;; erc-match.el ends here
--
2.39.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #10: 0008-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch --]
[-- Type: text/x-patch, Size: 39308 bytes --]
From 1162cf9dc8e1d6f6a99d99c4c49cae949d2d04d3 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 00:00:56 -0800
Subject: [PATCH 8/8] [5.6] Add erc-fill style based on visual-line-mode
* lisp/erc/erc-common.el (erc--features-to-modules): Add mapping for
local module `fill-wrap'.
* lisp/erc/erc-compat.el (erc-compat--29-set-transient-map-timer,
erc-compat--29-set-transient-map, erc-compat--set-transient-map):
Backport `set-transient-map' definition from Emacs 29.
* lisp/erc/erc-fill.el (erc-fill-function): Add new value,
`erc-fill-wrap'.
(erc-fill-static-center): Extend meaning of option to also affect
`erc-wrap-mode'.
(erc-fill--wrap-value, erc-fill--wrap-movement): New variables to
support new local module.
(erc-fill-wrap-movement): New option to control how where
`visual-line-mode' keys are active.
(erc-fill--wrap-kill-line, erc-fill--wrap-beginning-of-line,
erc-fill--wrap-end-of-line): New movement commands.
(erc-fill-wrap-cycle-visual-movement): New command to cycle local
value of `erc-fill-wrap-movement'.
(erc-fill-wrap-mode-map): New map based on `visual-line-mode-map'.
(erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable): New
local module.
(erc-fill-wrap): New function implementing
`erc-fill-function' (behavioral) interface.
(erc-fill-wrap-nudge, erc-fill--wrap-nudge): New command and helper
for growing and shrinking visual fill prefix.
* test/lisp/erc/erc-fill-tests.el: New file. (Bug#60936.)
---
lisp/erc/erc-compat.el | 57 +++
lisp/erc/erc-fill.el | 273 ++++++++++++++-
test/lisp/erc/erc-fill-tests.el | 324 ++++++++++++++++++
.../fill/snapshots/monospace-01-start.eld | 1 +
.../fill/snapshots/monospace-02-right.eld | 1 +
.../fill/snapshots/monospace-03-left.eld | 1 +
.../fill/snapshots/monospace-04-reset.eld | 1 +
7 files changed, 653 insertions(+), 5 deletions(-)
create mode 100644 test/lisp/erc/erc-fill-tests.el
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 5601ede27a5..7d635e5b1af 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -409,6 +409,63 @@ erc-compat--29-browse-url-irc
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+;; FIXME remove these after bumping Compat version to 29
+(defvar erc-compat--29-set-transient-map-timer nil)
+
+(defun erc-compat--29-set-transient-map
+ (map &optional keep-pred on-exit message timeout)
+ (let* ((message
+ (when message
+ (let (keys)
+ (map-keymap (lambda (key cmd) (and cmd (push key keys))) map)
+ (format-spec
+ (if (stringp message) message "Repeat with %k")
+ `((?k . ,(mapconcat
+ (lambda (key)
+ (substitute-command-keys
+ (format "\\`%s'" (key-description (vector key)))))
+ keys ", ")))))))
+ (clearfun (make-symbol "clear-transient-map"))
+ (exitfun (lambda ()
+ (internal-pop-keymap map 'overriding-terminal-local-map)
+ (remove-hook 'pre-command-hook clearfun)
+ (when message (message ""))
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (when on-exit (funcall on-exit)))))
+ (fset clearfun
+ (lambda ()
+ (with-demoted-errors "set-transient-map PCH: %S"
+ (if (cond
+ ((null keep-pred) nil)
+ ((and (not (eq map (cadr overriding-terminal-local-map)))
+ (memq map (cddr overriding-terminal-local-map)))
+ t)
+ ((eq t keep-pred)
+ (let ((mc (lookup-key map (this-command-keys-vector))))
+ (when (and mc (symbolp mc))
+ (setq mc (or (command-remapping mc) mc)))
+ (and mc (eq this-command mc))))
+ (t (funcall keep-pred)))
+ (when message (message "%s" message))
+ (funcall exitfun)))))
+ (add-hook 'pre-command-hook clearfun)
+ (internal-push-keymap map 'overriding-terminal-local-map)
+ (when timeout
+ (when erc-compat--29-set-transient-map-timer
+ (cancel-timer erc-compat--29-set-transient-map-timer))
+ (setq erc-compat--29-set-transient-map-timer
+ (run-with-idle-timer timeout nil exitfun)))
+ (when message (message "%s" message))
+ exitfun))
+
+(defmacro erc-compat--set-transient-map (&rest args)
+ (cons (if (>= emacs-major-version 29)
+ 'set-transient-map
+ 'erc-compat--29-set-transient-map)
+ args))
+
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index caf401bf222..032206b514a 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
;; change the style.
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
;;; Code:
(require 'erc)
@@ -79,16 +82,29 @@ erc-fill-function
These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
-function is called."
+function is called.
+
+A third style resembles static filling but \"wraps\" instead of
+fills, thanks to `visual-line-mode' mode, which ERC automatically
+enables when this option is `erc-fill-wrap' or when
+`erc-fill-wrap-mode' is active. Set `erc-fill-static-center' to
+your preferred initial \"prefix\" width. For adjusting the width
+during a session, see the command `erc-fill-wrap-nudge'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
+ (const :tag "Dynamic word-wrap" erc-fill-wrap)
function))
(defcustom erc-fill-static-center 27
- "Column around which all statically filled messages will be centered.
-This column denotes the point where the ` ' character between
-<nickname> and the entered text will be put, thus aligning nick
-names right and text left."
+ "Number of columns to \"outdent\" the first line of a message.
+During early message handing, ERC prepends a span of
+non-whitespace characters to every message, such as a bracketed
+\"<nickname>\" or an `erc-notice-prefix'. The
+`erc-fill-function' variants `erc-fill-static' and
+`erc-fill-wrap' look to this option to determine the amount of
+padding to apply to that portion until the filled (or wrapped)
+message content aligns with the indicated column. See also
+https://en.wikipedia.org/wiki/Hanging_indent."
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
@@ -155,6 +171,253 @@ erc-fill-variable
(erc-fill-regarding-timestamp))))
(erc-restore-text-properties)))
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-visual-keys nil)
+
+(defcustom erc-fill-wrap-use-pixels t
+ "Whether to calculate padding in pixels when possible.
+A value of nil means ERC should use columns, which may happen
+regardless, depending on the Emacs version. This option only
+matters when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type 'boolean)
+
+(defcustom erc-fill-wrap-visual-keys 'non-input
+ "Whether to retain keys defined by `visual-line-mode'.
+A value of t tells ERC to use movement commands defined by
+`visual-line-mode' everywhere in an ERC buffer along with visual
+editing commands in the input area. A value of nil means to
+never do so. A value of `non-input' tells ERC to act like the
+value is nil in the input area and t elsewhere. This option only
+plays a role when `erc-fill-wrap-mode' is enabled."
+ :package-version '(ERC . "5.6") ; FIXME sync on release
+ :type '(choice (const nil) (const t) (const non-input)))
+
+(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
+ (funcall (pcase erc-fill--wrap-visual-keys
+ ('non-input
+ (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ arg))
+
+(defun erc-fill--wrap-kill-line (arg)
+ "Defer to `kill-line' or `kill-visual-line'."
+ (interactive "P")
+ ;; ERC buffers are read-only outside of the input area, but we run
+ ;; `kill-line' anyway so that users can see the error.
+ (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
+
+(defun erc-fill--wrap-beginning-of-line (arg)
+ "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
+ (interactive "^p")
+ (let ((inhibit-field-text-motion t))
+ (erc-fill--wrap-move #'move-beginning-of-line
+ #'beginning-of-visual-line arg))
+ (when (get-text-property (point) 'erc-prompt)
+ (goto-char erc-input-marker)))
+
+(defun erc-fill--wrap-end-of-line (arg)
+ "Defer to `move-end-of-line' or `end-of-visual-line'."
+ (interactive "^p")
+ (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+ "Cycle through `erc-fill-wrap-visual-keys' styles ARG times.
+Go from nil to t to `non-input' and back around, but set internal
+state instead of mutating `erc-fill-wrap-visual-keys'. When ARG
+is 0, reset to value of `erc-fill-wrap-visual-keys'."
+ (interactive "^p")
+ (when (zerop arg)
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+ (while (not (zerop arg))
+ (cl-incf arg (- (abs arg)))
+ (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys
+ ('nil t)
+ ('t 'non-input)
+ ('non-input nil))))
+ (message "erc-fill-wrap-movement: %S" erc-fill--wrap-visual-keys))
+
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+ :doc "Keymap for ERC's `fill-wrap' module."
+ :parent visual-line-mode-map
+ "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+ "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+ "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+ "C-c a" #'erc-fill-wrap-cycle-visual-movement
+ ;; Not sure if this is problematic because `erc-bol' takes no args.
+ "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+
+(defvar erc-match-mode)
+(defvar erc-match--hide-fools-offset-bounds)
+
+;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
+(define-erc-module fill-wrap nil
+ "Fill style leveraging `visual-line-mode'.
+This local module depends on the global `fill' module. To use
+it, either include `fill-wrap' in `erc-modules' or set
+`erc-fill-function' to `erc-fill-wrap'. You can also manually
+invoke one of the minor-mode toggles. When the option
+`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
+or `erc-insert-timestamp-left-and-right', it shows timestamps in
+the right margin."
+ ((let (msg)
+ (unless erc-fill-mode
+ (unless (memq 'fill erc-modules)
+ (setq msg
+ ;; FIXME use `erc-button--display-error-notice-with-keys'
+ ;; when bug#60933 is ready.
+ (concat "Enabling default global module `fill' needed by local"
+ " module `fill-wrap'. This will impact \C-]all\C-] ERC"
+ " sessions. Add `fill' to `erc-modules' to avoid this"
+ " warning. See Info:\"(erc) Modules\" for more.")))
+ (erc-fill-mode +1))
+ ;; Set local value of user option (can we avoid this somehow?)
+ (unless (eq erc-fill-function #'erc-fill-wrap)
+ (setq-local erc-fill-function #'erc-fill-wrap))
+ (when-let* ((vars (or erc--server-reconnecting erc--target-priors))
+ ((alist-get 'erc-fill-wrap-mode vars)))
+ (setq erc-fill--wrap-visual-keys (alist-get 'erc-fill--wrap-visual-keys
+ vars)
+ erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars)))
+ (when (or erc-stamp-mode (memq 'stamp erc-modules))
+ (erc-stamp--display-margin-mode +1))
+ (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules))
+ (require 'erc-match)
+ (setq erc-match--hide-fools-offset-bounds t))
+ (setq erc-fill--wrap-value
+ (or erc-fill--wrap-value erc-fill-static-center))
+ (visual-line-mode +1)
+ (unless (local-variable-p 'erc-fill--wrap-visual-keys)
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+ (when msg
+ (erc-display-error-notice nil msg))))
+ ((when erc-stamp--display-margin-mode
+ (erc-stamp--display-margin-mode -1))
+ (kill-local-variable 'erc-button--add-nickname-face-function)
+ (kill-local-variable 'erc-fill--wrap-value)
+ (kill-local-variable 'erc-fill-function)
+ (kill-local-variable 'erc-fill--wrap-visual-keys)
+ (visual-line-mode -1))
+ 'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+ "Function to determine length of overhanging characters.
+It should return an EXPR as defined by the Info node `(elisp)
+Pixel Specification'. This value should represent the width of
+the overhang with all faces applied, including any enclosing
+brackets (which are not normally fontified) and a trailing space.
+It can also return nil to tell ERC to fall back to the default
+behavior of taking the length from the first \"word\". This
+variable can be converted to a public one if needed by third
+parties.")
+
+(defun erc-fill-wrap ()
+ "Use text props to mimic the effect of `erc-fill-static'.
+See `erc-fill-wrap-mode' for details."
+ (unless erc-fill-wrap-mode
+ (erc-fill-wrap-mode +1))
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((len (or (and erc-fill--wrap-length-function
+ (funcall erc-fill--wrap-length-function))
+ (progn
+ (skip-syntax-forward "^-")
+ (forward-char)
+ (if (and erc-fill-wrap-use-pixels
+ (fboundp 'buffer-text-pixel-size))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (list (car (buffer-text-pixel-size))))
+ (- (point) (point-min)))))))
+ ;; Leaving out the final newline doesn't seem to affect anything.
+ (erc-put-text-properties (point-min) (point-max)
+ '(line-prefix wrap-prefix) nil
+ `((space :width (- erc-fill--wrap-value ,len))
+ (space :width erc-fill--wrap-value))))))
+
+;; This is an experimental helper for third-party modules. You could,
+;; for example, use this to automatically resize the prefix to a
+;; fraction of the window's width on some event change. Another use
+;; case would be to fix lines affected by toggling a display-oriented
+;; mode, like `display-line-numbers-mode'.
+
+(defun erc-fill--wrap-fix (&optional value)
+ "Re-wrap from `point-min' to `point-max'.
+That is, recalculate the width of all accessible lines and reset
+local prefix VALUE when non-nil."
+ (save-excursion
+ (when value
+ (setq erc-fill--wrap-value value))
+ (let ((inhibit-field-text-motion t)
+ (inhibit-read-only t))
+ (goto-char (point-min))
+ (while (and (zerop (forward-line))
+ (< (point) (min (point-max) erc-insert-marker)))
+ (save-restriction
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (erc-fill-wrap))))))
+
+(defun erc-fill--wrap-nudge (arg)
+ (when (zerop arg)
+ (setq arg (- erc-fill-static-center erc-fill--wrap-value)))
+ (cl-incf erc-fill--wrap-value arg)
+ arg)
+
+(defun erc-fill-wrap-nudge (arg)
+ "Adjust `erc-fill-wrap' by ARG columns.
+Offer to repeat command in a manner similar to
+`text-scale-adjust'.
+
+ \\`+', \\`=' Increase indentation by one column
+ \\`-' Decrease indentation by one column
+ \\`0' Reset indentation to the default
+ \\`C-+', \\`C-=' Shift right margin rightward (shrink it)
+ by one column
+ \\`C--' Shift right margin leftward (grow it) by one
+ column
+ \\`C-0' Reset the right margin to the default
+
+Note that misalignment may occur when messages contain
+decorations applied by third-party modules. See
+`erc-fill--wrap-fix' for a temporary workaround."
+ (interactive "p")
+ (unless erc-fill--wrap-value
+ (cl-assert (not erc-fill-wrap-mode))
+ (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+ (unless (get-buffer-window)
+ (user-error "Command called in an undisplayed buffer"))
+ (let* ((total (erc-fill--wrap-nudge arg))
+ (win-ratio (/ (float (- (window-point) (window-start)))
+ (- (window-end nil t) (window-start)))))
+ (when (zerop arg)
+ (setq arg 1))
+ (erc-compat--set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (key '(?+ ?= ?- ?0))
+ (let ((a (pcase key
+ (?0 0)
+ (?- (- (abs arg)))
+ (_ (abs arg)))))
+ (define-key map (vector (list key))
+ (lambda ()
+ (interactive)
+ (cl-incf total (erc-fill--wrap-nudge a))
+ (recenter (round (* win-ratio (window-height))))))
+ (define-key map (vector (list 'control key))
+ (lambda ()
+ (interactive)
+ (erc-stamp--adjust-right-margin (- a))
+ (recenter (round (* win-ratio (window-height))))))))
+ map)
+ t
+ (lambda ()
+ (message "Fill prefix: %d (%+d col%s)"
+ erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+ "Use %k for further adjustment"
+ 1)
+ (recenter (round (* win-ratio (window-height))))))
+
(defun erc-fill-regarding-timestamp ()
"Fills a text such that messages start at column `erc-fill-static-center'."
(fill-region (point-min) (point-max) t t)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..a254d5bbc73
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,324 @@
+;;; 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 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 "<alice> ")
+ ;; Ensure the loop is not visited twice due to the gap.
+ (erc-fill-tests--wrap-check-props "<bob> ")))
+
+;; 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 "<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")))))
+
+;;; erc-fill-tests.el ends here
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<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.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
new file mode 100644
index 00000000000..3f5f344cc64
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<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.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 29 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 29 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
new file mode 100644
index 00000000000..3b215936c39
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<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.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 25) line-prefix #3=(space :width (- 25 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 25 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 25 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
new file mode 100644
index 00000000000..8262c5056f4
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n<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.\n<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#))
\ No newline at end of file
--
2.39.1
next prev parent reply other threads:[~2023-02-19 15:05 UTC|newest]
Thread overview: 56+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-01-18 14:53 bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
2023-01-18 15:01 ` J.P.
2023-01-25 14:11 ` J.P.
2023-01-27 14:31 ` J.P.
2023-01-31 15:28 ` J.P.
2023-02-01 14:27 ` J.P.
2023-02-07 15:23 ` J.P.
2023-02-19 15:05 ` J.P. [this message]
2023-02-20 15:31 ` J.P.
2023-03-09 14:42 ` J.P.
[not found] ` <87edpykmud.fsf@neverwas.me>
2023-04-10 20:49 ` J.P.
2023-05-09 20:46 ` J.P.
2023-05-22 4:20 ` J.P.
[not found] ` <87fs7p3sk6.fsf@neverwas.me>
2023-05-30 14:14 ` J.P.
2023-06-28 21:02 ` J.P.
[not found] ` <87jzvny7ez.fsf@neverwas.me>
2023-07-03 13:14 ` J.P.
2023-07-18 13:33 ` J.P.
[not found] ` <87msztl4xu.fsf@neverwas.me>
2023-07-18 13:55 ` J.P.
2023-07-19 13:15 ` J.P.
[not found] ` <87a5vsjb3q.fsf@neverwas.me>
2023-07-20 13:28 ` J.P.
[not found] ` <87351iiueu.fsf@neverwas.me>
2023-07-23 14:00 ` J.P.
[not found] ` <87h6pug23c.fsf@neverwas.me>
2023-07-28 23:59 ` J.P.
2023-08-09 14:53 ` J.P.
2023-08-09 16:50 ` Michael Albinus
[not found] ` <87jzu4upl9.fsf@gmx.de>
2023-08-15 14:01 ` J.P.
[not found] ` <87v8dgh0af.fsf@neverwas.me>
2023-08-15 16:12 ` Michael Albinus
[not found] ` <87sf8kuvxr.fsf@gmx.de>
2023-08-15 16:37 ` Michael Albinus
[not found] ` <87leecuuqu.fsf@gmx.de>
2023-08-16 14:28 ` J.P.
2023-08-16 17:38 ` Michael Albinus
2023-08-31 13:31 ` J.P.
[not found] ` <87il8vxrr1.fsf@neverwas.me>
2023-09-13 14:06 ` J.P.
2023-09-13 15:56 ` Stefan Kangas
[not found] ` <CADwFkmm3bfkXaOvDYXwKr+RsXird-X47rK=QW6M_cuD6YEm=zA@mail.gmail.com>
2023-09-13 23:11 ` J.P.
[not found] ` <87pm2lzn1i.fsf@neverwas.me>
2023-09-13 23:40 ` Stefan Kangas
2023-09-22 14:11 ` J.P.
[not found] ` <87a5te47sz.fsf@neverwas.me>
2023-09-27 13:59 ` J.P.
[not found] ` <87pm23yawb.fsf@neverwas.me>
2023-10-06 15:17 ` J.P.
[not found] ` <874jj3ok58.fsf@neverwas.me>
2023-10-14 0:24 ` J.P.
[not found] ` <87cyxi9hlc.fsf@neverwas.me>
2023-10-14 17:04 ` J.P.
[not found] ` <87h6mt87al.fsf@neverwas.me>
2023-10-16 14:07 ` J.P.
[not found] ` <8734yak6dr.fsf@neverwas.me>
2023-10-17 13:48 ` J.P.
2023-10-19 14:02 ` J.P.
[not found] ` <877cniaewr.fsf@neverwas.me>
2023-10-24 2:19 ` J.P.
[not found] ` <877cncg3ss.fsf@neverwas.me>
2023-10-24 14:29 ` J.P.
[not found] ` <87jzrcccw3.fsf@neverwas.me>
2023-10-24 17:10 ` Corwin Brust
2023-10-25 2:17 ` J.P.
[not found] ` <87lebra1io.fsf@neverwas.me>
2023-10-30 13:48 ` J.P.
[not found] ` <87bkcguspb.fsf@neverwas.me>
2023-11-01 0:28 ` J.P.
[not found] ` <874ji6tiyn.fsf@neverwas.me>
2023-11-06 2:30 ` J.P.
2024-04-09 18:19 ` J.P.
2023-11-13 21:01 ` J.P.
2023-12-07 7:14 ` J.P.
2024-02-15 12:01 ` tzakmagiel via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-21 1:12 ` J.P.
2024-04-09 20:48 ` bug#60936: (no subject) Alcor
2024-04-23 22:37 ` bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode J.P.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='87edqlwv8y.fsf__26617.4005389743$1676819257$gmane$org@neverwas.me' \
--to=jp@neverwas.me \
--cc=60936@debbugs.gnu.org \
--cc=emacs-erc@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).