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