1;;; erc-track.el --- Track modified channel buffers -*- lexical-binding:t -*- 2 3;; Copyright (C) 2002-2021 Free Software Foundation, Inc. 4 5;; Author: Mario Lang <mlang@delysid.org> 6;; Maintainer: Amin Bandali <bandali@gnu.org> 7;; Keywords: comm 8;; URL: https://www.emacswiki.org/emacs/ErcChannelTracking 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software: you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation, either version 3 of the License, or 15;; (at your option) any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 24 25;;; Commentary: 26 27;; Highlights keywords and pals (friends), and hides or highlights fools 28;; (using a dark color). Add to your init file: 29 30;; (require 'erc-track) 31;; (erc-track-mode 1) 32 33;; Todo: 34;; * Add extensibility so that custom functions can track 35;; custom modification types. 36 37(eval-when-compile (require 'cl-lib)) 38(require 'erc) 39(require 'erc-match) 40 41;;; Code: 42 43(defgroup erc-track nil 44 "Track active buffers and show activity in the mode line." 45 :group 'erc) 46 47(defcustom erc-track-enable-keybindings 'ask 48 "Whether to enable the ERC track keybindings, namely: 49`C-c C-SPC' and `C-c C-@', which both do the same thing. 50 51The default is to check to see whether these keys are used 52already: if not, then enable the ERC track minor mode, which 53provides these keys. Otherwise, do not touch the keys. 54 55This can alternatively be set to either t or nil, which indicate 56respectively always to enable ERC track minor mode or never to 57enable ERC track minor mode. 58 59The reason for using this default value is to both (1) adhere to 60the Emacs development guidelines which say not to touch keys of 61the form C-c C-<something> and also (2) to meet the expectations 62of long-time ERC users, many of whom rely on these keybindings." 63 :type '(choice (const :tag "Ask, if used already" ask) 64 (const :tag "Enable" t) 65 (const :tag "Disable" nil))) 66 67(defcustom erc-track-visibility t 68 "Where do we look for buffers to determine their visibility? 69The value of this variable determines, when a buffer is considered 70visible or invisible. New messages in invisible buffers are tracked, 71while switching to visible buffers when they are tracked removes them 72from the list. See also `erc-track-when-inactive'. 73 74Possible values are: 75 76t - all frames 77visible - all visible frames 78nil - only the selected frame 79selected-visible - only the selected frame if it is visible 80 81Activity means that there was no user input in the last 10 seconds." 82 :type '(choice (const :tag "All frames" t) 83 (const :tag "All visible frames" visible) 84 (const :tag "Only the selected frame" nil) 85 (const :tag "Only the selected frame if it is visible" 86 selected-visible))) 87 88(defcustom erc-track-exclude nil 89 "A list targets (channel names or query targets) which should not be tracked." 90 :type '(repeat string)) 91 92(defcustom erc-track-remove-disconnected-buffers nil 93 "If true, remove buffers associated with a server that is 94disconnected from `erc-modified-channels-alist'." 95 :type 'boolean) 96 97(defcustom erc-track-exclude-types '("NICK" "333" "353") 98 "List of message types to be ignored. 99This list could look like (\"JOIN\" \"PART\"). 100 101By default, exclude changes of nicknames (NICK), display of who 102set the channel topic (333), and listing of users on the current 103channel (353)." 104 :type 'erc-message-type) 105 106(defcustom erc-track-exclude-server-buffer nil 107 "If true, don't perform tracking on the server buffer. 108This is useful for excluding all the things like MOTDs from the 109server and other miscellaneous functions." 110 :type 'boolean) 111 112(defcustom erc-track-shorten-start 1 113 "Minimum number of characters for a channel name in the mode-line." 114 :type 'number) 115 116(defcustom erc-track-shorten-cutoff 4 117 "All channel names longer than this value will be shortened." 118 :type 'number) 119 120(defcustom erc-track-shorten-aggressively nil 121 "If non-nil, channel names will be shortened more aggressively. 122Usually, names are not shortened if this will save only one character. 123Example: If there are two channels, #linux-de and #linux-fr, then 124normally these will not be shortened. When shortening aggressively, 125however, these will be shortened to #linux-d and #linux-f. 126 127If this variable is set to `max', then channel names will be shortened 128to the max. Usually, shortened channel names will remain unique for a 129given set of existing channels. When shortening to the max, the shortened 130channel names will be unique for the set of active channels only. 131Example: If there are two active channels #emacs and #vi, and two inactive 132channels #electronica and #folk, then usually the active channels are 133shortened to #em and #v. When shortening to the max, however, #emacs is 134not compared to #electronica -- only to #vi, therefore it can be shortened 135even more and the result is #e and #v. 136 137This setting is used by `erc-track-shorten-names'." 138 :type '(choice (const :tag "No" nil) 139 (const :tag "Yes" t) 140 (const :tag "Max" max))) 141 142(defcustom erc-track-shorten-function 'erc-track-shorten-names 143 "This function will be used to reduce the channel names before display. 144It takes one argument, CHANNEL-NAMES which is a list of strings. 145It should return a list of strings of the same number of elements. 146If nil instead of a function, shortening is disabled." 147 :type '(choice (const :tag "Disabled") 148 function)) 149 150(defcustom erc-track-list-changed-hook nil 151 "Hook run when the contents of `erc-modified-channels-alist' changes. 152 153This is useful for people that don't use the default mode-line 154notification but instead use a separate mechanism to provide 155notification of channel activity." 156 :type 'hook) 157 158(defcustom erc-track-use-faces t 159 "Use faces in the mode-line. 160The faces used are the same as used for text in the buffers. 161\(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)" 162 :type 'boolean) 163 164(defcustom erc-track-faces-priority-list 165 '(erc-error-face 166 (erc-nick-default-face erc-current-nick-face) 167 erc-current-nick-face 168 erc-keyword-face 169 (erc-nick-default-face erc-pal-face) 170 erc-pal-face 171 erc-nick-msg-face 172 erc-direct-msg-face 173 (erc-button erc-default-face) 174 (erc-nick-default-face erc-dangerous-host-face) 175 erc-dangerous-host-face 176 erc-nick-default-face 177 (erc-nick-default-face erc-default-face) 178 erc-default-face 179 erc-action-face 180 (erc-nick-default-face erc-fool-face) 181 erc-fool-face 182 erc-notice-face 183 erc-input-face 184 erc-prompt-face) 185 "A list of faces used to highlight active buffer names in the mode line. 186If a message contains one of the faces in this list, the buffer name will 187be highlighted using that face. The first matching face is used." 188 :type '(repeat (choice face 189 (repeat :tag "Combination" face)))) 190 191(defcustom erc-track-priority-faces-only nil 192 "Only track text highlighted with a priority face. 193If you would like to ignore changes in certain channels where there 194are no faces corresponding to your `erc-track-faces-priority-list', set 195this variable. You can set a list of channel name strings, so those 196will be ignored while all other channels will be tracked as normal. 197Other options are `all', to apply this to all channels or nil, to disable 198this feature. 199 200Note: If you have a lot of faces listed in `erc-track-faces-priority-list', 201setting this variable might not be very useful." 202 :type '(choice (const nil) 203 (repeat string) 204 (const all))) 205 206(defcustom erc-track-faces-normal-list 207 '((erc-button erc-default-face) 208 (erc-nick-default-face erc-dangerous-host-face) 209 erc-dangerous-host-face 210 erc-nick-default-face 211 (erc-nick-default-face erc-default-face) 212 erc-default-face 213 erc-action-face) 214 "A list of faces considered to be part of normal conversations. 215This list is used to highlight active buffer names in the mode line. 216 217If a message contains one of the faces in this list, and the 218previous mode line face for this buffer is also in this list, then 219the buffer name will be highlighted using the face from the 220message. This gives a rough indication that active conversations 221are occurring in these channels. 222 223The effect may be disabled by setting this variable to nil." 224 :type '(repeat (choice face 225 (repeat :tag "Combination" face)))) 226 227(defcustom erc-track-position-in-mode-line 'before-modes 228 "Where to show modified channel information in the mode-line. 229 230Choices are: 231`before-modes' - add to the beginning of `mode-line-modes', 232`after-modes' - add to the end of `mode-line-modes', 233t - add to the end of `global-mode-string', 234nil - don't add to mode line." 235 :type '(choice (const :tag "Just before mode information" before-modes) 236 (const :tag "Just after mode information" after-modes) 237 (const :tag "After all other information" t) 238 (const :tag "Don't display in mode line" nil)) 239 :set (lambda (sym val) 240 (set sym val) 241 (when (and (boundp 'erc-track-mode) 242 erc-track-mode) 243 (erc-track-remove-from-mode-line) 244 (erc-track-add-to-mode-line val)))) 245 246(defun erc-modified-channels-object (strings) 247 "Generate a new `erc-modified-channels-object' based on STRINGS." 248 (if strings 249 (concat (if (eq erc-track-position-in-mode-line 'after-modes) 250 "[" " [") 251 (mapconcat #'identity (nreverse strings) ",") 252 (if (eq erc-track-position-in-mode-line 'before-modes) 253 "] " "]")) 254 "")) 255 256(defvar erc-modified-channels-object (erc-modified-channels-object nil) 257 "Internal object used for displaying modified channels in the mode line.") 258 259(put 'erc-modified-channels-object 'risky-local-variable t); allow properties 260 261(defvar erc-modified-channels-alist nil 262 "An ALIST used for tracking channel modification activity. 263Each element is a list of the form (BUFFER COUNT . FACE) where 264BUFFER is a buffer object of the channel the entry corresponds 265to, COUNT is a number indicating how often activity was noticed, 266and FACE is a face (or a list of faces, combined as usual) to use 267when displaying the buffer's name in the mode line. 268 269Entries in this list are only added/updated for buffers that were 270not visible when activity occurred in them, and are removed for 271each buffer as soon as it becomes visible again (or if the server 272is disconnected, provided `erc-track-remove-disconnected-buffers' 273is true). 274 275For how the face is chosen for a buffer, see 276`erc-track-select-mode-line-face' and 277`erc-track-priority-faces-only'. For how buffers are then 278displayed in the mode line, see `erc-modified-channels-display'.") 279 280(defcustom erc-track-showcount nil 281 "If non-nil, count of unseen messages will be shown for each channel." 282 :type 'boolean) 283 284(defcustom erc-track-showcount-string ":" 285 "The string to display between buffer name and the count in the mode line. 286The default is a colon, resulting in \"#emacs:9\"." 287 :type 'string) 288 289(defcustom erc-track-switch-from-erc t 290 "If non-nil, `erc-track-switch-buffer' will return to the last non-erc buffer 291when there are no more active channels." 292 :type 'boolean) 293 294(defcustom erc-track-switch-direction 'oldest 295 "Direction `erc-track-switch-buffer' should switch. 296 297 importance - find buffer with the most important message 298 oldest - find oldest active buffer 299 newest - find newest active buffer 300 leastactive - find buffer with least unseen messages 301 mostactive - find buffer with most unseen messages. 302 303If set to `importance', the importance is determined by position 304in `erc-track-faces-priority-list', where first is most 305important." 306 :type '(choice (const importance) 307 (const oldest) 308 (const newest) 309 (const leastactive) 310 (const mostactive))) 311 312 313(defun erc-track-remove-from-mode-line () 314 "Remove `erc-track-modified-channels' from the mode-line." 315 (setq mode-line-modes 316 (remove '(t erc-modified-channels-object) mode-line-modes)) 317 (when (consp global-mode-string) 318 (setq global-mode-string 319 (delq 'erc-modified-channels-object global-mode-string)))) 320 321(defun erc-track-add-to-mode-line (position) 322 "Add `erc-track-modified-channels' to POSITION in the mode-line. 323See `erc-track-position-in-mode-line' for possible values." 324 ;; CVS Emacs has a new format string, and global-mode-string 325 ;; is very far to the right. 326 (cond ((eq position 'before-modes) 327 (add-to-list 'mode-line-modes 328 '(t erc-modified-channels-object))) 329 ((eq position 'after-modes) 330 (add-to-list 'mode-line-modes 331 '(t erc-modified-channels-object) t)) 332 ((eq position t) 333 (when (not global-mode-string) 334 (setq global-mode-string '(""))) ; Padding for mode-line wart 335 (add-to-list 'global-mode-string 336 'erc-modified-channels-object 337 t)))) 338 339;;; Shortening of names 340 341(defun erc-track-shorten-names (channel-names) 342 "Call `erc-unique-channel-names' with the correct parameters. 343This function is a good value for `erc-track-shorten-function'. 344The list of all channels is returned by `erc-all-buffer-names'. 345CHANNEL-NAMES is the list of active channel names. 346Only channel names longer than `erc-track-shorten-cutoff' are 347actually shortened, and they are only shortened to a minimum 348of `erc-track-shorten-start' characters." 349 (erc-unique-channel-names 350 (erc-all-buffer-names) 351 channel-names 352 (lambda (s) 353 (> (length s) erc-track-shorten-cutoff)) 354 erc-track-shorten-start)) 355 356(defvar erc-default-recipients) 357 358(defun erc-all-buffer-names () 359 "Return all channel or query buffer names. 360Note that we cannot use `erc-channel-list' with a nil argument, 361because that does not return query buffers." 362 (save-excursion 363 (let (result) 364 (dolist (buf (buffer-list)) 365 (set-buffer buf) 366 (when (or (eq major-mode 'erc-mode) (eq major-mode 'erc-dcc-chat-mode)) 367 (setq result (cons (buffer-name) result)))) 368 result))) 369 370(defun erc-unique-channel-names (all active &optional predicate start) 371 "Return a list of unique channel names. 372ALL is the list of all channel and query buffer names. 373ACTIVE is the list of active buffer names. 374PREDICATE is a predicate that should return non-nil if a name needs 375 no shortening. 376START is the minimum length of the name used." 377 (if (eq 'max erc-track-shorten-aggressively) 378 ;; Return the unique substrings of all active channels. 379 (erc-unique-substrings active predicate start) 380 ;; Otherwise, determine the unique substrings of all channels, and 381 ;; for every active channel, return the corresponding substring. 382 ;; Given the names of the active channels, we now need to find the 383 ;; corresponding short name from the list of all substrings. To 384 ;; avoid problems when there are two channels and one is a 385 ;; substring of the other (notorious examples are #hurd and 386 ;; #hurd-bunny), every candidate gets the longest possible 387 ;; substring. 388 (let ((all-substrings (sort 389 (erc-unique-substrings all predicate start) 390 (lambda (a b) (> (length a) (length b))))) 391 result) 392 (dolist (channel active) 393 (let ((substrings all-substrings) 394 candidate 395 winner) 396 (while (and substrings (not winner)) 397 (setq candidate (car substrings) 398 substrings (cdr substrings)) 399 (when (and (string= candidate 400 (substring channel 401 0 402 (min (length candidate) 403 (length channel)))) 404 (not (member candidate result))) 405 (setq winner candidate))) 406 (setq result (cons winner result)))) 407 (nreverse result)))) 408 409(defun erc-unique-substrings (strings &optional predicate start) 410 "Return a list of unique substrings of STRINGS." 411 (if (or (not (numberp start)) 412 (< start 0)) 413 (setq start 2)) 414 (mapcar 415 (lambda (str) 416 (let* ((others (delete str (copy-sequence strings))) 417 (maxlen (length str)) 418 (i (min start 419 (length str))) 420 candidate 421 done) 422 (if (and (functionp predicate) (not (funcall predicate str))) 423 ;; do not shorten if a predicate exists and it returns nil 424 str 425 ;; Start with smallest substring candidate, ie. length 1. 426 ;; Then check all the others and see whether any of them starts 427 ;; with the same substring. While there is such another 428 ;; element in the list, increase the length of the candidate. 429 (while (not done) 430 (if (> i maxlen) 431 (setq done t) 432 (setq candidate (substring str 0 i) 433 done (not (erc-unique-substring-1 candidate others)))) 434 (setq i (1+ i))) 435 (if (and (= (length candidate) (1- maxlen)) 436 (not erc-track-shorten-aggressively)) 437 str 438 candidate)))) 439 strings)) 440 441(defun erc-unique-substring-1 (candidate others) 442 "Return non-nil when any string in OTHERS starts with CANDIDATE." 443 (let (result other (maxlen (length candidate))) 444 (while (and others 445 (not result)) 446 (setq other (car others) 447 others (cdr others)) 448 (when (and (>= (length other) maxlen) 449 (string= candidate (substring other 0 maxlen))) 450 (setq result other))) 451 result)) 452 453;;; Minor mode 454 455;; Play nice with other IRC clients (and Emacs development rules) by 456;; making this a minor mode 457 458(defvar erc-track-minor-mode-map (make-sparse-keymap) 459 "Keymap for rcirc track minor mode.") 460 461(define-key erc-track-minor-mode-map (kbd "C-c C-@") #'erc-track-switch-buffer) 462(define-key erc-track-minor-mode-map (kbd "C-c C-SPC") 463 #'erc-track-switch-buffer) 464 465;;;###autoload 466(define-minor-mode erc-track-minor-mode 467 "Toggle mode line display of ERC activity (ERC Track minor mode). 468 469ERC Track minor mode is a global minor mode. It exists for the 470sole purpose of providing the C-c C-SPC and C-c C-@ keybindings. 471Make sure that you have enabled the track module, otherwise the 472keybindings will not do anything useful." 473 :global t) 474 475(defun erc-track-minor-mode-maybe (&optional buffer) 476 "Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'." 477 (when (and (not erc-track-minor-mode) 478 ;; don't start the minor mode until we have an ERC 479 ;; process running, because we don't want to prompt the 480 ;; user while starting Emacs 481 (or (and (buffer-live-p buffer) 482 (with-current-buffer buffer (eq major-mode 'erc-mode))) 483 (erc-buffer-list))) 484 (cond ((eq erc-track-enable-keybindings 'ask) 485 (let ((key (or (and (key-binding (kbd "C-c C-SPC")) "C-SPC") 486 (and (key-binding (kbd "C-c C-@")) "C-@")))) 487 (if key 488 (if (y-or-n-p 489 (concat "The C-c " key " binding is in use;" 490 " override it for tracking? ")) 491 (progn 492 (message (concat "Will change it; set" 493 " `erc-track-enable-keybindings'" 494 " to disable this message")) 495 (sleep-for 3) 496 (erc-track-minor-mode 1)) 497 (message (concat "Not changing it; set" 498 " `erc-track-enable-keybindings'" 499 " to disable this message")) 500 (sleep-for 3)) 501 (erc-track-minor-mode 1)))) 502 ((eq erc-track-enable-keybindings t) 503 (erc-track-minor-mode 1)) 504 (t nil)))) 505 506;;; Module 507 508;;;###autoload(autoload 'erc-track-mode "erc-track" nil t) 509(define-erc-module track nil 510 "This mode tracks ERC channel buffers with activity." 511 ;; Enable: 512 ((when (boundp 'erc-track-when-inactive) 513 (if erc-track-when-inactive 514 (progn 515 (add-hook 'window-configuration-change-hook #'erc-user-is-active) 516 (add-hook 'erc-send-completed-hook #'erc-user-is-active) 517 (add-hook 'erc-server-001-functions #'erc-user-is-active)) 518 (erc-track-add-to-mode-line erc-track-position-in-mode-line) 519 (erc-update-mode-line) 520 (add-hook 'window-configuration-change-hook 521 #'erc-window-configuration-change) 522 (add-hook 'erc-insert-post-hook #'erc-track-modified-channels) 523 (add-hook 'erc-disconnected-hook #'erc-modified-channels-update)) 524 ;; enable the tracking keybindings 525 (add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe) 526 (erc-track-minor-mode-maybe))) 527 ;; Disable: 528 ((when (boundp 'erc-track-when-inactive) 529 (erc-track-remove-from-mode-line) 530 (if erc-track-when-inactive 531 (progn 532 (remove-hook 'window-configuration-change-hook 533 #'erc-user-is-active) 534 (remove-hook 'erc-send-completed-hook #'erc-user-is-active) 535 (remove-hook 'erc-server-001-functions #'erc-user-is-active) 536 (remove-hook 'erc-timer-hook #'erc-user-is-active)) 537 (remove-hook 'window-configuration-change-hook 538 #'erc-window-configuration-change) 539 (remove-hook 'erc-disconnected-hook #'erc-modified-channels-update) 540 (remove-hook 'erc-insert-post-hook #'erc-track-modified-channels)) 541 ;; disable the tracking keybindings 542 (remove-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe) 543 (when erc-track-minor-mode 544 (erc-track-minor-mode -1))))) 545 546(defcustom erc-track-when-inactive nil 547 "Enable channel tracking even for visible buffers, if you are inactive." 548 :type 'boolean 549 :set (lambda (sym val) 550 (if erc-track-mode 551 (progn 552 (erc-track-disable) 553 (set sym val) 554 (erc-track-enable)) 555 (set sym val)))) 556 557;;; Visibility 558 559(defvar erc-buffer-activity nil 560 "Last time the user sent something.") 561 562(defvar erc-buffer-activity-timeout 10 563 "How many seconds of inactivity by the user 564to consider when `erc-track-visibility' is set to 565only consider active buffers visible.") 566 567(defun erc-user-is-active (&rest _ignore) 568 "Set `erc-buffer-activity'." 569 (when erc-server-connected 570 (setq erc-buffer-activity (erc-current-time)) 571 (erc-track-modified-channels))) 572 573(defun erc-track-get-buffer-window (buffer frame-param) 574 (if (eq frame-param 'selected-visible) 575 (if (eq (frame-visible-p (selected-frame)) t) 576 (get-buffer-window buffer nil) 577 nil) 578 (get-buffer-window buffer frame-param))) 579 580(defun erc-buffer-visible (buffer) 581 "Return non-nil when the buffer is visible." 582 (if erc-track-when-inactive 583 (when erc-buffer-activity; could be nil 584 (and (erc-track-get-buffer-window buffer erc-track-visibility) 585 (not (time-less-p erc-buffer-activity-timeout 586 (erc-time-diff erc-buffer-activity nil))))) 587 (erc-track-get-buffer-window buffer erc-track-visibility))) 588 589;;; Tracking the channel modifications 590 591(defun erc-window-configuration-change () 592 (unless (minibuffer-window-active-p (minibuffer-window)) 593 ;; delay this until command has finished to make sure window is 594 ;; actually visible before clearing activity 595 (erc-modified-channels-update))) 596 597(defvar erc-modified-channels-update-inside nil 598 "Variable to prevent running `erc-modified-channels-update' multiple times. 599Without it, you cannot debug `erc-modified-channels-display', 600because the debugger also causes changes to the 601window-configuration.") 602 603(defun erc-modified-channels-update (&rest _args) 604 "Update `erc-modified-channels-alist' according to buffer visibility. 605It calls `erc-modified-channels-display' at the end. This should 606usually be called via `window-configuration-change-hook'. 607ARGS are ignored." 608 (interactive) 609 (unless erc-modified-channels-update-inside 610 (let ((erc-modified-channels-update-inside t) 611 (removed-channel nil)) 612 (mapc (lambda (elt) 613 (let ((buffer (car elt))) 614 (when (or (not (bufferp buffer)) 615 (not (buffer-live-p buffer)) 616 (erc-buffer-visible buffer) 617 (and erc-track-remove-disconnected-buffers 618 (not (with-current-buffer buffer 619 erc-server-connected)))) 620 (setq removed-channel t) 621 (erc-modified-channels-remove-buffer buffer)))) 622 erc-modified-channels-alist) 623 (when removed-channel 624 (erc-modified-channels-display))))) 625 626(defvar erc-track-mouse-face 'mode-line-highlight 627 "The face to use when mouse is over channel names in the mode line.") 628 629(defun erc-make-mode-line-buffer-name (string buffer &optional faces count) 630 "Return a button that switches to BUFFER when clicked. 631STRING is the string in the button. It is possibly suffixed with 632the number of unread messages, according to variables 633`erc-track-showcount' and `erc-track-showcount-string'. 634 635If `erc-track-use-faces' is true and FACES are provided, format 636STRING with them. When the mouse hovers above the button, STRING 637is displayed according to `erc-track-mouse-face'." 638 ;; We define a new sparse keymap every time, because 1. this data 639 ;; structure is very small, the alternative would require us to 640 ;; defvar a keymap, 2. the user is not interested in customizing it 641 ;; (really?), 3. the defun needs to switch to BUFFER, so we would 642 ;; need to save that value somewhere. 643 (let ((map (make-sparse-keymap)) 644 (name (if erc-track-showcount 645 (concat string 646 erc-track-showcount-string 647 (int-to-string count)) 648 (copy-sequence string)))) 649 (define-key map (vector 'mode-line 'mouse-2) 650 (lambda (e) 651 (interactive "e") 652 (save-selected-window 653 (select-window 654 (posn-window (event-start e))) 655 (switch-to-buffer buffer)))) 656 (define-key map (vector 'mode-line 'mouse-3) 657 (lambda (e) 658 (interactive "e") 659 (save-selected-window 660 (select-window 661 (posn-window (event-start e))) 662 (switch-to-buffer-other-window buffer)))) 663 (put-text-property 0 (length name) 'local-map map name) 664 (put-text-property 665 0 (length name) 666 'help-echo (concat "mouse-2: switch to buffer, " 667 "mouse-3: switch to buffer in other window") 668 name) 669 (put-text-property 0 (length name) 'mouse-face erc-track-mouse-face name) 670 (when (and faces erc-track-use-faces) 671 (put-text-property 0 (length name) 'face faces name)) 672 name)) 673 674(defun erc-modified-channels-display () 675 "Set `erc-modified-channels-object' according to `erc-modified-channels-alist'. 676Use `erc-make-mode-line-buffer-name' to create buttons." 677 (cond ((or (eq 'mostactive erc-track-switch-direction) 678 (eq 'leastactive erc-track-switch-direction)) 679 (erc-track-sort-by-activest)) 680 ((eq 'importance erc-track-switch-direction) 681 (erc-track-sort-by-importance))) 682 (run-hooks 'erc-track-list-changed-hook) 683 (when erc-track-position-in-mode-line 684 (let* ((oldobject erc-modified-channels-object) 685 (strings 686 (when erc-modified-channels-alist 687 ;; erc-modified-channels-alist contains all the data we need. To 688 ;; better understand what is going on, we split things up into 689 ;; four lists: BUFFERS, COUNTS, SHORT-NAMES, and FACES. These 690 ;; four lists we use to create a new 691 ;; `erc-modified-channels-object' using 692 ;; `erc-make-mode-line-buffer-name'. 693 (let* ((buffers (mapcar #'car erc-modified-channels-alist)) 694 (counts (mapcar #'cadr erc-modified-channels-alist)) 695 (faces (mapcar #'cddr erc-modified-channels-alist)) 696 (long-names (mapcar (lambda (buf) 697 (or (buffer-name buf) 698 "")) 699 buffers)) 700 (short-names (if (functionp erc-track-shorten-function) 701 (funcall erc-track-shorten-function 702 long-names) 703 long-names)) 704 strings) 705 (while buffers 706 (when (car short-names) 707 (setq strings (cons (erc-make-mode-line-buffer-name 708 (car short-names) 709 (car buffers) 710 (car faces) 711 (car counts)) 712 strings))) 713 (setq short-names (cdr short-names) 714 buffers (cdr buffers) 715 counts (cdr counts) 716 faces (cdr faces))) 717 strings))) 718 (newobject (erc-modified-channels-object strings))) 719 (unless (equal-including-properties oldobject newobject) 720 (setq erc-modified-channels-object newobject) 721 (force-mode-line-update t))))) 722 723(defun erc-modified-channels-remove-buffer (buffer) 724 "Remove BUFFER from `erc-modified-channels-alist'." 725 (interactive "bBuffer: ") 726 (setq erc-modified-channels-alist 727 (delete (assq buffer erc-modified-channels-alist) 728 erc-modified-channels-alist)) 729 (when (called-interactively-p 'interactive) 730 (erc-modified-channels-display))) 731 732(defun erc-track-find-face (faces) 733 "Return the face to use in the mode line." 734 (declare (obsolete erc-track-select-mode-line-face "28.1")) 735 (erc-track-select-mode-line-face (car faces) (cdr faces))) 736 737(defun erc-track-select-mode-line-face (cur-face new-faces) 738 "Return the face to use in the mode line. 739 740CUR-FACE is the face currently used in the mode line (for the 741current buffer). NEW-FACES is the list of new faces that have 742just been seen (in the current buffer). 743 744Initially, the selected face is the one with highest priority in 745`erc-track-faces-priority-list' (i.e., the one closest to the 746front of the list) among CUR-FACE and NEW-FACES. If nothing 747matches (including if `erc-track-faces-priority-list' is not 748set), the default mode-line faces will be used (NIL is returned). 749 750If the selected face is still CUR-FACE (highest priority), and 751the highest priority face in NEW-FACES alone is different (which 752necessarily means it has lower priority than CUR-FACE), and both 753are in `erc-track-faces-normal-list', then the latter is selected 754instead. This has the effect of allowing the current mode line 755face, if a member of `erc-track-faces-normal-list', to be 756replaced with another with lower priority face from NEW-FACES, if 757that face with highest priority in NEW-FACES is also a member of 758`erc-track-faces-normal-list'." 759 (let ((choice (catch 'face 760 (dolist (candidate erc-track-faces-priority-list) 761 (when (or (equal candidate cur-face) 762 (member candidate new-faces)) 763 (throw 'face candidate)))))) 764 (when choice 765 (if (and (equal choice cur-face) 766 (member choice erc-track-faces-normal-list)) 767 (let ((only-in-new 768 (catch 'face 769 (dolist (candidate erc-track-faces-priority-list) 770 (when (member candidate new-faces) 771 (throw 'face candidate)))))) 772 (if (member only-in-new erc-track-faces-normal-list) 773 only-in-new 774 choice)) 775 choice)))) 776 777(defun erc-track-modified-channels () 778 "Hook function for `erc-insert-post-hook'. 779Check if the current buffer should be added to the mode line as a 780hidden, modified channel. Assumes it will only be called when 781the current buffer is in `erc-mode'." 782 (let ((this-channel (or (erc-default-target) 783 (buffer-name (current-buffer))))) 784 (if (and (not (erc-buffer-visible (current-buffer))) 785 (not (member this-channel erc-track-exclude)) 786 (not (and erc-track-exclude-server-buffer 787 (erc-server-buffer-p))) 788 (not (erc-message-type-member 789 (or (erc-find-parsed-property) 790 (point-min)) 791 erc-track-exclude-types))) 792 ;; If the active buffer is not visible (not shown in a 793 ;; window), and not to be excluded, determine the kinds of 794 ;; faces used in the current message, and unless the user 795 ;; wants to ignore changes in certain channels where there 796 ;; are no faces corresponding to `erc-track-faces-priority-list', 797 ;; and the faces in the current message are found in said 798 ;; priority list, add the buffer to the erc-modified-channels-alist, 799 ;; if it is not already there. If the buffer is already on the list 800 ;; (in the car), change its face attribute (in the cddr) if 801 ;; necessary. See `erc-modified-channels-alist' for the 802 ;; exact data structure used. 803 (let ((faces (erc-faces-in (buffer-string)))) 804 (unless (and 805 (or (eq erc-track-priority-faces-only 'all) 806 (member this-channel erc-track-priority-faces-only)) 807 (not (catch 'found 808 (dolist (f faces) 809 (when (member f erc-track-faces-priority-list) 810 (throw 'found t)))))) 811 (if (not (assq (current-buffer) erc-modified-channels-alist)) 812 ;; Add buffer, faces and counts 813 (setq erc-modified-channels-alist 814 (cons (cons (current-buffer) 815 (cons 816 1 (erc-track-select-mode-line-face 817 nil faces))) 818 erc-modified-channels-alist)) 819 ;; Else modify the face for the buffer, if necessary. 820 (when faces 821 (let* ((cell (assq (current-buffer) 822 erc-modified-channels-alist)) 823 (old-face (cddr cell)) 824 (new-face (erc-track-select-mode-line-face 825 old-face faces))) 826 (setcdr cell (cons (1+ (cadr cell)) new-face))))) 827 ;; And display it 828 (erc-modified-channels-display))) 829 ;; Else if the active buffer is the current buffer, remove it 830 ;; from our list. 831 (when (and (or (erc-buffer-visible (current-buffer)) 832 (and this-channel 833 (member this-channel erc-track-exclude))) 834 (assq (current-buffer) erc-modified-channels-alist)) 835 ;; Remove it from mode-line if buffer is visible or 836 ;; channel was added to erc-track-exclude recently. 837 (erc-modified-channels-remove-buffer (current-buffer)) 838 (erc-modified-channels-display))))) 839 840(defun erc-faces-in (str) 841 "Return a list of all faces used in STR." 842 (let ((i 0) 843 (m (length str)) 844 (faces (let ((face1 (get-text-property 0 'face str))) 845 (when face1 (list face1)))) 846 cur) 847 (while (and (setq i (next-single-property-change i 'face str m)) 848 (not (= i m))) 849 (and (setq cur (get-text-property i 'face str)) 850 (not (member cur faces)) 851 (push cur faces))) 852 faces)) 853 854;;; Buffer switching 855 856(defvar erc-track-last-non-erc-buffer nil 857 "Name of the last buffer before activating `erc-track-switch-buffer'.") 858 859(defun erc-track-sort-by-activest () 860 "Sort erc-modified-channels-alist by activity. 861That means the number of unseen messages in a channel." 862 (setq erc-modified-channels-alist 863 (sort erc-modified-channels-alist 864 (lambda (a b) (> (nth 1 a) (nth 1 b)))))) 865 866(defun erc-track-face-priority (face) 867 "Return priority (a number) of FACE in `erc-track-faces-priority-list'. 868Lower number means higher priority. 869 870If face is not in `erc-track-faces-priority-list', it will have a 871higher number than any other face in that list." 872 (let ((count 0)) 873 (catch 'done 874 (dolist (item erc-track-faces-priority-list) 875 (if (equal item face) 876 (throw 'done t) 877 (setq count (1+ count))))) 878 count)) 879 880(defun erc-track-sort-by-importance () 881 "Sort `erc-modified-channels-alist' by importance. 882That means the position of the face in `erc-track-faces-priority-list'." 883 (setq erc-modified-channels-alist 884 (sort erc-modified-channels-alist 885 (lambda (a b) (< (erc-track-face-priority (cddr a)) 886 (erc-track-face-priority (cddr b))))))) 887 888(defun erc-track-get-active-buffer (arg) 889 "Return the buffer name of ARG in `erc-modified-channels-alist'. 890Negative arguments index in the opposite direction. This direction 891is relative to `erc-track-switch-direction'." 892 (let ((dir erc-track-switch-direction) 893 offset) 894 (when (< arg 0) 895 (setq dir (pcase dir 896 ('oldest 'newest) 897 ('newest 'oldest) 898 ('mostactive 'leastactive) 899 ('leastactive 'mostactive) 900 ('importance 'oldest))) 901 (setq arg (- arg))) 902 (setq offset (pcase dir 903 ((or 'oldest 'leastactive) 904 (- (length erc-modified-channels-alist) arg)) 905 (_ (1- arg)))) 906 ;; normalize out of range user input 907 (cond ((>= offset (length erc-modified-channels-alist)) 908 (setq offset (1- (length erc-modified-channels-alist)))) 909 ((< offset 0) 910 (setq offset 0))) 911 (car (nth offset erc-modified-channels-alist)))) 912 913(defun erc-track--switch-buffer (fun arg) 914 (if (not erc-track-mode) 915 (message (concat "Enable the ERC track module if you want to use the" 916 " tracking minor mode")) 917 (cond (erc-modified-channels-alist 918 ;; if we're not in erc-mode, set this buffer to return to 919 (unless (eq major-mode 'erc-mode) 920 (setq erc-track-last-non-erc-buffer (current-buffer))) 921 ;; and jump to the next active channel 922 (funcall fun (erc-track-get-active-buffer arg))) 923 ;; if no active channels, switch back to what we were doing before 924 ((and erc-track-last-non-erc-buffer 925 erc-track-switch-from-erc 926 (buffer-live-p erc-track-last-non-erc-buffer)) 927 (funcall fun erc-track-last-non-erc-buffer))))) 928 929(defun erc-track-switch-buffer (arg) 930 "Switch to the next active ERC buffer. 931If there are no active ERC buffers, switch back to the last 932non-ERC buffer visited. The order of buffers is defined by 933`erc-track-switch-direction', and a negative argument will 934reverse it." 935 (interactive "p") 936 (erc-track--switch-buffer 'switch-to-buffer arg)) 937 938(defun erc-track-switch-buffer-other-window (arg) 939 "Switch to the next active ERC buffer in another window. 940If there are no active ERC buffers, switch back to the last 941non-ERC buffer visited. The order of buffers is defined by 942`erc-track-switch-direction', and a negative argument will 943reverse it." 944 (interactive "p") 945 (erc-track--switch-buffer 'switch-to-buffer-other-window arg)) 946 947(provide 'erc-track) 948 949;;; erc-track.el ends here 950;; 951;; Local Variables: 952;; generated-autoload-file: "erc-loaddefs.el" 953;; End: 954