diff options
| author | F. Jason Park | 2023-11-04 11:08:22 -0700 |
|---|---|---|
| committer | F. Jason Park | 2023-11-04 15:36:24 -0700 |
| commit | 781f950edab0509f12e3ec4880690ef6541841ee (patch) | |
| tree | 84354df3801c823ec03520c9fec35eba337c2b00 | |
| parent | f7c7f7ac20defe3ee8a32659a6799b20ddd58aeb (diff) | |
| download | emacs-781f950edab0509f12e3ec4880690ef6541841ee.tar.gz emacs-781f950edab0509f12e3ec4880690ef6541841ee.zip | |
Preserve user markers when inserting ERC date stamps
* lisp/erc/erc-stamp.el
(erc-stamp--insert-date-stamp-as-phony-message): Ensure existing
user markers aren't displaced by date-stamp insertion.
* lisp/erc/erc.el (erc--insert-line-function): New function-valued
variable for overriding `insert'.
(erc-insert-line): Call `erc--insert-line-function', when non-nil, to
insert line specially.
* test/lisp/erc/erc-scenarios-stamp.el
(erc-scenarios-stamp--on-insert-modify): New assertion helper
function.
(erc-scenarios-stamp--date-mode/left-and-right): New test.
(Bug#60936)
| -rw-r--r-- | lisp/erc/erc-stamp.el | 1 | ||||
| -rw-r--r-- | lisp/erc/erc.el | 7 | ||||
| -rw-r--r-- | test/lisp/erc/erc-scenarios-stamp.el | 65 |
3 files changed, 72 insertions, 1 deletions
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index b5224674783..b65c7adf676 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el | |||
| @@ -670,6 +670,7 @@ value of t means the option's value doesn't require trimming.") | |||
| 670 | (let ((erc-stamp--skip t) | 670 | (let ((erc-stamp--skip t) |
| 671 | (erc-insert-modify-hook `(,@erc-insert-modify-hook | 671 | (erc-insert-modify-hook `(,@erc-insert-modify-hook |
| 672 | erc-stamp--propertize-left-date-stamp)) | 672 | erc-stamp--propertize-left-date-stamp)) |
| 673 | (erc--insert-line-function #'insert-before-markers) | ||
| 673 | ;; Don't run hooks that aren't expecting a narrowed buffer. | 674 | ;; Don't run hooks that aren't expecting a narrowed buffer. |
| 674 | (erc-insert-pre-hook nil) | 675 | (erc-insert-pre-hook nil) |
| 675 | (erc-insert-done-hook nil)) | 676 | (erc-insert-done-hook nil)) |
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a5457601223..fd57cb9d6a0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -3083,6 +3083,9 @@ If END is a marker, possibly update its position." | |||
| 3083 | (unless (eq end erc-insert-marker) | 3083 | (unless (eq end erc-insert-marker) |
| 3084 | (set-marker end nil))) | 3084 | (set-marker end nil))) |
| 3085 | 3085 | ||
| 3086 | (defvar erc--insert-line-function nil | ||
| 3087 | "When non-nil, an alterntive to `insert' for inserting messages.") | ||
| 3088 | |||
| 3086 | (defvar erc--insert-marker nil | 3089 | (defvar erc--insert-marker nil |
| 3087 | "Internal override for `erc-insert-marker'.") | 3090 | "Internal override for `erc-insert-marker'.") |
| 3088 | 3091 | ||
| @@ -3134,7 +3137,9 @@ modification hooks)." | |||
| 3134 | (save-restriction | 3137 | (save-restriction |
| 3135 | (widen) | 3138 | (widen) |
| 3136 | (goto-char insert-position) | 3139 | (goto-char insert-position) |
| 3137 | (insert string) | 3140 | (if erc--insert-line-function |
| 3141 | (funcall erc--insert-line-function string) | ||
| 3142 | (insert string)) | ||
| 3138 | (erc--assert-input-bounds) | 3143 | (erc--assert-input-bounds) |
| 3139 | ;; run insertion hook, with point at restored location | 3144 | ;; run insertion hook, with point at restored location |
| 3140 | (save-restriction | 3145 | (save-restriction |
diff --git a/test/lisp/erc/erc-scenarios-stamp.el b/test/lisp/erc/erc-scenarios-stamp.el index b98300d04be..49307dd228a 100644 --- a/test/lisp/erc/erc-scenarios-stamp.el +++ b/test/lisp/erc/erc-scenarios-stamp.el | |||
| @@ -113,4 +113,69 @@ | |||
| 113 | (not (eq 'erc-timestamp (field-at-pos (point)))))) | 113 | (not (eq 'erc-timestamp (field-at-pos (point)))))) |
| 114 | (should (erc--get-inserted-msg-prop 'erc-cmd))))))) | 114 | (should (erc--get-inserted-msg-prop 'erc-cmd))))))) |
| 115 | 115 | ||
| 116 | ;; This user-owned hook member places a marker on the first message in | ||
| 117 | ;; a buffer. Inserting a date stamp in front of it shouldn't move the | ||
| 118 | ;; marker. | ||
| 119 | (defun erc-scenarios-stamp--on-insert-modify () | ||
| 120 | (unless (marker-position erc-scenarios-stamp--user-marker) | ||
| 121 | (set-marker erc-scenarios-stamp--user-marker (point-min)) | ||
| 122 | (save-excursion | ||
| 123 | (goto-char erc-scenarios-stamp--user-marker) | ||
| 124 | (should (looking-at "Opening")))) | ||
| 125 | |||
| 126 | ;; Sometime after the first message ("Opening connection.."), assert | ||
| 127 | ;; that the marker we just placed hasn't moved. | ||
| 128 | (when (erc--check-msg-prop 'erc-cmd 2) | ||
| 129 | (save-restriction | ||
| 130 | (widen) | ||
| 131 | (ert-info ("Date stamp preserves opening user marker") | ||
| 132 | (goto-char erc-scenarios-stamp--user-marker) | ||
| 133 | (should-not (eq 'erc-timestamp (field-at-pos (point)))) | ||
| 134 | (should (looking-at "Opening")) | ||
| 135 | (should (eq 'unknown (get-text-property (point) 'erc-msg)))))) | ||
| 136 | |||
| 137 | ;; On 003 ("*** This server was created on"), clear state to force a | ||
| 138 | ;; new date stamp on the next message. | ||
| 139 | (when (erc--check-msg-prop 'erc-cmd 3) | ||
| 140 | (setq erc-timestamp-last-inserted-left nil) | ||
| 141 | (set-marker erc-scenarios-stamp--user-marker erc-insert-marker))) | ||
| 142 | |||
| 143 | (ert-deftest erc-scenarios-stamp--date-mode/left-and-right () | ||
| 144 | |||
| 145 | (should (eq erc-insert-timestamp-function | ||
| 146 | #'erc-insert-timestamp-left-and-right)) | ||
| 147 | |||
| 148 | (erc-scenarios-common-with-cleanup | ||
| 149 | ((erc-scenarios-common-dialog "base/reconnect") | ||
| 150 | (dumb-server (erc-d-run "localhost" t 'unexpected-disconnect)) | ||
| 151 | (port (process-contact dumb-server :service)) | ||
| 152 | (erc-scenarios-stamp--user-marker (make-marker)) | ||
| 153 | (erc-server-flood-penalty 0.1) | ||
| 154 | (erc-modules (if (zerop (random 2)) | ||
| 155 | (cons 'fill-wrap erc-modules) | ||
| 156 | erc-modules)) | ||
| 157 | (expect (erc-d-t-make-expecter)) | ||
| 158 | (erc-mode-hook | ||
| 159 | (cons (lambda () | ||
| 160 | (add-hook 'erc-insert-modify-hook | ||
| 161 | #'erc-scenarios-stamp--on-insert-modify -99 t)) | ||
| 162 | erc-mode-hook))) | ||
| 163 | |||
| 164 | (ert-info ("Connect") | ||
| 165 | (with-current-buffer (erc :server "127.0.0.1" | ||
| 166 | :port port | ||
| 167 | :full-name "tester" | ||
| 168 | :nick "tester") | ||
| 169 | |||
| 170 | (funcall expect 5 "Welcome to the foonet") | ||
| 171 | (funcall expect 5 "*** AWAYLEN=390") | ||
| 172 | |||
| 173 | (ert-info ("Date stamp preserves other user marker") | ||
| 174 | (goto-char erc-scenarios-stamp--user-marker) | ||
| 175 | (should-not (eq 'erc-timestamp (field-at-pos (point)))) | ||
| 176 | (should (looking-at (rx "*** irc.foonet.org oragono"))) | ||
| 177 | (should (eq 's004 (get-text-property (point) 'erc-msg)))) | ||
| 178 | |||
| 179 | (funcall expect 5 "This server is in debug mode"))))) | ||
| 180 | |||
| 116 | ;;; erc-scenarios-stamp.el ends here | 181 | ;;; erc-scenarios-stamp.el ends here |