diff options
| author | F. Jason Park | 2023-07-14 06:12:30 -0700 |
|---|---|---|
| committer | F. Jason Park | 2023-07-22 07:33:07 -0700 |
| commit | 63d8b2a59a4f395ca64adb698cdb4764d80dfbee (patch) | |
| tree | bdd38bda05c4c50da66c9c9ae3c988e7396aa313 | |
| parent | d09464e50482a792cc11c20916167d3f62637c2d (diff) | |
| download | emacs-63d8b2a59a4f395ca64adb698cdb4764d80dfbee.tar.gz emacs-63d8b2a59a4f395ca64adb698cdb4764d80dfbee.zip | |
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)
| -rw-r--r-- | etc/ERC-NEWS | 20 | ||||
| -rw-r--r-- | lisp/erc/erc-backend.el | 23 | ||||
| -rw-r--r-- | lisp/erc/erc-compat.el | 2 | ||||
| -rw-r--r-- | lisp/erc/erc-fill.el | 126 | ||||
| -rw-r--r-- | lisp/erc/erc-stamp.el | 202 | ||||
| -rw-r--r-- | lisp/erc/erc.el | 26 | ||||
| -rw-r--r-- | test/lisp/erc/erc-fill-tests.el | 37 | ||||
| -rw-r--r-- | test/lisp/erc/erc-stamp-tests.el | 29 | ||||
| -rw-r--r-- | test/lisp/erc/erc-tests.el | 6 | ||||
| -rw-r--r-- | test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld | 1 |
10 files changed, 354 insertions, 118 deletions
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 4c881e32ab4..13e49a9123d 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS | |||
| @@ -103,11 +103,8 @@ side window. Hit '<RET>' over a nick to spawn a "/QUERY" or a | |||
| 103 | ** The option 'erc-timestamp-use-align-to' is more versatile. | 103 | ** The option 'erc-timestamp-use-align-to' is more versatile. |
| 104 | While this option has always offered to right-align stamps via the | 104 | While this option has always offered to right-align stamps via the |
| 105 | 'display' text property, it's now more effective at doing so when set | 105 | 'display' text property, it's now more effective at doing so when set |
| 106 | to a number indicating an offset from the right edge. And when set to | 106 | to a number indicating an offset from the right edge. Users of the |
| 107 | the symbol 'margin', it displays stamps in the right margin, although, | 107 | 'log' module may want to customize 'erc-log-filter-function' to |
| 108 | at the moment, this is mostly intended for use by other modules, such | ||
| 109 | as 'fill-wrap', described above. For both these variants, users of | ||
| 110 | the 'log' module may want to customize 'erc-log-filter-function' to | ||
| 111 | 'erc-stamp-prefix-log-filter' to avoid ragged right-hand stamps | 108 | 'erc-stamp-prefix-log-filter' to avoid ragged right-hand stamps |
| 112 | appearing in their saved logs. | 109 | appearing in their saved logs. |
| 113 | 110 | ||
| @@ -228,7 +225,8 @@ Chiefly, 'rear-sticky' has been replaced by 'erc-command', which | |||
| 228 | records the IRC command (or numeric) associated with a message. Less | 225 | records the IRC command (or numeric) associated with a message. Less |
| 229 | impactfully, the value of the 'field' property for ERC's prompt has | 226 | impactfully, the value of the 'field' property for ERC's prompt has |
| 230 | changed from 't' to the more useful 'erc-prompt', although the | 227 | changed from 't' to the more useful 'erc-prompt', although the |
| 231 | property of the same name has been retained. | 228 | property of the same name has been retained and now has a value of |
| 229 | 'hidden' when disconnected. | ||
| 232 | 230 | ||
| 233 | *** Members of insert- and send-related hooks have been reordered. | 231 | *** Members of insert- and send-related hooks have been reordered. |
| 234 | Built-in and third-party modules rely on certain hooks for adjusting | 232 | 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 | |||
| 261 | with existing ones, when present, and it includes all white space | 259 | with existing ones, when present, and it includes all white space |
| 262 | around stamps when doing so. | 260 | around stamps when doing so. |
| 263 | 261 | ||
| 262 | Moreover, such "propertizing" of surrounding white space now extends | ||
| 263 | to all 'stamp'-applied properties, like 'field', in all intervening | ||
| 264 | space between message text and timestamps. This constitutes a | ||
| 265 | breaking change from the perspective of detecting a timestamp's | ||
| 266 | bounds. For example, ERC has always propertized leading space before | ||
| 267 | right-sided stamps on the same line as message text but not those | ||
| 268 | folded onto the next line. This inconsistency made stamp detection | ||
| 269 | overly complex and produced uneven results when toggling stamp | ||
| 270 | visibility. | ||
| 271 | |||
| 264 | *** The role of a module's Custom group is now more clearly defined. | 272 | *** The role of a module's Custom group is now more clearly defined. |
| 265 | Associating built-in modules with Custom groups and provided library | 273 | Associating built-in modules with Custom groups and provided library |
| 266 | features has improved. More specifically, a module's group now enjoys | 274 | features has improved. More specifically, a module's group now enjoys |
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 363509d17fa..eb3ec39fedd 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el | |||
| @@ -1045,13 +1045,25 @@ Conditionally try to reconnect and take appropriate action." | |||
| 1045 | ;; unexpected disconnect | 1045 | ;; unexpected disconnect |
| 1046 | (erc-process-sentinel-2 event buffer)))) | 1046 | (erc-process-sentinel-2 event buffer)))) |
| 1047 | 1047 | ||
| 1048 | (cl-defmethod erc--reveal-prompt () | ||
| 1049 | (remove-text-properties erc-insert-marker erc-input-marker | ||
| 1050 | '(display nil))) | ||
| 1051 | |||
| 1052 | (cl-defmethod erc--conceal-prompt () | ||
| 1053 | (add-text-properties erc-insert-marker (1- erc-input-marker) | ||
| 1054 | `(display ,erc-prompt-hidden))) | ||
| 1055 | |||
| 1056 | (defun erc--prompt-hidden-p () | ||
| 1057 | (and (marker-position erc-insert-marker) | ||
| 1058 | (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))) | ||
| 1059 | |||
| 1048 | (defun erc--unhide-prompt () | 1060 | (defun erc--unhide-prompt () |
| 1049 | (remove-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert t) | 1061 | (remove-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert t) |
| 1050 | (when (and (marker-position erc-insert-marker) | 1062 | (when (and (marker-position erc-insert-marker) |
| 1051 | (marker-position erc-input-marker)) | 1063 | (marker-position erc-input-marker)) |
| 1052 | (with-silent-modifications | 1064 | (with-silent-modifications |
| 1053 | (remove-text-properties erc-insert-marker erc-input-marker | 1065 | (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t) |
| 1054 | '(display nil))))) | 1066 | (erc--reveal-prompt)))) |
| 1055 | 1067 | ||
| 1056 | (defun erc--unhide-prompt-on-self-insert () | 1068 | (defun erc--unhide-prompt-on-self-insert () |
| 1057 | (when (and (eq this-command #'self-insert-command) | 1069 | (when (and (eq this-command #'self-insert-command) |
| @@ -1059,6 +1071,8 @@ Conditionally try to reconnect and take appropriate action." | |||
| 1059 | (erc--unhide-prompt))) | 1071 | (erc--unhide-prompt))) |
| 1060 | 1072 | ||
| 1061 | (defun erc--hide-prompt (proc) | 1073 | (defun erc--hide-prompt (proc) |
| 1074 | "Hide prompt in all buffers of server. | ||
| 1075 | Change value of property `erc-prompt' from t to `hidden'." | ||
| 1062 | (erc-with-all-buffers-of-server proc nil | 1076 | (erc-with-all-buffers-of-server proc nil |
| 1063 | (when (and erc-hide-prompt | 1077 | (when (and erc-hide-prompt |
| 1064 | (or (eq erc-hide-prompt t) | 1078 | (or (eq erc-hide-prompt t) |
| @@ -1072,8 +1086,9 @@ Conditionally try to reconnect and take appropriate action." | |||
| 1072 | (marker-position erc-input-marker) | 1086 | (marker-position erc-input-marker) |
| 1073 | (get-text-property erc-insert-marker 'erc-prompt)) | 1087 | (get-text-property erc-insert-marker 'erc-prompt)) |
| 1074 | (with-silent-modifications | 1088 | (with-silent-modifications |
| 1075 | (add-text-properties erc-insert-marker (1- erc-input-marker) | 1089 | (put-text-property erc-insert-marker (1- erc-input-marker) |
| 1076 | `(display ,erc-prompt-hidden))) | 1090 | 'erc-prompt 'hidden) |
| 1091 | (erc--conceal-prompt)) | ||
| 1077 | (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 91 t)))) | 1092 | (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 91 t)))) |
| 1078 | 1093 | ||
| 1079 | (defun erc-process-sentinel (cproc event) | 1094 | (defun erc-process-sentinel (cproc event) |
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index f451aaee754..109b5d245ab 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el | |||
| @@ -418,7 +418,7 @@ If START or END is negative, it counts from the end." | |||
| 418 | (require 'url-irc) | 418 | (require 'url-irc) |
| 419 | (let* ((url (url-generic-parse-url string)) | 419 | (let* ((url (url-generic-parse-url string)) |
| 420 | (url-irc-function | 420 | (url-irc-function |
| 421 | (if (function-equal url-irc-function 'url-irc-erc) | 421 | (if (eq url-irc-function 'url-irc-erc) |
| 422 | (lambda (host port chan user pass) | 422 | (lambda (host port chan user pass) |
| 423 | (erc-handle-irc-url host port chan user pass (url-type url))) | 423 | (erc-handle-irc-url host port chan user pass (url-type url))) |
| 424 | url-irc-function))) | 424 | url-irc-function))) |
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index a65c95f1d85..c74fcd298d5 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el | |||
| @@ -116,6 +116,25 @@ Set to nil to disable." | |||
| 116 | "The column at which a filled paragraph is broken." | 116 | "The column at which a filled paragraph is broken." |
| 117 | :type 'integer) | 117 | :type 'integer) |
| 118 | 118 | ||
| 119 | (defcustom erc-fill-wrap-margin-width nil | ||
| 120 | "Starting width in columns of dedicated stamp margin. | ||
| 121 | When nil, ERC normally pretends its value is one column greater | ||
| 122 | than the `string-width' of the formatted `erc-timestamp-format'. | ||
| 123 | However, when `erc-fill-wrap-margin-side' is `left' or | ||
| 124 | \"resolves\" to `left', ERC uses the width of the prompt if it's | ||
| 125 | wider on MOTD's end, which really only matters when `erc-prompt' | ||
| 126 | is a function." | ||
| 127 | :package-version '(ERC . "5.6") ; FIXME sync on release | ||
| 128 | :type '(choice (const nil) integer)) | ||
| 129 | |||
| 130 | (defcustom erc-fill-wrap-margin-side nil | ||
| 131 | "Margin side to use with `erc-fill-wrap-mode'. | ||
| 132 | A value of nil means ERC should decide based on the value of | ||
| 133 | `erc-insert-timestamp-function', which does not work for | ||
| 134 | user-defined functions." | ||
| 135 | :package-version '(ERC . "5.6") ; FIXME sync on release | ||
| 136 | :type '(choice (const nil) (const left) (const right))) | ||
| 137 | |||
| 119 | (defcustom erc-fill-line-spacing nil | 138 | (defcustom erc-fill-line-spacing nil |
| 120 | "Extra space between messages on graphical displays. | 139 | "Extra space between messages on graphical displays. |
| 121 | This may need adjusting depending on how your faces are | 140 | This may need adjusting depending on how your faces are |
| @@ -253,9 +272,9 @@ messages less than a day apart." | |||
| 253 | (goto-char erc-input-marker) | 272 | (goto-char erc-input-marker) |
| 254 | ;; Mimic what `move-beginning-of-line' does with invisible text. | 273 | ;; Mimic what `move-beginning-of-line' does with invisible text. |
| 255 | (when-let ((erc-fill-wrap-merge) | 274 | (when-let ((erc-fill-wrap-merge) |
| 256 | (empty (get-text-property (point) 'display)) | 275 | (prop (get-text-property (point) 'display)) |
| 257 | ((string-empty-p empty))) | 276 | ((or (equal prop "") (eq 'margin (car-safe (car-safe prop)))))) |
| 258 | (goto-char (text-property-not-all (point) (pos-eol) 'display empty))))) | 277 | (goto-char (text-property-not-all (point) (pos-eol) 'display prop))))) |
| 259 | 278 | ||
| 260 | (defun erc-fill--wrap-end-of-line (arg) | 279 | (defun erc-fill--wrap-end-of-line (arg) |
| 261 | "Defer to `move-end-of-line' or `end-of-visual-line'." | 280 | "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'." | |||
| 278 | ('non-input nil)))) | 297 | ('non-input nil)))) |
| 279 | (message "erc-fill-wrap movement: %S" erc-fill--wrap-visual-keys)) | 298 | (message "erc-fill-wrap movement: %S" erc-fill--wrap-visual-keys)) |
| 280 | 299 | ||
| 300 | (defun erc-fill-wrap-toggle-truncate-lines (arg) | ||
| 301 | "Toggle `truncate-lines' and maybe reinstate `visual-line-mode'." | ||
| 302 | (interactive "P") | ||
| 303 | (let ((wantp (if arg | ||
| 304 | (natnump (prefix-numeric-value arg)) | ||
| 305 | (not truncate-lines))) | ||
| 306 | (buffer (current-buffer))) | ||
| 307 | (if wantp | ||
| 308 | (setq truncate-lines t) | ||
| 309 | (walk-windows (lambda (window) | ||
| 310 | (when (eq buffer (window-buffer window)) | ||
| 311 | (set-window-hscroll window 0))) | ||
| 312 | nil t) | ||
| 313 | (visual-line-mode +1))) | ||
| 314 | (force-mode-line-update)) | ||
| 315 | |||
| 281 | (defvar-keymap erc-fill-wrap-mode-map ; Compat 29 | 316 | (defvar-keymap erc-fill-wrap-mode-map ; Compat 29 |
| 282 | :doc "Keymap for ERC's `fill-wrap' module." | 317 | :doc "Keymap for ERC's `fill-wrap' module." |
| 283 | :parent visual-line-mode-map | 318 | :parent visual-line-mode-map |
| 284 | "<remap> <kill-line>" #'erc-fill--wrap-kill-line | 319 | "<remap> <kill-line>" #'erc-fill--wrap-kill-line |
| 285 | "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line | 320 | "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line |
| 286 | "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line | 321 | "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line |
| 322 | "<remap> <toggle-truncate-lines>" #'erc-fill-wrap-toggle-truncate-lines | ||
| 287 | "C-c a" #'erc-fill-wrap-cycle-visual-movement | 323 | "C-c a" #'erc-fill-wrap-cycle-visual-movement |
| 288 | ;; Not sure if this is problematic because `erc-bol' takes no args. | 324 | ;; Not sure if this is problematic because `erc-bol' takes no args. |
| 289 | "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line) | 325 | "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line) |
| @@ -319,42 +355,57 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'." | |||
| 319 | "Fill style leveraging `visual-line-mode'. | 355 | "Fill style leveraging `visual-line-mode'. |
| 320 | This local module displays nicks overhanging leftward to a common | 356 | This local module displays nicks overhanging leftward to a common |
| 321 | offset, as determined by the option `erc-fill-static-center'. It | 357 | offset, as determined by the option `erc-fill-static-center'. It |
| 322 | depends on the `fill' and `button' modules and assumes the option | 358 | depends on the `fill', `stamp', and `button' modules and assumes |
| 323 | `erc-insert-timestamp-function' is `erc-insert-timestamp-right' | 359 | users who've defined their own `erc-insert-timestamp-function' |
| 324 | or the default `erc-insert-timestamp-left-and-right', so that it | 360 | have also customized the option `erc-fill-wrap-margin-side' to an |
| 325 | can display right-hand stamps in the right margin. A value of | 361 | explicit side. To use this module, either include `fill-wrap' in |
| 326 | `erc-insert-timestamp-left' is unsupported. To use it, either | 362 | `erc-modules' or set `erc-fill-function' to `erc-fill-wrap'. |
| 327 | include `fill-wrap' in `erc-modules' or set `erc-fill-function' | 363 | Manually invoking one of the minor-mode toggles is not |
| 328 | to `erc-fill-wrap' (recommended). You can also manually invoke | 364 | recommended. |
| 329 | one of the minor-mode toggles if really necessary." | 365 | |
| 366 | This module imposes various restrictions on the appearance of | ||
| 367 | timestamps. Most notably, it insists on displaying them in the | ||
| 368 | margins. Users preferring left-sided stamps may notice that ERC | ||
| 369 | also displays the prompt in the left margin, possibly truncating | ||
| 370 | or padding it to constrain it to the margin's width. When stamps | ||
| 371 | appear in the right margin, which they do by default, users may | ||
| 372 | find that ERC actually appends them to copy-as-killed messages | ||
| 373 | without an intervening space. This normally poses at most a | ||
| 374 | minor inconvenience, however users of the `log' module may prefer | ||
| 375 | a workaround provided by `erc-stamp-prefix-log-filter', which | ||
| 376 | strips trailing stamps from logged messages and instead prepends | ||
| 377 | them to every line." | ||
| 330 | ((erc-fill--wrap-ensure-dependencies) | 378 | ((erc-fill--wrap-ensure-dependencies) |
| 331 | ;; Restore or initialize local state variables. | ||
| 332 | (erc--restore-initialize-priors erc-fill-wrap-mode | 379 | (erc--restore-initialize-priors erc-fill-wrap-mode |
| 333 | erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys | 380 | erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys |
| 334 | erc-fill--wrap-value erc-fill-static-center) | 381 | erc-fill--wrap-value erc-fill-static-center |
| 382 | erc-stamp--margin-width erc-fill-wrap-margin-width | ||
| 383 | left-margin-width left-margin-width | ||
| 384 | right-margin-width right-margin-width) | ||
| 385 | (setq erc-stamp--margin-left-p | ||
| 386 | (or (eq erc-fill-wrap-margin-side 'left) | ||
| 387 | (eq (default-value 'erc-insert-timestamp-function) | ||
| 388 | #'erc-insert-timestamp-left))) | ||
| 335 | (setq erc-fill--function #'erc-fill-wrap) | 389 | (setq erc-fill--function #'erc-fill-wrap) |
| 336 | ;; Internal integrations. | ||
| 337 | (add-function :after (local 'erc-stamp--insert-date-function) | 390 | (add-function :after (local 'erc-stamp--insert-date-function) |
| 338 | #'erc-fill--wrap-stamp-insert-prefixed-date) | 391 | #'erc-fill--wrap-stamp-insert-prefixed-date) |
| 339 | (when (or erc-stamp-mode (memq 'stamp erc-modules)) | ||
| 340 | (erc-stamp--display-margin-mode +1)) | ||
| 341 | (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules)) | 392 | (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules)) |
| 342 | (require 'erc-match) | 393 | (require 'erc-match) |
| 343 | (setq erc-match--hide-fools-offset-bounds t)) | 394 | (setq erc-match--hide-fools-offset-bounds t)) |
| 344 | (when erc-fill-wrap-merge | 395 | (when erc-fill-wrap-merge |
| 345 | (add-hook 'erc-button--prev-next-predicate-functions | 396 | (add-hook 'erc-button--prev-next-predicate-functions |
| 346 | #'erc-fill--wrap-merged-button-p nil t)) | 397 | #'erc-fill--wrap-merged-button-p nil t)) |
| 398 | (erc-stamp--display-margin-mode +1) | ||
| 347 | (visual-line-mode +1)) | 399 | (visual-line-mode +1)) |
| 348 | ((when erc-stamp--display-margin-mode | 400 | ((visual-line-mode -1) |
| 349 | (erc-stamp--display-margin-mode -1)) | 401 | (erc-stamp--display-margin-mode -1) |
| 350 | (kill-local-variable 'erc-fill--wrap-value) | 402 | (kill-local-variable 'erc-fill--wrap-value) |
| 351 | (kill-local-variable 'erc-fill--function) | 403 | (kill-local-variable 'erc-fill--function) |
| 352 | (kill-local-variable 'erc-fill--wrap-visual-keys) | 404 | (kill-local-variable 'erc-fill--wrap-visual-keys) |
| 353 | (remove-hook 'erc-button--prev-next-predicate-functions | 405 | (remove-hook 'erc-button--prev-next-predicate-functions |
| 354 | #'erc-fill--wrap-merged-button-p t) | 406 | #'erc-fill--wrap-merged-button-p t) |
| 355 | (remove-function (local 'erc-stamp--insert-date-function) | 407 | (remove-function (local 'erc-stamp--insert-date-function) |
| 356 | #'erc-fill--wrap-stamp-insert-prefixed-date) | 408 | #'erc-fill--wrap-stamp-insert-prefixed-date)) |
| 357 | (visual-line-mode -1)) | ||
| 358 | 'local) | 409 | 'local) |
| 359 | 410 | ||
| 360 | (defvar-local erc-fill--wrap-length-function nil | 411 | (defvar-local erc-fill--wrap-length-function nil |
| @@ -381,18 +432,21 @@ parties.") | |||
| 381 | (widen) | 432 | (widen) |
| 382 | (when (eq 'erc-timestamp (field-at-pos m)) | 433 | (when (eq 'erc-timestamp (field-at-pos m)) |
| 383 | (set-marker m (field-end m))) | 434 | (set-marker m (field-end m))) |
| 384 | (and (eq 'PRIVMSG (get-text-property m 'erc-command)) | 435 | (and-let* |
| 385 | (not (eq (get-text-property m 'erc-ctcp) 'ACTION)) | 436 | (((eq 'PRIVMSG (get-text-property m 'erc-command))) |
| 386 | (cons (get-text-property m 'erc-timestamp) | 437 | ((not (eq (get-text-property m 'erc-ctcp) |
| 387 | (get-text-property (1+ m) 'erc-data))))) | 438 | 'ACTION))) |
| 439 | (spr (next-single-property-change m 'erc-speaker))) | ||
| 440 | (cons (get-text-property m 'erc-timestamp) | ||
| 441 | (get-text-property spr 'erc-speaker))))) | ||
| 388 | (ts (pop props)) | 442 | (ts (pop props)) |
| 389 | ((not (time-less-p (erc-stamp--current-time) ts))) | 443 | ((not (time-less-p (erc-stamp--current-time) ts))) |
| 390 | ((time-less-p (time-subtract (erc-stamp--current-time) ts) | 444 | ((time-less-p (time-subtract (erc-stamp--current-time) ts) |
| 391 | erc-fill--wrap-max-lull)) | 445 | erc-fill--wrap-max-lull)) |
| 392 | (nick (buffer-substring-no-properties | 446 | (speaker (next-single-property-change (point-min) 'erc-speaker)) |
| 393 | (1+ (point-min)) (- (point) 2))) | 447 | (nick (get-text-property speaker 'erc-speaker)) |
| 394 | (props) | 448 | (props) |
| 395 | ((erc-nick-equal-p (car props) nick)))) | 449 | ((erc-nick-equal-p props nick)))) |
| 396 | (set-marker erc-fill--wrap-last-msg (point-min)))) | 450 | (set-marker erc-fill--wrap-last-msg (point-min)))) |
| 397 | 451 | ||
| 398 | (defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args) | 452 | (defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args) |
| @@ -476,8 +530,8 @@ Offer to repeat command in a manner similar to | |||
| 476 | \\`=' Increase indentation by one column | 530 | \\`=' Increase indentation by one column |
| 477 | \\`-' Decrease indentation by one column | 531 | \\`-' Decrease indentation by one column |
| 478 | \\`0' Reset indentation to the default | 532 | \\`0' Reset indentation to the default |
| 479 | \\`+' Shift right margin rightward (shrink) by one column | 533 | \\`+' Shift margin boundary rightward by one column |
| 480 | \\`_' Shift right margin leftward (grow) by one column | 534 | \\`_' Shift margin boundary leftward by one column |
| 481 | \\`)' Reset the right margin to the default | 535 | \\`)' Reset the right margin to the default |
| 482 | 536 | ||
| 483 | Note that misalignment may occur when messages contain | 537 | Note that misalignment may occur when messages contain |
| @@ -489,6 +543,7 @@ decorations applied by third-party modules." | |||
| 489 | (unless (get-buffer-window) | 543 | (unless (get-buffer-window) |
| 490 | (user-error "Command called in an undisplayed buffer")) | 544 | (user-error "Command called in an undisplayed buffer")) |
| 491 | (let* ((total (erc-fill--wrap-nudge arg)) | 545 | (let* ((total (erc-fill--wrap-nudge arg)) |
| 546 | (leftp erc-stamp--margin-left-p) | ||
| 492 | (win-ratio (/ (float (- (window-point) (window-start))) | 547 | (win-ratio (/ (float (- (window-point) (window-start))) |
| 493 | (- (window-end nil t) (window-start))))) | 548 | (- (window-end nil t) (window-start))))) |
| 494 | (when (zerop arg) | 549 | (when (zerop arg) |
| @@ -509,18 +564,20 @@ decorations applied by third-party modules." | |||
| 509 | (dolist (key '(?\) ?_ ?+)) | 564 | (dolist (key '(?\) ?_ ?+)) |
| 510 | (let ((a (pcase key | 565 | (let ((a (pcase key |
| 511 | (?\) 0) | 566 | (?\) 0) |
| 512 | (?_ (- (abs arg))) | 567 | (?_ (if leftp (abs arg) (- (abs arg)))) |
| 513 | (?+ (abs arg))))) | 568 | (?+ (if leftp (- (abs arg)) (abs arg)))))) |
| 514 | (define-key map (vector (list key)) | 569 | (define-key map (vector (list key)) |
| 515 | (lambda () | 570 | (lambda () |
| 516 | (interactive) | 571 | (interactive) |
| 517 | (erc-stamp--adjust-right-margin (- a)) | 572 | (erc-stamp--adjust-margin (- a) (zerop a)) |
| 573 | (when leftp (erc-stamp--refresh-left-margin-prompt)) | ||
| 518 | (recenter (round (* win-ratio (window-height)))))))) | 574 | (recenter (round (* win-ratio (window-height)))))))) |
| 519 | map) | 575 | map) |
| 520 | t | 576 | t |
| 521 | (lambda () | 577 | (lambda () |
| 522 | (message "Fill prefix: %d (%+d col%s)" | 578 | (message "Fill prefix: %d (%+d col%s); Margin: %d" |
| 523 | erc-fill--wrap-value total (if (> (abs total) 1) "s" ""))) | 579 | erc-fill--wrap-value total (if (> (abs total) 1) "s" "") |
| 580 | (if leftp left-margin-width right-margin-width))) | ||
| 524 | "Use %k for further adjustment" | 581 | "Use %k for further adjustment" |
| 525 | 1) | 582 | 1) |
| 526 | (recenter (round (* win-ratio (window-height)))))) | 583 | (recenter (round (* win-ratio (window-height)))))) |
| @@ -536,6 +593,7 @@ decorations applied by third-party modules." | |||
| 536 | "Get length of timestamp if inserted left." | 593 | "Get length of timestamp if inserted left." |
| 537 | (if (and (boundp 'erc-timestamp-format) | 594 | (if (and (boundp 'erc-timestamp-format) |
| 538 | erc-timestamp-format | 595 | erc-timestamp-format |
| 596 | ;; FIXME use a more robust test than symbol equivalence. | ||
| 539 | (eq erc-insert-timestamp-function 'erc-insert-timestamp-left) | 597 | (eq erc-insert-timestamp-function 'erc-insert-timestamp-left) |
| 540 | (not erc-hide-timestamps)) | 598 | (not erc-hide-timestamps)) |
| 541 | (length (format-time-string erc-timestamp-format)) | 599 | (length (format-time-string erc-timestamp-format)) |
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 83ee4a200ed..a021cd26607 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el | |||
| @@ -281,49 +281,60 @@ This option only matters when `erc-insert-timestamp-function' is | |||
| 281 | set to `erc-insert-timestamp-right' or that option's default, | 281 | set to `erc-insert-timestamp-right' or that option's default, |
| 282 | `erc-insert-timestamp-left-and-right'. If the value is a | 282 | `erc-insert-timestamp-left-and-right'. If the value is a |
| 283 | positive integer, alignment occurs that many columns from the | 283 | positive integer, alignment occurs that many columns from the |
| 284 | right edge. If the value is `margin', the stamp appears in the | 284 | right edge. |
| 285 | right margin when visible. | ||
| 286 | 285 | ||
| 287 | Enabling this option produces a side effect in that stamps aren't | 286 | Enabling this option produces a side effect in that stamps aren't |
| 288 | indented in saved logs. When its value is an integer, this | 287 | indented in saved logs. When its value is an integer, this |
| 289 | option adds a space after the end of a message if the stamp | 288 | option adds a space after the end of a message if the stamp |
| 290 | doesn't already start with one. And when its value is t, it adds | 289 | doesn't already start with one. And when its value is t, it adds |
| 291 | a single space, unconditionally. And while this option never | 290 | a single space, unconditionally." |
| 292 | adds a space when its value is `margin', ERC does offer a | 291 | :type '(choice boolean integer) |
| 293 | workaround in `erc-stamp-prefix-log-filter', which strips | ||
| 294 | trailing stamps from messages and puts them before every line." | ||
| 295 | :type '(choice boolean integer (const margin)) | ||
| 296 | :package-version '(ERC . "5.6")) ; FIXME sync on release | 292 | :package-version '(ERC . "5.6")) ; FIXME sync on release |
| 297 | 293 | ||
| 298 | (defcustom erc-stamp-right-margin-width nil | 294 | (defvar-local erc-stamp--margin-width nil |
| 299 | "Width in columns of the right margin. | 295 | "Width in columns of margin for `erc-stamp--display-margin-mode'. |
| 300 | When this option is nil, pretend its value is one column greater | 296 | Only consulted when resetting or initializing margin.") |
| 301 | than the `string-width' of the formatted `erc-timestamp-format'. | 297 | |
| 302 | This option only matters when `erc-timestamp-use-align-to' is set | 298 | (defvar-local erc-stamp--margin-left-p nil |
| 303 | to `margin'." | 299 | "Whether `erc-stamp--display-margin-mode' uses the left margin. |
| 304 | :package-version '(ERC . "5.6") ; FIXME sync on release | 300 | During initialization, the mode respects this variable's existing |
| 305 | :type '(choice (const nil) integer)) | 301 | value if it already has a local binding. Otherwise, modules can |
| 306 | 302 | bind this to any value while enabling the mode. If it's nil, ERC | |
| 307 | (defun erc-stamp--display-margin-force (orig &rest r) | 303 | will check to see if `erc-insert-timestamp-function' is |
| 308 | (let ((erc-timestamp-use-align-to 'margin)) | 304 | `erc-insert-timestamp-left', interpreting the latter as a non-nil |
| 309 | (apply orig r))) | 305 | value. It'll then coerce any non-nil value to t.") |
| 310 | 306 | ||
| 311 | (defun erc-stamp--adjust-right-margin (cols) | 307 | (defun erc-stamp--init-margins-on-connect (&rest _) |
| 312 | "Adjust right margin by COLS. | 308 | (let ((existing (if erc-stamp--margin-left-p |
| 313 | When COLS is zero, reset width to `erc-stamp-right-margin-width' | 309 | left-margin-width |
| 314 | or one col more than the `string-width' of | 310 | right-margin-width))) |
| 315 | `erc-timestamp-format'." | 311 | (erc-stamp--adjust-margin existing 'resetp))) |
| 316 | (let ((width | 312 | |
| 317 | (if (zerop cols) | 313 | (defun erc-stamp--adjust-margin (cols &optional resetp) |
| 318 | (or erc-stamp-right-margin-width | 314 | "Adjust managed margin by increment COLS. |
| 319 | (1+ (string-width (or erc-timestamp-last-inserted-right | 315 | With RESETP, set margin's width to COLS. However, if COLS is |
| 320 | (erc-format-timestamp | 316 | zero, set the width to a non-nil `erc-stamp--margin-width'. |
| 321 | (current-time) | 317 | Otherwise, go with the `string-width' of `erc-timestamp-format'. |
| 322 | erc-timestamp-format))))) | 318 | However, when `erc-stamp--margin-left-p' is non-nil and the |
| 323 | (+ right-margin-width cols)))) | 319 | prompt is wider, use its width instead." |
| 324 | (setq right-margin-width width) | 320 | (let* ((leftp erc-stamp--margin-left-p) |
| 321 | (width | ||
| 322 | (if resetp | ||
| 323 | (or (and (not (zerop cols)) cols) | ||
| 324 | erc-stamp--margin-width | ||
| 325 | (max (if leftp (string-width (erc-prompt)) 0) | ||
| 326 | (1+ (string-width | ||
| 327 | (or (if leftp | ||
| 328 | erc-timestamp-last-inserted | ||
| 329 | erc-timestamp-last-inserted-right) | ||
| 330 | (erc-format-timestamp | ||
| 331 | (current-time) erc-timestamp-format)))))) | ||
| 332 | (+ (if leftp left-margin-width right-margin-width) cols)))) | ||
| 333 | (set (if leftp 'left-margin-width 'right-margin-width) width) | ||
| 325 | (when (eq (current-buffer) (window-buffer)) | 334 | (when (eq (current-buffer) (window-buffer)) |
| 326 | (set-window-margins nil left-margin-width width)))) | 335 | (set-window-margins nil |
| 336 | (if leftp width left-margin-width) | ||
| 337 | (if leftp right-margin-width width))))) | ||
| 327 | 338 | ||
| 328 | ;;;###autoload | 339 | ;;;###autoload |
| 329 | (defun erc-stamp-prefix-log-filter (text) | 340 | (defun erc-stamp-prefix-log-filter (text) |
| @@ -348,39 +359,100 @@ non-nil." | |||
| 348 | (zerop (forward-line)))) | 359 | (zerop (forward-line)))) |
| 349 | "") | 360 | "") |
| 350 | 361 | ||
| 362 | (defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)) | ||
| 363 | |||
| 351 | (declare-function erc--remove-text-properties "erc" (string)) | 364 | (declare-function erc--remove-text-properties "erc" (string)) |
| 352 | 365 | ||
| 353 | ;; If people want to use this directly, we can convert it into | 366 | ;; Currently, `erc-insert-timestamp-right' hard codes its display |
| 354 | ;; a local module. | 367 | ;; property to use `right-margin', and `erc-insert-timestamp-left' |
| 368 | ;; does the same for `left-margin'. However, there's no reason a | ||
| 369 | ;; trailing stamp couldn't be displayed on the left and vice versa. | ||
| 355 | (define-minor-mode erc-stamp--display-margin-mode | 370 | (define-minor-mode erc-stamp--display-margin-mode |
| 356 | "Internal minor mode for built-in modules integrating with `stamp'. | 371 | "Internal minor mode for built-in modules integrating with `stamp'. |
| 357 | It binds `erc-timestamp-use-align-to' to `margin' around calls to | 372 | Arranges for displaying stamps in a single margin, with the |
| 358 | `erc-insert-timestamp-function' in the current buffer, and sets | 373 | variable `erc-stamp--margin-left-p' controlling which one. |
| 359 | the right window margin to `erc-stamp-right-margin-width'. It | 374 | Provides `erc-stamp--margin-width' and `erc-stamp--adjust-margin' |
| 360 | also arranges to remove most text properties when a user kills | 375 | to help manage the chosen margin's width. Also removes `display' |
| 361 | message text so that stamps will be visible when yanked." | 376 | properties in killed text to reveal stamps. The invoking module |
| 377 | should set controlling variables, like `erc-stamp--margin-width' | ||
| 378 | and `erc-stamp--margin-left-p', before activating the mode." | ||
| 362 | :interactive nil | 379 | :interactive nil |
| 363 | (if erc-stamp--display-margin-mode | 380 | (if erc-stamp--display-margin-mode |
| 364 | (progn | 381 | (progn |
| 365 | (setq fringes-outside-margins t) | 382 | (setq fringes-outside-margins t) |
| 366 | (when (eq (current-buffer) (window-buffer)) | 383 | (when (eq (current-buffer) (window-buffer)) |
| 367 | (set-window-buffer (selected-window) (current-buffer))) | 384 | (set-window-buffer (selected-window) (current-buffer))) |
| 368 | (erc-stamp--adjust-right-margin 0) | 385 | (setq erc-stamp--margin-left-p (and erc-stamp--margin-left-p t)) |
| 386 | (if (or erc-server-connected (not (functionp erc-prompt))) | ||
| 387 | (erc-stamp--init-margins-on-connect) | ||
| 388 | (add-hook 'erc-after-connect | ||
| 389 | #'erc-stamp--init-margins-on-connect nil t)) | ||
| 369 | (add-function :filter-return (local 'filter-buffer-substring-function) | 390 | (add-function :filter-return (local 'filter-buffer-substring-function) |
| 370 | #'erc--remove-text-properties) | 391 | #'erc--remove-text-properties) |
| 371 | (add-function :around (local 'erc-insert-timestamp-function) | 392 | (add-hook 'erc--setup-buffer-hook |
| 372 | #'erc-stamp--display-margin-force)) | 393 | #'erc-stamp--refresh-left-margin-prompt nil t) |
| 394 | (when erc-stamp--margin-left-p | ||
| 395 | (add-hook 'erc--refresh-prompt-hook | ||
| 396 | #'erc-stamp--display-prompt-in-left-margin nil t))) | ||
| 373 | (remove-function (local 'filter-buffer-substring-function) | 397 | (remove-function (local 'filter-buffer-substring-function) |
| 374 | #'erc--remove-text-properties) | 398 | #'erc--remove-text-properties) |
| 375 | (remove-function (local 'erc-insert-timestamp-function) | 399 | (remove-hook 'erc-after-connect |
| 376 | #'erc-stamp--display-margin-force) | 400 | #'erc-stamp--init-margins-on-connect t) |
| 377 | (kill-local-variable 'right-margin-width) | 401 | (remove-hook 'erc--refresh-prompt-hook |
| 402 | #'erc-stamp--display-prompt-in-left-margin t) | ||
| 403 | (remove-hook 'erc--setup-buffer-hook | ||
| 404 | #'erc-stamp--refresh-left-margin-prompt t) | ||
| 405 | (kill-local-variable (if erc-stamp--margin-left-p | ||
| 406 | 'left-margin-width | ||
| 407 | 'right-margin-width)) | ||
| 378 | (kill-local-variable 'fringes-outside-margins) | 408 | (kill-local-variable 'fringes-outside-margins) |
| 409 | (kill-local-variable 'erc-stamp--margin-left-p) | ||
| 410 | (kill-local-variable 'erc-stamp--margin-width) | ||
| 379 | (when (eq (current-buffer) (window-buffer)) | 411 | (when (eq (current-buffer) (window-buffer)) |
| 380 | (set-window-margins nil left-margin-width nil) | 412 | (set-window-margins nil left-margin-width nil) |
| 381 | (set-window-buffer (selected-window) (current-buffer))))) | 413 | (set-window-buffer (selected-window) (current-buffer))))) |
| 382 | 414 | ||
| 383 | (defun erc-insert-timestamp-left (string) | 415 | (defvar-local erc-stamp--last-prompt nil) |
| 416 | |||
| 417 | (defun erc-stamp--display-prompt-in-left-margin () | ||
| 418 | "Show prompt in the left margin with padding." | ||
| 419 | (when (or (not erc-stamp--last-prompt) (functionp erc-prompt) | ||
| 420 | (> (string-width erc-stamp--last-prompt) left-margin-width)) | ||
| 421 | (let ((s (buffer-substring erc-insert-marker (1- erc-input-marker)))) | ||
| 422 | ;; Prevent #("abc" n m (display ((...) #("abc" p q (display...)))) | ||
| 423 | (remove-text-properties 0 (length s) '(display nil) s) | ||
| 424 | (when (and erc-stamp--last-prompt | ||
| 425 | (>= (string-width erc-stamp--last-prompt) left-margin-width)) | ||
| 426 | (let ((sm (truncate-string-to-width s (1- left-margin-width) 0 nil t))) | ||
| 427 | ;; This papers over a subtle off-by-1 bug here. | ||
| 428 | (unless (equal sm s) | ||
| 429 | (setq s (concat sm (substring s -1)))))) | ||
| 430 | (setq erc-stamp--last-prompt (string-pad s left-margin-width nil t)))) | ||
| 431 | (put-text-property erc-insert-marker (1- erc-input-marker) | ||
| 432 | 'display `((margin left-margin) ,erc-stamp--last-prompt)) | ||
| 433 | erc-stamp--last-prompt) | ||
| 434 | |||
| 435 | (defun erc-stamp--refresh-left-margin-prompt () | ||
| 436 | "Forcefully-recompute display property of prompt in left margin." | ||
| 437 | (with-silent-modifications | ||
| 438 | (unless (functionp erc-prompt) | ||
| 439 | (setq erc-stamp--last-prompt nil)) | ||
| 440 | (erc--refresh-prompt))) | ||
| 441 | |||
| 442 | (cl-defmethod erc--reveal-prompt | ||
| 443 | (&context (erc-stamp--display-margin-mode (eql t)) | ||
| 444 | (erc-stamp--margin-left-p (eql t))) | ||
| 445 | (put-text-property erc-insert-marker (1- erc-input-marker) | ||
| 446 | 'display `((margin left-margin) ,erc-stamp--last-prompt))) | ||
| 447 | |||
| 448 | (cl-defmethod erc--conceal-prompt | ||
| 449 | (&context (erc-stamp--display-margin-mode (eql t)) | ||
| 450 | (erc-stamp--margin-left-p (eql t))) | ||
| 451 | (let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start))) | ||
| 452 | (put-text-property erc-insert-marker (1- erc-input-marker) | ||
| 453 | 'display `((margin left-margin) ,prompt)))) | ||
| 454 | |||
| 455 | (cl-defmethod erc-insert-timestamp-left (string) | ||
| 384 | "Insert timestamps at the beginning of the line." | 456 | "Insert timestamps at the beginning of the line." |
| 385 | (goto-char (point-min)) | 457 | (goto-char (point-min)) |
| 386 | (let* ((ignore-p (and erc-timestamp-only-if-changed-flag | 458 | (let* ((ignore-p (and erc-timestamp-only-if-changed-flag |
| @@ -392,6 +464,22 @@ message text so that stamps will be visible when yanked." | |||
| 392 | (erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s) | 464 | (erc-put-text-property 0 len 'invisible erc-stamp--invisible-property s) |
| 393 | (insert s))) | 465 | (insert s))) |
| 394 | 466 | ||
| 467 | (cl-defmethod erc-insert-timestamp-left | ||
| 468 | (string &context (erc-stamp--display-margin-mode (eql t))) | ||
| 469 | (unless (and erc-timestamp-only-if-changed-flag | ||
| 470 | (string-equal string erc-timestamp-last-inserted)) | ||
| 471 | (goto-char (point-min)) | ||
| 472 | (insert-before-markers-and-inherit | ||
| 473 | (setq erc-timestamp-last-inserted string)) | ||
| 474 | (dolist (p erc-stamp--inherited-props) | ||
| 475 | (when-let ((v (get-text-property (point) p))) | ||
| 476 | (put-text-property (point-min) (point) p v))) | ||
| 477 | (erc-put-text-property (point-min) (point) 'invisible | ||
| 478 | erc-stamp--invisible-property) | ||
| 479 | (put-text-property (point-min) (point) 'field 'erc-timestamp) | ||
| 480 | (put-text-property (point-min) (point) | ||
| 481 | 'display `((margin left-margin) ,string)))) | ||
| 482 | |||
| 395 | (defun erc-insert-aligned (string pos) | 483 | (defun erc-insert-aligned (string pos) |
| 396 | "Insert STRING at the POSth column. | 484 | "Insert STRING at the POSth column. |
| 397 | 485 | ||
| @@ -408,7 +496,11 @@ property to get to the POSth column." | |||
| 408 | ;; Silence byte-compiler | 496 | ;; Silence byte-compiler |
| 409 | (defvar erc-fill-column) | 497 | (defvar erc-fill-column) |
| 410 | 498 | ||
| 411 | (defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)) | 499 | (defvar erc-stamp--omit-properties-on-folded-lines nil |
| 500 | "Skip properties before right stamps occupying their own line. | ||
| 501 | This escape hatch restores pre-5.6 behavior that left leading | ||
| 502 | white space alone (unpropertized) for right-sided stamps folded | ||
| 503 | onto their own line.") | ||
| 412 | 504 | ||
| 413 | (defun erc-insert-timestamp-right (string) | 505 | (defun erc-insert-timestamp-right (string) |
| 414 | "Insert timestamp on the right side of the screen. | 506 | "Insert timestamp on the right side of the screen. |
| @@ -465,6 +557,9 @@ printed just after each line's text (no alignment)." | |||
| 465 | ;; For compatibility reasons, the `erc-timestamp' field includes | 557 | ;; For compatibility reasons, the `erc-timestamp' field includes |
| 466 | ;; intervening white space unless a hard break is warranted. | 558 | ;; intervening white space unless a hard break is warranted. |
| 467 | (pcase erc-timestamp-use-align-to | 559 | (pcase erc-timestamp-use-align-to |
| 560 | ((guard erc-stamp--display-margin-mode) | ||
| 561 | (put-text-property 0 (length string) | ||
| 562 | 'display `((margin right-margin) ,string) string)) | ||
| 468 | ((and 't (guard (< col pos))) | 563 | ((and 't (guard (< col pos))) |
| 469 | (insert " ") | 564 | (insert " ") |
| 470 | (put-text-property from (point) 'display `(space :align-to ,pos))) | 565 | (put-text-property from (point) 'display `(space :align-to ,pos))) |
| @@ -475,11 +570,8 @@ printed just after each line's text (no alignment)." | |||
| 475 | (let ((s (+ erc-timestamp-use-align-to (string-width string)))) | 570 | (let ((s (+ erc-timestamp-use-align-to (string-width string)))) |
| 476 | (put-text-property from (point) 'display | 571 | (put-text-property from (point) 'display |
| 477 | `(space :align-to (- right ,s))))) | 572 | `(space :align-to (- right ,s))))) |
| 478 | ('margin | 573 | ((guard (>= col pos)) (newline) (indent-to pos) |
| 479 | (put-text-property 0 (length string) | 574 | (when erc-stamp--omit-properties-on-folded-lines (setq from (point)))) |
| 480 | 'display `((margin right-margin) ,string) | ||
| 481 | string)) | ||
| 482 | ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point))) | ||
| 483 | (_ (indent-to pos))) | 575 | (_ (indent-to pos))) |
| 484 | (insert string) | 576 | (insert string) |
| 485 | (dolist (p erc-stamp--inherited-props) | 577 | (dolist (p erc-stamp--inherited-props) |
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index eca6a90d706..d519bf221b9 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -2879,19 +2879,23 @@ this option to nil." | |||
| 2879 | (cl-assert (< erc-insert-marker erc-input-marker)) | 2879 | (cl-assert (< erc-insert-marker erc-input-marker)) |
| 2880 | (cl-assert (= (field-end erc-insert-marker) erc-input-marker))))) | 2880 | (cl-assert (= (field-end erc-insert-marker) erc-input-marker))))) |
| 2881 | 2881 | ||
| 2882 | (defvar erc--refresh-prompt-hook nil) | ||
| 2883 | |||
| 2882 | (defun erc--refresh-prompt () | 2884 | (defun erc--refresh-prompt () |
| 2883 | "Re-render ERC's prompt when the option `erc-prompt' is a function." | 2885 | "Re-render ERC's prompt when the option `erc-prompt' is a function." |
| 2884 | (erc--assert-input-bounds) | 2886 | (erc--assert-input-bounds) |
| 2885 | (when (functionp erc-prompt) | 2887 | (unless (erc--prompt-hidden-p) |
| 2886 | (save-excursion | 2888 | (when (functionp erc-prompt) |
| 2887 | (goto-char erc-insert-marker) | 2889 | (save-excursion |
| 2888 | (set-marker-insertion-type erc-insert-marker nil) | 2890 | (goto-char erc-insert-marker) |
| 2889 | ;; Avoid `erc-prompt' (the named function), which appends a | 2891 | (set-marker-insertion-type erc-insert-marker nil) |
| 2890 | ;; space, and `erc-display-prompt', which propertizes all but | 2892 | ;; Avoid `erc-prompt' (the named function), which appends a |
| 2891 | ;; that space. | 2893 | ;; space, and `erc-display-prompt', which propertizes all but |
| 2892 | (insert-and-inherit (funcall erc-prompt)) | 2894 | ;; that space. |
| 2893 | (set-marker-insertion-type erc-insert-marker t) | 2895 | (insert-and-inherit (funcall erc-prompt)) |
| 2894 | (delete-region (point) (1- erc-input-marker))))) | 2896 | (set-marker-insertion-type erc-insert-marker t) |
| 2897 | (delete-region (point) (1- erc-input-marker)))) | ||
| 2898 | (run-hooks 'erc--refresh-prompt-hook))) | ||
| 2895 | 2899 | ||
| 2896 | (defun erc-display-line-1 (string buffer) | 2900 | (defun erc-display-line-1 (string buffer) |
| 2897 | "Display STRING in `erc-mode' BUFFER. | 2901 | "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, | |||
| 4804 | ;; shall remain part of the prompt. | 4808 | ;; shall remain part of the prompt. |
| 4805 | (setq prompt (propertize prompt | 4809 | (setq prompt (propertize prompt |
| 4806 | 'rear-nonsticky t | 4810 | 'rear-nonsticky t |
| 4807 | 'erc-prompt t | 4811 | 'erc-prompt t ; t or `hidden' |
| 4808 | 'field 'erc-prompt | 4812 | 'field 'erc-prompt |
| 4809 | 'front-sticky t | 4813 | 'front-sticky t |
| 4810 | 'read-only t)) | 4814 | 'read-only t)) |
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 99ec4a9635e..67622da9f3d 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el | |||
| @@ -340,4 +340,41 @@ | |||
| 340 | (should (search-backward "ERC> " nil t)) | 340 | (should (search-backward "ERC> " nil t)) |
| 341 | (execute-kbd-macro "\C-a"))))) | 341 | (execute-kbd-macro "\C-a"))))) |
| 342 | 342 | ||
| 343 | (ert-deftest erc-fill--left-hand-stamps () | ||
| 344 | :tags '(:unstable) | ||
| 345 | (unless (>= emacs-major-version 29) | ||
| 346 | (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'")) | ||
| 347 | |||
| 348 | (let ((erc-timestamp-only-if-changed-flag nil) | ||
| 349 | (erc-insert-timestamp-function #'erc-insert-timestamp-left)) | ||
| 350 | (erc-fill-tests--wrap-populate | ||
| 351 | (lambda () | ||
| 352 | (should (= 8 left-margin-width)) | ||
| 353 | (pcase-let ((`((margin left-margin) ,displayed) | ||
| 354 | (get-text-property erc-insert-marker 'display))) | ||
| 355 | (should (equal-including-properties | ||
| 356 | displayed #(" ERC>" 4 8 | ||
| 357 | ( read-only t | ||
| 358 | front-sticky t | ||
| 359 | field erc-prompt | ||
| 360 | erc-prompt t | ||
| 361 | rear-nonsticky t | ||
| 362 | font-lock-face erc-prompt-face))))) | ||
| 363 | (erc-fill-tests--compare "stamps-left-01") | ||
| 364 | |||
| 365 | (ert-info ("Shrink left margin by 1 col") | ||
| 366 | (erc-stamp--adjust-margin -1) | ||
| 367 | (with-silent-modifications (erc--refresh-prompt)) | ||
| 368 | (should (= 7 left-margin-width)) | ||
| 369 | (pcase-let ((`((margin left-margin) ,displayed) | ||
| 370 | (get-text-property erc-insert-marker 'display))) | ||
| 371 | (should (equal-including-properties | ||
| 372 | displayed #(" ERC>" 3 7 | ||
| 373 | ( read-only t | ||
| 374 | front-sticky t | ||
| 375 | field erc-prompt | ||
| 376 | erc-prompt t | ||
| 377 | rear-nonsticky t | ||
| 378 | font-lock-face erc-prompt-face)))))))))) | ||
| 379 | |||
| 343 | ;;; erc-fill-tests.el ends here | 380 | ;;; erc-fill-tests.el ends here |
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index 6da7ed4503d..c448416cd69 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el | |||
| @@ -56,7 +56,7 @@ | |||
| 56 | (advice-remove 'erc-format-timestamp | 56 | (advice-remove 'erc-format-timestamp |
| 57 | 'ert-deftest--erc-timestamp-use-align-to))) | 57 | 'ert-deftest--erc-timestamp-use-align-to))) |
| 58 | 58 | ||
| 59 | (ert-deftest erc-timestamp-use-align-to--nil () | 59 | (defun erc-stamp-tests--use-align-to--nil (compat) |
| 60 | (erc-stamp-tests--insert-right | 60 | (erc-stamp-tests--insert-right |
| 61 | (lambda () | 61 | (lambda () |
| 62 | 62 | ||
| @@ -83,12 +83,20 @@ | |||
| 83 | (erc-display-message nil 'notice (current-buffer) | 83 | (erc-display-message nil 'notice (current-buffer) |
| 84 | "twenty characters")) | 84 | "twenty characters")) |
| 85 | (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t)) | 85 | (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t)) |
| 86 | ;; Field excludes leading whitespace (arguably undesirable). | 86 | ;; Field includes leading whitespace. |
| 87 | (should (eql ?\[ (char-after (field-beginning (point))))) | 87 | (should (eql (if compat ?\[ ?\n) |
| 88 | (char-after (field-beginning (point))))) | ||
| 88 | ;; Timestamp extends to the end of the line. | 89 | ;; Timestamp extends to the end of the line. |
| 89 | (should (eql ?\n (char-after (field-end (point))))))))) | 90 | (should (eql ?\n (char-after (field-end (point))))))))) |
| 90 | 91 | ||
| 91 | (ert-deftest erc-timestamp-use-align-to--t () | 92 | (ert-deftest erc-timestamp-use-align-to--nil () |
| 93 | (ert-info ("Field starts on stamp text (compat)") | ||
| 94 | (let ((erc-stamp--omit-properties-on-folded-lines t)) | ||
| 95 | (erc-stamp-tests--use-align-to--nil 'compat))) | ||
| 96 | (ert-info ("Field includes leaidng white space") | ||
| 97 | (erc-stamp-tests--use-align-to--nil nil))) | ||
| 98 | |||
| 99 | (defun erc-stamp-tests--use-align-to--t (compat) | ||
| 92 | (erc-stamp-tests--insert-right | 100 | (erc-stamp-tests--insert-right |
| 93 | (lambda () | 101 | (lambda () |
| 94 | 102 | ||
| @@ -110,10 +118,17 @@ | |||
| 110 | (erc-display-message nil nil (current-buffer) msg))) | 118 | (erc-display-message nil nil (current-buffer) msg))) |
| 111 | ;; Indented to pos (this is arguably a bug). | 119 | ;; Indented to pos (this is arguably a bug). |
| 112 | (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t)) | 120 | (should (search-forward-regexp (rx bol (+ "\t") (* " ") "[") nil t)) |
| 113 | ;; Field starts *after* leading space (arguably bad). | 121 | ;; Field includes leading space. |
| 114 | (should (eql ?\[ (char-after (field-beginning (point))))) | 122 | (should (eql (if compat ?\[ ?\n) (char-after (field-beginning (point))))) |
| 115 | (should (eql ?\n (char-after (field-end (point))))))))) | 123 | (should (eql ?\n (char-after (field-end (point))))))))) |
| 116 | 124 | ||
| 125 | (ert-deftest erc-timestamp-use-align-to--t () | ||
| 126 | (ert-info ("Field starts on stamp text (compat)") | ||
| 127 | (let ((erc-stamp--omit-properties-on-folded-lines t)) | ||
| 128 | (erc-stamp-tests--use-align-to--t 'compat))) | ||
| 129 | (ert-info ("Field includes leaidng white space") | ||
| 130 | (erc-stamp-tests--use-align-to--t nil))) | ||
| 131 | |||
| 117 | (ert-deftest erc-timestamp-use-align-to--integer () | 132 | (ert-deftest erc-timestamp-use-align-to--integer () |
| 118 | (erc-stamp-tests--insert-right | 133 | (erc-stamp-tests--insert-right |
| 119 | (lambda () | 134 | (lambda () |
| @@ -140,7 +155,7 @@ | |||
| 140 | (should (eql ?\s (char-after (field-beginning (point))))) | 155 | (should (eql ?\s (char-after (field-beginning (point))))) |
| 141 | (should (eql ?\n (char-after (field-end (point))))))))) | 156 | (should (eql ?\n (char-after (field-end (point))))))))) |
| 142 | 157 | ||
| 143 | (ert-deftest erc-timestamp-use-align-to--margin () | 158 | (ert-deftest erc-stamp--display-margin-mode--right () |
| 144 | (erc-stamp-tests--insert-right | 159 | (erc-stamp-tests--insert-right |
| 145 | (lambda () | 160 | (lambda () |
| 146 | (erc-stamp--display-margin-mode +1) | 161 | (erc-stamp--display-margin-mode +1) |
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b5db5fe8764..fff3c4cb704 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el | |||
| @@ -219,6 +219,7 @@ | |||
| 219 | (setq erc-hide-prompt '(server)) | 219 | (setq erc-hide-prompt '(server)) |
| 220 | (with-current-buffer "ServNet" | 220 | (with-current-buffer "ServNet" |
| 221 | (erc--hide-prompt erc-server-process) | 221 | (erc--hide-prompt erc-server-process) |
| 222 | (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) | ||
| 222 | (should (string= ">" (get-text-property erc-insert-marker 'display)))) | 223 | (should (string= ">" (get-text-property erc-insert-marker 'display)))) |
| 223 | 224 | ||
| 224 | (with-current-buffer "#chan" | 225 | (with-current-buffer "#chan" |
| @@ -229,6 +230,7 @@ | |||
| 229 | 230 | ||
| 230 | (with-current-buffer "ServNet" | 231 | (with-current-buffer "ServNet" |
| 231 | (erc--unhide-prompt) | 232 | (erc--unhide-prompt) |
| 233 | (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) | ||
| 232 | (should-not (get-text-property erc-insert-marker 'display)))) | 234 | (should-not (get-text-property erc-insert-marker 'display)))) |
| 233 | 235 | ||
| 234 | (ert-info ("Value: channel") | 236 | (ert-info ("Value: channel") |
| @@ -242,7 +244,9 @@ | |||
| 242 | 244 | ||
| 243 | (with-current-buffer "#chan" | 245 | (with-current-buffer "#chan" |
| 244 | (should (string= ">" (get-text-property erc-insert-marker 'display))) | 246 | (should (string= ">" (get-text-property erc-insert-marker 'display))) |
| 247 | (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) | ||
| 245 | (erc--unhide-prompt) | 248 | (erc--unhide-prompt) |
| 249 | (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) | ||
| 246 | (should-not (get-text-property erc-insert-marker 'display)))) | 250 | (should-not (get-text-property erc-insert-marker 'display)))) |
| 247 | 251 | ||
| 248 | (ert-info ("Value: query") | 252 | (ert-info ("Value: query") |
| @@ -253,7 +257,9 @@ | |||
| 253 | 257 | ||
| 254 | (with-current-buffer "bob" | 258 | (with-current-buffer "bob" |
| 255 | (should (string= ">" (get-text-property erc-insert-marker 'display))) | 259 | (should (string= ">" (get-text-property erc-insert-marker 'display))) |
| 260 | (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) | ||
| 256 | (erc--unhide-prompt) | 261 | (erc--unhide-prompt) |
| 262 | (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) | ||
| 257 | (should-not (get-text-property erc-insert-marker 'display))) | 263 | (should-not (get-text-property erc-insert-marker 'display))) |
| 258 | 264 | ||
| 259 | (with-current-buffer "#chan" | 265 | (with-current-buffer "#chan" |
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld new file mode 100644 index 00000000000..f62b65cd170 --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld | |||
| @@ -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)) \ No newline at end of file | |||