From c514a426bef91674fc726816ff415183f4d1da0c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 7 Feb 2023 00:30:23 -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-compat.el | 56 ++++ lisp/erc/erc-fill.el | 307 ++++++++++++++++-- lisp/erc/erc-match.el | 31 +- lisp/erc/erc-stamp.el | 204 ++++++++++-- lisp/erc/erc.el | 136 +++++--- test/lisp/erc/erc-fill-tests.el | 278 ++++++++++++++++ .../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 ++++- 10 files changed, 1451 insertions(+), 215 deletions(-) create mode 100644 test/lisp/erc/erc-fill-tests.el create mode 100644 test/lisp/erc/erc-scenarios-base-local-module-modes.el create mode 100644 test/lisp/erc/erc-stamp-tests.el Interdiff: diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index aae8280baa9..994555acecf 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -95,7 +95,6 @@ erc--features-to-modules (erc-join autojoin) (erc-page page ctcp-page) (erc-sound sound ctcp-sound) - (erc-fill fill-wrap) (erc-stamp stamp timestamp) (erc-services services nickserv)) "Migration alist mapping a library feature to module names. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 13e95967bf8..ba538a7c152 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -171,7 +171,6 @@ erc-fill-variable (erc-fill-regarding-timestamp)))) (erc-restore-text-properties))) -(defvar-local erc-fill--wrap-prefix nil) (defvar-local erc-fill--wrap-value nil) (defvar-local erc-fill--wrap-visual-keys nil) @@ -195,12 +194,12 @@ erc-fill-wrap-visual-keys :type '(choice (const nil) (const t) (const non-input))) (defun erc-fill--wrap-move (normal-cmd visual-cmd arg) - (funcall - (pcase erc-fill--wrap-visual-keys - ('non-input (if (>= (point) erc-input-marker) normal-cmd visual-cmd)) - ('t visual-cmd) - (_ normal-cmd)) - arg)) + (funcall (pcase erc-fill--wrap-visual-keys + ('non-input + (if (>= (point) erc-input-marker) normal-cmd visual-cmd)) + ('t visual-cmd) + (_ normal-cmd)) + arg)) (defun erc-fill--wrap-kill-line (arg) "Defer to `kill-line' or `kill-visual-line'." @@ -252,6 +251,7 @@ erc-fill-wrap-mode-map (defvar erc-match-mode) (defvar erc-match--hide-fools-offset-bounds) +;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill) (define-erc-module fill-wrap nil "Fill style leveraging `visual-line-mode'. This local module depends on the global `fill' module. To use @@ -265,10 +265,12 @@ fill-wrap (unless erc-fill-mode (unless (memq 'fill erc-modules) (setq msg - (concat "WARNING: enabling default global module `fill' needed " - " by local module `fill-wrap'. This will impact all" - " ERC sessions. Add `fill' to `erc-modules' to avoid " - " this warning. See Info:\"(erc) Modules\" for more."))) + ;; FIXME use `erc-button--display-error-notice-with-keys' + ;; when bug#60933 is ready. + (concat "Enabling default global module `fill' needed by local" + " module `fill-wrap'. This will impact \C-]all\C-] ERC" + " sessions. Add `fill' to `erc-modules' to avoid this" + " warning. See Info:\"(erc) Modules\" for more."))) (erc-fill-mode +1)) ;; Set local value of user option (can we avoid this somehow?) (unless (eq erc-fill-function #'erc-fill-wrap) @@ -277,7 +279,6 @@ fill-wrap ((alist-get 'erc-fill-wrap-mode vars))) (setq erc-fill--wrap-visual-keys (alist-get 'erc-fill--wrap-visual-keys vars) - erc-fill--wrap-prefix (alist-get 'erc-fill--wrap-prefix vars) erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars))) (when (or erc-stamp-mode (memq 'stamp erc-modules)) (erc-stamp--display-margin-mode +1)) @@ -285,11 +286,7 @@ fill-wrap (require 'erc-match) (setq erc-match--hide-fools-offset-bounds t)) (setq erc-fill--wrap-value - (or erc-fill--wrap-value erc-fill-static-center) - ;; - erc-fill--wrap-prefix - (or erc-fill--wrap-prefix - (list 'space :width erc-fill--wrap-value))) + (or erc-fill--wrap-value erc-fill-static-center)) (visual-line-mode +1) (unless (local-variable-p 'erc-fill--wrap-visual-keys) (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys)) @@ -298,7 +295,6 @@ fill-wrap ((when erc-stamp--display-margin-mode (erc-stamp--display-margin-mode -1)) (kill-local-variable 'erc-button--add-nickname-face-function) - (kill-local-variable 'erc-fill--wrap-prefix) (kill-local-variable 'erc-fill--wrap-value) (kill-local-variable 'erc-fill-function) (kill-local-variable 'erc-fill--wrap-visual-keys) @@ -307,7 +303,7 @@ fill-wrap (defvar-local erc-fill--wrap-length-function nil "Function to determine length of overhanging characters. -It should return an EXPR as defined by the info node `(elisp) +It should return an EXPR as defined by the Info node `(elisp) Pixel Specification'. This value should represent the width of the overhang with all faces applied, including any enclosing brackets (which are not normally fontified) and a trailing space. @@ -337,20 +333,22 @@ erc-fill-wrap ;; Leaving out the final newline doesn't seem to affect anything. (erc-put-text-properties (point-min) (point-max) '(line-prefix wrap-prefix) nil - `((space :width (- ,erc-fill--wrap-value ,len)) - ,erc-fill--wrap-prefix))))) + `((space :width (- erc-fill--wrap-value ,len)) + (space :width erc-fill--wrap-value)))))) ;; This is an experimental helper for third-party modules. You could, ;; for example, use this to automatically resize the prefix to a -;; fraction of the window's width on some event change. +;; fraction of the window's width on some event change. Another use +;; case would be to fix lines affected by toggling a display-oriented +;; mode, like `display-line-numbers-mode'. (defun erc-fill--wrap-fix (&optional value) "Re-wrap from `point-min' to `point-max'. -Reset prefix to VALUE, when given." +That is, recalculate the width of all accessible lines and reset +local prefix VALUE when non-nil." (save-excursion (when value - (setq erc-fill--wrap-value value - erc-fill--wrap-prefix (list 'space :width value))) + (setq erc-fill--wrap-value value)) (let ((inhibit-field-text-motion t) (inhibit-read-only t)) (goto-char (point-min)) @@ -361,22 +359,9 @@ erc-fill--wrap-fix (erc-fill-wrap)))))) (defun erc-fill--wrap-nudge (arg) - (save-excursion - (save-restriction - (widen) - (let ((inhibit-field-text-motion t) - (inhibit-read-only t) ; necessary? - (p (goto-char (point-min))) - 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* ((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)) + (when (zerop arg) + (setq arg (- erc-fill-static-center erc-fill--wrap-value))) + (cl-incf erc-fill--wrap-value arg) arg) (defun erc-fill-wrap-nudge (arg) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 04001ec6524..8e8d585617a 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -19,6 +19,13 @@ ;;; Commentary: +;; FIXME these fixtures (and tests) are now largely useless. Due to +;; the author's ignorance regarding display properties, the "space" +;; specs of prefix props on different lines didn't initially leverage +;; a common variable (`erc-fill--wrap-value'), so the column twiddling +;; was more laborious. See decades-old comment above +;; calc_pixel_width_or_height in in xdisp.c for examples. + ;;; Code: (require 'ert-x) (require 'erc-fill) @@ -91,55 +98,34 @@ erc-fill-tests--wrap-populate (when noninteractive (kill-buffer))))))) -(defun erc-fill-tests--wrap-check-nudge (expected-width) +(defun erc-fill-tests--wrap-check-props (speaker) + ;; Prefix props are applied properly and faces are accounted + ;; for when determining widths. + (should (search-forward speaker 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 erc-fill--wrap-value))) + (should (equal (get-text-property (pos-eol) 'wrap-prefix) + '(space :width erc-fill--wrap-value))) + + ;; The last elt in the `:width' value is a singleton (NUM) when + ;; figuring pixels. Otherwise, it's just NUM. See EXPR in the + ;; prod rules table under (info "(elisp) Pixel Specification"). + (should (pcase (get-text-property (point) 'line-prefix) + ((and (guard (fboundp 'string-pixel-width)) + `(space :width (- erc-fill--wrap-value (,w)))) + (= w (string-pixel-width speaker))) + (`(space :width (- erc-fill--wrap-value ,w)) + (= w (length speaker)))))) + +(defun erc-fill-tests--wrap-check-prefixes () (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 " ")))))) - + (erc-fill-tests--wrap-check-props "*** ") + (erc-fill-tests--wrap-check-props " ") ;; Ensure the loop is not visited twice due to the gap. - (should (search-forward " ")))) - (`(space :width (- ,n ,w)) - (and (= n expected-width) - (= w (length " ")))))))) + (erc-fill-tests--wrap-check-props " "))) (ert-deftest erc-fill-wrap--monospace () :tags '(:unstable) @@ -148,21 +134,25 @@ erc-fill-wrap--monospace (lambda () (set-window-buffer (selected-window) (current-buffer)) - (erc-fill-tests--wrap-check-nudge 27) + (should (= erc-fill--wrap-value 27)) + (erc-fill-tests--wrap-check-prefixes) - (ert-info ("Shift right by one") + (ert-info ("Shift right by one (plus)") (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)) + (should (= erc-fill--wrap-value 29)) + (erc-fill-tests--wrap-check-prefixes)) (ert-info ("Shift left by five") (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----")) - (erc-fill-tests--wrap-check-nudge 25)) + (should (= erc-fill--wrap-value 25)) + (erc-fill-tests--wrap-check-prefixes)) (ert-info ("Reset") (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0")) - (erc-fill-tests--wrap-check-nudge 27))))) + (should (= erc-fill--wrap-value 27)) + (erc-fill-tests--wrap-check-prefixes))))) (ert-deftest erc-fill-wrap--variable-pitch () :tags '(:unstable) @@ -179,13 +169,17 @@ erc-fill-wrap--variable-pitch (erc-fill-tests--wrap-populate (lambda () - (erc-fill-tests--wrap-check-nudge 27) + (should (= erc-fill--wrap-value 27)) + (erc-fill-tests--wrap-check-prefixes) (erc-fill--wrap-nudge 2) - (erc-fill-tests--wrap-check-nudge 29) + (should (= erc-fill--wrap-value 29)) + (erc-fill-tests--wrap-check-prefixes) (erc-fill--wrap-nudge -6) - (erc-fill-tests--wrap-check-nudge 25) + (should (= erc-fill--wrap-value 25)) + (erc-fill-tests--wrap-check-prefixes) (erc-fill--wrap-nudge 0) - (erc-fill-tests--wrap-check-nudge 27) + (should (= erc-fill--wrap-value 27)) + (erc-fill-tests--wrap-check-prefixes) ;; FIXME get rid of this "void variable `erc--results-ewoc'" ;; error, which seems related to operating in a non-default @@ -195,4 +189,90 @@ erc-fill-wrap--variable-pitch ;; serve as visual confirmation that the test passed. (goto-char (point-max)))))) +(ert-deftest erc-fill-wrap-visual-keys--body () + :tags '(:unstable) + (erc-fill-tests--wrap-populate + + (lambda () + (set-window-buffer (selected-window) (current-buffer)) + (ert-info ("Value: non-input") + (should (eq erc-fill--wrap-visual-keys 'non-input)) + (goto-char (point-min)) + (should (search-forward "that he hath" nil t)) + (execute-kbd-macro "\C-a") + (should-not (looking-at (rx " "))) + (execute-kbd-macro "\C-e") + (should (search-backward "tedious fool" nil t)) + (should-not (looking-back "done to her\\.")) + (forward-char) + (execute-kbd-macro "\C-e") + (should (search-forward "done to her." nil t))) + + (ert-info ("Value: nil") + (execute-kbd-macro "\C-ca") + (should-not erc-fill--wrap-visual-keys) + (goto-char (point-min)) + (should (search-forward "in debug mode" nil t)) + (execute-kbd-macro "\C-a") + (should (looking-at (rx "*** "))) + (execute-kbd-macro "\C-e") + (should (eql ?\] (char-before (point))))) + + (ert-info ("Value: t") + (execute-kbd-macro "\C-ca") + (should (eq erc-fill--wrap-visual-keys t)) + (goto-char (point-min)) + (should (search-forward "that he hath" nil t)) + (execute-kbd-macro "\C-a") + (should-not (looking-at (rx " "))) + (should (search-backward "tedious fool" nil t)) + (execute-kbd-macro "\C-e") + (should-not (looking-back (rx "done to her\\."))) + (should (search-forward "done to her." nil t)) + (execute-kbd-macro "\C-a") + (should-not (looking-at (rx " "))))))) + +(ert-deftest erc-fill-wrap-visual-keys--prompt () + :tags '(:unstable) + (erc-fill-tests--wrap-populate + + (lambda () + (set-window-buffer (selected-window) (current-buffer)) + (goto-char erc-input-marker) + (insert "This buffer is for text that is not saved, and for Lisp " + "evaluation. To create a file, visit it with C-x C-f and " + "enter text in its buffer.") + + (ert-info ("Value: non-input") + (should (eq erc-fill--wrap-visual-keys 'non-input)) + (execute-kbd-macro "\C-a") + (should (looking-at "This buffer")) + (execute-kbd-macro "\C-e") + (should (looking-back "its buffer\\.")) + (execute-kbd-macro "\C-a") + (execute-kbd-macro "\C-k") + (should (eobp))) + + (ert-info ("Value: nil") ; same + (execute-kbd-macro "\C-ca") + (should-not erc-fill--wrap-visual-keys) + (execute-kbd-macro "\C-y") + (should (looking-back "its buffer\\.")) + (execute-kbd-macro "\C-a") + (should (looking-at "This buffer")) + (execute-kbd-macro "\C-k") + (should (eobp))) + + (ert-info ("Value: non-input") + (execute-kbd-macro "\C-ca") + (should (eq erc-fill--wrap-visual-keys t)) + (execute-kbd-macro "\C-y") + (execute-kbd-macro "\C-a") + (should-not (looking-at "This buffer")) + (execute-kbd-macro "\C-p") + (should-not (looking-back "its buffer\\.")) + (should (search-forward "its buffer." nil t)) + (should (search-backward "ERC> " nil t)) + (execute-kbd-macro "\C-a"))))) + ;;; erc-fill-tests.el ends here -- 2.39.1