Make erc-fill-wrap work with left-sided stamps

* etc/ERC-NEWS: Remove all mention of option `erc-timestamp-align-to'
supporting a value of `margin', which has been abandoned.  Do mention
leading white space before stamps now having stamp-related properties.
* lisp/erc/erc-backend.el (erc--reveal-prompt, erc--conceal-prompt):
New generic functions with default implementations factored out from
`erc--unhide-prompt' and `erc--hide-prompt'.
(erc--prompt-hidden-p): New internal predicate function.
(erc--unhide-prompt): Defer to `erc--reveal-prompt', and set
`erc-prompt' text property to t.
(erc--hide-prompt): Defer to `erc--conceal-prompt', and set
`erc-prompt' text property to `hidden'.
* lisp/erc/erc-compat.el (erc-compat--29-browse-url-irc): Don't
use `function-equal'.
* lisp/erc/erc-fill.el (erc-fill-wrap-margin-width,
erc-fill-wrap-margin-side): New options to control side and initial
width of `fill-wrap' margin.
(erc-fill--wrap-beginning-of-line): Fix bug involving non-string
valued `display' props.
(erc-fill-wrap-toggle-truncate-lines): New command to re-enable
`visual-line-mode' when toggling off `truncate-lines'.
(erc-fill-wrap-mode-map): Remap `toggle-truncate-lines' to
`erc-fill-wrap-toggle-truncate-lines'.
(erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable):
Update doc string, persist a few local vars, and conditionally set
`erc-stamp--margin-left-p'.  When deactivating, disable
`visual-line-mode' first.
(erc-fill--wrap-continued-message-p): Use `erc-speaker' instead of
heuristics when comparing nicks between consecutive messages.
(erc-fill-wrap-nudge): Update doc string and account for left-sided
stamps.
(erc-timestamp-offset): Add comment regarding conditional guard based
on function-valued option.
* lisp/erc/erc-stamp.el (erc-timestamp-use-align-to): Remove value
variant `margin', which was originally intended to be new in ERC 5.6.
This functionality was all but useless without the internal minor mode
`erc-stamp--display-margin-mode' active.
(erc-stamp-right-margin-width): Remove unused option new in 5.6.
(erc-stamp--display-margin-force): Remove unused function.
(erc-stamp--margin-width, erc-stamp--margin-left-p): New internal
variables.
(erc-stamp--init-margins-on-connect): New function for initializing
mode-managed margin after connecting.
(erc-stamp--adjust-right-margin, erc-stamp--adjust-margin): Rename
function to latter and accommodate left-hand stamps.
(erc-stamp--inherited-props): Move definition higher up in same file.
(erc-stamp--display-margin-mode): Update function name, and adjust
setup and teardown to accommodate left-handed stamps.  Don't add
advice around `erc-insert-timestamp-function'.
(erc-stamp--last-prompt, erc-stamp--display-prompt-in-left-margin):
New function and helper var to convert a normal inserted prompt so
that it appears in the left margin.
(erc-stamp--refresh-left-margin-prompt): Helper for other modules to
quickly refresh prompt outside of insert hooks.
(erc--reveal-prompt, erc--conceal-prompt): New implementations for
when `erc-stamp--display-margin-mode' is active.
(erc-insert-timestamp-left): Convert to generic function and provide
implementation for `erc-stamp--display-margin-mode'.
(erc-stamp--omit-properties-on-folded-lines): New variable, an escape
hatch for propertizing white space before right-side stamps folded
over onto another line.
(erc-insert-timestamp-right): Don't expect `erc-timestamp-align-to' to
ever be the symbol `margin'.  Move handling for that case to one
contingent on the internal minor mode `erc-stamp--display-margin-mode'
being active.  Add text properties preceding stamps that occupy a line
by their lonesome.  See related news entry for rationale.  This is
arguably a breaking change.
* lisp/erc/erc.el (erc--refresh-prompt-hook): New hook variable for
modules to adjust prompt properties whenever it's refreshed.
(erc--refresh-prompt): Fix bug in which user-defined prompt functions
failed to hide when quitting in server buffers.  Run new hook
`erc--refresh-prompt-hook'.
(erc-display-prompt): Add comment noting that the text property
`erc-prompt' now actually matters: it's t while a session is running
and `hidden' when disconnected.
* test/lisp/erc/erc-fill-tests.el (erc-fill--left-hand-stamps): New
test.
* test/lisp/erc/erc-stamp-tests.el
(erc-stamp-tests--use-align-to--nil,
erc-stamp-tests--use-align-to--t): New functions forged from old test
bodies to allow optionally asserting pre-5.6 behavior regarding
leading white space on right-hand stamps that exist on their own line.
(erc-timestamp-use-align-to--nil, erc-timestamp-use-align-to--t):
Parameterize with compatibility flag.
(erc-timestamp-use-align-to--margin,
erc-stamp--display-margin-mode--right): Rename test to latter.
* test/lisp/erc/erc-tests.el (erc-hide-prompt): Add some assertions
for new possible value of `erc-prompt' text property.
* test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld: New test
data file.  (Bug#60936)
This commit is contained in:
F. Jason Park 2023-07-14 06:12:30 -07:00
parent d09464e504
commit 63d8b2a59a
10 changed files with 352 additions and 116 deletions

View file

@ -103,11 +103,8 @@ side window. Hit '<RET>' over a nick to spawn a "/QUERY" or a
** The option 'erc-timestamp-use-align-to' is more versatile.
While this option has always offered to right-align stamps via the
'display' text property, it's now more effective at doing so when set
to a number indicating an offset from the right edge. And when set to
the symbol 'margin', it displays stamps in the right margin, although,
at the moment, this is mostly intended for use by other modules, such
as 'fill-wrap', described above. For both these variants, users of
the 'log' module may want to customize 'erc-log-filter-function' to
to a number indicating an offset from the right edge. Users of the
'log' module may want to customize 'erc-log-filter-function' to
'erc-stamp-prefix-log-filter' to avoid ragged right-hand stamps
appearing in their saved logs.
@ -228,7 +225,8 @@ Chiefly, 'rear-sticky' has been replaced by 'erc-command', which
records the IRC command (or numeric) associated with a message. Less
impactfully, the value of the 'field' property for ERC's prompt has
changed from 't' to the more useful 'erc-prompt', although the
property of the same name has been retained.
property of the same name has been retained and now has a value of
'hidden' when disconnected.
*** Members of insert- and send-related hooks have been reordered.
Built-in and third-party modules rely on certain hooks for adjusting
@ -261,6 +259,16 @@ Additionally, the 'stamp' module now merges its 'invisible' property
with existing ones, when present, and it includes all white space
around stamps when doing so.
Moreover, such "propertizing" of surrounding white space now extends
to all 'stamp'-applied properties, like 'field', in all intervening
space between message text and timestamps. This constitutes a
breaking change from the perspective of detecting a timestamp's
bounds. For example, ERC has always propertized leading space before
right-sided stamps on the same line as message text but not those
folded onto the next line. This inconsistency made stamp detection
overly complex and produced uneven results when toggling stamp
visibility.
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library
features has improved. More specifically, a module's group now enjoys

View file

@ -1045,13 +1045,25 @@ Conditionally try to reconnect and take appropriate action."
;; unexpected disconnect
(erc-process-sentinel-2 event buffer))))
(cl-defmethod erc--reveal-prompt ()
(remove-text-properties erc-insert-marker erc-input-marker
'(display nil)))
(cl-defmethod erc--conceal-prompt ()
(add-text-properties erc-insert-marker (1- erc-input-marker)
`(display ,erc-prompt-hidden)))
(defun erc--prompt-hidden-p ()
(and (marker-position erc-insert-marker)
(eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)))
(defun erc--unhide-prompt ()
(remove-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert t)
(when (and (marker-position erc-insert-marker)
(marker-position erc-input-marker))
(with-silent-modifications
(remove-text-properties erc-insert-marker erc-input-marker
'(display nil)))))
(put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t)
(erc--reveal-prompt))))
(defun erc--unhide-prompt-on-self-insert ()
(when (and (eq this-command #'self-insert-command)
@ -1059,6 +1071,8 @@ Conditionally try to reconnect and take appropriate action."
(erc--unhide-prompt)))
(defun erc--hide-prompt (proc)
"Hide prompt in all buffers of server.
Change value of property `erc-prompt' from t to `hidden'."
(erc-with-all-buffers-of-server proc nil
(when (and erc-hide-prompt
(or (eq erc-hide-prompt t)
@ -1072,8 +1086,9 @@ Conditionally try to reconnect and take appropriate action."
(marker-position erc-input-marker)
(get-text-property erc-insert-marker 'erc-prompt))
(with-silent-modifications
(add-text-properties erc-insert-marker (1- erc-input-marker)
`(display ,erc-prompt-hidden)))
(put-text-property erc-insert-marker (1- erc-input-marker)
'erc-prompt 'hidden)
(erc--conceal-prompt))
(add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 91 t))))
(defun erc-process-sentinel (cproc event)

View file

@ -418,7 +418,7 @@ If START or END is negative, it counts from the end."
(require 'url-irc)
(let* ((url (url-generic-parse-url string))
(url-irc-function
(if (function-equal url-irc-function 'url-irc-erc)
(if (eq url-irc-function 'url-irc-erc)
(lambda (host port chan user pass)
(erc-handle-irc-url host port chan user pass (url-type url)))
url-irc-function)))

View file

@ -116,6 +116,25 @@ Set to nil to disable."
"The column at which a filled paragraph is broken."
:type 'integer)
(defcustom erc-fill-wrap-margin-width nil
"Starting width in columns of dedicated stamp margin.
When nil, ERC normally pretends its value is one column greater
than the `string-width' of the formatted `erc-timestamp-format'.
However, when `erc-fill-wrap-margin-side' is `left' or
\"resolves\" to `left', ERC uses the width of the prompt if it's
wider on MOTD's end, which really only matters when `erc-prompt'
is a function."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) integer))
(defcustom erc-fill-wrap-margin-side nil
"Margin side to use with `erc-fill-wrap-mode'.
A value of nil means ERC should decide based on the value of
`erc-insert-timestamp-function', which does not work for
user-defined functions."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) (const left) (const right)))
(defcustom erc-fill-line-spacing nil
"Extra space between messages on graphical displays.
This may need adjusting depending on how your faces are
@ -253,9 +272,9 @@ messages less than a day apart."
(goto-char erc-input-marker)
;; Mimic what `move-beginning-of-line' does with invisible text.
(when-let ((erc-fill-wrap-merge)
(empty (get-text-property (point) 'display))
((string-empty-p empty)))
(goto-char (text-property-not-all (point) (pos-eol) 'display empty)))))
(prop (get-text-property (point) 'display))
((or (equal prop "") (eq 'margin (car-safe (car-safe prop))))))
(goto-char (text-property-not-all (point) (pos-eol) 'display prop)))))
(defun erc-fill--wrap-end-of-line (arg)
"Defer to `move-end-of-line' or `end-of-visual-line'."
@ -278,12 +297,29 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
('non-input nil))))
(message "erc-fill-wrap movement: %S" erc-fill--wrap-visual-keys))
(defun erc-fill-wrap-toggle-truncate-lines (arg)
"Toggle `truncate-lines' and maybe reinstate `visual-line-mode'."
(interactive "P")
(let ((wantp (if arg
(natnump (prefix-numeric-value arg))
(not truncate-lines)))
(buffer (current-buffer)))
(if wantp
(setq truncate-lines t)
(walk-windows (lambda (window)
(when (eq buffer (window-buffer window))
(set-window-hscroll window 0)))
nil t)
(visual-line-mode +1)))
(force-mode-line-update))
(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
"<remap> <toggle-truncate-lines>" #'erc-fill-wrap-toggle-truncate-lines
"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)
@ -319,42 +355,57 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
"Fill style leveraging `visual-line-mode'.
This local module displays nicks overhanging leftward to a common
offset, as determined by the option `erc-fill-static-center'. It
depends on the `fill' and `button' modules and assumes the option
`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
or the default `erc-insert-timestamp-left-and-right', so that it
can display right-hand stamps in the right margin. A value of
`erc-insert-timestamp-left' is unsupported. To use it, either
include `fill-wrap' in `erc-modules' or set `erc-fill-function'
to `erc-fill-wrap' (recommended). You can also manually invoke
one of the minor-mode toggles if really necessary."
depends on the `fill', `stamp', and `button' modules and assumes
users who've defined their own `erc-insert-timestamp-function'
have also customized the option `erc-fill-wrap-margin-side' to an
explicit side. To use this module, either include `fill-wrap' in
`erc-modules' or set `erc-fill-function' to `erc-fill-wrap'.
Manually invoking one of the minor-mode toggles is not
recommended.
This module imposes various restrictions on the appearance of
timestamps. Most notably, it insists on displaying them in the
margins. Users preferring left-sided stamps may notice that ERC
also displays the prompt in the left margin, possibly truncating
or padding it to constrain it to the margin's width. When stamps
appear in the right margin, which they do by default, users may
find that ERC actually appends them to copy-as-killed messages
without an intervening space. This normally poses at most a
minor inconvenience, however users of the `log' module may prefer
a workaround provided by `erc-stamp-prefix-log-filter', which
strips trailing stamps from logged messages and instead prepends
them to every line."
((erc-fill--wrap-ensure-dependencies)
;; Restore or initialize local state variables.
(erc--restore-initialize-priors erc-fill-wrap-mode
erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys
erc-fill--wrap-value erc-fill-static-center)
erc-fill--wrap-value erc-fill-static-center
erc-stamp--margin-width erc-fill-wrap-margin-width
left-margin-width left-margin-width
right-margin-width right-margin-width)
(setq erc-stamp--margin-left-p
(or (eq erc-fill-wrap-margin-side 'left)
(eq (default-value 'erc-insert-timestamp-function)
#'erc-insert-timestamp-left)))
(setq erc-fill--function #'erc-fill-wrap)
;; Internal integrations.
(add-function :after (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
(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))
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
(erc-stamp--display-margin-mode +1)
(visual-line-mode +1))
((when erc-stamp--display-margin-mode
(erc-stamp--display-margin-mode -1))
((visual-line-mode -1)
(erc-stamp--display-margin-mode -1)
(kill-local-variable 'erc-fill--wrap-value)
(kill-local-variable 'erc-fill--function)
(kill-local-variable 'erc-fill--wrap-visual-keys)
(remove-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p t)
(remove-function (local 'erc-stamp--insert-date-function)
#'erc-fill--wrap-stamp-insert-prefixed-date)
(visual-line-mode -1))
#'erc-fill--wrap-stamp-insert-prefixed-date))
'local)
(defvar-local erc-fill--wrap-length-function nil
@ -381,18 +432,21 @@ parties.")
(widen)
(when (eq 'erc-timestamp (field-at-pos m))
(set-marker m (field-end m)))
(and (eq 'PRIVMSG (get-text-property m 'erc-command))
(not (eq (get-text-property m 'erc-ctcp) 'ACTION))
(cons (get-text-property m 'erc-timestamp)
(get-text-property (1+ m) 'erc-data)))))
(and-let*
(((eq 'PRIVMSG (get-text-property m 'erc-command)))
((not (eq (get-text-property m 'erc-ctcp)
'ACTION)))
(spr (next-single-property-change m 'erc-speaker)))
(cons (get-text-property m 'erc-timestamp)
(get-text-property spr 'erc-speaker)))))
(ts (pop props))
((not (time-less-p (erc-stamp--current-time) ts)))
((time-less-p (time-subtract (erc-stamp--current-time) ts)
erc-fill--wrap-max-lull))
(nick (buffer-substring-no-properties
(1+ (point-min)) (- (point) 2)))
(speaker (next-single-property-change (point-min) 'erc-speaker))
(nick (get-text-property speaker 'erc-speaker))
(props)
((erc-nick-equal-p (car props) nick))))
((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args)
@ -476,8 +530,8 @@ Offer to repeat command in a manner similar to
\\`=' Increase indentation by one column
\\`-' Decrease indentation by one column
\\`0' Reset indentation to the default
\\`+' Shift right margin rightward (shrink) by one column
\\`_' Shift right margin leftward (grow) by one column
\\`+' Shift margin boundary rightward by one column
\\`_' Shift margin boundary leftward by one column
\\`)' Reset the right margin to the default
Note that misalignment may occur when messages contain
@ -489,6 +543,7 @@ decorations applied by third-party modules."
(unless (get-buffer-window)
(user-error "Command called in an undisplayed buffer"))
(let* ((total (erc-fill--wrap-nudge arg))
(leftp erc-stamp--margin-left-p)
(win-ratio (/ (float (- (window-point) (window-start)))
(- (window-end nil t) (window-start)))))
(when (zerop arg)
@ -509,18 +564,20 @@ decorations applied by third-party modules."
(dolist (key '(?\) ?_ ?+))
(let ((a (pcase key
(?\) 0)
(?_ (- (abs arg)))
(?+ (abs arg)))))
(?_ (if leftp (abs arg) (- (abs arg))))
(?+ (if leftp (- (abs arg)) (abs arg))))))
(define-key map (vector (list key))
(lambda ()
(interactive)
(erc-stamp--adjust-right-margin (- a))
(erc-stamp--adjust-margin (- a) (zerop a))
(when leftp (erc-stamp--refresh-left-margin-prompt))
(recenter (round (* win-ratio (window-height))))))))
map)
t
(lambda ()
(message "Fill prefix: %d (%+d col%s)"
erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
(message "Fill prefix: %d (%+d col%s); Margin: %d"
erc-fill--wrap-value total (if (> (abs total) 1) "s" "")
(if leftp left-margin-width right-margin-width)))
"Use %k for further adjustment"
1)
(recenter (round (* win-ratio (window-height))))))
@ -536,6 +593,7 @@ decorations applied by third-party modules."
"Get length of timestamp if inserted left."
(if (and (boundp 'erc-timestamp-format)
erc-timestamp-format
;; FIXME use a more robust test than symbol equivalence.
(eq erc-insert-timestamp-function 'erc-insert-timestamp-left)
(not erc-hide-timestamps))
(length (format-time-string erc-timestamp-format))

View file

@ -281,49 +281,60 @@ 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.
right edge.
Enabling this option produces a side effect in that stamps aren't
indented in saved logs. When its value is an integer, this
option adds a space after the end of a message if the stamp
doesn't already start with one. And when its value is t, it adds
a single space, unconditionally. And while this option never
adds a space when its value is `margin', ERC does offer a
workaround in `erc-stamp-prefix-log-filter', which strips
trailing stamps from messages and puts them before every line."
:type '(choice boolean integer (const margin))
a single space, unconditionally."
:type '(choice boolean integer)
:package-version '(ERC . "5.6")) ; FIXME sync on release
(defcustom erc-stamp-right-margin-width nil
"Width in columns of the right margin.
When this option is nil, pretend its value is one column greater
than the `string-width' of the formatted `erc-timestamp-format'.
This option only matters when `erc-timestamp-use-align-to' is set
to `margin'."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type '(choice (const nil) integer))
(defvar-local erc-stamp--margin-width nil
"Width in columns of margin for `erc-stamp--display-margin-mode'.
Only consulted when resetting or initializing margin.")
(defun erc-stamp--display-margin-force (orig &rest r)
(let ((erc-timestamp-use-align-to 'margin))
(apply orig r)))
(defvar-local erc-stamp--margin-left-p nil
"Whether `erc-stamp--display-margin-mode' uses the left margin.
During initialization, the mode respects this variable's existing
value if it already has a local binding. Otherwise, modules can
bind this to any value while enabling the mode. If it's nil, ERC
will check to see if `erc-insert-timestamp-function' is
`erc-insert-timestamp-left', interpreting the latter as a non-nil
value. It'll then coerce any non-nil value to t.")
(defun erc-stamp--adjust-right-margin (cols)
"Adjust right margin by COLS.
When COLS is zero, reset width to `erc-stamp-right-margin-width'
or one col more than the `string-width' of
`erc-timestamp-format'."
(let ((width
(if (zerop cols)
(or erc-stamp-right-margin-width
(1+ (string-width (or erc-timestamp-last-inserted-right
(erc-format-timestamp
(current-time)
erc-timestamp-format)))))
(+ right-margin-width cols))))
(setq right-margin-width width)
(defun erc-stamp--init-margins-on-connect (&rest _)
(let ((existing (if erc-stamp--margin-left-p
left-margin-width
right-margin-width)))
(erc-stamp--adjust-margin existing 'resetp)))
(defun erc-stamp--adjust-margin (cols &optional resetp)
"Adjust managed margin by increment COLS.
With RESETP, set margin's width to COLS. However, if COLS is
zero, set the width to a non-nil `erc-stamp--margin-width'.
Otherwise, go with the `string-width' of `erc-timestamp-format'.
However, when `erc-stamp--margin-left-p' is non-nil and the
prompt is wider, use its width instead."
(let* ((leftp erc-stamp--margin-left-p)
(width
(if resetp
(or (and (not (zerop cols)) cols)
erc-stamp--margin-width
(max (if leftp (string-width (erc-prompt)) 0)
(1+ (string-width
(or (if leftp
erc-timestamp-last-inserted
erc-timestamp-last-inserted-right)
(erc-format-timestamp
(current-time) erc-timestamp-format))))))
(+ (if leftp left-margin-width right-margin-width) cols))))
(set (if leftp 'left-margin-width 'right-margin-width) width)
(when (eq (current-buffer) (window-buffer))
(set-window-margins nil left-margin-width width))))
(set-window-margins nil
(if leftp width left-margin-width)
(if leftp right-margin-width width)))))
;;;###autoload
(defun erc-stamp-prefix-log-filter (text)
@ -348,39 +359,100 @@ non-nil."
(zerop (forward-line))))
"")
(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
(declare-function erc--remove-text-properties "erc" (string))
;; If people want to use this directly, we can convert it into
;; a local module.
;; Currently, `erc-insert-timestamp-right' hard codes its display
;; property to use `right-margin', and `erc-insert-timestamp-left'
;; does the same for `left-margin'. However, there's no reason a
;; trailing stamp couldn't be displayed on the left and vice versa.
(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."
Arranges for displaying stamps in a single margin, with the
variable `erc-stamp--margin-left-p' controlling which one.
Provides `erc-stamp--margin-width' and `erc-stamp--adjust-margin'
to help manage the chosen margin's width. Also removes `display'
properties in killed text to reveal stamps. The invoking module
should set controlling variables, like `erc-stamp--margin-width'
and `erc-stamp--margin-left-p', before activating the mode."
:interactive nil
(if erc-stamp--display-margin-mode
(progn
(setq fringes-outside-margins t)
(when (eq (current-buffer) (window-buffer))
(set-window-buffer (selected-window) (current-buffer)))
(erc-stamp--adjust-right-margin 0)
(setq erc-stamp--margin-left-p (and erc-stamp--margin-left-p t))
(if (or erc-server-connected (not (functionp erc-prompt)))
(erc-stamp--init-margins-on-connect)
(add-hook 'erc-after-connect
#'erc-stamp--init-margins-on-connect nil t))
(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))
(add-hook 'erc--setup-buffer-hook
#'erc-stamp--refresh-left-margin-prompt nil t)
(when erc-stamp--margin-left-p
(add-hook 'erc--refresh-prompt-hook
#'erc-stamp--display-prompt-in-left-margin nil t)))
(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)
(remove-hook 'erc-after-connect
#'erc-stamp--init-margins-on-connect t)
(remove-hook 'erc--refresh-prompt-hook
#'erc-stamp--display-prompt-in-left-margin t)
(remove-hook 'erc--setup-buffer-hook
#'erc-stamp--refresh-left-margin-prompt t)
(kill-local-variable (if erc-stamp--margin-left-p
'left-margin-width
'right-margin-width))
(kill-local-variable 'fringes-outside-margins)
(kill-local-variable 'erc-stamp--margin-left-p)
(kill-local-variable 'erc-stamp--margin-width)
(when (eq (current-buffer) (window-buffer))
(set-window-margins nil left-margin-width nil)
(set-window-buffer (selected-window) (current-buffer)))))
(defun erc-insert-timestamp-left (string)
(defvar-local erc-stamp--last-prompt nil)
(defun erc-stamp--display-prompt-in-left-margin ()
"Show prompt in the left margin with padding."
(when (or (not erc-stamp--last-prompt) (functionp erc-prompt)
(> (string-width erc-stamp--last-prompt) left-margin-width))
(let ((s (buffer-substring erc-insert-marker (1- erc-input-marker))))
;; Prevent #("abc" n m (display ((...) #("abc" p q (display...))))
(remove-text-properties 0 (length s) '(display nil) s)
(when (and erc-stamp--last-prompt
(>= (string-width erc-stamp--last-prompt) left-margin-width))
(let ((sm (truncate-string-to-width s (1- left-margin-width) 0 nil t)))
;; This papers over a subtle off-by-1 bug here.
(unless (equal sm s)
(setq s (concat sm (substring s -1))))))
(setq erc-stamp--last-prompt (string-pad s left-margin-width nil t))))
(put-text-property erc-insert-marker (1- erc-input-marker)
'display `((margin left-margin) ,erc-stamp--last-prompt))
erc-stamp--last-prompt)
(defun erc-stamp--refresh-left-margin-prompt ()
"Forcefully-recompute display property of prompt in left margin."
(with-silent-modifications
(unless (functionp erc-prompt)
(setq erc-stamp--last-prompt nil))
(erc--refresh-prompt)))
(cl-defmethod erc--reveal-prompt
(&context (erc-stamp--display-margin-mode (eql t))
(erc-stamp--margin-left-p (eql t)))
(put-text-property erc-insert-marker (1- erc-input-marker)
'display `((margin left-margin) ,erc-stamp--last-prompt)))
(cl-defmethod erc--conceal-prompt
(&context (erc-stamp--display-margin-mode (eql t))
(erc-stamp--margin-left-p (eql t)))
(let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)))
(put-text-property erc-insert-marker (1- erc-input-marker)
'display `((margin left-margin) ,prompt))))
(cl-defmethod erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
(goto-char (point-min))
(let* ((ignore-p (and erc-timestamp-only-if-changed-flag
@ -392,6 +464,22 @@ message text so that stamps will be visible when yanked."
(erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s)
(insert s)))
(cl-defmethod erc-insert-timestamp-left
(string &context (erc-stamp--display-margin-mode (eql t)))
(unless (and erc-timestamp-only-if-changed-flag
(string-equal string erc-timestamp-last-inserted))
(goto-char (point-min))
(insert-before-markers-and-inherit
(setq erc-timestamp-last-inserted string))
(dolist (p erc-stamp--inherited-props)
(when-let ((v (get-text-property (point) p)))
(put-text-property (point-min) (point) p v)))
(erc-put-text-property (point-min) (point) 'invisible
erc-stamp--invisible-property)
(put-text-property (point-min) (point) 'field 'erc-timestamp)
(put-text-property (point-min) (point)
'display `((margin left-margin) ,string))))
(defun erc-insert-aligned (string pos)
"Insert STRING at the POSth column.
@ -408,7 +496,11 @@ property to get to the POSth column."
;; Silence byte-compiler
(defvar erc-fill-column)
(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
(defvar erc-stamp--omit-properties-on-folded-lines nil
"Skip properties before right stamps occupying their own line.
This escape hatch restores pre-5.6 behavior that left leading
white space alone (unpropertized) for right-sided stamps folded
onto their own line.")
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
@ -465,6 +557,9 @@ printed just after each line's text (no alignment)."
;; For compatibility reasons, the `erc-timestamp' field includes
;; intervening white space unless a hard break is warranted.
(pcase erc-timestamp-use-align-to
((guard erc-stamp--display-margin-mode)
(put-text-property 0 (length string)
'display `((margin right-margin) ,string) string))
((and 't (guard (< col pos)))
(insert " ")
(put-text-property from (point) 'display `(space :align-to ,pos)))
@ -475,11 +570,8 @@ printed just after each line's text (no alignment)."
(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)))
((guard (>= col pos)) (newline) (indent-to pos)
(when erc-stamp--omit-properties-on-folded-lines (setq from (point))))
(_ (indent-to pos)))
(insert string)
(dolist (p erc-stamp--inherited-props)

View file

@ -2879,19 +2879,23 @@ this option to nil."
(cl-assert (< erc-insert-marker erc-input-marker))
(cl-assert (= (field-end erc-insert-marker) erc-input-marker)))))
(defvar erc--refresh-prompt-hook nil)
(defun erc--refresh-prompt ()
"Re-render ERC's prompt when the option `erc-prompt' is a function."
(erc--assert-input-bounds)
(when (functionp erc-prompt)
(save-excursion
(goto-char erc-insert-marker)
(set-marker-insertion-type erc-insert-marker nil)
;; Avoid `erc-prompt' (the named function), which appends a
;; space, and `erc-display-prompt', which propertizes all but
;; that space.
(insert-and-inherit (funcall erc-prompt))
(set-marker-insertion-type erc-insert-marker t)
(delete-region (point) (1- erc-input-marker)))))
(unless (erc--prompt-hidden-p)
(when (functionp erc-prompt)
(save-excursion
(goto-char erc-insert-marker)
(set-marker-insertion-type erc-insert-marker nil)
;; Avoid `erc-prompt' (the named function), which appends a
;; space, and `erc-display-prompt', which propertizes all but
;; that space.
(insert-and-inherit (funcall erc-prompt))
(set-marker-insertion-type erc-insert-marker t)
(delete-region (point) (1- erc-input-marker))))
(run-hooks 'erc--refresh-prompt-hook)))
(defun erc-display-line-1 (string buffer)
"Display STRING in `erc-mode' BUFFER.
@ -4804,7 +4808,7 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
;; shall remain part of the prompt.
(setq prompt (propertize prompt
'rear-nonsticky t
'erc-prompt t
'erc-prompt t ; t or `hidden'
'field 'erc-prompt
'front-sticky t
'read-only t))

View file

@ -340,4 +340,41 @@
(should (search-backward "ERC> " nil t))
(execute-kbd-macro "\C-a")))))
(ert-deftest erc-fill--left-hand-stamps ()
:tags '(:unstable)
(unless (>= emacs-major-version 29)
(ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
(let ((erc-timestamp-only-if-changed-flag nil)
(erc-insert-timestamp-function #'erc-insert-timestamp-left))
(erc-fill-tests--wrap-populate
(lambda ()
(should (= 8 left-margin-width))
(pcase-let ((`((margin left-margin) ,displayed)
(get-text-property erc-insert-marker 'display)))
(should (equal-including-properties
displayed #(" ERC>" 4 8
( read-only t
front-sticky t
field erc-prompt
erc-prompt t
rear-nonsticky t
font-lock-face erc-prompt-face)))))
(erc-fill-tests--compare "stamps-left-01")
(ert-info ("Shrink left margin by 1 col")
(erc-stamp--adjust-margin -1)
(with-silent-modifications (erc--refresh-prompt))
(should (= 7 left-margin-width))
(pcase-let ((`((margin left-margin) ,displayed)
(get-text-property erc-insert-marker 'display)))
(should (equal-including-properties
displayed #(" ERC>" 3 7
( read-only t
front-sticky t
field erc-prompt
erc-prompt t
rear-nonsticky t
font-lock-face erc-prompt-face))))))))))
;;; erc-fill-tests.el ends here

View file

@ -56,7 +56,7 @@
(advice-remove 'erc-format-timestamp
'ert-deftest--erc-timestamp-use-align-to)))
(ert-deftest erc-timestamp-use-align-to--nil ()
(defun erc-stamp-tests--use-align-to--nil (compat)
(erc-stamp-tests--insert-right
(lambda ()
@ -83,12 +83,20 @@
(erc-display-message nil 'notice (current-buffer)
"twenty characters"))
(should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t))
;; Field excludes leading whitespace (arguably undesirable).
(should (eql ?\[ (char-after (field-beginning (point)))))
;; Field includes leading whitespace.
(should (eql (if compat ?\[ ?\n)
(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 ()
(ert-deftest erc-timestamp-use-align-to--nil ()
(ert-info ("Field starts on stamp text (compat)")
(let ((erc-stamp--omit-properties-on-folded-lines t))
(erc-stamp-tests--use-align-to--nil 'compat)))
(ert-info ("Field includes leaidng white space")
(erc-stamp-tests--use-align-to--nil nil)))
(defun erc-stamp-tests--use-align-to--t (compat)
(erc-stamp-tests--insert-right
(lambda ()
@ -110,10 +118,17 @@
(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 (field-beginning (point)))))
;; Field includes leading space.
(should (eql (if compat ?\[ ?\n) (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
(ert-deftest erc-timestamp-use-align-to--t ()
(ert-info ("Field starts on stamp text (compat)")
(let ((erc-stamp--omit-properties-on-folded-lines t))
(erc-stamp-tests--use-align-to--t 'compat)))
(ert-info ("Field includes leaidng white space")
(erc-stamp-tests--use-align-to--t nil)))
(ert-deftest erc-timestamp-use-align-to--integer ()
(erc-stamp-tests--insert-right
(lambda ()
@ -140,7 +155,7 @@
(should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
(ert-deftest erc-timestamp-use-align-to--margin ()
(ert-deftest erc-stamp--display-margin-mode--right ()
(erc-stamp-tests--insert-right
(lambda ()
(erc-stamp--display-margin-mode +1)

View file

@ -219,6 +219,7 @@
(setq erc-hide-prompt '(server))
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(should (string= ">" (get-text-property erc-insert-marker 'display))))
(with-current-buffer "#chan"
@ -229,6 +230,7 @@
(with-current-buffer "ServNet"
(erc--unhide-prompt)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display))))
(ert-info ("Value: channel")
@ -242,7 +244,9 @@
(with-current-buffer "#chan"
(should (string= ">" (get-text-property erc-insert-marker 'display)))
(should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display))))
(ert-info ("Value: query")
@ -253,7 +257,9 @@
(with-current-buffer "bob"
(should (string= ">" (get-text-property erc-insert-marker 'display)))
(should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
(should-not (get-text-property erc-insert-marker 'display)))
(with-current-buffer "#chan"

View file

@ -0,0 +1 @@
#("\n\n[00:00]*** 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.\n[00:00]<alice> bob: come, you are a tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause to complain of? Come me to what was done to her.\n[00:00]<bob> alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 9 (erc-timestamp 0 display (#4=(margin left-margin) #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1=(space :width 27) line-prefix #2=(space :width (- 27 (4)))) 9 171 (erc-timestamp 0 wrap-prefix #1# line-prefix #2#) 172 179 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #3=(space :width (- 27 (8)))) 179 180 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 180 185 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 185 187 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 187 190 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 190 303 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 303 304 (erc-timestamp 0 erc-command PRIVMSG) 304 336 (erc-timestamp 0 wrap-prefix #1# line-prefix #3# erc-command PRIVMSG) 337 344 (erc-timestamp 0 display (#4# #("[00:00]" 0 7 (invisible timestamp font-lock-face erc-timestamp-face))) field erc-timestamp wrap-prefix #1# line-prefix #5=(space :width (- 27 (6)))) 344 345 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 345 348 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 348 350 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 350 355 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG) 355 430 (erc-timestamp 0 wrap-prefix #1# line-prefix #5# erc-command PRIVMSG))