From 1162cf9dc8e1d6f6a99d99c4c49cae949d2d04d3 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 16 Feb 2023 22:34:26 -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 | 57 +++ lisp/erc/erc-fill.el | 307 +++++++++++++++-- lisp/erc/erc-match.el | 31 +- lisp/erc/erc-stamp.el | 210 ++++++++++-- lisp/erc/erc.el | 136 +++++--- test/lisp/erc/erc-fill-tests.el | 324 ++++++++++++++++++ .../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 ++++- .../fill/snapshots/monospace-01-start.eld | 1 + .../fill/snapshots/monospace-02-right.eld | 1 + .../fill/snapshots/monospace-03-left.eld | 1 + .../fill/snapshots/monospace-04-reset.eld | 1 + 14 files changed, 1506 insertions(+), 217 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 create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld create mode 100644 test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld Interdiff: diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index a4367fe4ba5..7d635e5b1af 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -409,6 +409,7 @@ erc-compat--29-browse-url-irc (cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc) existing)))))) +;; FIXME remove these after bumping Compat version to 29 (defvar erc-compat--29-set-transient-map-timer nil) (defun erc-compat--29-set-transient-map diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index ba538a7c152..032206b514a 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -179,7 +179,7 @@ erc-fill-wrap-use-pixels A value of nil means ERC should use columns, which may happen regardless, depending on the Emacs version. This option only matters when `erc-fill-wrap-mode' is enabled." - :package-version '(ERC . "5.5") ; FIXME sync on release + :package-version '(ERC . "5.6") ; FIXME sync on release :type 'boolean) (defcustom erc-fill-wrap-visual-keys 'non-input @@ -190,7 +190,7 @@ erc-fill-wrap-visual-keys never do so. A value of `non-input' tells ERC to act like the value is nil in the input area and t elsewhere. This option only plays a role when `erc-fill-wrap-mode' is enabled." - :package-version '(ERC . "5.5") ; FIXME sync on release + :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const nil) (const t) (const non-input))) (defun erc-fill--wrap-move (normal-cmd visual-cmd arg) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index c8f6e7c195c..a5e9720bad4 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -650,8 +650,6 @@ erc-go-to-log-matches-buffer (get-buffer (car buffer-cons)))))) (switch-to-buffer buffer-name))) -(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer) - (defvar-local erc-match--hide-fools-offset-bounds nil) (defun erc-hide-fools (match-type _nickuserhost _message) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index d1c2f790bc8..e689caf7b61 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -260,7 +260,7 @@ erc-timestamp-use-align-to 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)) - :package-version '(ERC . "5.5")) ; FIXME sync on release + :package-version '(ERC . "5.6")) ; FIXME sync on release (defcustom erc-stamp-right-margin-width nil "Width in columns of the right margin. @@ -268,7 +268,7 @@ erc-stamp-right-margin-width 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.5") ; FIXME sync on release + :package-version '(ERC . "5.6") ; FIXME sync on release :type '(choice (const nil) integer)) (defun erc-stamp--display-margin-force (orig &rest r) @@ -315,6 +315,8 @@ erc-stamp-prefix-log-filter (zerop (forward-line)))) "") +(declare-function erc--remove-text-properties "erc" (string)) + ;; If people want to use this directly, we can convert it into ;; a local module. (define-minor-mode erc-stamp--display-margin-mode @@ -338,8 +340,8 @@ erc-stamp--display-margin-mode #'erc-stamp--display-margin-force) (kill-local-variable 'right-margin-width) (kill-local-variable 'right-fringe-width) - (set-window-margins left-margin-width nil) - (set-window-fringes left-fringe-width nil))) + (set-window-margins nil left-margin-width nil) + (set-window-fringes nil left-fringe-width nil))) (defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." @@ -476,12 +478,13 @@ erc-insert-timestamp-left-and-right (setq erc-timestamp-last-inserted-right ts-right)))) ;; for testing: (setq erc-timestamp-only-if-changed-flag nil) +(defvar erc-stamp--tz nil) (defun erc-format-timestamp (time format) "Return TIME formatted as string according to FORMAT. Return the empty string if FORMAT is nil." (if format - (let ((ts (format-time-string format time))) + (let ((ts (format-time-string format time erc-stamp--tz))) (erc-put-text-property 0 (length ts) 'font-lock-face 'erc-timestamp-face ts) (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts) @@ -540,6 +543,7 @@ erc-toggle-timestamps (defun erc-echo-timestamp (dir stamp) "Print timestamp text-property of an IRC message." + ;; Could also pass an &optional `zone' arg to `format-time-string'. (interactive (list 'entered (get-text-property (point) 'erc-timestamp))) (when (eq 'entered dir) (when stamp diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 8e8d585617a..a254d5bbc73 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -25,78 +25,87 @@ ;; 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. +;; +;; TODO maybe use erts files instead of own snapshots. ;;; Code: (require 'ert-x) (require 'erc-fill) +(defvar erc-fill-tests--buffers nil) + (defun erc-fill-tests--wrap-populate (test) - (let ((proc (start-process "sleep" (current-buffer) "sleep" "1")) - (id (erc-networks--id-create 'foonet)) - (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)) - (erc-mode) - (setq erc-server-process proc erc-networks--id id) - (set-process-query-on-exit-flag erc-server-process nil) - - (with-current-buffer (get-buffer-create "#chan") + (cl-letf (((symbol-function 'erc-stamp--current-time) + (lambda () '(0 1)))) + (let ((proc (start-process "sleep" (current-buffer) "sleep" "1")) + (erc-stamp--tz t) + (id (erc-networks--id-create 'foonet)) + (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)) (erc-mode) - (erc-munge-invisibility-spec) - (setq erc-server-process proc - erc-networks--id id - erc-channel-users (make-hash-table :test 'equal) - erc--target (erc--target-from-string "#chan") - erc-default-recipients (list "#chan")) - (erc--initialize-markers (point) nil) - - (erc-update-channel-member - "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t) - - (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.\ + (setq erc-server-process proc erc-networks--id id) + (set-process-query-on-exit-flag erc-server-process nil) + + (with-current-buffer (get-buffer-create "#chan") + (erc-mode) + (erc-munge-invisibility-spec) + (setq erc-server-process proc + erc-networks--id id + erc-channel-users (make-hash-table :test 'equal) + erc--target (erc--target-from-string "#chan") + erc-default-recipients (list "#chan")) + (erc--initialize-markers (point) nil) + + (erc-update-channel-member + "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t) + + (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) + (erc-display-message nil 'notice (current-buffer) msg) - (setq msg "bob: come, you are a tedious fool: to the purpose.\ + (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))) - - (setq msg "alice: Either your unparagoned mistress is dead,\ + (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))) + + (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)) - - (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))))))) + (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 + (while-let ((buf (pop erc-fill-tests--buffers))) + (kill-buffer buf)) + (kill-buffer)))))))) (defun erc-fill-tests--wrap-check-props (speaker) ;; Prefix props are applied properly and faces are accounted @@ -127,6 +136,39 @@ erc-fill-tests--wrap-check-prefixes ;; Ensure the loop is not visited twice due to the gap. (erc-fill-tests--wrap-check-props " "))) +;; Set this variable to t to generate new snapshots after carefully +;; reviewing the output of each. +(defvar erc-fill-tests--save-p nil) + +(defun erc-fill-tests--compare (name) + (let* ((dir (expand-file-name "fill/snapshots/" (ert-resource-directory))) + (expect-file (file-name-with-extension (expand-file-name name dir) + "eld")) + (erc--own-property-names + (seq-difference `(erc-timestamp font-lock-face + ,@erc--own-property-names) + '(display wrap-prefix line-prefix) + #'eq)) + (print-circle t) + (print-escape-newlines t) + (print-escape-nonascii t) + (got (erc--remove-text-properties + (buffer-substring (point-min) erc-insert-marker))) + (repr (string-replace "erc-fill--wrap-value" + (number-to-string erc-fill--wrap-value) + (prin1-to-string got)))) + (with-current-buffer (generate-new-buffer name) + (push name erc-fill-tests--buffers) + (with-silent-modifications + (insert (setq got (read repr)))) + (erc-mode)) + (if erc-fill-tests--save-p + (with-temp-file expect-file + (insert repr)) + (with-temp-buffer + (insert-file-contents-literally expect-file) + (should (equal got (read (current-buffer)))))))) + (ert-deftest erc-fill-wrap--monospace () :tags '(:unstable) @@ -136,23 +178,27 @@ erc-fill-wrap--monospace (set-window-buffer (selected-window) (current-buffer)) (should (= erc-fill--wrap-value 27)) (erc-fill-tests--wrap-check-prefixes) + (erc-fill-tests--compare "monospace-01-start") (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))) (should (= erc-fill--wrap-value 29)) - (erc-fill-tests--wrap-check-prefixes)) + (erc-fill-tests--wrap-check-prefixes) + (erc-fill-tests--compare "monospace-02-right")) (ert-info ("Shift left by five") (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET -----")) (should (= erc-fill--wrap-value 25)) - (erc-fill-tests--wrap-check-prefixes)) + (erc-fill-tests--wrap-check-prefixes) + (erc-fill-tests--compare "monospace-03-left")) (ert-info ("Reset") (execute-kbd-macro (kbd "M-x erc-fill-wrap-nudge RET 0")) (should (= erc-fill--wrap-value 27)) - (erc-fill-tests--wrap-check-prefixes))))) + (erc-fill-tests--wrap-check-prefixes) + (erc-fill-tests--compare "monospace-04-reset"))))) (ert-deftest erc-fill-wrap--variable-pitch () :tags '(:unstable) diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld new file mode 100644 index 00000000000..8262c5056f4 --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld @@ -0,0 +1 @@ +#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld new file mode 100644 index 00000000000..3f5f344cc64 --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld @@ -0,0 +1 @@ +#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 29) line-prefix #3=(space :width (- 29 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 29 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 29 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld new file mode 100644 index 00000000000..3b215936c39 --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld @@ -0,0 +1 @@ +#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 25) line-prefix #3=(space :width (- 25 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 25 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 25 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#)) \ No newline at end of file diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld new file mode 100644 index 00000000000..8262c5056f4 --- /dev/null +++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld @@ -0,0 +1 @@ +#("\n\n\n[Thu Jan 1 1970]\n*** 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.[00:00]\n 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 alice: Either your unparagoned mistress is dead, or she's outprized by a trifle.\n" 21 183 (wrap-prefix #2=(space :width 27) line-prefix #3=(space :width (- 27 (4)))) 183 190 (wrap-prefix #2# line-prefix #3# display #1=((margin right-margin) #("[00:00]" 0 7 (display #1# isearch-open-invisible timestamp invisible timestamp font-lock-face erc-timestamp-face)))) 190 191 (wrap-prefix #2# line-prefix #3#) 191 192 (wrap-prefix #2# line-prefix #4=(space :width (- 27 (8)))) 192 197 (wrap-prefix #2# line-prefix #4#) 197 315 (wrap-prefix #2# line-prefix #4#) 316 348 (wrap-prefix #2# line-prefix #4#) 348 349 (wrap-prefix #2# line-prefix #4#) 349 350 (wrap-prefix #2# line-prefix #5=(space :width (- 27 (6)))) 350 353 (wrap-prefix #2# line-prefix #5#) 353 435 (wrap-prefix #2# line-prefix #5#) 435 436 (wrap-prefix #2# line-prefix #5#)) \ No newline at end of file -- 2.39.1