From a3e7f1555a29b147688112b01e20057d595a8eac Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 31 Jan 2023 06:48:02 -0800 Subject: [PATCH 0/8] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (8): [5.6] Refactor marker initialization in erc-open [5.6] Adjust some old text properties in ERC buffers [5.6] Expose insertion time as text prop in erc-stamp [5.6] Make some erc-stamp functions more limber [5.6] Put display properties to better use in erc-stamp [5.6] Convert erc-fill minor mode into a proper module [5.6] Add variant for erc-match invisibility spec [5.6] Add erc-fill style based on visual-line-mode lisp/erc/erc-common.el | 1 + lisp/erc/erc-compat.el | 56 +++ lisp/erc/erc-fill.el | 322 ++++++++++++++++-- lisp/erc/erc-match.el | 31 +- lisp/erc/erc-stamp.el | 174 ++++++++-- lisp/erc/erc.el | 136 +++++--- test/lisp/erc/erc-fill-tests.el | 198 +++++++++++ .../erc-scenarios-base-local-module-modes.el | 211 ++++++++++++ .../erc/erc-scenarios-base-local-modules.el | 99 ------ test/lisp/erc/erc-stamp-tests.el | 265 ++++++++++++++ test/lisp/erc/erc-tests.el | 79 ++++- 11 files changed, 1359 insertions(+), 213 deletions(-) create mode 100644 test/lisp/erc/erc-fill-tests.el create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el create mode 100644 test/lisp/erc/erc-stamp-tests.el Interdiff: diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 5601ede27a5..a4367fe4ba5 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -409,6 +409,62 @@ erc-compat--29-browse-url-irc (cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc) existing)))))) +(defvar erc-compat--29-set-transient-map-timer nil) + +(defun erc-compat--29-set-transient-map + (map &optional keep-pred on-exit message timeout) + (let* ((message + (when message + (let (keys) + (map-keymap (lambda (key cmd) (and cmd (push key keys))) map) + (format-spec + (if (stringp message) message "Repeat with %k") + `((?k . ,(mapconcat + (lambda (key) + (substitute-command-keys + (format "\\`%s'" (key-description (vector key))))) + keys ", "))))))) + (clearfun (make-symbol "clear-transient-map")) + (exitfun (lambda () + (internal-pop-keymap map 'overriding-terminal-local-map) + (remove-hook 'pre-command-hook clearfun) + (when message (message "")) + (when erc-compat--29-set-transient-map-timer + (cancel-timer erc-compat--29-set-transient-map-timer)) + (when on-exit (funcall on-exit))))) + (fset clearfun + (lambda () + (with-demoted-errors "set-transient-map PCH: %S" + (if (cond + ((null keep-pred) nil) + ((and (not (eq map (cadr overriding-terminal-local-map))) + (memq map (cddr overriding-terminal-local-map))) + t) + ((eq t keep-pred) + (let ((mc (lookup-key map (this-command-keys-vector)))) + (when (and mc (symbolp mc)) + (setq mc (or (command-remapping mc) mc))) + (and mc (eq this-command mc)))) + (t (funcall keep-pred))) + (when message (message "%s" message)) + (funcall exitfun))))) + (add-hook 'pre-command-hook clearfun) + (internal-push-keymap map 'overriding-terminal-local-map) + (when timeout + (when erc-compat--29-set-transient-map-timer + (cancel-timer erc-compat--29-set-transient-map-timer)) + (setq erc-compat--29-set-transient-map-timer + (run-with-idle-timer timeout nil exitfun))) + (when message (message "%s" message)) + exitfun)) + +(defmacro erc-compat--set-transient-map (&rest args) + (cons (if (>= emacs-major-version 29) + 'set-transient-map + 'erc-compat--29-set-transient-map) + args)) + + (provide 'erc-compat) ;;; erc-compat.el ends here diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index ecd721f2f03..13e95967bf8 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -366,35 +366,48 @@ erc-fill--wrap-nudge (widen) (let ((inhibit-field-text-motion t) (inhibit-read-only t) ; necessary? - (p (goto-char (point-min)))) + (p (goto-char (point-min))) + v) (when (zerop arg) (setq arg (- erc-fill-static-center erc-fill--wrap-value))) (cl-incf (caddr erc-fill--wrap-prefix) arg) (cl-incf erc-fill--wrap-value arg) (while (setq p (next-single-property-change p 'line-prefix)) - (when-let ((v (get-text-property p 'line-prefix))) - (cl-incf (nth 1 (nth 2 v)) arg) ; (space :width (- *this* len)) - (when-let - ((e (text-property-not-all p (point-max) 'line-prefix v))) - (goto-char e))))))) + (when-let* ((this-v (get-text-property p 'line-prefix)) + ((not (eq this-v v)))) + (setq v this-v) + (cl-incf (nth 1 (nth 2 v)) arg)))))) ; (space :width (- *i* len)) arg) (defun erc-fill-wrap-nudge (arg) "Adjust `erc-fill-wrap' by ARG columns. Offer to repeat command in a manner similar to -`text-scale-adjust'. Note that misalignment may occur when -messages contain decorations applied by third-party modules. -See `erc-fill--wrap-fix' for a workaround." +`text-scale-adjust'. + + \\`+', \\`=' Increase indentation by one column + \\`-' Decrease indentation by one column + \\`0' Reset indentation to the default + \\`C-+', \\`C-=' Shift right margin rightward (shrink it) + by one column + \\`C--' Shift right margin leftward (grow it) by one + column + \\`C-0' Reset the right margin to the default + +Note that misalignment may occur when messages contain +decorations applied by third-party modules. See +`erc-fill--wrap-fix' for a temporary workaround." (interactive "p") (unless erc-fill--wrap-value (cl-assert (not erc-fill-wrap-mode)) (user-error "Minor mode `erc-fill-wrap-mode' disabled")) - (let ((total (erc-fill--wrap-nudge arg)) - (start (window-start)) - (marker (set-marker (make-marker) (point)))) + (unless (get-buffer-window) + (user-error "Command called in an undisplayed buffer")) + (let* ((total (erc-fill--wrap-nudge arg)) + (win-ratio (/ (float (- (window-point) (window-start))) + (- (window-end nil t) (window-start))))) (when (zerop arg) (setq arg 1)) - (set-transient-map + (erc-compat--set-transient-map (let ((map (make-sparse-keymap))) (dolist (key '(?+ ?= ?- ?0)) (let ((a (pcase key @@ -405,18 +418,20 @@ erc-fill-wrap-nudge (lambda () (interactive) (cl-incf total (erc-fill--wrap-nudge a)) - (set-window-start (selected-window) start) - (goto-char marker))))) + (recenter (round (* win-ratio (window-height)))))) + (define-key map (vector (list 'control key)) + (lambda () + (interactive) + (erc-stamp--adjust-right-margin (- a)) + (recenter (round (* win-ratio (window-height)))))))) map) t (lambda () - (set-marker marker nil) (message "Fill prefix: %d (%+d col%s)" erc-fill--wrap-value total (if (> (abs total) 1) "s" ""))) "Use %k for further adjustment" 1) - (goto-char marker) - (set-window-start (selected-window) start))) + (recenter (round (* win-ratio (window-height)))))) (defun erc-fill-regarding-timestamp () "Fills a text such that messages start at column `erc-fill-static-center'." diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 21885f3a36f..8862b14b061 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -269,6 +269,24 @@ erc-stamp--display-margin-force (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 + (erc-format-timestamp + (current-time) + erc-timestamp-format))))) + (+ right-margin-width cols)))) + (setq right-margin-width width + right-fringe-width 0) + (set-window-margins nil left-margin-width width) + (set-window-fringes nil left-fringe-width 0))) + ;; If people want to use this directly, we can convert it into ;; a local module. (define-minor-mode erc-stamp--display-margin-mode @@ -280,15 +298,8 @@ erc-stamp--display-margin-mode message text so that stamps will be visible when yanked." :interactive nil (if erc-stamp--display-margin-mode - (let ((width (or erc-stamp-right-margin-width - (1+ (string-width (or erc-timestamp-last-inserted - (erc-format-timestamp - (current-time) - erc-timestamp-format))))))) - (setq right-margin-width width - right-fringe-width 0) - (set-window-margins nil left-margin-width width) - (set-window-fringes nil left-fringe-width 0) + (progn + (erc-stamp--adjust-right-margin 0) (add-function :filter-return (local 'filter-buffer-substring-function) #'erc--remove-text-properties) (add-function :around (local 'erc-insert-timestamp-function) @@ -397,6 +408,8 @@ erc-insert-timestamp-right (put-text-property from (point) 'display `(space :align-to (- right ,s))))) ('margin + (unless (eq ?\s (aref string 0)) + (insert-and-inherit " ")) (put-text-property 0 (length string) 'display `((margin right-margin) ,string) string)) @@ -451,9 +464,8 @@ erc-format-timestamp ;; N.B. Later use categories instead of this harmless, but ;; inelegant, hack. -- BPT (and erc-timestamp-intangible - ;; (not erc-hide-timestamps) ; bug#11706 - (erc-put-text-property 0 (1- (length ts)) - 'cursor-intangible t ts)) + (not erc-hide-timestamps) ; bug#11706 + (erc-put-text-property 0 (length ts) 'cursor-intangible t ts)) ts) "")) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 77d553bc3a2..04001ec6524 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -29,8 +29,12 @@ erc-fill-tests--wrap-populate (erc-insert-modify-hook '(erc-fill erc-add-timestamp)) (erc-server-users (make-hash-table :test 'equal)) (erc-fill-function 'erc-fill-wrap) + (pre-command-hook pre-command-hook) (erc-modules '(fill stamp)) (msg "Hello World") + (inhibit-message noninteractive) + erc-insert-post-hook + extended-command-history erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) (when (bound-and-true-p erc-button-mode) (push 'erc-button-add-buttons erc-insert-modify-hook)) @@ -53,28 +57,89 @@ erc-fill-tests--wrap-populate (erc-update-channel-member "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t) + (setq msg "This server is in debug mode and is logging all user I/O.\ If you do not wish for everything you send to be readable\ by the server owner(s), please disconnect.") - (erc-display-message nil 'notice (current-buffer) msg) + (setq msg "bob: come, you are a tedious fool: to the purpose.\ What was done to Elbow's wife, that he hath cause to complain of?\ Come me to what was done to her.") + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage "alice" msg nil t)) + + ;; Introduce an artificial gap in properties `line-prefix' and + ;; `wrap-prefix' and later ensure they're not incremented twice. + (save-excursion + (forward-line -1) + (search-forward "? ") + (remove-text-properties (1- (point)) (point) + '(line-prefix t wrap-prefix t))) - (erc-display-message - nil nil (current-buffer) - (erc-format-privmessage "alice" msg nil t)) (setq msg "alice: Either your unparagoned mistress is dead,\ or she's outprized by a trifle.") - - (erc-display-message - nil nil (current-buffer) - (erc-format-privmessage "bob" msg nil t)) - - (funcall test) - (when noninteractive - (kill-buffer))))) + (erc-display-message nil nil (current-buffer) + (erc-format-privmessage "bob" msg nil t)) + + (let ((original-window-buffer (window-buffer (selected-window)))) + (set-window-buffer (selected-window) (current-buffer)) + ;; Defend against non-local exits from `ert-skip' + (unwind-protect + (funcall test) + (set-window-buffer (selected-window) original-window-buffer) + (when noninteractive + (kill-buffer))))))) + +(defun erc-fill-tests--wrap-check-nudge (expected-width) + (save-excursion + (goto-char (point-min)) + (should (search-forward "*** This server" nil t)) + (should (get-text-property (pos-bol) 'line-prefix)) + (should (get-text-property (pos-eol) 'line-prefix)) + (should (equal (get-text-property (pos-bol) 'wrap-prefix) + `(space :width ,expected-width))) + (should (equal (get-text-property (pos-eol) 'wrap-prefix) + `(space :width ,expected-width))) + + ;; Prefix props are applied properly and faces are accounted + ;; for when determining widths. + (should (search-forward " ")))) + (`(space :width (- ,n ,w)) + (and (= n expected-width) + (= w (length " ")))))) + + ;; Ensure the loop is not visited twice due to the gap. + (should (search-forward " ")))) + (`(space :width (- ,n ,w)) + (and (= n expected-width) + (= w (length " ")))))))) (ert-deftest erc-fill-wrap--monospace () :tags '(:unstable) @@ -82,42 +147,22 @@ erc-fill-wrap--monospace (erc-fill-tests--wrap-populate (lambda () + (set-window-buffer (selected-window) (current-buffer)) + (erc-fill-tests--wrap-check-nudge 27) - ;; Prefix props are applied properly and faces are accounted - ;; for when determining widths. - (goto-char (point-min)) - (should (search-forward " "))) - (`(space :width (- 27 ,w)) - (= w (length " "))))) - - (erc-fill--wrap-nudge 2) - - (should (search-forward " "))) - (`(space :width (- 29 ,w)) - (= w (length " ")))))))) + (ert-info ("Shift right by one") + (ert-with-message-capture messages + (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET +")) + (should (string-match (rx "for further adjustment") messages))) + (erc-fill-tests--wrap-check-nudge 29)) + + (ert-info ("Shift left by five") + (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----")) + (erc-fill-tests--wrap-check-nudge 25)) + + (ert-info ("Reset") + (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0")) + (erc-fill-tests--wrap-check-nudge 27))))) (ert-deftest erc-fill-wrap--variable-pitch () :tags '(:unstable) @@ -133,37 +178,18 @@ erc-fill-wrap--variable-pitch :font 'unspecified) (erc-fill-tests--wrap-populate - (lambda () - - (goto-char (point-min)) - (should (search-forward " w (string-pixel-width " "))))) - + (erc-fill-tests--wrap-check-nudge 27) (erc-fill--wrap-nudge 2) - - (should (search-forward " w (string-pixel-width " "))))) - - ;; FIXME figure out how to get rid of this "void variable - ;; `erc--results-ewoc'" error, which seems related to operating - ;; in this second frame. + (erc-fill-tests--wrap-check-nudge 29) + (erc-fill--wrap-nudge -6) + (erc-fill-tests--wrap-check-nudge 25) + (erc-fill--wrap-nudge 0) + (erc-fill-tests--wrap-check-nudge 27) + + ;; FIXME get rid of this "void variable `erc--results-ewoc'" + ;; error, which seems related to operating in a non-default + ;; frame. ;; ;; As a kludge, checking if point made it to the prompt can ;; serve as visual confirmation that the test passed. diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el index 69523274812..73260ff126b 100644 --- a/test/lisp/erc/erc-stamp-tests.el +++ b/test/lisp/erc/erc-stamp-tests.el @@ -155,8 +155,8 @@ erc-timestamp-use-align-to--margin (erc-display-message nil nil (current-buffer) msg))) (goto-char (point-min)) ;; Space not added (treated as opaque string). - (should (search-forward "msg one[" nil t)) - ;; Field covers stamp alone + (should (search-forward "msg one [" nil t)) + ;; Field covers stamp and leading space (should (eql ?e (char-before (field-beginning (point))))) ;; Vanity props extended (should (get-text-property (field-beginning (point)) 'wrap-prefix)) @@ -170,12 +170,13 @@ erc-timestamp-use-align-to--margin (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t))) (erc-display-message nil nil (current-buffer) msg))) ;; No hard wrap - (should (search-forward "oooo[" nil t)) + (should (search-forward "oooo [" nil t)) ;; Field starts at leading space. - (should (eql ?\[ (char-after (field-beginning (point))))) + (should (eql ?\s (char-after (field-beginning (point))))) (should (eql ?\n (char-after (field-end (point))))))))) -;; This concerns the partial reversal of changes resulting from: +;; This concerns a proposed partial reversal of the changes resulting +;; from: ;; ;; 24.1.50; Wrong behavior of move-end-of-line in ERC (Bug#11706) ;; @@ -186,12 +187,15 @@ erc-timestamp-use-align-to--margin ;; C-n puts point one past the start of the message (i.e., two chars ;; beyond the timestamp's closing "]". Dropping the invisible ;; property when timestamps are hidden does indeed prevent this, but -;; it's also irreversible, which at least one user has complained -;; about. Turning off `cursor-intangible-mode' does do the trick, but -;; a better solution seems to be decrementing the end of the -;; `cursor-intangible' interval so that, in addition to C-n working, a -;; C-f from before the timestamp doesn't overshoot. This works -;; whether `erc-hide-timestamps' is enabled or not. +;; it's also a lasting commitment. The docs mention that it's +;; pointless to pair the old `intangible' property with `invisible' +;; and suggest users look at `cursor-intangible-mode'. Turning off +;; the latter does indeed do the trick as does decrementing the end of +;; the `cursor-intangible' interval so that, in addition to C-n +;; working, a C-f from before the timestamp doesn't overshoot. This +;; appears to be the case whether `erc-hide-timestamps' is enabled or +;; not, but it may be inadvisable for some reason (a hack) and +;; therefore warrants further investigation. ;; ;; Note some striking omissions here: ;; -- 2.39.1