aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorF. Jason Park2023-11-18 23:44:20 -0800
committerF. Jason Park2023-11-24 13:38:52 -0800
commit0d6c8d41ab7172a496c6db951c270821807dce99 (patch)
treecec32be0beef207b55923480bf983abfb152d94d
parent3c9cba9df3d392a89314e06a6396c4157065f3b0 (diff)
downloademacs-0d6c8d41ab7172a496c6db951c270821807dce99.tar.gz
emacs-0d6c8d41ab7172a496c6db951c270821807dce99.zip
Use overlay instead of text prop to hide ERC's prompt
* lisp/erc/erc-backend.el (erc--hidden-prompt-overlay): New variable, a buffer-local handle for the prompt overlay. (erc--reveal-prompt): Delete overlay instead of text prop. (erc--conceal-prompt): Add overlay instead of text prop. (erc--unhide-prompt): Run `erc--refresh-prompt-hook' after revealing. (erc--hide-prompt): Run `erc--refresh-prompt-hook' after hiding. * lisp/erc/erc-stamp.el (erc-stamp--adjust-margin): Attempt a more accurate estimate of the prompt's width in columns when initially setting left-margin. (erc-stamp--skip-left-margin-prompt-p): New variable to inhibit normal behavior of displaying prompt in left margin. (erc-stamp--display-margin-mode): Allow opting out of prompt-in-left-margin behavior. (erc--reveal-prompt): Delete unneeded method implementation. (erc--conceal-prompt): Put overlay in margin. * test/lisp/erc/erc-tests.el (erc-hide-prompt): Use `get-char-property' instead of `get-text-property' in order to accommodate overlay-based prompt hiding. (Bug#51082)
-rw-r--r--lisp/erc/erc-backend.el21
-rw-r--r--lisp/erc/erc-stamp.el38
-rw-r--r--test/lisp/erc/erc-tests.el46
3 files changed, 64 insertions, 41 deletions
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 371b4591915..7ff55de0d0c 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1043,13 +1043,20 @@ Conditionally try to reconnect and take appropriate action."
1043 ;; unexpected disconnect 1043 ;; unexpected disconnect
1044 (erc-process-sentinel-2 event buffer)))) 1044 (erc-process-sentinel-2 event buffer))))
1045 1045
1046(defvar-local erc--hidden-prompt-overlay nil
1047 "Overlay for hiding the prompt when disconnected.")
1048
1046(cl-defmethod erc--reveal-prompt () 1049(cl-defmethod erc--reveal-prompt ()
1047 (remove-text-properties erc-insert-marker erc-input-marker 1050 (when erc--hidden-prompt-overlay
1048 '(display nil))) 1051 (delete-overlay erc--hidden-prompt-overlay)
1052 (setq erc--hidden-prompt-overlay nil)))
1049 1053
1050(cl-defmethod erc--conceal-prompt () 1054(cl-defmethod erc--conceal-prompt ()
1051 (add-text-properties erc-insert-marker (1- erc-input-marker) 1055 (when-let (((null erc--hidden-prompt-overlay))
1052 `(display ,erc-prompt-hidden))) 1056 (ov (make-overlay erc-insert-marker (1- erc-input-marker)
1057 nil 'front-advance)))
1058 (overlay-put ov 'display erc-prompt-hidden)
1059 (setq erc--hidden-prompt-overlay ov)))
1053 1060
1054(defun erc--prompt-hidden-p () 1061(defun erc--prompt-hidden-p ()
1055 (and (marker-position erc-insert-marker) 1062 (and (marker-position erc-insert-marker)
@@ -1061,7 +1068,8 @@ Conditionally try to reconnect and take appropriate action."
1061 (marker-position erc-input-marker)) 1068 (marker-position erc-input-marker))
1062 (with-silent-modifications 1069 (with-silent-modifications
1063 (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t) 1070 (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t)
1064 (erc--reveal-prompt)))) 1071 (erc--reveal-prompt)
1072 (run-hooks 'erc--refresh-prompt-hook))))
1065 1073
1066(defun erc--unhide-prompt-on-self-insert () 1074(defun erc--unhide-prompt-on-self-insert ()
1067 (when (and (eq this-command #'self-insert-command) 1075 (when (and (eq this-command #'self-insert-command)
@@ -1086,7 +1094,8 @@ Change value of property `erc-prompt' from t to `hidden'."
1086 (with-silent-modifications 1094 (with-silent-modifications
1087 (put-text-property erc-insert-marker (1- erc-input-marker) 1095 (put-text-property erc-insert-marker (1- erc-input-marker)
1088 'erc-prompt 'hidden) 1096 'erc-prompt 'hidden)
1089 (erc--conceal-prompt)) 1097 (erc--conceal-prompt)
1098 (run-hooks 'erc--refresh-prompt-hook))
1090 (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 80 t)))) 1099 (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 80 t))))
1091 1100
1092(defun erc-process-sentinel (cproc event) 1101(defun erc-process-sentinel (cproc event)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 6eeb7706a61..e6a8f36c332 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -360,7 +360,18 @@ prompt is wider, use its width instead."
360 (if resetp 360 (if resetp
361 (or (and (not (zerop cols)) cols) 361 (or (and (not (zerop cols)) cols)
362 erc-stamp--margin-width 362 erc-stamp--margin-width
363 (max (if leftp (string-width (erc-prompt)) 0) 363 (max (if leftp
364 (cond ((fboundp 'erc-fill--wrap-measure)
365 (let* ((b erc-insert-marker)
366 (e (1- erc-input-marker))
367 (w (erc-fill--wrap-measure b e)))
368 (/ (if (consp w) (car w) w)
369 (frame-char-width))))
370 ((fboundp 'string-pixel-width)
371 (/ (string-pixel-width (erc-prompt))
372 (frame-char-width)))
373 (t (string-width (erc-prompt))))
374 0)
364 (1+ (string-width 375 (1+ (string-width
365 (or (if leftp 376 (or (if leftp
366 erc-timestamp-last-inserted 377 erc-timestamp-last-inserted
@@ -407,6 +418,9 @@ non-nil."
407(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix) 418(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)
408 "Extant properties at the start of a message inherited by the stamp.") 419 "Extant properties at the start of a message inherited by the stamp.")
409 420
421(defvar-local erc-stamp--skip-left-margin-prompt-p nil
422 "Don't display prompt in left margin.")
423
410(declare-function erc--remove-text-properties "erc" (string)) 424(declare-function erc--remove-text-properties "erc" (string))
411 425
412;; Currently, `erc-insert-timestamp-right' hard codes its display 426;; Currently, `erc-insert-timestamp-right' hard codes its display
@@ -437,7 +451,8 @@ and `erc-stamp--margin-left-p', before activating the mode."
437 #'erc--remove-text-properties) 451 #'erc--remove-text-properties)
438 (add-hook 'erc--setup-buffer-hook 452 (add-hook 'erc--setup-buffer-hook
439 #'erc-stamp--refresh-left-margin-prompt nil t) 453 #'erc-stamp--refresh-left-margin-prompt nil t)
440 (when erc-stamp--margin-left-p 454 (when (and erc-stamp--margin-left-p
455 (not erc-stamp--skip-left-margin-prompt-p))
441 (add-hook 'erc--refresh-prompt-hook 456 (add-hook 'erc--refresh-prompt-hook
442 #'erc-stamp--display-prompt-in-left-margin nil t))) 457 #'erc-stamp--display-prompt-in-left-margin nil t)))
443 (remove-function (local 'filter-buffer-substring-function) 458 (remove-function (local 'filter-buffer-substring-function)
@@ -451,6 +466,7 @@ and `erc-stamp--margin-left-p', before activating the mode."
451 (kill-local-variable (if erc-stamp--margin-left-p 466 (kill-local-variable (if erc-stamp--margin-left-p
452 'left-margin-width 467 'left-margin-width
453 'right-margin-width)) 468 'right-margin-width))
469 (kill-local-variable 'erc-stamp--skip-left-margin-prompt-p)
454 (kill-local-variable 'fringes-outside-margins) 470 (kill-local-variable 'fringes-outside-margins)
455 (kill-local-variable 'erc-stamp--margin-left-p) 471 (kill-local-variable 'erc-stamp--margin-left-p)
456 (kill-local-variable 'erc-stamp--margin-width) 472 (kill-local-variable 'erc-stamp--margin-width)
@@ -485,18 +501,16 @@ and `erc-stamp--margin-left-p', before activating the mode."
485 (setq erc-stamp--last-prompt nil)) 501 (setq erc-stamp--last-prompt nil))
486 (erc--refresh-prompt))) 502 (erc--refresh-prompt)))
487 503
488(cl-defmethod erc--reveal-prompt
489 (&context (erc-stamp--display-margin-mode (eql t))
490 (erc-stamp--margin-left-p (eql t)))
491 (put-text-property erc-insert-marker (1- erc-input-marker)
492 'display `((margin left-margin) ,erc-stamp--last-prompt)))
493
494(cl-defmethod erc--conceal-prompt 504(cl-defmethod erc--conceal-prompt
495 (&context (erc-stamp--display-margin-mode (eql t)) 505 (&context (erc-stamp--display-margin-mode (eql t))
496 (erc-stamp--margin-left-p (eql t))) 506 (erc-stamp--margin-left-p (eql t))
497 (let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start))) 507 (erc-stamp--skip-left-margin-prompt-p null))
498 (put-text-property erc-insert-marker (1- erc-input-marker) 508 (when-let (((null erc--hidden-prompt-overlay))
499 'display `((margin left-margin) ,prompt)))) 509 (prompt (string-pad erc-prompt-hidden left-margin-width nil 'start))
510 (ov (make-overlay erc-insert-marker (1- erc-input-marker)
511 nil 'front-advance)))
512 (overlay-put ov 'display `((margin left-margin) ,prompt))
513 (setq erc--hidden-prompt-overlay ov)))
500 514
501(defun erc-insert-timestamp-left (string) 515(defun erc-insert-timestamp-left (string)
502 "Insert timestamps at the beginning of the line." 516 "Insert timestamps at the beginning of the line."
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 8c85f37dfe5..980928aceac 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -187,101 +187,101 @@
187 (with-current-buffer "ServNet" 187 (with-current-buffer "ServNet"
188 (should (= (point) erc-insert-marker)) 188 (should (= (point) erc-insert-marker))
189 (erc--hide-prompt erc-server-process) 189 (erc--hide-prompt erc-server-process)
190 (should (string= ">" (get-text-property (point) 'display)))) 190 (should (string= ">" (get-char-property (point) 'display))))
191 191
192 (with-current-buffer "#chan" 192 (with-current-buffer "#chan"
193 (goto-char erc-insert-marker) 193 (goto-char erc-insert-marker)
194 (should (string= ">" (get-text-property (point) 'display))) 194 (should (string= ">" (get-char-property (point) 'display)))
195 (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook)) 195 (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
196 (goto-char erc-input-marker) 196 (goto-char erc-input-marker)
197 (ert-simulate-command '(self-insert-command 1 ?/)) 197 (ert-simulate-command '(self-insert-command 1 ?/))
198 (goto-char erc-insert-marker) 198 (goto-char erc-insert-marker)
199 (should-not (get-text-property (point) 'display)) 199 (should-not (get-char-property (point) 'display))
200 (should-not (memq #'erc--unhide-prompt-on-self-insert 200 (should-not (memq #'erc--unhide-prompt-on-self-insert
201 pre-command-hook))) 201 pre-command-hook)))
202 202
203 (with-current-buffer "bob" 203 (with-current-buffer "bob"
204 (goto-char erc-insert-marker) 204 (goto-char erc-insert-marker)
205 (should (string= ">" (get-text-property (point) 'display))) 205 (should (string= ">" (get-char-property (point) 'display)))
206 (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook)) 206 (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
207 (goto-char erc-input-marker) 207 (goto-char erc-input-marker)
208 (ert-simulate-command '(self-insert-command 1 ?/)) 208 (ert-simulate-command '(self-insert-command 1 ?/))
209 (goto-char erc-insert-marker) 209 (goto-char erc-insert-marker)
210 (should-not (get-text-property (point) 'display)) 210 (should-not (get-char-property (point) 'display))
211 (should-not (memq #'erc--unhide-prompt-on-self-insert 211 (should-not (memq #'erc--unhide-prompt-on-self-insert
212 pre-command-hook))) 212 pre-command-hook)))
213 213
214 (with-current-buffer "ServNet" 214 (with-current-buffer "ServNet"
215 (should (get-text-property erc-insert-marker 'display)) 215 (should (get-char-property erc-insert-marker 'display))
216 (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook)) 216 (should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
217 (erc--unhide-prompt) 217 (erc--unhide-prompt)
218 (should-not (memq #'erc--unhide-prompt-on-self-insert 218 (should-not (memq #'erc--unhide-prompt-on-self-insert
219 pre-command-hook)) 219 pre-command-hook))
220 (should-not (get-text-property erc-insert-marker 'display)))) 220 (should-not (get-char-property erc-insert-marker 'display))))
221 221
222 (ert-info ("Value: server") 222 (ert-info ("Value: server")
223 (setq erc-hide-prompt '(server)) 223 (setq erc-hide-prompt '(server))
224 (with-current-buffer "ServNet" 224 (with-current-buffer "ServNet"
225 (erc--hide-prompt erc-server-process) 225 (erc--hide-prompt erc-server-process)
226 (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) 226 (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
227 (should (string= ">" (get-text-property erc-insert-marker 'display)))) 227 (should (string= ">" (get-char-property erc-insert-marker 'display))))
228 228
229 (with-current-buffer "#chan" 229 (with-current-buffer "#chan"
230 (should-not (get-text-property erc-insert-marker 'display))) 230 (should-not (get-char-property erc-insert-marker 'display)))
231 231
232 (with-current-buffer "bob" 232 (with-current-buffer "bob"
233 (should-not (get-text-property erc-insert-marker 'display))) 233 (should-not (get-char-property erc-insert-marker 'display)))
234 234
235 (with-current-buffer "ServNet" 235 (with-current-buffer "ServNet"
236 (erc--unhide-prompt) 236 (erc--unhide-prompt)
237 (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) 237 (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
238 (should-not (get-text-property erc-insert-marker 'display)))) 238 (should-not (get-char-property erc-insert-marker 'display))))
239 239
240 (ert-info ("Value: channel") 240 (ert-info ("Value: channel")
241 (setq erc-hide-prompt '(channel)) 241 (setq erc-hide-prompt '(channel))
242 (with-current-buffer "ServNet" 242 (with-current-buffer "ServNet"
243 (erc--hide-prompt erc-server-process) 243 (erc--hide-prompt erc-server-process)
244 (should-not (get-text-property erc-insert-marker 'display))) 244 (should-not (get-char-property erc-insert-marker 'display)))
245 245
246 (with-current-buffer "bob" 246 (with-current-buffer "bob"
247 (should-not (get-text-property erc-insert-marker 'display))) 247 (should-not (get-char-property erc-insert-marker 'display)))
248 248
249 (with-current-buffer "#chan" 249 (with-current-buffer "#chan"
250 (should (string= ">" (get-text-property erc-insert-marker 'display))) 250 (should (string= ">" (get-char-property erc-insert-marker 'display)))
251 (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) 251 (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
252 (erc--unhide-prompt) 252 (erc--unhide-prompt)
253 (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) 253 (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
254 (should-not (get-text-property erc-insert-marker 'display)))) 254 (should-not (get-char-property erc-insert-marker 'display))))
255 255
256 (ert-info ("Value: query") 256 (ert-info ("Value: query")
257 (setq erc-hide-prompt '(query)) 257 (setq erc-hide-prompt '(query))
258 (with-current-buffer "ServNet" 258 (with-current-buffer "ServNet"
259 (erc--hide-prompt erc-server-process) 259 (erc--hide-prompt erc-server-process)
260 (should-not (get-text-property erc-insert-marker 'display))) 260 (should-not (get-char-property erc-insert-marker 'display)))
261 261
262 (with-current-buffer "bob" 262 (with-current-buffer "bob"
263 (should (string= ">" (get-text-property erc-insert-marker 'display))) 263 (should (string= ">" (get-char-property erc-insert-marker 'display)))
264 (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden)) 264 (should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
265 (erc--unhide-prompt) 265 (erc--unhide-prompt)
266 (should (eq (get-text-property erc-insert-marker 'erc-prompt) t)) 266 (should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
267 (should-not (get-text-property erc-insert-marker 'display))) 267 (should-not (get-char-property erc-insert-marker 'display)))
268 268
269 (with-current-buffer "#chan" 269 (with-current-buffer "#chan"
270 (should-not (get-text-property erc-insert-marker 'display)))) 270 (should-not (get-char-property erc-insert-marker 'display))))
271 271
272 (ert-info ("Value: nil") 272 (ert-info ("Value: nil")
273 (setq erc-hide-prompt nil) 273 (setq erc-hide-prompt nil)
274 (with-current-buffer "ServNet" 274 (with-current-buffer "ServNet"
275 (erc--hide-prompt erc-server-process) 275 (erc--hide-prompt erc-server-process)
276 (should-not (get-text-property erc-insert-marker 'display))) 276 (should-not (get-char-property erc-insert-marker 'display)))
277 277
278 (with-current-buffer "bob" 278 (with-current-buffer "bob"
279 (should-not (get-text-property erc-insert-marker 'display))) 279 (should-not (get-char-property erc-insert-marker 'display)))
280 280
281 (with-current-buffer "#chan" 281 (with-current-buffer "#chan"
282 (should-not (get-text-property erc-insert-marker 'display)) 282 (should-not (get-char-property erc-insert-marker 'display))
283 (erc--unhide-prompt) ; won't blow up when prompt already showing 283 (erc--unhide-prompt) ; won't blow up when prompt already showing
284 (should-not (get-text-property erc-insert-marker 'display)))) 284 (should-not (get-char-property erc-insert-marker 'display))))
285 285
286 (when noninteractive 286 (when noninteractive
287 (kill-buffer "#chan") 287 (kill-buffer "#chan")