1 ;;; erc-track.el --- Track modified channel buffers
3 ;; Copyright (C) 2002-2012 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 3 of the License, or
14 ;; (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>.
26 ;; Highlights keywords and pals (friends), and hides or highlights fools
27 ;; (using a dark color). Add to your ~/.emacs:
29 ;; (require 'erc-track)
33 ;; * Add extensibility so that custom functions can track
34 ;; custom modification types.
36 (eval-when-compile (require 'cl
))
43 (defgroup erc-track nil
44 "Track active buffers and show activity in the mode line."
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.
51 The default is to check to see whether these keys are used
52 already: if not, then enable the ERC track minor mode, which
53 provides these keys. Otherwise, do not touch the keys.
55 This can alternatively be set to either t or nil, which indicate
56 respectively always to enable ERC track minor mode or never to
57 enable ERC track minor mode.
59 The reason for using this default value is to both (1) adhere to
60 the Emacs development guidelines which say not to touch keys of
61 the form C-c C-<something> and also (2) to meet the expectations
62 of long-time ERC users, many of whom rely on these keybindings."
64 :type
'(choice (const :tag
"Ask, if used already" ask
)
65 (const :tag
"Enable" t
)
66 (const :tag
"Disable" nil
)))
68 (defcustom erc-track-visibility t
69 "Where do we look for buffers to determine their visibility?
70 The value of this variable determines, when a buffer is considered
71 visible or invisible. New messages in invisible buffers are tracked,
72 while switching to visible buffers when they are tracked removes them
73 from the list. See also `erc-track-when-inactive'.
78 visible - all visible frames
79 nil - only the selected frame
80 selected-visible - only the selected frame if it is visible
82 Activity means that there was no user input in the last 10 seconds."
84 :type
'(choice (const :tag
"All frames" t
)
85 (const :tag
"All visible frames" visible
)
86 (const :tag
"Only the selected frame" nil
)
87 (const :tag
"Only the selected frame if it is visible"
90 (defcustom erc-track-exclude nil
91 "A list targets (channel names or query targets) which should not be tracked."
93 :type
'(repeat string
))
95 (defcustom erc-track-remove-disconnected-buffers nil
96 "If true, remove buffers associated with a server that is
97 disconnected from `erc-modified-channels-alist'."
101 (defcustom erc-track-exclude-types
'("NICK" "333" "353")
102 "List of message types to be ignored.
103 This list could look like '(\"JOIN\" \"PART\").
105 By default, exclude changes of nicknames (NICK), display of who
106 set the channel topic (333), and listing of users on the current
109 :type
'erc-message-type
)
111 (defcustom erc-track-exclude-server-buffer nil
112 "If true, don't perform tracking on the server buffer; this is
113 useful for excluding all the things like MOTDs from the server and
114 other miscellaneous functions."
118 (defcustom erc-track-shorten-start
1
119 "This number specifies the minimum number of characters a channel name in
120 the mode-line should be reduced to."
124 (defcustom erc-track-shorten-cutoff
4
125 "All channel names longer than this value will be shortened."
129 (defcustom erc-track-shorten-aggressively nil
130 "If non-nil, channel names will be shortened more aggressively.
131 Usually, names are not shortened if this will save only one character.
132 Example: If there are two channels, #linux-de and #linux-fr, then
133 normally these will not be shortened. When shortening aggressively,
134 however, these will be shortened to #linux-d and #linux-f.
136 If this variable is set to `max', then channel names will be shortened
137 to the max. Usually, shortened channel names will remain unique for a
138 given set of existing channels. When shortening to the max, the shortened
139 channel names will be unique for the set of active channels only.
140 Example: If there are two active channels #emacs and #vi, and two inactive
141 channels #electronica and #folk, then usually the active channels are
142 shortened to #em and #v. When shortening to the max, however, #emacs is
143 not compared to #electronica -- only to #vi, therefore it can be shortened
144 even more and the result is #e and #v.
146 This setting is used by `erc-track-shorten-names'."
148 :type
'(choice (const :tag
"No" nil
)
150 (const :tag
"Max" max
)))
152 (defcustom erc-track-shorten-function
'erc-track-shorten-names
153 "This function will be used to reduce the channel names before display.
154 It takes one argument, CHANNEL-NAMES which is a list of strings.
155 It should return a list of strings of the same number of elements.
156 If nil instead of a function, shortening is disabled."
158 :type
'(choice (const :tag
"Disabled")
161 (defcustom erc-track-list-changed-hook nil
162 "Hook that is run whenever the contents of
163 `erc-modified-channels-alist' changes.
165 This is useful for people that don't use the default mode-line
166 notification but instead use a separate mechanism to provide
167 notification of channel activity."
171 (defcustom erc-track-use-faces t
172 "Use faces in the mode-line.
173 The faces used are the same as used for text in the buffers.
174 \(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)"
178 (defcustom erc-track-faces-priority-list
180 (erc-nick-default-face erc-current-nick-face
)
181 erc-current-nick-face
183 (erc-nick-default-face erc-pal-face
)
187 (erc-button erc-default-face
)
188 (erc-nick-default-face erc-dangerous-host-face
)
189 erc-dangerous-host-face
190 erc-nick-default-face
191 (erc-nick-default-face erc-default-face
)
194 (erc-nick-default-face erc-fool-face
)
199 "A list of faces used to highlight active buffer names in the mode line.
200 If a message contains one of the faces in this list, the buffer name will
201 be highlighted using that face. The first matching face is used."
203 :type
'(repeat (choice face
204 (repeat :tag
"Combination" face
))))
206 (defcustom erc-track-priority-faces-only nil
207 "Only track text highlighted with a priority face.
208 If you would like to ignore changes in certain channels where there
209 are no faces corresponding to your `erc-track-faces-priority-list', set
210 this variable. You can set a list of channel name strings, so those
211 will be ignored while all other channels will be tracked as normal.
212 Other options are 'all, to apply this to all channels or nil, to disable
215 Note: If you have a lot of faces listed in `erc-track-faces-priority-list',
216 setting this variable might not be very useful."
218 :type
'(choice (const nil
)
222 (defcustom erc-track-faces-normal-list
223 '((erc-button erc-default-face
)
224 (erc-nick-default-face erc-dangerous-host-face
)
225 erc-dangerous-host-face
226 erc-nick-default-face
227 (erc-nick-default-face erc-default-face
)
230 "A list of faces considered to be part of normal conversations.
231 This list is used to highlight active buffer names in the mode line.
233 If a message contains one of the faces in this list, and the
234 previous mode line face for this buffer is also in this list, then
235 the buffer name will be highlighted using the face from the
236 message. This gives a rough indication that active conversations
237 are occurring in these channels.
239 The effect may be disabled by setting this variable to nil."
241 :type
'(repeat (choice face
242 (repeat :tag
"Combination" face
))))
244 (defcustom erc-track-position-in-mode-line
'before-modes
245 "Where to show modified channel information in the mode-line.
247 Setting this variable only has effects in GNU Emacs versions above 21.3.
250 'before-modes - add to the beginning of `mode-line-modes',
251 'after-modes - add to the end of `mode-line-modes',
252 t - add to the end of `global-mode-string',
253 nil - don't add to mode line."
255 :type
'(choice (const :tag
"Just before mode information" before-modes
)
256 (const :tag
"Just after mode information" after-modes
)
257 (const :tag
"After all other information" t
)
258 (const :tag
"Don't display in mode line" nil
))
259 :set
(lambda (sym val
)
261 (when (and (boundp 'erc-track-mode
)
263 (erc-track-remove-from-mode-line)
264 (erc-track-add-to-mode-line val
))))
266 (defun erc-modified-channels-object (strings)
267 "Generate a new `erc-modified-channels-object' based on STRINGS.
268 If STRINGS is nil, we initialize `erc-modified-channels-object' to
269 an appropriate initial value for this flavor of Emacs."
271 (if (featurep 'xemacs
)
272 (let ((e-m-c-s '("[")))
273 (push (cons (extent-at 0 (car strings
)) (car strings
))
275 (dolist (string (cdr strings
))
277 (push (cons (extent-at 0 string
) string
)
281 (concat (if (eq erc-track-position-in-mode-line
'after-modes
)
283 (mapconcat 'identity
(nreverse strings
) ",")
284 (if (eq erc-track-position-in-mode-line
'before-modes
)
286 (if (featurep 'xemacs
) '() "")))
288 (defvar erc-modified-channels-object
(erc-modified-channels-object nil
)
289 "Internal object used for displaying modified channels in the mode line.")
291 (put 'erc-modified-channels-object
'risky-local-variable t
); allow properties
293 (defvar erc-modified-channels-alist nil
294 "An ALIST used for tracking channel modification activity.
295 Each element looks like (BUFFER COUNT FACE) where BUFFER is a buffer
296 object of the channel the entry corresponds to, COUNT is a number
297 indicating how often activity was noticed, and FACE is the face to use
298 when displaying the buffer's name. See `erc-track-faces-priority-list',
299 and `erc-track-showcount'.
301 Entries in this list should only happen for buffers where activity occurred
302 while the buffer was not visible.")
304 (defcustom erc-track-showcount nil
305 "If non-nil, count of unseen messages will be shown for each channel."
309 (defcustom erc-track-showcount-string
":"
310 "The string to display between buffer name and the count in the mode line.
311 The default is a colon, resulting in \"#emacs:9\"."
315 (defcustom erc-track-switch-from-erc t
316 "If non-nil, `erc-track-switch-buffer' will return to the last non-erc buffer
317 when there are no more active channels."
321 (defcustom erc-track-switch-direction
'oldest
322 "Direction `erc-track-switch-buffer' should switch.
324 importance - find buffer with the most important message
325 oldest - find oldest active buffer
326 newest - find newest active buffer
327 leastactive - find buffer with least unseen messages
328 mostactive - find buffer with most unseen messages.
330 If set to 'importance, the importance is determined by position
331 in `erc-track-faces-priority-list', where first is most
334 :type
'(choice (const importance
)
341 (defun erc-track-remove-from-mode-line ()
342 "Remove `erc-track-modified-channels' from the mode-line"
343 (when (boundp 'mode-line-modes
)
344 (setq mode-line-modes
345 (remove '(t erc-modified-channels-object
) mode-line-modes
)))
346 (when (consp global-mode-string
)
347 (setq global-mode-string
348 (delq 'erc-modified-channels-object global-mode-string
))))
350 (defun erc-track-add-to-mode-line (position)
351 "Add `erc-track-modified-channels' to POSITION in the mode-line.
352 See `erc-track-position-in-mode-line' for possible values."
353 ;; CVS Emacs has a new format string, and global-mode-string
354 ;; is very far to the right.
355 (cond ((and (eq position
'before-modes
)
356 (boundp 'mode-line-modes
))
357 (add-to-list 'mode-line-modes
358 '(t erc-modified-channels-object
)))
359 ((and (eq position
'after-modes
)
360 (boundp 'mode-line-modes
))
361 (add-to-list 'mode-line-modes
362 '(t erc-modified-channels-object
) t
))
364 (when (not global-mode-string
)
365 (setq global-mode-string
'(""))) ; Padding for mode-line wart
366 (add-to-list 'global-mode-string
367 'erc-modified-channels-object
370 ;;; Shortening of names
372 (defun erc-track-shorten-names (channel-names)
373 "Call `erc-unique-channel-names' with the correct parameters.
374 This function is a good value for `erc-track-shorten-function'.
375 The list of all channels is returned by `erc-all-buffer-names'.
376 CHANNEL-NAMES is the list of active channel names.
377 Only channel names longer than `erc-track-shorten-cutoff' are
378 actually shortened, and they are only shortened to a minimum
379 of `erc-track-shorten-start' characters."
380 (erc-unique-channel-names
381 (erc-all-buffer-names)
384 (> (length s
) erc-track-shorten-cutoff
))
385 erc-track-shorten-start
))
387 (defvar erc-default-recipients
)
389 (defun erc-all-buffer-names ()
390 "Return all channel or query buffer names.
391 Note that we cannot use `erc-channel-list' with a nil argument,
392 because that does not return query buffers."
395 (dolist (buf (buffer-list))
397 (when (or (eq major-mode
'erc-mode
) (eq major-mode
'erc-dcc-chat-mode
))
398 (setq result
(cons (buffer-name) result
))))
401 (defun erc-unique-channel-names (all active
&optional predicate start
)
402 "Return a list of unique channel names.
403 ALL is the list of all channel and query buffer names.
404 ACTIVE is the list of active buffer names.
405 PREDICATE is a predicate that should return non-nil if a name needs
407 START is the minimum length of the name used."
408 (if (eq 'max erc-track-shorten-aggressively
)
409 ;; Return the unique substrings of all active channels.
410 (erc-unique-substrings active predicate start
)
411 ;; Otherwise, determine the unique substrings of all channels, and
412 ;; for every active channel, return the corresponding substring.
413 ;; Given the names of the active channels, we now need to find the
414 ;; corresponding short name from the list of all substrings. To
415 ;; avoid problems when there are two channels and one is a
416 ;; substring of the other (notorious examples are #hurd and
417 ;; #hurd-bunny), every candidate gets the longest possible
419 (let ((all-substrings (sort
420 (erc-unique-substrings all predicate start
)
421 (lambda (a b
) (> (length a
) (length b
)))))
423 (dolist (channel active
)
424 (let ((substrings all-substrings
)
427 (while (and substrings
(not winner
))
428 (setq candidate
(car substrings
)
429 substrings
(cdr substrings
))
430 (when (and (string= candidate
433 (min (length candidate
)
435 (not (member candidate result
)))
436 (setq winner candidate
)))
437 (setq result
(cons winner result
))))
440 (defun erc-unique-substrings (strings &optional predicate start
)
441 "Return a list of unique substrings of STRINGS."
442 (if (or (not (numberp start
))
447 (let* ((others (delete str
(copy-sequence strings
)))
448 (maxlen (length str
))
453 (if (and (functionp predicate
) (not (funcall predicate str
)))
454 ;; do not shorten if a predicate exists and it returns nil
456 ;; Start with smallest substring candidate, ie. length 1.
457 ;; Then check all the others and see whether any of them starts
458 ;; with the same substring. While there is such another
459 ;; element in the list, increase the length of the candidate.
463 (setq candidate
(substring str
0 i
)
464 done
(not (erc-unique-substring-1 candidate others
))))
466 (if (and (= (length candidate
) (1- maxlen
))
467 (not erc-track-shorten-aggressively
))
472 (defun erc-unique-substring-1 (candidate others
)
473 "Return non-nil when any string in OTHERS starts with CANDIDATE."
474 (let (result other
(maxlen (length candidate
)))
477 (setq other
(car others
)
479 (when (and (>= (length other
) maxlen
)
480 (string= candidate
(substring other
0 maxlen
)))
481 (setq result other
)))
488 ;; verify examples from the doc strings
489 (equal (let ((erc-track-shorten-aggressively nil
))
490 (erc-unique-channel-names
491 '("#emacs" "#vi" "#electronica" "#folk")
493 '("#em" "#vi")) ; emacs is different from electronica
494 (equal (let ((erc-track-shorten-aggressively t
))
495 (erc-unique-channel-names
496 '("#emacs" "#vi" "#electronica" "#folk")
498 '("#em" "#v")) ; vi is shortened by one letter
499 (equal (let ((erc-track-shorten-aggressively 'max
))
500 (erc-unique-channel-names
501 '("#emacs" "#vi" "#electronica" "#folk")
503 '("#e" "#v")) ; emacs need not be different from electronica
504 (equal (let ((erc-track-shorten-aggressively nil
))
505 (erc-unique-channel-names
506 '("#linux-de" "#linux-fr")
507 '("#linux-de" "#linux-fr")))
508 '("#linux-de" "#linux-fr")) ; shortening by one letter is too aggressive
509 (equal (let ((erc-track-shorten-aggressively t
))
510 (erc-unique-channel-names
511 '("#linux-de" "#linux-fr")
512 '("#linux-de" "#linux-fr")))
513 '("#linux-d" "#linux-f")); now we want to be aggressive
515 (equal (let ((erc-track-shorten-aggressively nil
))
516 (erc-unique-channel-names
517 '("#dunnet" "#lisp" "#sawfish" "#fsf" "#guile"
518 "#testgnome" "#gnu" "#fsbot" "#hurd" "#hurd-bunny"
520 '("#hurd-bunny" "#hurd" "#sawfish" "#lisp")))
521 '("#hurd-" "#hurd" "#s" "#l"))
522 (equal (let ((erc-track-shorten-aggressively nil
))
523 (erc-unique-substrings
524 '("#emacs" "#vi" "#electronica" "#folk")))
525 '("#em" "#vi" "#el" "#f"))
526 (equal (let ((erc-track-shorten-aggressively t
))
527 (erc-unique-substrings
528 '("#emacs" "#vi" "#electronica" "#folk")))
529 '("#em" "#v" "#el" "#f"))
530 (equal (let ((erc-track-shorten-aggressively nil
))
531 (erc-unique-channel-names
532 '("#emacs" "#burse" "+linux.de" "#starwars"
533 "#bitlbee" "+burse" "#ratpoison")
534 '("+linux.de" "#starwars" "#burse")))
536 (equal (let ((erc-track-shorten-aggressively nil
))
537 (erc-unique-channel-names
538 '("fsbot" "#emacs" "deego")
541 (equal (let ((erc-track-shorten-aggressively nil
))
542 (erc-unique-channel-names
543 '("fsbot" "#emacs" "deego")
549 (equal (let ((erc-track-shorten-aggressively nil
))
550 (erc-unique-channel-names
551 '("fsbot" "#emacs" "deego")
557 (let ((erc-track-shorten-aggressively nil
))
558 (equal (erc-unique-channel-names '("deego" "#hurd" "#hurd-bunny" "#emacs")
559 '("#hurd" "#hurd-bunny"))
560 '("#hurd" "#hurd-")))
562 (let ((erc-track-shorten-aggressively t
))
563 (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
564 (not (erc-unique-substring-1 "a" '("xyz" "xab")))
565 (equal (erc-unique-substrings '("abc" "xyz" "xab"))
567 (equal (erc-unique-substrings '("abc" "abcdefg"))
569 (let ((erc-track-shorten-aggressively nil
))
570 (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
571 (not (erc-unique-substring-1 "a" '("xyz" "xab")))
572 (equal (erc-unique-substrings '("abc" "xyz" "xab"))
573 '("abc" "xyz" "xab"))
574 (equal (erc-unique-substrings '("abc" "abcdefg"))
579 ;; Play nice with other IRC clients (and Emacs development rules) by
580 ;; making this a minor mode
582 (defvar erc-track-minor-mode-map
(make-sparse-keymap)
583 "Keymap for rcirc track minor mode.")
585 (define-key erc-track-minor-mode-map
(kbd "C-c C-@") 'erc-track-switch-buffer
)
586 (define-key erc-track-minor-mode-map
(kbd "C-c C-SPC")
587 'erc-track-switch-buffer
)
590 (define-minor-mode erc-track-minor-mode
591 "Toggle mode line display of ERC activity (ERC Track minor mode).
592 With a prefix argument ARG, enable ERC Track minor mode if ARG is
593 positive, and disable it otherwise. If called from Lisp, enable
594 the mode if ARG is omitted or nil.
596 ERC Track minor mode is a global minor mode. It exists for the
597 sole purpose of providing the C-c C-SPC and C-c C-@ keybindings.
598 Make sure that you have enabled the track module, otherwise the
599 keybindings will not do anything useful."
602 :keymap erc-track-minor-mode-map
606 (defun erc-track-minor-mode-maybe (&optional buffer
)
607 "Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'."
608 (when (and (not erc-track-minor-mode
)
609 ;; don't start the minor mode until we have an ERC
610 ;; process running, because we don't want to prompt the
611 ;; user while starting Emacs
612 (or (and (buffer-live-p buffer
)
613 (with-current-buffer buffer
(eq major-mode
'erc-mode
)))
615 (cond ((eq erc-track-enable-keybindings
'ask
)
616 (let ((key (or (and (key-binding (kbd "C-c C-SPC")) "C-SPC")
617 (and (key-binding (kbd "C-c C-@")) "C-@"))))
620 (concat "The C-c " key
" binding is in use;"
621 " override it for tracking? "))
623 (message (concat "Will change it; set"
624 " `erc-track-enable-keybindings'"
625 " to disable this message"))
627 (erc-track-minor-mode 1))
628 (message (concat "Not changing it; set"
629 " `erc-track-enable-keybindings'"
630 " to disable this message"))
632 (erc-track-minor-mode 1))))
633 ((eq erc-track-enable-keybindings t
)
634 (erc-track-minor-mode 1))
639 ;;;###autoload (autoload 'erc-track-mode "erc-track" nil t)
640 (define-erc-module track nil
641 "This mode tracks ERC channel buffers with activity."
643 ((when (boundp 'erc-track-when-inactive
)
644 (if erc-track-when-inactive
646 (if (featurep 'xemacs
)
647 (defadvice switch-to-buffer
(after erc-update-when-inactive
648 (&rest args
) activate
)
649 (erc-user-is-active))
650 (add-hook 'window-configuration-change-hook
'erc-user-is-active
))
651 (add-hook 'erc-send-completed-hook
'erc-user-is-active
)
652 (add-hook 'erc-server-001-functions
'erc-user-is-active
))
653 (erc-track-add-to-mode-line erc-track-position-in-mode-line
)
654 (erc-update-mode-line)
655 (if (featurep 'xemacs
)
656 (defadvice switch-to-buffer
(after erc-update
(&rest args
) activate
)
657 (erc-modified-channels-update))
658 (add-hook 'window-configuration-change-hook
659 'erc-window-configuration-change
))
660 (add-hook 'erc-insert-post-hook
'erc-track-modified-channels
)
661 (add-hook 'erc-disconnected-hook
'erc-modified-channels-update
))
662 ;; enable the tracking keybindings
663 (add-hook 'erc-connect-pre-hook
'erc-track-minor-mode-maybe
)
664 (erc-track-minor-mode-maybe)))
666 ((when (boundp 'erc-track-when-inactive
)
667 (erc-track-remove-from-mode-line)
668 (if erc-track-when-inactive
670 (if (featurep 'xemacs
)
671 (ad-disable-advice 'switch-to-buffer
'after
672 'erc-update-when-inactive
)
673 (remove-hook 'window-configuration-change-hook
674 'erc-user-is-active
))
675 (remove-hook 'erc-send-completed-hook
'erc-user-is-active
)
676 (remove-hook 'erc-server-001-functions
'erc-user-is-active
)
677 (remove-hook 'erc-timer-hook
'erc-user-is-active
))
678 (if (featurep 'xemacs
)
679 (ad-disable-advice 'switch-to-buffer
'after
'erc-update
)
680 (remove-hook 'window-configuration-change-hook
681 'erc-window-configuration-change
))
682 (remove-hook 'erc-disconnected-hook
'erc-modified-channels-update
)
683 (remove-hook 'erc-insert-post-hook
'erc-track-modified-channels
))
684 ;; disable the tracking keybindings
685 (remove-hook 'erc-connect-pre-hook
'erc-track-minor-mode-maybe
)
686 (when erc-track-minor-mode
687 (erc-track-minor-mode -
1)))))
689 (defcustom erc-track-when-inactive nil
690 "Enable channel tracking even for visible buffers, if you are
694 :set
(lambda (sym val
)
704 (defvar erc-buffer-activity nil
705 "Last time the user sent something.")
707 (defvar erc-buffer-activity-timeout
10
708 "How many seconds of inactivity by the user
709 to consider when `erc-track-visibility' is set to
710 only consider active buffers visible.")
712 (defun erc-user-is-active (&rest ignore
)
713 "Set `erc-buffer-activity'."
714 (when erc-server-connected
715 (setq erc-buffer-activity
(erc-current-time))
716 (erc-track-modified-channels)))
718 (defun erc-track-get-buffer-window (buffer frame-param
)
719 (if (eq frame-param
'selected-visible
)
720 (if (eq (frame-visible-p (selected-frame)) t
)
721 (get-buffer-window buffer nil
)
723 (get-buffer-window buffer frame-param
)))
725 (defun erc-buffer-visible (buffer)
726 "Return non-nil when the buffer is visible."
727 (if erc-track-when-inactive
728 (when erc-buffer-activity
; could be nil
729 (and (erc-track-get-buffer-window buffer erc-track-visibility
)
730 (<= (erc-time-diff erc-buffer-activity
(erc-current-time))
731 erc-buffer-activity-timeout
)))
732 (erc-track-get-buffer-window buffer erc-track-visibility
)))
734 ;;; Tracking the channel modifications
736 (defun erc-window-configuration-change ()
737 (unless (minibuffer-window-active-p (minibuffer-window))
738 ;; delay this until command has finished to make sure window is
739 ;; actually visible before clearing activity
740 (add-hook 'post-command-hook
'erc-modified-channels-update
)))
742 (defvar erc-modified-channels-update-inside nil
743 "Variable to prevent running `erc-modified-channels-update' multiple
744 times. Without it, you cannot debug `erc-modified-channels-display',
745 because the debugger also cases changes to the window-configuration.")
747 (defun erc-modified-channels-update (&rest args
)
748 "This function updates the information in `erc-modified-channels-alist'
749 according to buffer visibility. It calls
750 `erc-modified-channels-display' at the end. This should usually be
751 called via `window-configuration-change-hook'.
754 (unless erc-modified-channels-update-inside
755 (let ((erc-modified-channels-update-inside t
)
756 (removed-channel nil
))
758 (let ((buffer (car elt
)))
759 (when (or (not (bufferp buffer
))
760 (not (buffer-live-p buffer
))
761 (erc-buffer-visible buffer
)
762 (and erc-track-remove-disconnected-buffers
763 (not (with-current-buffer buffer
764 erc-server-connected
))))
765 (setq removed-channel t
)
766 (erc-modified-channels-remove-buffer buffer
))))
767 erc-modified-channels-alist
)
768 (when removed-channel
769 (erc-modified-channels-display)
770 (force-mode-line-update t
)))
771 (remove-hook 'post-command-hook
'erc-modified-channels-update
)))
773 (defvar erc-track-mouse-face
(if (featurep 'xemacs
)
775 'mode-line-highlight
)
776 "The face to use when mouse is over channel names in the mode line.")
778 (defun erc-make-mode-line-buffer-name (string buffer
&optional faces count
)
779 "Return STRING as a button that switches to BUFFER when clicked.
780 If FACES are provided, color STRING with them."
781 ;; We define a new sparse keymap every time, because 1. this data
782 ;; structure is very small, the alternative would require us to
783 ;; defvar a keymap, 2. the user is not interested in customizing it
784 ;; (really?), 3. the defun needs to switch to BUFFER, so we would
785 ;; need to save that value somewhere.
786 (let ((map (make-sparse-keymap))
787 (name (if erc-track-showcount
789 erc-track-showcount-string
790 (int-to-string count
))
791 (copy-sequence string
))))
792 (define-key map
(vector 'mode-line
'mouse-2
)
795 (save-selected-window
797 (posn-window (event-start e
)))
798 (switch-to-buffer ,buffer
))))
799 (define-key map
(vector 'mode-line
'mouse-3
)
802 (save-selected-window
804 (posn-window (event-start e
)))
805 (switch-to-buffer-other-window ,buffer
))))
806 (put-text-property 0 (length name
) 'local-map map name
)
809 'help-echo
(concat "mouse-2: switch to buffer, "
810 "mouse-3: switch to buffer in other window")
812 (put-text-property 0 (length name
) 'mouse-face erc-track-mouse-face name
)
813 (when (and faces erc-track-use-faces
)
814 (put-text-property 0 (length name
) 'face faces name
))
817 (defun erc-modified-channels-display ()
818 "Set `erc-modified-channels-object'
819 according to `erc-modified-channels-alist'.
820 Use `erc-make-mode-line-buffer-name' to create buttons."
821 (cond ((or (eq 'mostactive erc-track-switch-direction
)
822 (eq 'leastactive erc-track-switch-direction
))
823 (erc-track-sort-by-activest))
824 ((eq 'importance erc-track-switch-direction
)
825 (erc-track-sort-by-importance)))
826 (run-hooks 'erc-track-list-changed-hook
)
827 (unless (eq erc-track-position-in-mode-line nil
)
828 (if (null erc-modified-channels-alist
)
829 (setq erc-modified-channels-object
(erc-modified-channels-object nil
))
830 ;; erc-modified-channels-alist contains all the data we need. To
831 ;; better understand what is going on, we split things up into
832 ;; four lists: BUFFERS, COUNTS, SHORT-NAMES, and FACES. These
833 ;; four lists we use to create a new
834 ;; `erc-modified-channels-object' using
835 ;; `erc-make-mode-line-buffer-name'.
836 (let* ((buffers (mapcar 'car erc-modified-channels-alist
))
837 (counts (mapcar 'cadr erc-modified-channels-alist
))
838 (faces (mapcar 'cddr erc-modified-channels-alist
))
839 (long-names (mapcar #'(lambda (buf)
840 (or (buffer-name buf
)
843 (short-names (if (functionp erc-track-shorten-function
)
844 (funcall erc-track-shorten-function
849 (when (car short-names
)
850 (setq strings
(cons (erc-make-mode-line-buffer-name
856 (setq short-names
(cdr short-names
)
857 buffers
(cdr buffers
)
860 (when (featurep 'xemacs
)
861 (erc-modified-channels-object nil
))
862 (setq erc-modified-channels-object
863 (erc-modified-channels-object strings
))))))
865 (defun erc-modified-channels-remove-buffer (buffer)
866 "Remove BUFFER from `erc-modified-channels-alist'."
867 (interactive "bBuffer: ")
868 (setq erc-modified-channels-alist
869 (delete (assq buffer erc-modified-channels-alist
)
870 erc-modified-channels-alist
))
871 (when (interactive-p)
872 (erc-modified-channels-display)))
874 (defun erc-track-find-face (faces)
875 "Return the face to use in the mode line from the faces in FACES.
876 If `erc-track-faces-priority-list' is set, the one from FACES who
877 is first in that list will be used. If nothing matches or if
878 `erc-track-faces-priority-list' is not set, the default mode-line
881 If `erc-track-faces-normal-list' is non-nil, use it to produce a
882 blinking effect that indicates channel activity when the first
883 element in FACES and the highest-ranking face among the rest of
884 FACES are both members of `erc-track-faces-normal-list'.
886 If one of the faces is a list, then it will be ranked according
887 to its highest-tanking face member. A list of faces including
888 that member will take priority over just the single member
890 (let ((choice (catch 'face
891 (dolist (candidate erc-track-faces-priority-list
)
892 (when (member candidate faces
)
893 (throw 'face candidate
)))))
894 (no-first (and erc-track-faces-normal-list
896 (dolist (candidate erc-track-faces-priority-list
)
897 (when (member candidate
(cdr faces
))
898 (throw 'face candidate
)))))))
901 ((and (member choice erc-track-faces-normal-list
)
902 (member no-first erc-track-faces-normal-list
))
907 (defun erc-track-modified-channels ()
908 "Hook function for `erc-insert-post-hook' to check if the current
909 buffer should be added to the mode line as a hidden, modified
910 channel. Assumes it will only be called when current-buffer
912 (let ((this-channel (or (erc-default-target)
913 (buffer-name (current-buffer)))))
914 (if (and (not (erc-buffer-visible (current-buffer)))
915 (not (member this-channel erc-track-exclude
))
916 (not (and erc-track-exclude-server-buffer
917 (erc-server-buffer-p)))
918 (not (erc-message-type-member
919 (or (erc-find-parsed-property)
921 erc-track-exclude-types
)))
922 ;; If the active buffer is not visible (not shown in a
923 ;; window), and not to be excluded, determine the kinds of
924 ;; faces used in the current message, and unless the user
925 ;; wants to ignore changes in certain channels where there
926 ;; are no faces corresponding to `erc-track-faces-priority-list',
927 ;; and the faces in the current message are found in said
928 ;; priority list, add the buffer to the erc-modified-channels-alist,
929 ;; if it is not already there. If the buffer is already on the list
930 ;; (in the car), change its face attribute (in the cddr) if
931 ;; necessary. See `erc-modified-channels-alist' for the
932 ;; exact data structure used.
933 (let ((faces (erc-faces-in (buffer-string))))
935 (or (eq erc-track-priority-faces-only
'all
)
936 (member this-channel erc-track-priority-faces-only
))
939 (when (member f erc-track-faces-priority-list
)
940 (throw 'found t
))))))
941 (if (not (assq (current-buffer) erc-modified-channels-alist
))
942 ;; Add buffer, faces and counts
943 (setq erc-modified-channels-alist
944 (cons (cons (current-buffer)
945 (cons 1 (erc-track-find-face faces
)))
946 erc-modified-channels-alist
))
947 ;; Else modify the face for the buffer, if necessary.
949 (let* ((cell (assq (current-buffer)
950 erc-modified-channels-alist
))
951 (old-face (cddr cell
))
952 (new-face (erc-track-find-face
954 (cons old-face faces
)
956 (setcdr cell
(cons (1+ (cadr cell
)) new-face
)))))
958 (erc-modified-channels-display)))
959 ;; Else if the active buffer is the current buffer, remove it
961 (when (and (or (erc-buffer-visible (current-buffer))
963 (member this-channel erc-track-exclude
)))
964 (assq (current-buffer) erc-modified-channels-alist
))
965 ;; Remove it from mode-line if buffer is visible or
966 ;; channel was added to erc-track-exclude recently.
967 (erc-modified-channels-remove-buffer (current-buffer))
968 (erc-modified-channels-display)))))
970 (defun erc-faces-in (str)
971 "Return a list of all faces used in STR."
974 (faces (erc-list (get-text-property 0 'face str
)))
976 (while (and (setq i
(next-single-property-change i
'face str m
))
978 (when (setq cur
(get-text-property i
'face str
))
979 (add-to-list 'faces cur
)))
983 (let ((str "is bold"))
984 (put-text-property 3 (length str
)
985 'face
'(bold erc-current-nick-face
)
991 (defvar erc-track-last-non-erc-buffer nil
992 "Stores the name of the last buffer you were in before activating
993 `erc-track-switch-buffers'")
995 (defun erc-track-sort-by-activest ()
996 "Sort erc-modified-channels-alist by activity.
997 That means the number of unseen messages in a channel."
998 (setq erc-modified-channels-alist
999 (sort erc-modified-channels-alist
1000 (lambda (a b
) (> (nth 1 a
) (nth 1 b
))))))
1002 (defun erc-track-face-priority (face)
1003 "Return a number indicating the priority of FACE in
1004 `erc-track-faces-priority-list'. Lower number means higher
1007 If face is not in `erc-track-faces-priority-list', it will have a
1008 higher number than any other face in that list."
1011 (dolist (item erc-track-faces-priority-list
)
1012 (if (equal item face
)
1014 (setq count
(1+ count
)))))
1017 (defun erc-track-sort-by-importance ()
1018 "Sort erc-modified-channels-alist by importance.
1019 That means the position of the face in `erc-track-faces-priority-list'."
1020 (setq erc-modified-channels-alist
1021 (sort erc-modified-channels-alist
1022 (lambda (a b
) (< (erc-track-face-priority (cddr a
))
1023 (erc-track-face-priority (cddr b
)))))))
1025 (defun erc-track-get-active-buffer (arg)
1026 "Return the buffer name of ARG in `erc-modified-channels-alist'.
1027 Negative arguments index in the opposite direction. This direction is
1028 relative to `erc-track-switch-direction'"
1029 (let ((dir erc-track-switch-direction
)
1035 (mostactive 'leastactive
)
1036 (leastactive 'mostactive
)
1037 (importance 'oldest
)))
1039 (setq offset
(case dir
1040 ((oldest leastactive
)
1041 (- (length erc-modified-channels-alist
) arg
))
1043 ;; normalize out of range user input
1044 (cond ((>= offset
(length erc-modified-channels-alist
))
1045 (setq offset
(1- (length erc-modified-channels-alist
))))
1048 (car (nth offset erc-modified-channels-alist
))))
1050 (defun erc-track-switch-buffer (arg)
1051 "Switch to the next active ERC buffer, or if there are no active buffers,
1052 switch back to the last non-ERC buffer visited. Next is defined by
1053 `erc-track-switch-direction', a negative argument will reverse this."
1055 (if (not erc-track-mode
)
1056 (message (concat "Enable the ERC track module if you want to use the"
1057 " tracking minor mode"))
1058 (cond (erc-modified-channels-alist
1059 ;; if we're not in erc-mode, set this buffer to return to
1060 (unless (eq major-mode
'erc-mode
)
1061 (setq erc-track-last-non-erc-buffer
(current-buffer)))
1062 ;; and jump to the next active channel
1063 (switch-to-buffer (erc-track-get-active-buffer arg
)))
1064 ;; if no active channels, switch back to what we were doing before
1065 ((and erc-track-last-non-erc-buffer
1066 erc-track-switch-from-erc
1067 (buffer-live-p erc-track-last-non-erc-buffer
))
1068 (switch-to-buffer erc-track-last-non-erc-buffer
)))))
1070 (provide 'erc-track
)
1072 ;;; erc-track.el ends here
1075 ;; indent-tabs-mode: t