Re: bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
"J.P." <[email protected]>
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
v3. Accommodate variable-pitch faces on graphical displays. Use `defvar-keymap', now available in the latest Compat. Screenshot: https://debbugs.gnu.org/cgi/bugreport.cgi?msg=11;filename=fill-wrap-vp.png;bug=60936;att=1
0000-v2-v3.diff
(text/x-patch, 11.6 KB)
From 19ddf027ab3cbfde020e43cdb2bcece828c6638f Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 25 Jan 2023 05:51:53 -0800 Subject: [PATCH 0/4] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (4): [5.6] Adjust some old text properties in ERC buffers [5.6] Leverage display properties better in erc-stamp [5.6] Convert erc-fill minor mode into a proper module [5.6] Add erc-fill style based on visual-line-mode lisp/erc/erc-common.el | 1 + lisp/erc/erc-fill.el | 281 ++++++++++++++++++++++++++++--- lisp/erc/erc-stamp.el | 66 +++++++- lisp/erc/erc.el | 3 +- test/lisp/erc/erc-fill-tests.el | 162 ++++++++++++++++++ test/lisp/erc/erc-stamp-tests.el | 178 ++++++++++++++++++++ 6 files changed, 656 insertions(+), 35 deletions(-) create mode 100644 test/lisp/erc/erc-fill-tests.el create mode 100644 test/lisp/erc/erc-stamp-tests.el Interdiff: diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 6a461786be1..a05f2a558f8 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) @@ -228,20 +231,15 @@ erc-fill-wrap-cycle-visual-movement ('display nil)))) (message "erc-fill-wrap-movement: %S" erc-fill--wrap-movement)) -;; We could just override `visual-line-mode-map' locally, but that -;; seems pretty hacky. -(defvar erc-fill-wrap-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map visual-line-mode-map) - (define-key map [remap kill-line] #'erc-fill--wrap-kill-line) - (define-key map [remap move-end-of-line] #'erc-fill--wrap-end-of-line) - (define-key map [remap move-beginning-of-line] - #'erc-fill--wrap-beginning-of-line) - ;; This is redundant anyway (right?). - (define-key map "\C-c\C-a" #'erc-fill-wrap-cycle-visual-movement) - ;; Not sure if this is dumb because `erc-bol' takes no args. - (define-key map [remap erc-bol] #'erc-fill--wrap-beginning-of-line) - map)) +(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 c" #'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) (define-erc-module fill-wrap nil "Fill style leveraging `visual-line-mode'. @@ -295,6 +293,10 @@ erc-fill--wrap-length-function nickname, including any enclosing brackets, or nil, to fall back to the default behavior of taking the length from the first word.") +(defvar erc-fill--wrap-use-pixels t) +(declare-function buffer-text-pixel-size "xdisp" + (&optional buffer-or-name window x-limit y-limit)) + (defun erc-fill-wrap () "Use text props to mimic the effect of `erc-fill-static'. See `erc-fill-wrap-mode' for details." @@ -302,13 +304,20 @@ erc-fill-wrap (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 "^-") - (- (point) (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))))))) (erc-put-text-properties (point-min) (point-max) '(line-prefix wrap-prefix) nil - `((space :width ,(- erc-fill--wrap-value 1 len)) + `((space :width (- ,erc-fill--wrap-value ,len)) ,erc-fill--wrap-prefix))))) ;; This is an experimental helper for third-party modules. You could, @@ -344,7 +353,7 @@ erc-fill--wrap-nudge (cl-incf erc-fill--wrap-value arg) (while (setq p (next-single-property-change p 'line-prefix)) (when-let ((v (get-text-property p 'line-prefix))) - (cl-incf (caddr v) arg) + (cl-incf (nth 1 (nth 2 v)) arg) ; (space :width (- *this* len)) (when-let ((e (text-property-not-all p (point-max) 'line-prefix v))) (goto-char e))))))) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el new file mode 100644 index 00000000000..cf243ef43c7 --- /dev/null +++ b/test/lisp/erc/erc-fill-tests.el @@ -0,0 +1,162 @@ +;;; 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: + +;;; Code: +(require 'ert-x) +(require 'erc-fill) + +(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) + (erc-modules '(fill stamp)) + (msg "Hello World") + 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) + + (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-privmsg "alice" msg nil t nil)) + (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-privmsg "bob" msg nil t nil)) + + (funcall test) + (when noninteractive + (kill-buffer))))) + +(ert-deftest erc-fill-wrap--monospace () + :tags '(:unstable) + + (erc-fill-tests--wrap-populate + + (lambda () + + ;; Prefix props are applied properly and faces are accounted + ;; for when determining widths. + (goto-char (point-min)) + (should (search-forward "<a" 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 27))) + (should (equal (get-text-property (pos-eol) 'wrap-prefix) + '(space :width 27))) + (should (pcase (get-text-property (point) 'line-prefix) + (`(space :width (- 27 (,w))) + (should (= w (string-pixel-width "<alice> ")))))) + + (erc-fill--wrap-nudge 2) + + (should (search-forward "<b" 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 29))) + (should (equal (get-text-property (pos-eol) 'wrap-prefix) + '(space :width 29))) + (should (pcase (get-text-property (point) 'line-prefix) + (`(space :width (- 29 (,w))) + (should (= w (string-pixel-width "<bob> "))))))))) + +(ert-deftest erc-fill-wrap--variable-pitch () + :tags '(:unstable) + (unless (and (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 () + + ;; Prefix props are applied properly and faces are accounted + ;; for when determining widths. + (goto-char (point-min)) + (should (search-forward "<a" 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 27))) + (should (equal (get-text-property (pos-eol) 'wrap-prefix) + '(space :width 27))) + (should (pcase (get-text-property (point) 'line-prefix) + (`(space :width (- 27 (,w))) + (should (> w (string-pixel-width "<alice> ")))))) + + (erc-fill--wrap-nudge 2) + + (should (search-forward "<b" 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 29))) + (should (equal (get-text-property (pos-eol) 'wrap-prefix) + '(space :width 29))) + (should (pcase (get-text-property (point) 'line-prefix) + (`(space :width (- 29 (,w))) + (should (> w (string-pixel-width "<bob> ")))))) + + ;; FIXME figure out how to get rid of this "void variable + ;; `erc--results-ewoc'" error, which seems related to operating + ;; in this second 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)))))) + +;;; erc-fill-tests.el ends here -- 2.38.1
0001-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch
(text/x-patch, 1.7 KB)
From 80dccfa483020177c3e705f3c59c4875a635a568 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Thu, 16 Jun 2022 01:20:49 -0700 Subject: [PATCH 1/4] [5.6] Adjust some old text properties in ERC buffers TODO: because these have been around forever, we should mention their deletion in the misc-library section of ERC-NEWS for 5.6. * lisp/erc/erc.el (erc-display-message): Remove the confusing `rear-sticky' text property, which has been around since 2002. (erc-display-prompt): Make the `field' text property more meaningful to aid in searching, although this makes the `erc-prompt' property somewhat redundant. --- lisp/erc/erc.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ff1820cfaf2..4bc9fc20f8a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2867,7 +2867,6 @@ 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) (when (erc-response.tags parsed) (erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed) string)) @@ -4296,7 +4295,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)) -- 2.38.1
0002-5.6-Leverage-display-properties-better-in-erc-stamp.patch
(text/x-patch, 13.5 KB)
From 5e9422dc39c61af03dd3ca24d419927f2f07c8bd Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 24 Nov 2021 05:35:35 -0800 Subject: [PATCH 2/4] [5.6] Leverage display properties better in erc-stamp (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-timestamp--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: New file. --- lisp/erc/erc-stamp.el | 66 ++++++++++-- test/lisp/erc/erc-stamp-tests.el | 178 +++++++++++++++++++++++++++++++ 2 files changed, 236 insertions(+), 8 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..e9592448a33 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -217,14 +217,44 @@ 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. +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. + A side effect of enabling this is that there will only be one space before a right timestamp in any saved logs." - :type 'boolean) + :type '(choice boolean integer (const margin)) + :package-version '(ERC . "5.4.1")) ; FIXME update when merging + +;; If people want to use this directly, we can offer an option to set +;; the margin's width. +(define-minor-mode erc-timestamp--display-margin-mode + "Internal minor mode for built-in modules integrating with `stamp'." + :interactive nil + (if-let ((erc-timestamp--display-margin-mode) + (width (if erc-timestamp-last-inserted-right + (length erc-timestamp-last-inserted-right) + (1+ (length (erc-format-timestamp + (current-time) + erc-timestamp-format-right)))))) + (progn + (setq right-margin-width width + right-fringe-width 0) + (unless noninteractive + (set-window-margins nil left-margin-width width) + (set-window-fringes nil left-fringe-width 0))) + (kill-local-variable 'right-margin-width) + (unless noninteractive + (set-window-margins nil nil) + (set-window-fringes nil nil)))) (defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." @@ -243,6 +273,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 " ") @@ -253,6 +284,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 @@ -304,12 +337,29 @@ 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 diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el new file mode 100644 index 00000000000..4994feefd4e --- /dev/null +++ b/test/lisp/erc/erc-stamp-tests.el @@ -0,0 +1,178 @@ +;;; 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) +(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 ?\[ (char-after (1+ (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))))))))) + +(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-timestamp--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 leading space. + (should (eql ?\s (char-after (field-beginning (point))))) + (should (eql ?\n (char-after (field-end (point))))))))) + +;;; erc-stamp-tests.el ends here -- 2.38.1
0003-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch
(text/x-patch, 2.4 KB)
From 35d1b98e38a2848f3cef3297131a379b1690e6ea Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 24 Apr 2022 02:38:12 -0700 Subject: [PATCH 3/4] [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. --- 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.38.1
0004-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch
(text/x-patch, 20.2 KB)
From 19ddf027ab3cbfde020e43cdb2bcece828c6638f Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Fri, 13 Jan 2023 00:00:56 -0800 Subject: [PATCH 4/4] [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-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-mode, erc-fill--wrap-prefix, erc-fill--wrap-value, erc-fill--wrap-movement): New minor mode and variables to support it. (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): 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. --- lisp/erc/erc-common.el | 1 + lisp/erc/erc-fill.el | 247 +++++++++++++++++++++++++++++++- test/lisp/erc/erc-fill-tests.el | 162 +++++++++++++++++++++ 3 files changed, 408 insertions(+), 2 deletions(-) create mode 100644 test/lisp/erc/erc-fill-tests.el diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 994555acecf..aae8280baa9 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -95,6 +95,7 @@ erc--features-to-modules (erc-join autojoin) (erc-page page ctcp-page) (erc-sound sound ctcp-sound) + (erc-fill fill-wrap) (erc-stamp stamp timestamp) (erc-services services nickserv)) "Migration alist mapping a library feature to module names. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index caf401bf222..a05f2a558f8 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,27 @@ 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, courtesy of `visual-line-mode' mode, which ERC +automatically enables when this option is `erc-fill-wrap' or +`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." +names right and text left. + +Also used by the `erc-fill-function' variant `erc-fill-wrap' for +its initial leading \"prefix\" width." :type 'integer) (defcustom erc-fill-variable-maximum-indentation 17 @@ -155,6 +169,235 @@ erc-fill-variable (erc-fill-regarding-timestamp)))) (erc-restore-text-properties))) +(defvar-local erc-fill--wrap-prefix nil) +(defvar-local erc-fill--wrap-value nil) +(defvar-local erc-fill--wrap-movement nil) + +(defcustom erc-fill-wrap-movement t + "Whether to override keys defined by `visual-line-mode'. +A value of `display' means to favor default `erc-mode' keys when +point is in the input area." + :package-version '(ERC . "5.5") ; FIXME sync on release + :type '(choice boolean (const display :tag "Display area" + :doc "Use `erc-mode' keys in input area"))) + +(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 users + ;; still need to see the message. + (pcase erc-fill--wrap-movement + ('display (if (>= (point) erc-input-marker) + (kill-line arg) + (kill-visual-line arg))) + ('t (kill-visual-line arg)) + (_ (kill-line arg)))) + +(defun erc-fill--wrap-beginning-of-line (arg) + "Defer to `move-beginning-of-line' or `beginning-of-visual-line'." + (interactive "^p") + (pcase erc-fill--wrap-movement + ('display (if (>= (point) erc-input-marker) + (move-beginning-of-line arg) + (beginning-of-visual-line arg))) + ('t (beginning-of-visual-line arg)) + (_ (move-beginning-of-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") + (pcase erc-fill--wrap-movement + ('display (if (>= (point) erc-input-marker) + (move-end-of-line arg) + (end-of-visual-line arg))) + ('t (end-of-visual-line arg)) + (_ (move-end-of-line arg)))) + +(defun erc-fill-wrap-cycle-visual-movement (arg) + "Cycle through `erc-fill-wrap-movement' styles ARG times. +Go from nil to t to `display' and back around, but set internal +state instead of mutating `erc-fill-wrap-movement'. When ARG is +0, reset to value of `erc-fill-wrap-movement'." + (interactive "^p") + (when (zerop arg) + (setq erc-fill--wrap-movement erc-fill-wrap-movement)) + (while (not (zerop arg)) + (cl-incf arg (- (abs arg))) + (setq erc-fill--wrap-movement (pcase erc-fill--wrap-movement + ('nil t) + ('t 'display) + ('display nil)))) + (message "erc-fill-wrap-movement: %S" erc-fill--wrap-movement)) + +(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 c" #'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) + +(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." + ((let (msg) + (unless erc-fill-mode + (unless (memq 'fill erc-modules) + (setq msg + (concat "WARNING: enabling default global module `fill' needed " + " by local module `fill-wrap'. This will impact all" + " 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-movement (alist-get 'erc-fill--wrap-movement vars) + erc-fill--wrap-prefix (alist-get 'erc-fill--wrap-prefix vars) + erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars))) + (when (eq erc-timestamp-use-align-to 'margin) + (erc-timestamp--display-margin-mode +1)) + (setq erc-fill--wrap-value + (or erc-fill--wrap-value erc-fill-static-center) + ;; + erc-fill--wrap-prefix + (or erc-fill--wrap-prefix + (list 'space :width erc-fill--wrap-value))) + (visual-line-mode +1) + (unless (local-variable-p 'erc-fill--wrap-movement) + (setq erc-fill--wrap-movement erc-fill-wrap-movement)) + (when msg + (erc-display-error-notice nil msg)))) + ((when erc-timestamp--display-margin-mode + (erc-timestamp--display-margin-mode -1)) + (kill-local-variable 'erc-button--add-nickname-face-function) + (kill-local-variable 'erc-fill--wrap-prefix) + (kill-local-variable 'erc-fill--wrap-value) + (kill-local-variable 'erc-fill-function) + (kill-local-variable 'erc-fill--wrap-movement) + (visual-line-mode -1)) + 'local) + +(defvar-local erc-fill--wrap-length-function nil + "Function to determine length of perceived nickname. +It should return an integer representing the length of the +nickname, including any enclosing brackets, or nil, to fall back +to the default behavior of taking the length from the first word.") + +(defvar erc-fill--wrap-use-pixels t) +(declare-function buffer-text-pixel-size "xdisp" + (&optional buffer-or-name window x-limit y-limit)) + +(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))))))) + (erc-put-text-properties (point-min) (point-max) + '(line-prefix wrap-prefix) nil + `((space :width (- ,erc-fill--wrap-value ,len)) + ,erc-fill--wrap-prefix))))) + +;; 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. + +(defun erc-fill--wrap-fix (&optional value) + "Re-wrap from `point-min' to `point-max'. +Reset prefix to VALUE, when given." + (save-excursion + (when value + (setq erc-fill--wrap-value value + erc-fill--wrap-prefix (list 'space :width 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 (pos-bol) (pos-eol)) + (erc-fill-wrap)))))) + +(defun erc-fill--wrap-nudge (arg) + (save-excursion + (save-restriction + (widen) + (let ((inhibit-field-text-motion t) + (inhibit-read-only t) ; necessary? + (p (goto-char (point-min)))) + (when (zerop arg) + (setq arg (- erc-fill-static-center erc-fill--wrap-value))) + (cl-incf (caddr erc-fill--wrap-prefix) arg) + (cl-incf erc-fill--wrap-value arg) + (while (setq p (next-single-property-change p 'line-prefix)) + (when-let ((v (get-text-property p 'line-prefix))) + (cl-incf (nth 1 (nth 2 v)) arg) ; (space :width (- *this* len)) + (when-let + ((e (text-property-not-all p (point-max) 'line-prefix v))) + (goto-char e))))))) + 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'. Note that misalignment may occur when +messages contain decorations applied by third-party modules. +See `erc-fill--wrap-fix' for a workaround." + (interactive "p") + (unless erc-fill--wrap-value + (cl-assert (not erc-fill-wrap-mode)) + (user-error "Minor mode `erc-fill-wrap-mode' disabled")) + (let ((total (erc-fill--wrap-nudge arg)) + (start (window-start)) + (marker (set-marker (make-marker) (point)))) + (when (zerop arg) + (setq arg 1)) + (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)) + (set-window-start (selected-window) start) + (goto-char marker))))) + map) + t + (lambda () + (set-marker marker nil) + (message "Fill prefix: %d (%+d col%s)" + erc-fill--wrap-value total (if (> (abs total) 1) "s" ""))) + "Use %k for further adjustment" + 1) + (goto-char marker) + (set-window-start (selected-window) start))) + (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..cf243ef43c7 --- /dev/null +++ b/test/lisp/erc/erc-fill-tests.el @@ -0,0 +1,162 @@ +;;; 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: + +;;; Code: +(require 'ert-x) +(require 'erc-fill) + +(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) + (erc-modules '(fill stamp)) + (msg "Hello World") + 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) + + (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-privmsg "alice" msg nil t nil)) + (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-privmsg "bob" msg nil t nil)) + + (funcall test) + (when noninteractive + (kill-buffer))))) + +(ert-deftest erc-fill-wrap--monospace () + :tags '(:unstable) + + (erc-fill-tests--wrap-populate + + (lambda () + + ;; Prefix props are applied properly and faces are accounted + ;; for when determining widths. + (goto-char (point-min)) + (should (search-forward "<a" 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 27))) + (should (equal (get-text-property (pos-eol) 'wrap-prefix) + '(space :width 27))) + (should (pcase (get-text-property (point) 'line-prefix) + (`(space :width (- 27 (,w))) + (should (= w (string-pixel-width "<alice> ")))))) + + (erc-fill--wrap-nudge 2) + + (should (search-forward "<b" 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 29))) + (should (equal (get-text-property (pos-eol) 'wrap-prefix) + '(space :width 29))) + (should (pcase (get-text-property (point) 'line-prefix) + (`(space :width (- 29 (,w))) + (should (= w (string-pixel-width "<bob> "))))))))) + +(ert-deftest erc-fill-wrap--variable-pitch () + :tags '(:unstable) + (unless (and (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 () + + ;; Prefix props are applied properly and faces are accounted + ;; for when determining widths. + (goto-char (point-min)) + (should (search-forward "<a" 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 27))) + (should (equal (get-text-property (pos-eol) 'wrap-prefix) + '(space :width 27))) + (should (pcase (get-text-property (point) 'line-prefix) + (`(space :width (- 27 (,w))) + (should (> w (string-pixel-width "<alice> ")))))) + + (erc-fill--wrap-nudge 2) + + (should (search-forward "<b" 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 29))) + (should (equal (get-text-property (pos-eol) 'wrap-prefix) + '(space :width 29))) + (should (pcase (get-text-property (point) 'line-prefix) + (`(space :width (- 29 (,w))) + (should (> w (string-pixel-width "<bob> ")))))) + + ;; FIXME figure out how to get rid of this "void variable + ;; `erc--results-ewoc'" error, which seems related to operating + ;; in this second 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)))))) + +;;; erc-fill-tests.el ends here -- 2.38.1