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: Fri, 27 Jan 2023 06:31:47 -0800 [thread overview]
Message-ID: <87a6242gmk.fsf@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: 144 bytes --]
v4. Fix invisibility for fools and timestamps with wrapped filling.
Consolidate prompt setup in `erc-open'. Deprecate some items in
erc-stamp.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v3-v4.diff --]
[-- Type: text/x-patch, Size: 64881 bytes --]
From 8ff3d6905355e41bd91fd8e24577b68e762cfb0a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 27 Jan 2023 06:28:37 -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-common.el | 1 +
lisp/erc/erc-fill.el | 307 ++++++++++++++++--
lisp/erc/erc-match.el | 31 +-
lisp/erc/erc-stamp.el | 166 ++++++++--
lisp/erc/erc.el | 136 +++++---
test/lisp/erc/erc-fill-tests.el | 172 ++++++++++
.../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++
.../erc/erc-scenarios-base-local-modules.el | 99 ------
test/lisp/erc/erc-stamp-tests.el | 261 +++++++++++++++
test/lisp/erc/erc-tests.el | 79 ++++-
10 files changed, 1248 insertions(+), 215 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
Interdiff:
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index a05f2a558f8..ecd721f2f03 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -85,8 +85,8 @@ erc-fill-function
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
+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'."
@@ -96,13 +96,15 @@ erc-fill-function
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.
-
-Also used by the `erc-fill-function' variant `erc-fill-wrap' for
-its initial leading \"prefix\" width."
+ "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
@@ -171,65 +173,71 @@ erc-fill-variable
(defvar-local erc-fill--wrap-prefix nil)
(defvar-local erc-fill--wrap-value nil)
-(defvar-local erc-fill--wrap-movement nil)
+(defvar-local erc-fill--wrap-visual-keys 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."
+(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.5") ; 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.5") ; FIXME sync on release
- :type '(choice boolean (const display :tag "Display area"
- :doc "Use `erc-mode' keys in input area")))
+ :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 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))))
+ ;; 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")
- (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)))
+ (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'."
+ "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))))
+ (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-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'."
+ "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-movement erc-fill-wrap-movement))
+ (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
(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))
+ (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."
@@ -237,16 +245,22 @@ erc-fill-wrap-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
+ "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)
+
(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."
+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)
@@ -261,11 +275,15 @@ 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)
+ (setq erc-fill--wrap-visual-keys (alist-get 'erc-fill--wrap-visual-keys
+ 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))
+ (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)
;;
@@ -273,29 +291,30 @@ fill-wrap
(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))
+ (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-timestamp--display-margin-mode
- (erc-timestamp--display-margin-mode -1))
+ ((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-prefix)
(kill-local-variable 'erc-fill--wrap-value)
(kill-local-variable 'erc-fill-function)
- (kill-local-variable 'erc-fill--wrap-movement)
+ (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 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))
+ "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'.
@@ -309,12 +328,13 @@ erc-fill-wrap
(progn
(skip-syntax-forward "^-")
(forward-char)
- (if (and erc-fill--wrap-use-pixels
+ (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))
@@ -337,7 +357,7 @@ erc-fill--wrap-fix
(while (and (zerop (forward-line))
(< (point) (min (point-max) erc-insert-marker)))
(save-restriction
- (narrow-to-region (pos-bol) (pos-eol))
+ (narrow-to-region (line-beginning-position) (line-end-position))
(erc-fill-wrap))))))
(defun erc-fill--wrap-nudge (arg)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 499bcaf5724..87272f0b647 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
@@ -649,13 +652,22 @@ erc-go-to-log-matches-buffer
(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 +675,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
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index e9592448a33..21885f3a36f 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,29 +165,43 @@ 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) '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"))
+ (unless (get-text-property (point-min) 'invisible)
+ (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)
(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.
@@ -232,29 +254,53 @@ erc-timestamp-use-align-to
A side effect of enabling this is that there will only be one
space before a right timestamp in any saved logs."
: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'."
+ :package-version '(ERC . "5.5")) ; 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.5") ; 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)))
+
+;; 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-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
+ (if erc-stamp--display-margin-mode
+ (let ((width (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))))
(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)))
+ (set-window-margins nil left-margin-width width)
+ (set-window-fringes nil left-fringe-width 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)
- (unless noninteractive
- (set-window-margins nil nil)
- (set-window-fringes nil nil))))
+ (kill-local-variable 'right-fringe-width)
+ (set-window-margins left-margin-width nil)
+ (set-window-fringes left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -365,14 +411,19 @@ erc-insert-timestamp-right
(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))
@@ -400,8 +451,9 @@ erc-format-timestamp
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible
- (not erc-hide-timestamps) ; bug#11706
- (erc-put-text-property 0 (length ts) 'cursor-intangible t ts))
+ ;; (not erc-hide-timestamps) ; bug#11706
+ (erc-put-text-property 0 (1- (length ts))
+ 'cursor-intangible t ts))
ts)
""))
@@ -450,11 +502,15 @@ 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))
+ (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/lisp/erc/erc.el b/lisp/erc/erc.el
index 4bc9fc20f8a..6b3d0b4af2f 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)))
@@ -2867,6 +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)
+ (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))
@@ -4244,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.
@@ -5667,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'.
@@ -5677,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).
@@ -7278,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."
@@ -7301,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'.
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index cf243ef43c7..77d553bc3a2 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -36,6 +36,7 @@ erc-fill-tests--wrap-populate
(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)
@@ -63,13 +64,13 @@ erc-fill-tests--wrap-populate
(erc-display-message
nil nil (current-buffer)
- (erc--format-privmsg "alice" msg nil t nil))
+ (erc-format-privmessage "alice" msg nil 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-privmsg "bob" msg nil t nil))
+ (erc-format-privmessage "bob" msg nil t))
(funcall test)
(when noninteractive
@@ -92,9 +93,15 @@ erc-fill-wrap--monospace
'(space :width 27)))
(should (equal (get-text-property (pos-eol) 'wrap-prefix)
'(space :width 27)))
+ ;; 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)
- (`(space :width (- 27 (,w)))
- (should (= w (string-pixel-width "<alice> "))))))
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- 27 (,w))))
+ (= w (string-pixel-width "<alice> ")))
+ (`(space :width (- 27 ,w))
+ (= w (length "<alice> ")))))
(erc-fill--wrap-nudge 2)
@@ -106,12 +113,17 @@ erc-fill-wrap--monospace
(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> ")))))))))
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- 29 (,w))))
+ (= w (string-pixel-width "<bob> ")))
+ (`(space :width (- 29 ,w))
+ (= w (length "<bob> "))))))))
(ert-deftest erc-fill-wrap--variable-pitch ()
:tags '(:unstable)
- (unless (and (not noninteractive) (display-graphic-p))
+ (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")))
@@ -124,8 +136,6 @@ erc-fill-wrap--variable-pitch
(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))
@@ -136,7 +146,7 @@ erc-fill-wrap--variable-pitch
'(space :width 27)))
(should (pcase (get-text-property (point) 'line-prefix)
(`(space :width (- 27 (,w)))
- (should (> w (string-pixel-width "<alice> "))))))
+ (> w (string-pixel-width "<alice> ")))))
(erc-fill--wrap-nudge 2)
@@ -149,7 +159,7 @@ erc-fill-wrap--variable-pitch
'(space :width 29)))
(should (pcase (get-text-property (point) 'line-prefix)
(`(space :width (- 29 (,w)))
- (should (> w (string-pixel-width "<bob> "))))))
+ (> 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
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 916d105779a..990c971b4cd 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -81,105 +81,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-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 4994feefd4e..69523274812 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -20,7 +20,7 @@
;;; Commentary:
;;; Code:
-(require 'ert)
+(require 'ert-x)
(require 'erc-stamp)
(require 'erc-goodies) ; for `erc-make-read-only'
@@ -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 ?\[ (char-after (1+ (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,9 @@ 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 ()
@@ -146,7 +146,7 @@ erc-timestamp-use-align-to--integer
(ert-deftest erc-timestamp-use-align-to--margin ()
(erc-stamp-tests--insert-right
(lambda ()
- (erc-timestamp--display-margin-mode +1)
+ (erc-stamp--display-margin-mode +1)
(ert-info ("margin, normal")
(let ((erc-timestamp-use-align-to 'margin))
@@ -155,7 +155,7 @@ erc-timestamp-use-align-to--margin
(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))
+ (should (search-forward "msg one[" nil t))
;; Field covers stamp alone
(should (eql ?e (char-before (field-beginning (point)))))
;; Vanity props extended
@@ -170,9 +170,92 @@ erc-timestamp-use-align-to--margin
(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))
+ (should (search-forward "oooo[" nil t))
;; Field starts at leading space.
- (should (eql ?\s (char-after (field-beginning (point)))))
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
+;; This concerns the partial reversal of 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 irreversible, which at least one user has complained
+;; about. Turning off `cursor-intangible-mode' does do the trick, but
+;; a better solution seems to be 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 works
+;; whether `erc-hide-timestamps' is enabled or not.
+;;
+;; 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
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 #3: 0001-5.6-Refactor-marker-initialization-in-erc-open.patch --]
[-- Type: text/x-patch, Size: 24873 bytes --]
From 4ab7539fa3f6b44e645b004438c6256feee3a5b2 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.
---
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 ff1820cfaf2..363fe30ee58 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 916d105779a..990c971b4cd 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -81,105 +81,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: 5557 bytes --]
From 456f765ec19ecb7421093a887bdb22afac5ec631 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.
---
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 363fe30ee58..6b3d0b4af2f 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: 13386 bytes --]
From 9172c82d0e896d4129dd0c83624d282045c52c21 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-format-timestamp): Don't omit the `cursor-intangible' property
when `erc-hide-timestamps' is non-nil. This reverts the changes from
bug#11706.
(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.
---
lisp/erc/erc-stamp.el | 19 +--
test/lisp/erc/erc-stamp-tests.el | 203 +++++++++++++++++++++++++++++++
2 files changed, 215 insertions(+), 7 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..bf1b0c6952c 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.
@@ -350,8 +350,9 @@ erc-format-timestamp
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible
- (not erc-hide-timestamps) ; bug#11706
- (erc-put-text-property 0 (length ts) 'cursor-intangible t ts))
+ ;; (not erc-hide-timestamps) ; bug#11706
+ (erc-put-text-property 0 (1- (length ts))
+ 'cursor-intangible t ts))
ts)
""))
@@ -400,11 +401,15 @@ 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))
+ (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..c8e5d75d77d
--- /dev/null
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -0,0 +1,203 @@
+;;; 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 the partial reversal of 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 irreversible, which at least one user has complained
+;; about. Turning off `cursor-intangible-mode' does do the trick, but
+;; a better solution seems to be 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 works
+;; whether `erc-hide-timestamps' is enabled or not.
+;;
+;; 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: 4437 bytes --]
From 3671227a2be6ac134279cd383bc18e952c196ef0 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.
---
lisp/erc/erc-stamp.el | 36 +++++++++++++++++++++++++++++-------
1 file changed, 29 insertions(+), 7 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index bf1b0c6952c..459d022338a 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)
--
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: 14364 bytes --]
From 65833116b95cf7d21a3ed655387c28277d3f3e3a 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.
---
lisp/erc/erc-stamp.el | 111 ++++++++++++++++++++++++++-----
test/lisp/erc/erc-stamp-tests.el | 70 +++++++++++++++++--
2 files changed, 159 insertions(+), 22 deletions(-)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 459d022338a..21885f3a36f 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -239,14 +239,68 @@ 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.5")) ; 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.5") ; 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)))
+
+;; 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
+ (let ((width (or erc-stamp-right-margin-width
+ (1+ (string-width (or erc-timestamp-last-inserted
+ (erc-format-timestamp
+ (current-time)
+ erc-timestamp-format)))))))
+ (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)
+ (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 left-margin-width nil)
+ (set-window-fringes left-fringe-width nil)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
@@ -265,6 +319,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 +330,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 +383,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 c8e5d75d77d..69523274812 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 leading space.
+ (should (eql ?\[ (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns the partial reversal of changes resulting from:
--
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: 2444 bytes --]
From 23a185750d8e246dc517bc3ad0a11e491f2be2ef 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.
---
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: 3181 bytes --]
From 563bd525a913e98efca9ce1e50b07924f4c1b689 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.
---
lisp/erc/erc-match.el | 31 +++++++++++++++++++++++++------
1 file changed, 25 insertions(+), 6 deletions(-)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 499bcaf5724..87272f0b647 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
@@ -649,13 +652,22 @@ erc-go-to-log-matches-buffer
(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 +675,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: 22653 bytes --]
From 8ff3d6905355e41bd91fd8e24577b68e762cfb0a 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-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 | 273 +++++++++++++++++++++++++++++++-
test/lisp/erc/erc-fill-tests.el | 172 ++++++++++++++++++++
3 files changed, 441 insertions(+), 5 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..ecd721f2f03 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-prefix nil)
+(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.5") ; 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.5") ; 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)
+
+(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
+ (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-visual-keys (alist-get 'erc-fill--wrap-visual-keys
+ vars)
+ erc-fill--wrap-prefix (alist-get 'erc-fill--wrap-prefix 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)
+ ;;
+ 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-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-prefix)
+ (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))
+ ,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 (line-beginning-position) (line-end-position))
+ (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..77d553bc3a2
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,172 @@
+;;; 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)
+ (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))
+ (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))
+
+ (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)))
+ ;; 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 (- 27 (,w))))
+ (= w (string-pixel-width "<alice> ")))
+ (`(space :width (- 27 ,w))
+ (= w (length "<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)
+ ((and (guard (fboundp 'string-pixel-width))
+ `(space :width (- 29 (,w))))
+ (= w (string-pixel-width "<bob> ")))
+ (`(space :width (- 29 ,w))
+ (= w (length "<bob> "))))))))
+
+(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 ()
+
+ (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)))
+ (> 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)))
+ (> 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.39.1
next prev parent reply other threads:[~2023-01-27 14:31 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. [this message]
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.
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=87a6242gmk.fsf@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).