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