aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorF. Jason Park2024-09-23 13:48:19 -0700
committerF. Jason Park2024-09-29 16:43:39 -0700
commitdf593b5a619d63b620f8fd569ecf032dab2602d9 (patch)
tree2911d4e6ec52624d271ac6837d528791c4ac20b4
parent4d7f41716e1485fb57efc6eac9f45f2879c90266 (diff)
downloademacs-df593b5a619d63b620f8fd569ecf032dab2602d9.tar.gz
emacs-df593b5a619d63b620f8fd569ecf032dab2602d9.zip
Skip indentation when gathering faces in erc-track
* lisp/erc/erc-nicks.el (erc-nicks-mode, erc-nicks-enable) (erc-nicks-disable): Use correct name for `track' module hook. (erc-nicks--check-normals): Remove falsity from doc string. * lisp/erc/erc-track.el (erc-make-mode-line-buffer-name): Don't error when optional COUNT is nil. (erc-track-modified-channels): Use new name for preferred face-finding function. (erc-track--get-faces-in-current-message, erc-track--collect-faces-in): Rename former to latter to better reflect expanded utility, which now includes spanning gaps, including newlines and indentation that may be lacking in face-related properties. * test/lisp/erc/erc-track-tests.el (erc-track--collect-faces-in): New test. (Bug#73443)
-rw-r--r--lisp/erc/erc-nicks.el5
-rw-r--r--lisp/erc/erc-track.el42
-rw-r--r--test/lisp/erc/erc-track-tests.el126
3 files changed, 149 insertions, 24 deletions
diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index ccf65f15abd..a0d6d17d732 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -580,7 +580,7 @@ Abandon search after examining LIMIT faces."
580 (setf (alist-get "Edit face" erc-button--nick-popup-alist nil nil #'equal) 580 (setf (alist-get "Edit face" erc-button--nick-popup-alist nil nil #'equal)
581 #'erc-nicks-customize-face) 581 #'erc-nicks-customize-face)
582 (erc-nicks--setup-track-integration) 582 (erc-nicks--setup-track-integration)
583 (add-hook 'erc-track-mode #'erc-nicks--setup-track-integration 50 t) 583 (add-hook 'erc-track-mode-hook #'erc-nicks--setup-track-integration 50 t)
584 (advice-add 'widget-create-child-and-convert :filter-args 584 (advice-add 'widget-create-child-and-convert :filter-args
585 #'erc-nicks--redirect-face-widget-link)) 585 #'erc-nicks--redirect-face-widget-link))
586 ((kill-local-variable 'erc-nicks--face-table) 586 ((kill-local-variable 'erc-nicks--face-table)
@@ -598,6 +598,7 @@ Abandon search after examining LIMIT faces."
598 #'erc-nicks--highlight-button) 598 #'erc-nicks--highlight-button)
599 (remove-function (local 'erc-track--alt-normals-function) 599 (remove-function (local 'erc-track--alt-normals-function)
600 #'erc-nicks--check-normals) 600 #'erc-nicks--check-normals)
601 (remove-hook 'erc-track-mode-hook #'erc-nicks--setup-track-integration t)
601 (setf (alist-get "Edit face" 602 (setf (alist-get "Edit face"
602 erc-button--nick-popup-alist nil 'remove #'equal) 603 erc-button--nick-popup-alist nil 'remove #'equal)
603 nil) 604 nil)
@@ -736,7 +737,7 @@ Expect PREFIX to be something like \"ansi-color-\" or \"font-lock-\"."
736 "Return a viable `nicks'-owned face from NORMALS in CONTENDERS. 737 "Return a viable `nicks'-owned face from NORMALS in CONTENDERS.
737But only do so if the CURRENT face is also one of ours and in 738But only do so if the CURRENT face is also one of ours and in
738NORMALS and if the highest ranked CONTENDER among new faces is 739NORMALS and if the highest ranked CONTENDER among new faces is
739`erc-default-face', the lowest ranking default priority face." 740`erc-default-face'."
740 (and-let* (((eq contender 'erc-default-face)) 741 (and-let* (((eq contender 'erc-default-face))
741 ((or (null current) (gethash current normals))) 742 ((or (null current) (gethash current normals)))
742 (spkr (or (null current) (erc-nicks--oursp current)))) 743 (spkr (or (null current) (erc-nicks--oursp current))))
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 39a4775ddca..f40960e4a22 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -768,7 +768,7 @@ is displayed according to `erc-track-mouse-face'."
768 ;; (really?), 3. the defun needs to switch to BUFFER, so we would 768 ;; (really?), 3. the defun needs to switch to BUFFER, so we would
769 ;; need to save that value somewhere. 769 ;; need to save that value somewhere.
770 (let ((map (make-sparse-keymap)) 770 (let ((map (make-sparse-keymap))
771 (name (if erc-track-showcount 771 (name (if (and count erc-track-showcount)
772 (concat string 772 (concat string
773 erc-track-showcount-string 773 erc-track-showcount-string
774 (int-to-string count)) 774 (int-to-string count))
@@ -992,7 +992,7 @@ the current buffer is in `erc-mode'."
992 (when-let 992 (when-let
993 ((faces (if erc-track-ignore-normal-contenders-p 993 ((faces (if erc-track-ignore-normal-contenders-p
994 (erc-faces-in (buffer-string)) 994 (erc-faces-in (buffer-string))
995 (erc-track--get-faces-in-current-message))) 995 (erc-track--collect-faces-in)))
996 (normals erc-track--normal-faces) 996 (normals erc-track--normal-faces)
997 (erc-track-faces-priority-list 997 (erc-track-faces-priority-list
998 `(,@erc-track--attn-faces ,@erc-track-faces-priority-list)) 998 `(,@erc-track--attn-faces ,@erc-track-faces-priority-list))
@@ -1057,25 +1057,25 @@ the current buffer is in `erc-mode'."
1057(defvar erc-track--face-reject-function nil 1057(defvar erc-track--face-reject-function nil
1058 "Function called with face in current buffer to massage or reject.") 1058 "Function called with face in current buffer to massage or reject.")
1059 1059
1060(defun erc-track--get-faces-in-current-message () 1060(defun erc-track--collect-faces-in ()
1061 "Collect all faces in the narrowed buffer. 1061 "Collect all faces in the (presumably narrowed) current buffer.
1062Return a cons of a hash table and a list ordered from most 1062Return a cons cell of a hash table and a list ordered from most recently
1063recently seen to earliest seen." 1063seen to least."
1064 (let ((i (text-property-not-all (point-min) (point-max) 'font-lock-face nil)) 1064 (let* ((prop (if noninteractive 'font-lock-face 'face))
1065 (seen (make-hash-table :test #'equal)) 1065 (p (text-property-not-all (point-min) (point-max) prop nil))
1066 ;; 1066 (seen (and p (make-hash-table :test #'equal)))
1067 (rfaces ()) 1067 (faces (make-hash-table :test #'equal))
1068 (faces (make-hash-table :test #'equal))) 1068 (rfaces ()))
1069 (while-let ((i) 1069 (while p
1070 (cur (get-text-property i 'face))) 1070 (when-let ((cur (get-text-property p prop)))
1071 (unless (gethash cur seen) 1071 (unless (gethash cur seen)
1072 (puthash cur t seen) 1072 (puthash cur t seen)
1073 (when erc-track--face-reject-function 1073 (when erc-track--face-reject-function
1074 (setq cur (funcall erc-track--face-reject-function cur))) 1074 (setq cur (funcall erc-track--face-reject-function cur)))
1075 (when cur 1075 (when cur
1076 (push cur rfaces) 1076 (push cur rfaces)
1077 (puthash cur t faces))) 1077 (puthash cur t faces))))
1078 (setq i (next-single-property-change i 'font-lock-face))) 1078 (setq p (next-single-property-change p prop)))
1079 (cons faces rfaces))) 1079 (cons faces rfaces)))
1080 1080
1081;;; Buffer switching 1081;;; Buffer switching
diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el
index 3288c42a42e..8149138a971 100644
--- a/test/lisp/erc/erc-track-tests.el
+++ b/test/lisp/erc/erc-track-tests.el
@@ -22,8 +22,12 @@
22 22
23;;; Code: 23;;; Code:
24 24
25(require 'ert)
26(require 'erc-track) 25(require 'erc-track)
26(require 'ert-x)
27(eval-and-compile
28 (let ((load-path (cons (ert-resource-directory) load-path)))
29 (require 'erc-tests-common)))
30
27 31
28(ert-deftest erc-track--shorten-aggressive-nil () 32(ert-deftest erc-track--shorten-aggressive-nil ()
29 "Test non-aggressive erc track buffer name shortening." 33 "Test non-aggressive erc track buffer name shortening."
@@ -286,4 +290,124 @@
286 (a b (b a)) 290 (a b (b a))
287 (a b (a b))))) 291 (a b (a b)))))
288 292
293(ert-deftest erc-track--collect-faces-in ()
294 (with-current-buffer (get-buffer-create "*erc-track--get-faces-in*")
295 (erc-tests-common-prep-for-insertion)
296 (goto-char (point-min))
297 (skip-chars-forward "\n")
298
299 (let ((ts #("[04:37]"
300 0 1 ( erc--msg 0 field erc-timestamp
301 font-lock-face erc-timestamp-face)
302 1 7 ( field erc-timestamp
303 font-lock-face erc-timestamp-face)))
304 bounds)
305
306 (with-silent-modifications
307
308 (push (list (point)) bounds)
309 (insert ; JOIN
310 ts " " ; iniital `fill' indentation lacks properties
311 #("*** You have joined channel #chan" 0 33
312 (font-lock-face erc-notice-face))
313 "\n")
314 (setcdr (car bounds) (point))
315
316 (push (list (point)) bounds)
317 (insert ; 353
318 ts " "
319 #("*** Users on #chan: bob alice dummy tester"
320 0 30 (font-lock-face erc-notice-face)
321 30 35 (font-lock-face erc-current-nick-face)
322 35 42 (font-lock-face erc-notice-face))
323 "\n" #(" @fsbot" ; but intervening HAS properties
324 0 23 (font-lock-face erc-notice-face)))
325 (setcdr (car bounds) (point))
326
327 (push (list (point)) bounds)
328 (insert ; PRIVMSG
329 "\n" ts " "
330 #("<alice> bob: Thou canst not come to me: I come to"
331 0 1 (font-lock-face erc-default-face)
332 ;; erc-dangerous-host-face -> erc-nicks-alice-face (undefined)
333 1 6 (font-lock-face (erc-dangerous-host-face erc-nick-default-face))
334 6 8 (font-lock-face erc-default-face)
335 ;; erc-pal-face -> erc-nicks-bob-face (undefined)
336 8 11 (font-lock-face (erc-pal-face erc-default-face))
337 11 49 (font-lock-face erc-default-face))
338 "\n" #(" thee."
339 0 22 (font-lock-face erc-default-face))
340 "\n")
341 (setcdr (car bounds) (point)))
342
343 (goto-char (point-max))
344 (should (equal (setq bounds (nreverse bounds))
345 '((3 . 50) (50 . 129) (129 . 212))))
346
347 ;; For these result assertions, the insertion order of the table
348 ;; elements should mirror that of the consed lists.
349
350 ;; Baseline
351 (narrow-to-region 1 3)
352 (let ((result (erc-track--collect-faces-in)))
353 (should-not (map-pairs (car result)))
354 (should-not (cdr result)))
355
356 ;; JOIN
357 (narrow-to-region (car (nth 0 bounds)) (cdr (nth 0 bounds)))
358 (let ((result (erc-track--collect-faces-in)))
359 (should (seq-set-equal-p
360 (map-pairs (car result)) '((erc-timestamp-face . t)
361 (erc-notice-face . t))))
362 (should (equal (cdr result) '(erc-notice-face erc-timestamp-face))))
363
364 ;; 353
365 (narrow-to-region (car (nth 1 bounds)) (cdr (nth 1 bounds)))
366 (let ((result (erc-track--collect-faces-in)))
367 (should (seq-set-equal-p (map-pairs (car result))
368 '((erc-timestamp-face . t)
369 (erc-notice-face . t)
370 (erc-current-nick-face . t))))
371 (should (equal (cdr result) '(erc-current-nick-face
372 erc-notice-face
373 erc-timestamp-face))))
374
375 ;; PRIVMSG
376 (narrow-to-region (car (nth 2 bounds)) (cdr (nth 2 bounds)))
377 (let ((result (erc-track--collect-faces-in)))
378 (should (seq-set-equal-p
379 (map-pairs (car result))
380 '((erc-timestamp-face . t)
381 (erc-default-face . t)
382 ((erc-dangerous-host-face erc-nick-default-face) . t)
383 ((erc-pal-face erc-default-face) . t))))
384 (should (equal (cdr result)
385 '((erc-pal-face erc-default-face)
386 (erc-dangerous-host-face erc-nick-default-face)
387 erc-default-face
388 erc-timestamp-face))))
389
390 ;; Entire buffer.
391 (narrow-to-region (car (nth 0 bounds)) erc-insert-marker)
392 (let ((result (erc-track--collect-faces-in)))
393 (should (seq-set-equal-p
394 (map-pairs (car result))
395 '((erc-timestamp-face . t)
396 (erc-notice-face . t)
397 (erc-current-nick-face . t)
398 (erc-default-face . t)
399 ((erc-dangerous-host-face erc-nick-default-face) . t)
400 ((erc-pal-face erc-default-face) . t))))
401 (should (equal (cdr result)
402 '((erc-pal-face erc-default-face)
403 (erc-dangerous-host-face erc-nick-default-face)
404 erc-default-face
405 erc-current-nick-face
406 erc-notice-face
407 erc-timestamp-face)))))
408
409 (widen)
410 (when noninteractive
411 (kill-buffer))))
412
289;;; erc-track-tests.el ends here 413;;; erc-track-tests.el ends here