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