1 ;;; erc-track.el --- Track modified channel buffers
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006,
4 ;; 2007 Free Software Foundation, Inc.
6 ;; Author: Mario Lang <mlang@delysid.org>
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, or (at your option)
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; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
29 ;; Highlights keywords and pals (friends), and hides or highlights fools
30 ;; (using a dark color). Add to your ~/.emacs:
32 ;; (require 'erc-track)
36 ;; * Add extensibility so that custom functions can track
37 ;; custom modification types.
39 (eval-when-compile (require 'cl
))
46 (defgroup erc-track nil
47 "Track active buffers and show activity in the modeline."
50 (defcustom erc-track-enable-keybindings
'ask
51 "Whether to enable the ERC track keybindings, namely:
52 `C-c C-SPC' and `C-c C-@', which both do the same thing.
54 The default is to check to see whether these keys are used
55 already: if not, then enable the ERC track minor mode, which
56 provides these keys. Otherwise, do not touch the keys.
58 This can alternatively be set to either t or nil, which indicate
59 respectively always to enable ERC track minor mode or never to
60 enable ERC track minor mode.
62 The reason for using this default value is to both (1) adhere to
63 the Emacs development guidelines which say not to touch keys of
64 the form C-c C-<something> and also (2) to meet the expectations
65 of long-time ERC users, many of whom rely on these keybindings."
67 :type
'(choice (const :tag
"Ask, if used already" ask
)
68 (const :tag
"Enable" t
)
69 (const :tag
"Disable" nil
)))
71 (defcustom erc-track-visibility t
72 "Where do we look for buffers to determine their visibility?
73 The value of this variable determines, when a buffer is considered
74 visible or invisible. New messages in invisible buffers are tracked,
75 while switching to visible buffers when they are tracked removes them
76 from the list. See also `erc-track-when-inactive'.
81 visible - all visible frames
82 nil - only the selected frame
83 selected-visible - only the selected frame if it is visible
85 Activity means that there was no user input in the last 10 seconds."
87 :type
'(choice (const :tag
"All frames" t
)
88 (const :tag
"All visible frames" visible
)
89 (const :tag
"Only the selected frame" nil
)
90 (const :tag
"Only the selected frame if it was active"
93 (defcustom erc-track-exclude nil
94 "A list targets (channel names or query targets) which should not be tracked."
96 :type
'(repeat string
))
98 (defcustom erc-track-exclude-types
'("NICK")
99 "*List of message types to be ignored.
100 This list could look like '(\"JOIN\" \"PART\")."
102 :type
'erc-message-type
)
104 (defcustom erc-track-exclude-server-buffer nil
105 "*If true, don't perform tracking on the server buffer; this is
106 useful for excluding all the things like MOTDs from the server and
107 other miscellaneous functions."
111 (defcustom erc-track-shorten-start
1
112 "This number specifies the minimum number of characters a channel name in
113 the mode-line should be reduced to."
117 (defcustom erc-track-shorten-cutoff
4
118 "All channel names longer than this value will be shortened."
122 (defcustom erc-track-shorten-aggressively nil
123 "*If non-nil, channel names will be shortened more aggressively.
124 Usually, names are not shortened if this will save only one character.
125 Example: If there are two channels, #linux-de and #linux-fr, then
126 normally these will not be shortened. When shortening aggressively,
127 however, these will be shortened to #linux-d and #linux-f.
129 If this variable is set to `max', then channel names will be shortened
130 to the max. Usually, shortened channel names will remain unique for a
131 given set of existing channels. When shortening to the max, the shortened
132 channel names will be unique for the set of active channels only.
133 Example: If there are two active channels #emacs and #vi, and two inactive
134 channels #electronica and #folk, then usually the active channels are
135 shortened to #em and #v. When shortening to the max, however, #emacs is
136 not compared to #electronica -- only to #vi, therefore it can be shortened
137 even more and the result is #e and #v.
139 This setting is used by `erc-track-shorten-names'."
141 :type
'(choice (const :tag
"No" nil
)
143 (const :tag
"Max" max
)))
145 (defcustom erc-track-shorten-function
'erc-track-shorten-names
146 "*This function will be used to reduce the channel names before display.
147 It takes one argument, CHANNEL-NAMES which is a list of strings.
148 It should return a list of strings of the same number of elements.
149 If nil instead of a function, shortening is disabled."
151 :type
'(choice (const :tag
"Disabled")
154 (defcustom erc-track-use-faces t
155 "*Use faces in the mode-line.
156 The faces used are the same as used for text in the buffers.
157 \(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)"
161 (defcustom erc-track-faces-priority-list
162 '(erc-error-face erc-current-nick-face erc-keyword-face erc-pal-face
163 erc-nick-msg-face erc-direct-msg-face erc-button erc-dangerous-host-face
164 erc-default-face erc-action-face erc-nick-default-face erc-fool-face
165 erc-notice-face erc-input-face erc-prompt-face
)
166 "A list of faces used to highlight active buffer names in the modeline.
167 If a message contains one of the faces in this list, the buffer name will
168 be highlighted using that face. The first matching face is used."
170 :type
'(repeat face
))
172 (defcustom erc-track-priority-faces-only nil
173 "Only track text highlighted with a priority face.
174 If you would like to ignore changes in certain channels where there
175 are no faces corresponding to your `erc-track-faces-priority-list', set
176 this variable. You can set a list of channel name strings, so those
177 will be ignored while all other channels will be tracked as normal.
178 Other options are 'all, to apply this to all channels or nil, to disable
180 Note: If you have a lot of faces listed in `erc-track-faces-priority-list',
181 setting this variable might not be very useful."
183 :type
'(choice (const nil
)
187 (defcustom erc-track-position-in-mode-line
'before-modes
188 "Where to show modified channel information in the mode-line.
190 Setting this variable only has effects in GNU Emacs versions above 21.3.
193 'before-modes - add to the beginning of `mode-line-modes'
194 'after-modes - add to the end of `mode-line-modes'
196 Any other value means add to the end of `global-mode-string'."
198 :type
'(choice (const :tag
"Just before mode information" before-modes
)
199 (const :tag
"Just after mode information" after-modes
)
200 (const :tag
"After all other information" nil
))
201 :set
(lambda (sym val
)
203 (when (and (boundp 'erc-track-mode
)
205 (erc-track-remove-from-mode-line)
206 (erc-track-add-to-mode-line val
))))
208 (defun erc-modified-channels-object (strings)
209 "Generate a new `erc-modified-channels-object' based on STRINGS.
210 If STRINGS is nil, we initialize `erc-modified-channels-object' to
211 an appropriate initial value for this flavor of Emacs."
213 (if (featurep 'xemacs
)
214 (let ((e-m-c-s '("[")))
215 (push (cons (extent-at 0 (car strings
)) (car strings
))
217 (dolist (string (cdr strings
))
219 (push (cons (extent-at 0 string
) string
)
223 (concat (if (eq erc-track-position-in-mode-line
'after-modes
)
225 (mapconcat 'identity
(nreverse strings
) ",")
226 (if (eq erc-track-position-in-mode-line
'before-modes
)
228 (if (featurep 'xemacs
) '() "")))
230 (defvar erc-modified-channels-object
(erc-modified-channels-object nil
)
231 "Internal object used for displaying modified channels in the mode line.")
233 (put 'erc-modified-channels-object
'risky-local-variable t
); allow properties
235 (defvar erc-modified-channels-alist nil
236 "An ALIST used for tracking channel modification activity.
237 Each element looks like (BUFFER COUNT FACE) where BUFFER is a buffer
238 object of the channel the entry corresponds to, COUNT is a number
239 indicating how often activity was noticed, and FACE is the face to use
240 when displaying the buffer's name. See `erc-track-faces-priority-list',
241 and `erc-track-showcount'.
243 Entries in this list should only happen for buffers where activity occurred
244 while the buffer was not visible.")
246 (defcustom erc-track-showcount nil
247 "If non-nil, count of unseen messages will be shown for each channel."
251 (defcustom erc-track-showcount-string
":"
252 "The string to display between buffer name and the count in the mode line.
253 The default is a colon, resulting in \"#emacs:9\"."
257 (defcustom erc-track-switch-from-erc t
258 "If non-nil, `erc-track-switch-buffer' will return to the last non-erc buffer
259 when there are no more active channels."
263 (defcustom erc-track-switch-direction
'oldest
264 "Direction `erc-track-switch-buffer' should switch.
266 oldest - find oldest active buffer
267 newest - find newest active buffer
268 leastactive - find buffer with least unseen messages
269 mostactive - find buffer with most unseen messages."
271 :type
'(choice (const oldest
)
277 (defun erc-track-remove-from-mode-line ()
278 "Remove `erc-track-modified-channels' from the mode-line"
279 (when (boundp 'mode-line-modes
)
280 (setq mode-line-modes
281 (remove '(t erc-modified-channels-object
) mode-line-modes
)))
282 (when (consp global-mode-string
)
283 (setq global-mode-string
284 (delq 'erc-modified-channels-object global-mode-string
))))
286 (defun erc-track-add-to-mode-line (position)
287 "Add `erc-track-modified-channels' to POSITION in the mode-line.
288 See `erc-track-position-in-mode-line' for possible values."
289 ;; CVS Emacs has a new format string, and global-mode-string
290 ;; is very far to the right.
291 (cond ((and (eq position
'before-modes
)
292 (boundp 'mode-line-modes
))
293 (add-to-list 'mode-line-modes
294 '(t erc-modified-channels-object
)))
295 ((and (eq position
'after-modes
)
296 (boundp 'mode-line-modes
))
297 (add-to-list 'mode-line-modes
298 '(t erc-modified-channels-object
) t
))
300 (when (not global-mode-string
)
301 (setq global-mode-string
'(""))) ; Padding for mode-line wart
302 (add-to-list 'global-mode-string
303 'erc-modified-channels-object
306 ;;; Shortening of names
308 (defun erc-track-shorten-names (channel-names)
309 "Call `erc-unique-channel-names' with the correct parameters.
310 This function is a good value for `erc-track-shorten-function'.
311 The list of all channels is returned by `erc-all-buffer-names'.
312 CHANNEL-NAMES is the list of active channel names.
313 Only channel names longer than `erc-track-shorten-cutoff' are
314 actually shortened, and they are only shortened to a minimum
315 of `erc-track-shorten-start' characters."
316 (erc-unique-channel-names
317 (erc-all-buffer-names)
320 (> (length s
) erc-track-shorten-cutoff
))
321 erc-track-shorten-start
))
323 (defvar erc-default-recipients
)
325 (defun erc-all-buffer-names ()
326 "Return all channel or query buffer names.
327 Note that we cannot use `erc-channel-list' with a nil argument,
328 because that does not return query buffers."
331 (dolist (buf (buffer-list))
333 (when (or (eq major-mode
'erc-mode
) (eq major-mode
'erc-dcc-chat-mode
))
334 (setq result
(cons (buffer-name) result
))))
337 (defun erc-unique-channel-names (all active
&optional predicate start
)
338 "Return a list of unique channel names.
339 ALL is the list of all channel and query buffer names.
340 ACTIVE is the list of active buffer names.
341 PREDICATE is a predicate that should return non-nil if a name needs
343 START is the minimum length of the name used."
344 (if (eq 'max erc-track-shorten-aggressively
)
345 ;; Return the unique substrings of all active channels.
346 (erc-unique-substrings active predicate start
)
347 ;; Otherwise, determine the unique substrings of all channels, and
348 ;; for every active channel, return the corresponding substring.
349 ;; Given the names of the active channels, we now need to find the
350 ;; corresponding short name from the list of all substrings. To
351 ;; avoid problems when there are two channels and one is a
352 ;; substring of the other (notorious examples are #hurd and
353 ;; #hurd-bunny), every candidate gets the longest possible
355 (let ((all-substrings (sort
356 (erc-unique-substrings all predicate start
)
357 (lambda (a b
) (> (length a
) (length b
)))))
359 (dolist (channel active
)
360 (let ((substrings all-substrings
)
363 (while (and substrings
(not winner
))
364 (setq candidate
(car substrings
)
365 substrings
(cdr substrings
))
366 (when (and (string= candidate
369 (min (length candidate
)
371 (not (member candidate result
)))
372 (setq winner candidate
)))
373 (setq result
(cons winner result
))))
376 (defun erc-unique-substrings (strings &optional predicate start
)
377 "Return a list of unique substrings of STRINGS."
378 (if (or (not (numberp start
))
383 (let* ((others (delete str
(copy-sequence strings
)))
384 (maxlen (length str
))
389 (if (and (functionp predicate
) (not (funcall predicate str
)))
390 ;; do not shorten if a predicate exists and it returns nil
392 ;; Start with smallest substring candidate, ie. length 1.
393 ;; Then check all the others and see whether any of them starts
394 ;; with the same substring. While there is such another
395 ;; element in the list, increase the length of the candidate.
399 (setq candidate
(substring str
0 i
)
400 done
(not (erc-unique-substring-1 candidate others
))))
402 (if (and (= (length candidate
) (1- maxlen
))
403 (not erc-track-shorten-aggressively
))
408 (defun erc-unique-substring-1 (candidate others
)
409 "Return non-nil when any string in OTHERS starts with CANDIDATE."
410 (let (result other
(maxlen (length candidate
)))
413 (setq other
(car others
)
415 (when (and (>= (length other
) maxlen
)
416 (string= candidate
(substring other
0 maxlen
)))
417 (setq result other
)))
424 ;; verify examples from the doc strings
425 (equal (let ((erc-track-shorten-aggressively nil
))
426 (erc-unique-channel-names
427 '("#emacs" "#vi" "#electronica" "#folk")
429 '("#em" "#vi")) ; emacs is different from electronica
430 (equal (let ((erc-track-shorten-aggressively t
))
431 (erc-unique-channel-names
432 '("#emacs" "#vi" "#electronica" "#folk")
434 '("#em" "#v")) ; vi is shortened by one letter
435 (equal (let ((erc-track-shorten-aggressively 'max
))
436 (erc-unique-channel-names
437 '("#emacs" "#vi" "#electronica" "#folk")
439 '("#e" "#v")) ; emacs need not be different from electronica
440 (equal (let ((erc-track-shorten-aggressively nil
))
441 (erc-unique-channel-names
442 '("#linux-de" "#linux-fr")
443 '("#linux-de" "#linux-fr")))
444 '("#linux-de" "#linux-fr")) ; shortening by one letter is too aggressive
445 (equal (let ((erc-track-shorten-aggressively t
))
446 (erc-unique-channel-names
447 '("#linux-de" "#linux-fr")
448 '("#linux-de" "#linux-fr")))
449 '("#linux-d" "#linux-f")); now we want to be aggressive
451 (equal (let ((erc-track-shorten-aggressively nil
))
452 (erc-unique-channel-names
453 '("#dunnet" "#lisp" "#sawfish" "#fsf" "#guile"
454 "#testgnome" "#gnu" "#fsbot" "#hurd" "#hurd-bunny"
456 '("#hurd-bunny" "#hurd" "#sawfish" "#lisp")))
457 '("#hurd-" "#hurd" "#s" "#l"))
458 (equal (let ((erc-track-shorten-aggressively nil
))
459 (erc-unique-substrings
460 '("#emacs" "#vi" "#electronica" "#folk")))
461 '("#em" "#vi" "#el" "#f"))
462 (equal (let ((erc-track-shorten-aggressively t
))
463 (erc-unique-substrings
464 '("#emacs" "#vi" "#electronica" "#folk")))
465 '("#em" "#v" "#el" "#f"))
466 (equal (let ((erc-track-shorten-aggressively nil
))
467 (erc-unique-channel-names
468 '("#emacs" "#burse" "+linux.de" "#starwars"
469 "#bitlbee" "+burse" "#ratpoison")
470 '("+linux.de" "#starwars" "#burse")))
472 (equal (let ((erc-track-shorten-aggressively nil
))
473 (erc-unique-channel-names
474 '("fsbot" "#emacs" "deego")
477 (equal (let ((erc-track-shorten-aggressively nil
))
478 (erc-unique-channel-names
479 '("fsbot" "#emacs" "deego")
485 (equal (let ((erc-track-shorten-aggressively nil
))
486 (erc-unique-channel-names
487 '("fsbot" "#emacs" "deego")
493 (let ((erc-track-shorten-aggressively nil
))
494 (equal (erc-unique-channel-names '("deego" "#hurd" "#hurd-bunny" "#emacs")
495 '("#hurd" "#hurd-bunny"))
496 '("#hurd" "#hurd-")))
498 (let ((erc-track-shorten-aggressively t
))
499 (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
500 (not (erc-unique-substring-1 "a" '("xyz" "xab")))
501 (equal (erc-unique-substrings '("abc" "xyz" "xab"))
503 (equal (erc-unique-substrings '("abc" "abcdefg"))
505 (let ((erc-track-shorten-aggressively nil
))
506 (and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
507 (not (erc-unique-substring-1 "a" '("xyz" "xab")))
508 (equal (erc-unique-substrings '("abc" "xyz" "xab"))
509 '("abc" "xyz" "xab"))
510 (equal (erc-unique-substrings '("abc" "abcdefg"))
515 ;; Play nice with other IRC clients (and Emacs development rules) by
516 ;; making this a minor mode
518 (defvar erc-track-minor-mode-map
(make-sparse-keymap)
519 "Keymap for rcirc track minor mode.")
521 (define-key erc-track-minor-mode-map
(kbd "C-c C-@") 'erc-track-switch-buffer
)
522 (define-key erc-track-minor-mode-map
(kbd "C-c C-SPC")
523 'erc-track-switch-buffer
)
526 (define-minor-mode erc-track-minor-mode
527 "Global minor mode for tracking ERC buffers and showing activity in the
530 This exists for the sole purpose of providing the C-c C-SPC and
531 C-c C-@ keybindings. Make sure that you have enabled the track
532 module, otherwise the keybindings will not do anything useful."
535 :keymap erc-track-minor-mode-map
539 (defun erc-track-minor-mode-maybe ()
540 "Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'."
541 (unless (or erc-track-minor-mode
542 ;; don't start the minor mode until we have an ERC
543 ;; process running, because we don't want to prompt the
544 ;; user while starting Emacs
545 (null (erc-buffer-list)))
546 (cond ((eq erc-track-enable-keybindings
'ask
)
547 (let ((key (or (and (key-binding (kbd "C-c C-SPC")) "C-SPC")
548 (and (key-binding (kbd "C-c C-@")) "C-@"))))
551 (concat "The C-c " key
" binding is in use;"
552 " override it for tracking? "))
554 (message (concat "Will change it; set"
555 " `erc-track-enable-keybindings'"
556 " to disable this message"))
558 (erc-track-minor-mode 1))
559 (message (concat "Not changing it; set"
560 " `erc-track-enable-keybindings'"
561 " to disable this message"))
563 (erc-track-minor-mode 1))))
564 ((eq erc-track-enable-keybindings t
)
565 (erc-track-minor-mode 1))
570 ;;;###autoload (autoload 'erc-track-mode "erc-track" nil t)
571 (define-erc-module track nil
572 "This mode tracks ERC channel buffers with activity."
574 ((when (boundp 'erc-track-when-inactive
)
575 (if erc-track-when-inactive
577 (if (featurep 'xemacs
)
578 (defadvice switch-to-buffer
(after erc-update-when-inactive
579 (&rest args
) activate
)
580 (erc-user-is-active))
581 (add-hook 'window-configuration-change-hook
'erc-user-is-active
))
582 (add-hook 'erc-send-completed-hook
'erc-user-is-active
)
583 (add-hook 'erc-server-001-functions
'erc-user-is-active
))
584 (erc-track-add-to-mode-line erc-track-position-in-mode-line
)
585 (setq erc-modified-channels-object
(erc-modified-channels-object nil
))
586 (erc-update-mode-line)
587 (if (featurep 'xemacs
)
588 (defadvice switch-to-buffer
(after erc-update
(&rest args
) activate
)
589 (erc-modified-channels-update))
590 (add-hook 'window-configuration-change-hook
591 'erc-modified-channels-update
))
592 (add-hook 'erc-insert-post-hook
'erc-track-modified-channels
)
593 (add-hook 'erc-disconnected-hook
'erc-modified-channels-update
))
594 ;; enable the tracking keybindings
595 (erc-track-minor-mode-maybe)))
597 ((when (boundp 'erc-track-when-inactive
)
598 (erc-track-remove-from-mode-line)
599 (if erc-track-when-inactive
601 (if (featurep 'xemacs
)
602 (ad-disable-advice 'switch-to-buffer
'after
603 'erc-update-when-inactive
)
604 (remove-hook 'window-configuration-change-hook
605 'erc-user-is-active
))
606 (remove-hook 'erc-send-completed-hook
'erc-user-is-active
)
607 (remove-hook 'erc-server-001-functions
'erc-user-is-active
)
608 (remove-hook 'erc-timer-hook
'erc-user-is-active
))
609 (if (featurep 'xemacs
)
610 (ad-disable-advice 'switch-to-buffer
'after
'erc-update
)
611 (remove-hook 'window-configuration-change-hook
612 'erc-modified-channels-update
))
613 (remove-hook 'erc-disconnected-hook
'erc-modified-channels-update
)
614 (remove-hook 'erc-insert-post-hook
'erc-track-modified-channels
))
615 ;; disable the tracking keybindings
616 (when erc-track-minor-mode
617 (erc-track-minor-mode -
1)))))
619 (defcustom erc-track-when-inactive nil
620 "Enable channel tracking even for visible buffers, if you are
624 :set
(lambda (sym val
)
634 (defvar erc-buffer-activity nil
635 "Last time the user sent something.")
637 (defvar erc-buffer-activity-timeout
10
638 "How many seconds of inactivity by the user
639 to consider when `erc-track-visibility' is set to
640 only consider active buffers visible.")
642 (defun erc-user-is-active (&rest ignore
)
643 "Set `erc-buffer-activity'."
644 (setq erc-buffer-activity
(erc-current-time))
645 (erc-track-modified-channels))
647 (defun erc-buffer-visible (buffer)
648 "Return non-nil when the buffer is visible."
649 (if erc-track-when-inactive
650 (when erc-buffer-activity
; could be nil
651 (and (get-buffer-window buffer erc-track-visibility
)
652 (<= (erc-time-diff erc-buffer-activity
(erc-current-time))
653 erc-buffer-activity-timeout
)))
654 (get-buffer-window buffer erc-track-visibility
)))
656 ;;; Tracking the channel modifications
658 (defvar erc-modified-channels-update-inside nil
659 "Variable to prevent running `erc-modified-channels-update' multiple
660 times. Without it, you cannot debug `erc-modified-channels-display',
661 because the debugger also cases changes to the window-configuration.")
663 (defun erc-modified-channels-update (&rest args
)
664 "This function updates the information in `erc-modified-channels-alist'
665 according to buffer visibility. It calls
666 `erc-modified-channels-display' at the end. This should usually be
667 called via `window-configuration-change-hook'.
670 (unless erc-modified-channels-update-inside
671 (let ((erc-modified-channels-update-inside t
))
672 (mapcar (lambda (elt)
673 (let ((buffer (car elt
)))
674 (when (or (not (bufferp buffer
))
675 (not (buffer-live-p buffer
))
676 (erc-buffer-visible buffer
)
677 (not (with-current-buffer buffer
678 erc-server-connected
)))
679 (erc-modified-channels-remove-buffer buffer
))))
680 erc-modified-channels-alist
)
681 (erc-modified-channels-display)
682 (force-mode-line-update t
))))
684 (defvar erc-track-mouse-face
(if (featurep 'xemacs
)
686 'mode-line-highlight
)
687 "The face to use when mouse is over channel names in the mode line.")
689 (defun erc-make-mode-line-buffer-name (string buffer
&optional faces count
)
690 "Return STRING as a button that switches to BUFFER when clicked.
691 If FACES are provided, color STRING with them."
692 ;; We define a new sparse keymap every time, because 1. this data
693 ;; structure is very small, the alternative would require us to
694 ;; defvar a keymap, 2. the user is not interested in customizing it
695 ;; (really?), 3. the defun needs to switch to BUFFER, so we would
696 ;; need to save that value somewhere.
697 (let ((map (make-sparse-keymap))
698 (name (if erc-track-showcount
700 erc-track-showcount-string
701 (int-to-string count
))
702 (copy-sequence string
))))
703 (define-key map
(vector 'mode-line
'mouse-2
)
706 (save-selected-window
708 (posn-window (event-start e
)))
709 (switch-to-buffer ,buffer
))))
710 (define-key map
(vector 'mode-line
'mouse-3
)
713 (save-selected-window
715 (posn-window (event-start e
)))
716 (switch-to-buffer-other-window ,buffer
))))
717 (put-text-property 0 (length name
) 'local-map map name
)
720 'help-echo
(concat "mouse-2: switch to buffer, "
721 "mouse-3: switch to buffer in other window")
723 (put-text-property 0 (length name
) 'mouse-face erc-track-mouse-face name
)
724 (when (and faces erc-track-use-faces
)
725 (put-text-property 0 (length name
) 'face faces name
))
728 (defun erc-modified-channels-display ()
729 "Set `erc-modified-channels-object'
730 according to `erc-modified-channels-alist'.
731 Use `erc-make-mode-line-buffer-name' to create buttons."
733 (eq 'mostactive erc-track-switch-direction
)
734 (eq 'leastactive erc-track-switch-direction
))
735 (erc-track-sort-by-activest))
736 (if (null erc-modified-channels-alist
)
737 (setq erc-modified-channels-object
(erc-modified-channels-object nil
))
738 ;; erc-modified-channels-alist contains all the data we need. To
739 ;; better understand what is going on, we split things up into
740 ;; four lists: BUFFERS, COUNTS, SHORT-NAMES, and FACES. These
741 ;; four lists we use to create a new
742 ;; `erc-modified-channels-object' using
743 ;; `erc-make-mode-line-buffer-name'.
744 (let* ((buffers (mapcar 'car erc-modified-channels-alist
))
745 (counts (mapcar 'cadr erc-modified-channels-alist
))
746 (faces (mapcar 'cddr erc-modified-channels-alist
))
747 (long-names (mapcar #'(lambda (buf)
748 (or (buffer-name buf
)
751 (short-names (if (functionp erc-track-shorten-function
)
752 (funcall erc-track-shorten-function
757 (when (car short-names
)
758 (setq strings
(cons (erc-make-mode-line-buffer-name
764 (setq short-names
(cdr short-names
)
765 buffers
(cdr buffers
)
768 (when (featurep 'xemacs
)
769 (erc-modified-channels-object nil
))
770 (setq erc-modified-channels-object
771 (erc-modified-channels-object strings
)))))
773 (defun erc-modified-channels-remove-buffer (buffer)
774 "Remove BUFFER from `erc-modified-channels-alist'."
775 (interactive "bBuffer: ")
776 (setq erc-modified-channels-alist
777 (delete (assq buffer erc-modified-channels-alist
)
778 erc-modified-channels-alist
))
779 (when (interactive-p)
780 (erc-modified-channels-display)))
782 (defun erc-track-find-face (faces)
783 "Return the face to use in the modeline from the faces in FACES.
784 If `erc-track-faces-priority-list' is set, the one from FACES who is
785 first in that list will be used."
786 (let ((candidates erc-track-faces-priority-list
)
788 (while (and candidates
(not face
))
789 (setq candidate
(car candidates
)
790 candidates
(cdr candidates
))
791 (when (memq candidate faces
)
792 (setq face candidate
)))
795 (defun erc-track-modified-channels ()
796 "Hook function for `erc-insert-post-hook' to check if the current
797 buffer should be added to the modeline as a hidden, modified
798 channel. Assumes it will only be called when current-buffer
800 (let ((this-channel (or (erc-default-target)
801 (buffer-name (current-buffer)))))
802 (if (and (not (erc-buffer-visible (current-buffer)))
803 (not (member this-channel erc-track-exclude
))
804 (not (and erc-track-exclude-server-buffer
805 (string= this-channel
806 (buffer-name (erc-server-buffer)))))
807 (not (erc-message-type-member
808 (or (erc-find-parsed-property)
810 erc-track-exclude-types
)))
811 ;; If the active buffer is not visible (not shown in a
812 ;; window), and not to be excluded, determine the kinds of
813 ;; faces used in the current message, and unless the user
814 ;; wants to ignore changes in certain channels where there
815 ;; are no faces corresponding to `erc-track-faces-priority-list',
816 ;; and the faces in the current message are found in said
817 ;; priority list, add the buffer to the erc-modified-channels-alist,
818 ;; if it is not already there. If the buffer is already on the list
819 ;; (in the car), change its face attribute (in the cddr) if
820 ;; necessary. See `erc-modified-channels-alist' for the
821 ;; exact data structure used.
822 (let ((faces (erc-faces-in (buffer-string))))
824 (or (eq erc-track-priority-faces-only
'all
)
825 (member this-channel erc-track-priority-faces-only
))
828 (when (member f erc-track-faces-priority-list
)
829 (throw 'found t
))))))
830 (if (not (assq (current-buffer) erc-modified-channels-alist
))
831 ;; Add buffer, faces and counts
832 (setq erc-modified-channels-alist
833 (cons (cons (current-buffer)
834 (cons 1 (erc-track-find-face faces
)))
835 erc-modified-channels-alist
))
836 ;; Else modify the face for the buffer, if necessary.
838 (let* ((cell (assq (current-buffer)
839 erc-modified-channels-alist
))
840 (old-face (cddr cell
))
841 (new-face (erc-track-find-face
843 (cons old-face faces
)
845 (setcdr cell
(cons (1+ (cadr cell
)) new-face
)))))
847 (erc-modified-channels-display)))
848 ;; Else if the active buffer is the current buffer, remove it
850 (when (or (erc-buffer-visible (current-buffer))
852 (assq (current-buffer) erc-modified-channels-alist
)
853 (member this-channel erc-track-exclude
)))
854 ;; Remove it from mode-line if buffer is visible or
855 ;; channel was added to erc-track-exclude recently.
856 (erc-modified-channels-remove-buffer (current-buffer))
857 (erc-modified-channels-display)))))
859 (defun erc-faces-in (str)
860 "Return a list of all faces used in STR."
863 (faces (erc-list (get-text-property 0 'face str
))))
864 (while (and (setq i
(next-single-property-change i
'face str m
))
866 (dolist (face (erc-list (get-text-property i
'face str
)))
867 (add-to-list 'faces face
)))
871 (let ((str "is bold"))
872 (put-text-property 3 (length str
)
873 'face
'(bold erc-current-nick-face
)
879 (defvar erc-track-last-non-erc-buffer nil
880 "Stores the name of the last buffer you were in before activating
881 `erc-track-switch-buffers'")
883 (defun erc-track-sort-by-activest ()
884 "Sort erc-modified-channels-alist by activity.
885 That means the number of unseen messages in a channel."
886 (setq erc-modified-channels-alist
887 (sort erc-modified-channels-alist
888 (lambda (a b
) (> (nth 1 a
) (nth 1 b
))))))
890 (defun erc-track-get-active-buffer (arg)
891 "Return the buffer name of ARG in `erc-modified-channels-alist'.
892 Negative arguments index in the opposite direction. This direction is
893 relative to `erc-track-switch-direction'"
894 (let ((dir erc-track-switch-direction
)
900 (mostactive 'leastactive
)
901 (leastactive 'mostactive
)))
903 (setq offset
(case dir
904 ((oldest leastactive
)
905 (- (length erc-modified-channels-alist
) arg
))
907 ;; normalise out of range user input
908 (cond ((>= offset
(length erc-modified-channels-alist
))
909 (setq offset
(1- (length erc-modified-channels-alist
))))
912 (car (nth offset erc-modified-channels-alist
))))
914 (defun erc-track-switch-buffer (arg)
915 "Switch to the next active ERC buffer, or if there are no active buffers,
916 switch back to the last non-ERC buffer visited. Next is defined by
917 `erc-track-switch-direction', a negative argument will reverse this."
919 (if (not erc-track-mode
)
920 (message (concat "Enable the ERC track module if you want to use the"
921 " tracking minor mode"))
922 (cond (erc-modified-channels-alist
923 ;; if we're not in erc-mode, set this buffer to return to
924 (unless (eq major-mode
'erc-mode
)
925 (setq erc-track-last-non-erc-buffer
(current-buffer)))
926 ;; and jump to the next active channel
927 (switch-to-buffer (erc-track-get-active-buffer arg
)))
928 ;; if no active channels, switch back to what we were doing before
929 ((and erc-track-last-non-erc-buffer
930 erc-track-switch-from-erc
931 (buffer-live-p erc-track-last-non-erc-buffer
))
932 (switch-to-buffer erc-track-last-non-erc-buffer
)))))
936 ;;; erc-track.el ends here
939 ;; indent-tabs-mode: t
943 ;; arch-tag: 11b439f5-e5d7-4c6c-bb3f-eda98f9b0ac1