Re: bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode
"J.P." <[email protected]>
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
v2 (left-margin enhancement). Merge subsequent messages from a status-prefixed speaker. Fix prompt not appearing in left margin on /QUERY. Fix `visual-line-mode' not being restored after toggling off `truncate-lines'. Have `erc-fill-wrap-nudge' print margin width.
0000-v1-v2.diff
(text/x-patch, 8 KB)
From a6ad80553d5ef1d332de3a1e4bbdf85eaf36b1fc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 19 Jul 2023 06:00:55 -0700 Subject: [PATCH 0/1] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (1): [5.6] Make erc-fill-wrap work with left-hand stamps etc/ERC-NEWS | 7 +- lisp/erc/erc-backend.el | 23 +- lisp/erc/erc-compat.el | 1 + lisp/erc/erc-fill.el | 111 +++++++--- lisp/erc/erc-stamp.el | 203 +++++++++++++----- lisp/erc/erc.el | 26 ++- test/lisp/erc/erc-fill-tests.el | 37 ++++ test/lisp/erc/erc-stamp-tests.el | 2 +- test/lisp/erc/erc-tests.el | 6 + .../fill/snapshots/stamps-left-01.eld | 1 + 10 files changed, 313 insertions(+), 104 deletions(-) create mode 100644 test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld Interdiff: diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 9f39f41133d..6c2228f6337 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -129,8 +129,8 @@ erc-fill-wrap-margin-width (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 -`erc-insert-timestamp-function', which obviously cannot work for +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))) @@ -297,12 +297,29 @@ erc-fill-wrap-cycle-visual-movement ('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) @@ -361,9 +378,9 @@ fill-wrap left-margin-width 0 right-margin-width 0) ;; Only give this a local binding if known for sure. - (pcase erc-fill-wrap-margin-side - ('right (setq erc-stamp--margin-left-p nil)) - ('left (setq erc-stamp--margin-left-p t))) + (when erc-fill-wrap-margin-side + (setq erc-stamp--margin-left-p + (pcase erc-fill-wrap-margin-side ('right nil) ('left t)))) (setq erc-fill--function #'erc-fill-wrap) (add-function :after (local 'erc-stamp--insert-date-function) #'erc-fill--wrap-stamp-insert-prefixed-date) @@ -412,18 +429,21 @@ erc-fill--wrap-continued-message-p (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) @@ -520,6 +540,7 @@ erc-fill-wrap-nudge (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) @@ -538,11 +559,10 @@ erc-fill-wrap-nudge (cl-incf total (erc-fill--wrap-nudge a)) (recenter (round (* win-ratio (window-height)))))))) (dolist (key '(?\) ?_ ?+)) - (let* ((leftp erc-stamp--margin-left-p) - (a (pcase key - (?\) 0) - (?_ (if leftp (abs arg) (- (abs arg)))) - (?+ (if leftp (- (abs arg)) (abs arg)))))) + (let ((a (pcase key + (?\) 0) + (?_ (if leftp (abs arg) (- (abs arg)))) + (?+ (if leftp (- (abs arg)) (abs arg)))))) (define-key map (vector (list key)) (lambda () (interactive) @@ -552,8 +572,9 @@ erc-fill-wrap-nudge 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)))))) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 727d334f13b..eff99766d81 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -397,6 +397,8 @@ erc-stamp--display-margin-mode #'erc-stamp--init-margins-on-connect nil t)) (add-function :filter-return (local 'filter-buffer-substring-function) #'erc--remove-text-properties) + (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))) @@ -405,6 +407,8 @@ erc-stamp--display-margin-mode (add-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)) -- 2.41.0
0001-5.6-Make-erc-fill-wrap-work-with-left-hand-stamps.patch
(text/x-patch, 39.8 KB)
From a6ad80553d5ef1d332de3a1e4bbdf85eaf36b1fc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Fri, 14 Jul 2023 06:12:30 -0700 Subject: [PATCH 1/1] [5.6] Make erc-fill-wrap work with left-hand stamps * etc/ERC-NEWS: Remove all mention of option `erc-timestamp-align-to' supporting a value of `margin', which has been removed. * 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): Add FIXME comment for likely insufficient test of function equality. * 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, erc-fill-wrap-enable): Update doc string, persist a few local vars, and conditionally set `erc-stamp--margin-left-p'. (erc-fill-wrap-nudge): Update doc string and account for left-hand 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 var. (erc-stamp--margin-left-p, erc-stamp--init-margins-on-connect): New functions for other modules that use `erc-stamp--display-margin-mode'. (erc-stamp--adjust-right-margin, erc-stamp--adjust-margin): Rename function to latter and accommodate left-hand stamps. (erc-stamp--inherited-props): Relocate from lower down in 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 defmethod and provide implementation for `erc-stamp--display-margin-mode'. (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. * lisp/erc/erc.el (erc--refresh-prompt-hook): New variable. (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-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) --- etc/ERC-NEWS | 7 +- lisp/erc/erc-backend.el | 23 +- lisp/erc/erc-compat.el | 1 + lisp/erc/erc-fill.el | 111 +++++++--- lisp/erc/erc-stamp.el | 203 +++++++++++++----- lisp/erc/erc.el | 26 ++- test/lisp/erc/erc-fill-tests.el | 37 ++++ test/lisp/erc/erc-stamp-tests.el | 2 +- test/lisp/erc/erc-tests.el | 6 + .../fill/snapshots/stamps-left-01.eld | 1 + 10 files changed, 313 insertions(+), 104 deletions(-) create mode 100644 test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index cd0b8e5f823..379d5eb2ad0 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -102,11 +102,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. 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 @@ erc-process-sentinel-1 ;; 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 @@ erc--unhide-prompt-on-self-insert (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 @@ erc--hide-prompt (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) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index f451aaee754..912a4bc576c 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -418,6 +418,7 @@ erc-compat--29-browse-url-irc (require 'url-irc) (let* ((url (url-generic-parse-url string)) (url-irc-function + ;; FIXME this should probably use `symbol-function'. (if (function-equal url-irc-function 'url-irc-erc) (lambda (host port chan user pass) (erc-handle-irc-url host port chan user pass (url-type url))) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index a65c95f1d85..6c2228f6337 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -116,6 +116,25 @@ erc-fill-column "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 @@ erc-fill--wrap-beginning-of-line (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 @@ erc-fill-wrap-cycle-visual-movement ('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,21 +355,33 @@ fill-wrap "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' 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' (recommended). You can also manually invoke one +of the minor-mode toggles if really necessary. + +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 nuisance, 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 0 + right-margin-width 0) + ;; Only give this a local binding if known for sure. + (when erc-fill-wrap-margin-side + (setq erc-stamp--margin-left-p + (pcase erc-fill-wrap-margin-side ('right nil) ('left t)))) (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)) @@ -381,18 +429,21 @@ erc-fill--wrap-continued-message-p (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 +527,8 @@ erc-fill-wrap-nudge \\`=' 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 +540,7 @@ erc-fill-wrap-nudge (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 +561,20 @@ erc-fill-wrap-nudge (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 +590,7 @@ erc-timestamp-offset "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)) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 83ee4a200ed..eff99766d81 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -281,49 +281,67 @@ erc-timestamp-use-align-to 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)) - -(defun erc-stamp--display-margin-force (orig &rest r) - (let ((erc-timestamp-use-align-to 'margin)) - (apply orig r))) - -(defun erc-stamp--adjust-right-margin (cols) - "Adjust right margin by COLS. -When COLS is zero, reset width to `erc-stamp-right-margin-width' -or one col more than the `string-width' of -`erc-timestamp-format'." - (let ((width - (if (zerop cols) - (or erc-stamp-right-margin-width - (1+ (string-width (or erc-timestamp-last-inserted-right - (erc-format-timestamp - (current-time) - erc-timestamp-format))))) - (+ right-margin-width cols)))) - (setq right-margin-width width) +(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.") + +(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--margin-left-p (&optional value) + (and (or value + (function-equal (symbol-function (default-value + 'erc-insert-timestamp-function)) + (symbol-function 'erc-insert-timestamp-left))) + t)) + +(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 +366,101 @@ erc-stamp-prefix-log-filter (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. +;; If people want to use this directly, we can convert it into a local +;; module. Also, `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. +;; Note: this adds advice that breaks `erc-timestamp-offset' because +;; the thinking is there's no use case in which that function would be +;; called while this mode is active. See note below for more. (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." +Manages chosen window margin and arranges to remove `display' +text properties in killed text to reveal stamps." :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) + (unless (local-variable-p 'erc-stamp--margin-left-p) + (setq erc-stamp--margin-left-p + (erc-stamp--margin-left-p erc-stamp--margin-left-p))) + (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) + (add-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-prompt-width) + (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 +472,22 @@ erc-insert-timestamp-left (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,8 +504,6 @@ erc-insert-aligned ;; Silence byte-compiler (defvar erc-fill-column) -(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)) - (defun erc-insert-timestamp-right (string) "Insert timestamp on the right side of the screen. STRING is the timestamp to insert. This function is a possible @@ -465,6 +559,9 @@ erc-insert-timestamp-right ;; 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,10 +572,6 @@ erc-insert-timestamp-right (let ((s (+ erc-timestamp-use-align-to (string-width string)))) (put-text-property from (point) 'display `(space :align-to (- right ,s))))) - ('margin - (put-text-property 0 (length string) - 'display `((margin right-margin) ,string) - string)) ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point))) (_ (indent-to pos))) (insert string) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 03c21059a92..c90f20cc9a4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2879,19 +2879,23 @@ erc--assert-input-bounds (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 @@ erc-display-prompt ;; 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)) 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 @@ erc-fill-wrap-visual-keys--prompt (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 diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index 6da7ed4503d..f6de087a09a 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -140,7 +140,7 @@ erc-timestamp-use-align-to--integer (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) 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 @@ erc-hide-prompt (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 @@ erc-hide-prompt (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 @@ erc-hide-prompt (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 @@ erc-hide-prompt (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" 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 -- 2.41.0