diff options
| author | F. Jason Park | 2024-09-23 13:48:19 -0700 |
|---|---|---|
| committer | F. Jason Park | 2024-09-29 16:43:39 -0700 |
| commit | df593b5a619d63b620f8fd569ecf032dab2602d9 (patch) | |
| tree | 2911d4e6ec52624d271ac6837d528791c4ac20b4 | |
| parent | 4d7f41716e1485fb57efc6eac9f45f2879c90266 (diff) | |
| download | emacs-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.el | 5 | ||||
| -rw-r--r-- | lisp/erc/erc-track.el | 42 | ||||
| -rw-r--r-- | test/lisp/erc/erc-track-tests.el | 126 |
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. |
| 737 | But only do so if the CURRENT face is also one of ours and in | 738 | But only do so if the CURRENT face is also one of ours and in |
| 738 | NORMALS and if the highest ranked CONTENDER among new faces is | 739 | NORMALS 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. |
| 1062 | Return a cons of a hash table and a list ordered from most | 1062 | Return a cons cell of a hash table and a list ordered from most recently |
| 1063 | recently seen to earliest seen." | 1063 | seen 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 |