1 ;;; erc-track.el --- Track modified channel buffers
3 ;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
5 ;; Author: Mario Lang <mlang@delysid.org>
6 ;; Keywords: comm, faces
7 ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcChannelTracking
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
28 ;; Highlights keywords and pals (friends), and hides or highlights fools
29 ;; (using a dark color). Add to your ~/.emacs:
31 ;; (require 'erc-track)
35 ;; * Add extensibility so that custom functions can track
36 ;; custom modification types.
38 (eval-when-compile (require 'cl))
45 (defconst erc-track-version "$Revision: 1.86.2.1 $"
46 "ERC track mode revision")
48 (defgroup erc-track nil
49 "Track active buffers and show activity in the modeline."
52 (defcustom erc-track-visibility t
53 "Where do we look for buffers to determine their visibility?
54 The value of this variable determines, when a buffer is considered
55 visible or invisible. New messages in invisible buffers are tracked,
56 while switching to visible buffers when they are tracked removes them
57 from the list. See also `erc-track-when-inactive-mode'.
62 visible - all visible frames
63 nil - only the selected frame
64 selected-visible - only the selected frame if it is visible
66 Activity means that there was no user input in the last 10 seconds."
68 :type '(choice (const :tag "All frames" t)
69 (const :tag "All visible frames" visible)
70 (const :tag "Only the selected frame" nil)
71 (const :tag "Only the selected frame if it was active"
74 (defcustom erc-track-exclude nil
75 "A list targets (channel names or query targets) which should not be tracked."
77 :type '(repeat string))
79 (defcustom erc-track-exclude-types '("NICK")
80 "*List of message types to be ignored.
81 This list could look like '(\"JOIN\" \"PART\")."
83 :type 'erc-message-type)
85 (defcustom erc-track-exclude-server-buffer nil
86 "*If true, don't perform tracking on the server buffer; this is
87 useful for excluding all the things like MOTDs from the server and
88 other miscellaneous functions."
92 (defcustom erc-track-shorten-start 1
93 "This number specifies the minimum number of characters a channel name in
94 the mode-line should be reduced to."
98 (defcustom erc-track-shorten-cutoff 4
99 "All channel names longer than this value will be shortened."
103 (defcustom erc-track-shorten-aggressively nil
104 "*If non-nil, channel names will be shortened more aggressively.
105 Usually, names are not shortened if this will save only one character.
106 Example: If there are two channels, #linux-de and #linux-fr, then
107 normally these will not be shortened. When shortening aggressively,
108 however, these will be shortened to #linux-d and #linux-f.
110 If this variable is set to `max', then channel names will be shortened
111 to the max. Usually, shortened channel names will remain unique for a
112 given set of existing channels. When shortening to the max, the shortened
113 channel names will be unique for the set of active channels only.
114 Example: If there are tow active channels #emacs and #vi, and two inactive
115 channels #electronica and #folk, then usually the active channels are
116 shortened to #em and #v. When shortening to the max, however, #emacs is
117 not compared to #electronica -- only to #vi, therefore it can be shortened
118 even more and the result is #e and #v.
120 This setting is used by `erc-track-shorten-names'."
122 :type '(choice (const :tag "No" nil)
124 (const :tag "Max" max)))
126 (defcustom erc-track-shorten-function 'erc-track-shorten-names
127 "*This function will be used to reduce the channel names before display.
128 It takes one argument, CHANNEL-NAMES which is a list of strings.
129 It should return a list of strings of the same number of elements.
130 If nil instead of a function, shortening is disabled."
132 :type '(choice (const :tag "Disabled")
135 (defcustom erc-track-use-faces t
136 "*Use faces in the mode-line.
137 The faces used are the same as used for text in the buffers.
138 \(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)"
142 (defcustom erc-track-faces-priority-list
143 '(erc-error-face erc-current-nick-face erc-keyword-face erc-pal-face
144 erc-nick-msg-face erc-direct-msg-face erc-button erc-dangerous-host-face
145 erc-default-face erc-action-face erc-nick-default-face erc-fool-face
146 erc-notice-face erc-input-face erc-prompt-face)
147 "A list of faces used to highlight active buffer names in the modeline.
148 If a message contains one of the faces in this list, the buffer name will
149 be highlighted using that face. The first matching face is used."
151 :type '(repeat face))
153 (defcustom erc-track-priority-faces-only nil
154 "Only track text highlighted with a priority face.
155 If you would like to ignore changes in certain channels where there
156 are no faces corresponding to your `erc-track-faces-priority-list', set
157 this variable. You can set a list of channel name strings, so those
158 will be ignored while all other channels will be tracked as normal.
159 Other options are 'all, to apply this to all channels or nil, to disable
161 Note: If you have a lot of faces listed in `erc-track-faces-priority-list',
162 setting this variable might not be very useful."
164 :type '(choice (const nil)
168 (defcustom erc-track-position-in-mode-line 'before-modes
169 "Where to show modified channel information in the mode-line.
171 Setting this variable only has effects in GNU Emacs versions above 21.3.
174 'before-modes - add to the beginning of `mode-line-modes'
175 'after-modes - add to the end of `mode-line-modes'
177 Any other value means add to the end of `global-mode-string'."
179 :type '(choice (const :tag "Just before mode information" before-modes)
180 (const :tag "Just after mode information" after-modes)
181 (const :tag "After all other information" nil))
182 :set (lambda (sym val)
184 (when (and (boundp 'erc-track-mode)
186 (erc-track-remove-from-mode-line)
187 (erc-track-add-to-mode-line val))))
189 (defun erc-modified-channels-object (strings)
190 "Generate a new `erc-modified-channels-object' based on STRINGS.
191 If STRINGS is nil, we initialize `erc-modified-channels-object' to
192 an appropriate initial value for this flavor of Emacs."
194 (if (featurep 'xemacs)
195 (let ((e-m-c-s '("[")))
196 (push (cons (extent-at 0 (car strings)) (car strings))
198 (dolist (string (cdr strings))
200 (push (cons (extent-at 0 string) string)
204 (concat (if (eq erc-track-position-in-mode-line 'after-modes)
206 (mapconcat 'identity (nreverse strings) ",")
207 (if (eq erc-track-position-in-mode-line 'before-modes)
209 (if (featurep 'xemacs) '() "")))
211 (defvar erc-modified-channels-object (erc-modified-channels-object nil)
212 "Internal object used for displaying modified channels in the mode line.")
214 (put 'erc-modified-channels-object 'risky-local-variable t); allow properties
216 (defvar erc-modified-channels-alist nil
217 "An ALIST used for tracking channel modification activity.
218 Each element looks like (BUFFER COUNT FACE) where BUFFER is a buffer
219 object of the channel the entry corresponds to, COUNT is a number
220 indicating how often activity was noticed, and FACE is the face to use
221 when displaying the buffer's name. See `erc-track-faces-priority-list',
222 and `erc-track-showcount'.
224 Entries in this list should only happen for buffers where activity occurred
225 while the buffer was not visible.")
227 (defcustom erc-track-showcount nil
228 "If non-nil, count of unseen messages will be shown for each channel."
232 (defcustom erc-track-showcount-string ":"
233 "The string to display between buffer name and the count in the mode line.
234 The default is a colon, resulting in \"#emacs:9\"."
238 (defcustom erc-track-switch-from-erc t
239 "If non-nil, `erc-track-switch-buffer' will return to the last non-erc buffer
240 when there are no more active channels."
244 (defcustom erc-track-switch-direction 'oldest
245 "Direction `erc-track-switch-buffer' should switch.
247 oldest - find oldest active buffer
248 newest - find newest active buffer
249 leastactive - find buffer with least unseen messages
250 mostactive - find buffer with most unseen messages."
252 :type '(choice (const oldest)
258 (defun erc-track-remove-from-mode-line ()
259 "Remove `erc-track-modified-channels' from the mode-line"
260 (when (boundp 'mode-line-modes)
261 (setq mode-line-modes
262 (remove '(t erc-modified-channels-object) mode-line-modes)))
263 (when (consp global-mode-string)
264 (setq global-mode-string
265 (delq 'erc-modified-channels-object global-mode-string))))
267 (defun erc-track-add-to-mode-line (position)
268 "Add `erc-track-modified-channels' to POSITION in the mode-line.
269 See `erc-track-position-in-mode-line' for possible values."
270 ;; CVS Emacs has a new format string, and global-mode-string
271 ;; is very far to the right.
272 (cond ((and (eq position 'before-modes)
273 (boundp 'mode-line-modes))
274 (add-to-list 'mode-line-modes
275 '(t erc-modified-channels-object)))
276 ((and (eq position 'after-modes)
277 (boundp 'mode-line-modes))
278 (add-to-list 'mode-line-modes
279 '(t erc-modified-channels-object) t))
281 (when (not global-mode-string)
282 (setq global-mode-string '(""))) ; Padding for mode-line wart
283 (add-to-list 'global-mode-string
284 'erc-modified-channels-object
287 ;;; Shortening of names
289 (defun erc-track-shorten-names (channel-names)
290 "Call `erc-unique-channel-names' with the correct parameters.
291 This function is a good value for `erc-track-shorten-function'.
292 The list of all channels is returned by `erc-all-buffer-names'.
293 CHANNEL-NAMES is the list of active channel names.
294 Only channel names longer than `erc-track-shorten-cutoff' are
295 actually shortened, and they are only shortened to a minimum
296 of `erc-track-shorten-start' characters."
297 (erc-unique-channel-names
298 (erc-all-buffer-names)
301 (> (length s) erc-track-shorten-cutoff))
302 erc-track-shorten-start))
304 (defvar erc-default-recipients)
306 (defun erc-all-buffer-names ()
307 "Return all channel or query buffer names.
308 Note that we cannot use `erc-channel-list' with a nil argument,
309 because that does not return query buffers."
312 (dolist (buf (buffer-list))
314 (when (or (eq major-mode 'erc-mode) (eq major-mode 'erc-dcc-chat-mode))
315 (setq result (cons (buffer-name) result))))
318 (defun erc-unique-channel-names (all active &optional predicate start)
319 "Return a list of unique channel names.
320 ALL is the list of all channel and query buffer names.
321 ACTIVE is the list of active buffer names.
322 PREDICATE is a predicate that should return non-nil if a name needs
324 START is the minimum length of the name used."
325 (if (eq 'max erc-track-shorten-aggressively)
326 ;; Return the unique substrings of all active channels.
327 (erc-unique-substrings active predicate start)
328 ;; Otherwise, determine the unique substrings of all channels, and
329 ;; for every active channel, return the corresponding substring.
330 ;; Given the names of the active channels, we now need to find the
331 ;; corresponding short name from the list of all substrings. To
332 ;; avoid problems when there are two channels and one is a
333 ;; substring of the other (notorious examples are #hurd and
334 ;; #hurd-bunny), every candidate gets the longest possible
336 (let ((all-substrings (sort
337 (erc-unique-substrings all predicate start)
338 (lambda (a b) (> (length a) (length b)))))
340 (dolist (channel active)
341 (let ((substrings all-substrings)
344 (while (and substrings (not winner))
345 (setq candidate (car substrings)
346 substrings (cdr substrings))
347 (when (and (string= candidate
350 (min (length candidate)
352 (not (member candidate result)))
353 (setq winner candidate)))
354 (setq result (cons winner result))))
357 (defun erc-unique-substrings (strings &optional predicate start)
358 "Return a list of unique substrings of STRINGS."
359 (if (or (not (numberp start))
364 (let* ((others (delete str (copy-sequence strings)))
365 (maxlen (length str))
370 (if (and (functionp predicate) (not (funcall predicate str)))
371 ;; do not shorten if a predicate exists and it returns nil
373 ;; Start with smallest substring candidate, ie. length 1.
374 ;; Then check all the others and see whether any of them starts
375 ;; with the same substring. While there is such another
376 ;; element in the list, increase the length of the candidate.
380 (setq candidate (substring str 0 i)
381 done (not (erc-unique-substring-1 candidate others))))
383 (if (and (= (length candidate) (1- maxlen))
384 (not erc-track-shorten-aggressively))
389 (defun erc-unique-substring-1 (candidate others)
390 "Return non-nil when any string in OTHERS starts with CANDIDATE."
391 (let (result other (maxlen (length candidate)))
394 (setq other (car others)
396 (when (and (>= (length other) maxlen)
397 (string= candidate (substring other 0 maxlen)))
398 (setq result other)))
405 ;; verify examples from the doc strings
406 (equal (let ((erc-track-shorten-aggressively nil))
407 (erc-unique-channel-names
408 '("#emacs" "#vi" "#electronica" "#folk")
410 '("#em" "#vi")) ; emacs is different from electronica
411 (equal (let ((erc-track-shorten-aggressively t))
412 (erc-unique-channel-names
413 '("#emacs" "#vi" "#electronica" "#folk")
415 '("#em" "#v")) ; vi is shortened by one letter
416 (equal (let ((erc-track-shorten-aggressively 'max))
417 (erc-unique-channel-names
418 '("#emacs" "#vi" "#electronica" "#folk")
420 '("#e" "#v")) ; emacs need not be different from electronica
421 (equal (let ((erc-track-shorten-aggressively nil))
422 (erc-unique-channel-names
423 '("#linux-de" "#linux-fr")
424 '("#linux-de" "#linux-fr")))
425 '("#linux-de" "#linux-fr")) ; shortening by one letter is too aggressive
426 (equal (let ((erc-track-shorten-aggressively t))
427 (erc-unique-channel-names
428 '("#linux-de" "#linux-fr")
429 '("#linux-de" "#linux-fr")))
430 '("#linux-d" "#linux-f")); now we want to be aggressive
432 (equal (let ((erc-track-shorten-aggressively nil))
433 (erc-unique-channel-names
434 '("#dunnet" "#lisp" "#sawfish" "#fsf" "#guile"
435 "#testgnome" "#gnu" "#fsbot" "#hurd" "#hurd-bunny"
437 '("#hurd-bunny" "#hurd" "#sawfish" "#lisp")))
438 '("#hurd-" "#hurd" "#s" "#l"))
439 (equal (let ((erc-track-shorten-aggressively nil))
440 (erc-unique-substrings
441 '("#emacs" "#vi" "#electronica" "#folk")))
442 '("#em" "#vi" "#el" "#f"))
443 (equal (let ((erc-track-shorten-aggressively t))
444 (erc-unique-substrings
445 '("#emacs" "#vi" "#electronica" "#folk")))
446 '("#em" "#v" "#el" "#f"))
447 (equal (let ((erc-track-shorten-aggressively nil))
448 (erc-unique-channel-names
449 '("#emacs" "#burse" "+linux.de" "#starwars"
450 "#bitlbee" "+burse" "#ratpoison")
451 '("+linux.de" "#starwars" "#burse")))
453 (equal (let ((erc-track-shorten-aggressively nil))
454 (erc-unique-channel-names
455 '("fsbot" "#emacs" "deego")
458 (equal (let ((erc-track-shorten-aggressively nil))
459 (erc-unique-channel-names
460 '("fsbot" "#emacs" "deego")
466 (equal (let ((erc-track-shorten-aggressively nil))
467 (erc-unique-channel-names
468 '("fsbot" "#emacs" "deego")
474 (let ((erc-track-shorten-aggressively nil))
475 (equal (erc-unique-channel-names '("deego" "#hurd" "#hurd-bunny" "#emacs")
476 '("#hurd" "#hurd-bunny"))
477 '("#hurd" "#hurd-")))
479 (let ((erc-track-shorten-aggressively t))
480 (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
481 (not (erc-unique-substring-1 "a" '("xyz" "xab")))
482 (equal (erc-unique-substrings '("abc" "xyz" "xab"))
484 (equal (erc-unique-substrings '("abc" "abcdefg"))
486 (let ((erc-track-shorten-aggressively nil))
487 (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
488 (not (erc-unique-substring-1 "a" '("xyz" "xab")))
489 (equal (erc-unique-substrings '("abc" "xyz" "xab"))
490 '("abc" "xyz" "xab"))
491 (equal (erc-unique-substrings '("abc" "abcdefg"))
496 ;;;###autoload (autoload 'erc-track-mode "erc-track" nil t)
497 (define-erc-module track track-modified-channels
498 "This mode tracks ERC channel buffers with activity."
499 ((erc-track-add-to-mode-line erc-track-position-in-mode-line)
500 (setq erc-modified-channels-object (erc-modified-channels-object nil))
501 (erc-update-mode-line)
502 (if (featurep 'xemacs)
503 (defadvice switch-to-buffer (after erc-update (&rest args) activate)
504 (erc-modified-channels-update))
505 (add-hook 'window-configuration-change-hook 'erc-modified-channels-update))
506 (add-hook 'erc-insert-post-hook 'erc-track-modified-channels)
507 (add-hook 'erc-disconnected-hook 'erc-modified-channels-update))
508 ((erc-track-remove-from-mode-line)
509 (if (featurep 'xemacs)
510 (ad-disable-advice 'switch-to-buffer 'after 'erc-update)
511 (remove-hook 'window-configuration-change-hook
512 'erc-modified-channels-update))
513 (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update)
514 (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels)))
516 ;;;###autoload (autoload 'erc-track-when-inactive-mode "erc-track" nil t)
517 (define-erc-module track-when-inactive nil
518 "This mode enables channel tracking even for visible buffers,
519 if you are inactivity."
520 ((if (featurep 'xemacs)
521 (defadvice switch-to-buffer (after erc-update-when-inactive (&rest args) activate)
522 (erc-user-is-active))
523 (add-hook 'window-configuration-change-hook 'erc-user-is-active))
524 (add-hook 'erc-send-completed-hook 'erc-user-is-active)
525 (add-hook 'erc-server-001-functions 'erc-user-is-active))
526 ((erc-track-remove-from-mode-line)
527 (if (featurep 'xemacs)
528 (ad-disable-advice 'switch-to-buffer 'after 'erc-update-when-inactive)
529 (remove-hook 'window-configuration-change-hook 'erc-user-is-active))
530 (remove-hook 'erc-send-completed-hook 'erc-user-is-active)
531 (remove-hook 'erc-server-001-functions 'erc-user-is-active)
532 (remove-hook 'erc-timer-hook 'erc-user-is-active)))
536 (defvar erc-buffer-activity nil
537 "Last time the user sent something.")
539 (defvar erc-buffer-activity-timeout 10
540 "How many seconds of inactivity by the user
541 to consider when `erc-track-visibility' is set to
542 only consider active buffers visible.")
544 (defun erc-user-is-active (&rest ignore)
545 "Set `erc-buffer-activity'."
546 (setq erc-buffer-activity (erc-current-time))
547 (erc-track-modified-channels))
549 (defun erc-buffer-visible (buffer)
550 "Return non-nil when the buffer is visible."
551 (if erc-track-when-inactive-mode
552 (when erc-buffer-activity; could be nil
553 (and (get-buffer-window buffer erc-track-visibility)
554 (<= (erc-time-diff erc-buffer-activity (erc-current-time))
555 erc-buffer-activity-timeout)))
556 (get-buffer-window buffer erc-track-visibility)))
558 ;;; Tracking the channel modifications
560 (defvar erc-modified-channels-update-inside nil
561 "Variable to prevent running `erc-modified-channels-update' multiple
562 times. Without it, you cannot debug `erc-modified-channels-display',
563 because the debugger also cases changes to the window-configuration.")
565 (defun erc-modified-channels-update (&rest args)
566 "This function updates the information in `erc-modified-channels-alist'
567 according to buffer visibility. It calls
568 `erc-modified-channels-display' at the end. This should usually be
569 called via `window-configuration-change-hook'.
572 (unless erc-modified-channels-update-inside
573 (let ((erc-modified-channels-update-inside t))
574 (mapcar (lambda (elt)
575 (let ((buffer (car elt)))
576 (when (or (not (bufferp buffer))
577 (not (buffer-live-p buffer))
578 (erc-buffer-visible buffer)
579 (not (with-current-buffer buffer
580 erc-server-connected)))
581 (erc-modified-channels-remove-buffer buffer))))
582 erc-modified-channels-alist)
583 (erc-modified-channels-display)
584 (force-mode-line-update t))))
586 (defun erc-make-mode-line-buffer-name (string buffer &optional faces count)
587 "Return STRING as a button that switches to BUFFER when clicked.
588 If FACES are provided, color STRING with them."
589 ;; We define a new sparse keymap every time, because 1. this data
590 ;; structure is very small, the alternative would require us to
591 ;; defvar a keymap, 2. the user is not interested in customizing it
592 ;; (really?), 3. the defun needs to switch to BUFFER, so we would
593 ;; need to save that value somewhere.
594 (let ((map (make-sparse-keymap))
595 (name (if erc-track-showcount
597 erc-track-showcount-string
598 (int-to-string count))
599 (copy-sequence string))))
600 (define-key map (vector 'mode-line 'mouse-2)
603 (save-selected-window
605 (posn-window (event-start e)))
606 (switch-to-buffer ,buffer))))
607 (define-key map (vector 'mode-line 'mouse-3)
610 (save-selected-window
612 (posn-window (event-start e)))
613 (switch-to-buffer-other-window ,buffer))))
614 (put-text-property 0 (length name) 'local-map map name)
615 (when (and faces erc-track-use-faces)
616 (put-text-property 0 (length name) 'face faces name))
619 (defun erc-modified-channels-display ()
620 "Set `erc-modified-channels-object'
621 according to `erc-modified-channels-alist'.
622 Use `erc-make-mode-line-buffer-name' to create buttons."
624 (eq 'mostactive erc-track-switch-direction)
625 (eq 'leastactive erc-track-switch-direction))
626 (erc-track-sort-by-activest))
627 (if (null erc-modified-channels-alist)
628 (setq erc-modified-channels-object (erc-modified-channels-object nil))
629 ;; erc-modified-channels-alist contains all the data we need. To
630 ;; better understand what is going on, we split things up into
631 ;; four lists: BUFFERS, COUNTS, SHORT-NAMES, and FACES. These
632 ;; four lists we use to create a new
633 ;; `erc-modified-channels-object' using
634 ;; `erc-make-mode-line-buffer-name'.
635 (let* ((buffers (mapcar 'car erc-modified-channels-alist))
636 (counts (mapcar 'cadr erc-modified-channels-alist))
637 (faces (mapcar 'cddr erc-modified-channels-alist))
638 (long-names (mapcar #'(lambda (buf)
639 (or (buffer-name buf)
642 (short-names (if (functionp erc-track-shorten-function)
643 (funcall erc-track-shorten-function
648 (when (car short-names)
649 (setq strings (cons (erc-make-mode-line-buffer-name
655 (setq short-names (cdr short-names)
656 buffers (cdr buffers)
659 (when (featurep 'xemacs)
660 (erc-modified-channels-object nil))
661 (setq erc-modified-channels-object
662 (erc-modified-channels-object strings)))))
664 (defun erc-modified-channels-remove-buffer (buffer)
665 "Remove BUFFER from `erc-modified-channels-alist'."
666 (interactive "bBuffer: ")
667 (setq erc-modified-channels-alist
668 (delete (assq buffer erc-modified-channels-alist)
669 erc-modified-channels-alist))
670 (when (interactive-p)
671 (erc-modified-channels-display)))
673 (defun erc-track-find-face (faces)
674 "Return the face to use in the modeline from the faces in FACES.
675 If `erc-track-faces-priority-list' is set, the one from FACES who is
676 first in that list will be used."
677 (let ((candidates erc-track-faces-priority-list)
679 (while (and candidates (not face))
680 (setq candidate (car candidates)
681 candidates (cdr candidates))
682 (when (memq candidate faces)
683 (setq face candidate)))
686 (defun erc-track-modified-channels ()
687 "Hook function for `erc-insert-post-hook' to check if the current
688 buffer should be added to the modeline as a hidden, modified
689 channel. Assumes it will only be called when current-buffer
691 (let ((this-channel (or (erc-default-target)
692 (buffer-name (current-buffer)))))
693 (if (and (not (erc-buffer-visible (current-buffer)))
694 (not (member this-channel erc-track-exclude))
695 (not (and erc-track-exclude-server-buffer
696 (string= this-channel
697 (buffer-name (erc-server-buffer)))))
698 (not (erc-message-type-member
699 (or (erc-find-parsed-property)
701 erc-track-exclude-types)))
702 ;; If the active buffer is not visible (not shown in a
703 ;; window), and not to be excluded, determine the kinds of
704 ;; faces used in the current message, and unless the user
705 ;; wants to ignore changes in certain channels where there
706 ;; are no faces corresponding to `erc-track-faces-priority-list',
707 ;; and the faces in the current message are found in said
708 ;; priority list, add the buffer to the erc-modified-channels-alist,
709 ;; if it is not already there. If the buffer is already on the list
710 ;; (in the car), change its face attribute (in the cddr) if
711 ;; necessary. See `erc-modified-channels-alist' for the
712 ;; exact data structure used.
713 (let ((faces (erc-faces-in (buffer-string))))
715 (or (eq erc-track-priority-faces-only 'all)
716 (member this-channel erc-track-priority-faces-only))
719 (when (member f erc-track-faces-priority-list)
720 (throw 'found t))))))
721 (if (not (assq (current-buffer) erc-modified-channels-alist))
722 ;; Add buffer, faces and counts
723 (setq erc-modified-channels-alist
724 (cons (cons (current-buffer)
725 (cons 1 (erc-track-find-face faces)))
726 erc-modified-channels-alist))
727 ;; Else modify the face for the buffer, if necessary.
729 (let* ((cell (assq (current-buffer)
730 erc-modified-channels-alist))
731 (old-face (cddr cell))
732 (new-face (erc-track-find-face
734 (cons old-face faces)
736 (setcdr cell (cons (1+ (cadr cell)) new-face)))))
738 (erc-modified-channels-display)))
739 ;; Else if the active buffer is the current buffer, remove it
741 (when (or (erc-buffer-visible (current-buffer))
743 (assq (current-buffer) erc-modified-channels-alist)
744 (member this-channel erc-track-exclude)))
745 ;; Remove it from mode-line if buffer is visible or
746 ;; channel was added to erc-track-exclude recently.
747 (erc-modified-channels-remove-buffer (current-buffer))
748 (erc-modified-channels-display)))))
750 (defun erc-faces-in (str)
751 "Return a list of all faces used in STR."
754 (faces (erc-list (get-text-property 0 'face str))))
755 (while (and (setq i (next-single-property-change i 'face str m))
757 (dolist (face (erc-list (get-text-property i 'face str)))
758 (add-to-list 'faces face)))
762 (let ((str "is bold"))
763 (put-text-property 3 (length str)
764 'face '(bold erc-current-nick-face)
768 (defun erc-find-parsed-property ()
769 "Find the next occurrence of the `erc-parsed' text property."
770 (text-property-not-all (point-min) (point-max) 'erc-parsed nil))
774 (defvar erc-track-last-non-erc-buffer nil
775 "Stores the name of the last buffer you were in before activating
776 `erc-track-switch-buffers'")
778 (defun erc-track-sort-by-activest ()
779 "Sort erc-modified-channels-alist by activity.
780 That means the number of unseen messages in a channel."
781 (setq erc-modified-channels-alist
782 (sort erc-modified-channels-alist
783 (lambda (a b) (> (nth 1 a) (nth 1 b))))))
785 (defun erc-track-get-active-buffer (arg)
786 "Return the buffer name of ARG in `erc-modified-channels-alist'.
787 Negative arguments index in the opposite direction. This direction is
788 relative to `erc-track-switch-direction'"
789 (let ((dir erc-track-switch-direction)
795 (mostactive 'leastactive)
796 (leastactive 'mostactive)))
798 (setq offset (case dir
799 ((oldest leastactive)
800 (- (length erc-modified-channels-alist) arg))
802 ;; normalise out of range user input
803 (cond ((>= offset (length erc-modified-channels-alist))
804 (setq offset (1- (length erc-modified-channels-alist))))
807 (car (nth offset erc-modified-channels-alist))))
809 (defun erc-track-switch-buffer (arg)
810 "Switch to the next active ERC buffer, or if there are no active buffers,
811 switch back to the last non-ERC buffer visited. Next is defined by
812 `erc-track-switch-direction', a negative argument will reverse this."
815 (cond (erc-modified-channels-alist
816 ;; if we're not in erc-mode, set this buffer to return to
817 (unless (eq major-mode 'erc-mode)
818 (setq erc-track-last-non-erc-buffer (current-buffer)))
819 ;; and jump to the next active channel
820 (switch-to-buffer (erc-track-get-active-buffer arg)))
821 ;; if no active channels, switch back to what we were doing before
822 ((and erc-track-last-non-erc-buffer
823 erc-track-switch-from-erc
824 (buffer-live-p erc-track-last-non-erc-buffer))
825 (switch-to-buffer erc-track-last-non-erc-buffer)))))
827 ;; These bindings are global, because they pop us from any other
828 ;; buffer to an active ERC buffer!
830 (global-set-key (kbd "C-c C-@") 'erc-track-switch-buffer)
831 (global-set-key (kbd "C-c C-SPC") 'erc-track-switch-buffer)
835 ;;; erc-track.el ends here
838 ;; indent-tabs-mode: t
842 ;; arch-tag: 11b439f5-e5d7-4c6c-bb3f-eda98f9b0ac1