|
68451
|
1 ;;; erc-track.el --- Track modified channel buffers
|
|
|
2
|
|
76856
|
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006,
|
|
100908
|
4 ;; 2007, 2008, 2009 Free Software Foundation, Inc.
|
|
68451
|
5
|
|
|
6 ;; Author: Mario Lang <mlang@delysid.org>
|
|
|
7 ;; Keywords: comm, faces
|
|
|
8 ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcChannelTracking
|
|
|
9
|
|
|
10 ;; This file is part of GNU Emacs.
|
|
|
11
|
|
94660
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
68451
|
13 ;; it under the terms of the GNU General Public License as published by
|
|
94660
|
14 ;; the Free Software Foundation, either version 3 of the License, or
|
|
|
15 ;; (at your option) any later version.
|
|
68451
|
16
|
|
|
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.
|
|
|
21
|
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
94660
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
68451
|
24
|
|
|
25 ;;; Commentary:
|
|
|
26
|
|
|
27 ;; Highlights keywords and pals (friends), and hides or highlights fools
|
|
|
28 ;; (using a dark color). Add to your ~/.emacs:
|
|
|
29
|
|
|
30 ;; (require 'erc-track)
|
|
|
31 ;; (erc-track-mode 1)
|
|
|
32
|
|
|
33 ;; Todo:
|
|
|
34 ;; * Add extensibility so that custom functions can track
|
|
|
35 ;; custom modification types.
|
|
|
36
|
|
|
37 (eval-when-compile (require 'cl))
|
|
|
38 (require 'erc)
|
|
|
39 (require 'erc-compat)
|
|
|
40 (require 'erc-match)
|
|
|
41
|
|
|
42 ;;; Code:
|
|
|
43
|
|
|
44 (defgroup erc-track nil
|
|
|
45 "Track active buffers and show activity in the modeline."
|
|
|
46 :group 'erc)
|
|
|
47
|
|
76856
|
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.
|
|
|
51
|
|
|
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.
|
|
|
55
|
|
|
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.
|
|
|
59
|
|
|
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)))
|
|
|
68
|
|
68451
|
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
|
|
76856
|
74 from the list. See also `erc-track-when-inactive'.
|
|
68451
|
75
|
|
|
76 Possible values are:
|
|
|
77
|
|
|
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
|
|
|
82
|
|
|
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 was active"
|
|
|
89 active)))
|
|
|
90
|
|
|
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))
|
|
|
95
|
|
84387
|
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)
|
|
|
101
|
|
87952
|
102 (defcustom erc-track-exclude-types '("NICK" "333" "353")
|
|
68451
|
103 "*List of message types to be ignored.
|
|
87952
|
104 This list could look like '(\"JOIN\" \"PART\").
|
|
|
105
|
|
|
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)."
|
|
68451
|
109 :group 'erc-track
|
|
|
110 :type 'erc-message-type)
|
|
|
111
|
|
|
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)
|
|
|
118
|
|
|
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)
|
|
|
124
|
|
|
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)
|
|
|
129
|
|
|
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.
|
|
|
136
|
|
|
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.
|
|
71883
|
141 Example: If there are two active channels #emacs and #vi, and two inactive
|
|
68451
|
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.
|
|
|
146
|
|
|
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)))
|
|
|
152
|
|
|
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))
|
|
|
161
|
|
84387
|
162 (defcustom erc-track-list-changed-hook nil
|
|
|
163 "Hook that is run whenever the contents of
|
|
|
164 `erc-modified-channels-alist' changes.
|
|
|
165
|
|
|
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)
|
|
|
171
|
|
68451
|
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)
|
|
|
178
|
|
|
179 (defcustom erc-track-faces-priority-list
|
|
87952
|
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)
|
|
68451
|
200 "A list of faces used to highlight active buffer names in the modeline.
|
|
|
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
|
|
87952
|
204 :type '(repeat (choice face
|
|
|
205 (repeat :tag "Combination" face))))
|
|
68451
|
206
|
|
|
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.
|
|
87952
|
215
|
|
68451
|
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)))
|
|
|
222
|
|
87952
|
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 modeline.
|
|
|
233
|
|
|
234 If a message contains one of the faces in this list, and the
|
|
|
235 previous modeline 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.
|
|
|
239
|
|
|
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))))
|
|
|
244
|
|
68451
|
245 (defcustom erc-track-position-in-mode-line 'before-modes
|
|
|
246 "Where to show modified channel information in the mode-line.
|
|
|
247
|
|
|
248 Setting this variable only has effects in GNU Emacs versions above 21.3.
|
|
|
249
|
|
|
250 Choices are:
|
|
87952
|
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."
|
|
68451
|
255 :group 'erc-track
|
|
|
256 :type '(choice (const :tag "Just before mode information" before-modes)
|
|
|
257 (const :tag "Just after mode information" after-modes)
|
|
84387
|
258 (const :tag "After all other information" t)
|
|
|
259 (const :tag "Don't display in mode line" nil))
|
|
68451
|
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))))
|
|
|
266
|
|
|
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) '() "")))
|
|
|
288
|
|
|
289 (defvar erc-modified-channels-object (erc-modified-channels-object nil)
|
|
|
290 "Internal object used for displaying modified channels in the mode line.")
|
|
|
291
|
|
|
292 (put 'erc-modified-channels-object 'risky-local-variable t); allow properties
|
|
|
293
|
|
|
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'.
|
|
|
301
|
|
|
302 Entries in this list should only happen for buffers where activity occurred
|
|
|
303 while the buffer was not visible.")
|
|
|
304
|
|
|
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)
|
|
|
309
|
|
|
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)
|
|
|
315
|
|
|
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)
|
|
|
321
|
|
|
322 (defcustom erc-track-switch-direction 'oldest
|
|
|
323 "Direction `erc-track-switch-buffer' should switch.
|
|
|
324
|
|
84387
|
325 importance - find buffer with the most important message
|
|
68451
|
326 oldest - find oldest active buffer
|
|
|
327 newest - find newest active buffer
|
|
|
328 leastactive - find buffer with least unseen messages
|
|
84636
|
329 mostactive - find buffer with most unseen messages.
|
|
|
330
|
|
|
331 If set to 'importance, the importance is determined by position
|
|
|
332 in `erc-track-faces-priority-list', where first is most
|
|
|
333 important."
|
|
68451
|
334 :group 'erc-track
|
|
84387
|
335 :type '(choice (const importance)
|
|
|
336 (const oldest)
|
|
68451
|
337 (const newest)
|
|
|
338 (const leastactive)
|
|
|
339 (const mostactive)))
|
|
|
340
|
|
|
341
|
|
|
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))))
|
|
|
350
|
|
|
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))
|
|
84387
|
364 ((eq position t)
|
|
68451
|
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))))
|
|
|
370
|
|
|
371 ;;; Shortening of names
|
|
|
372
|
|
|
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))
|
|
|
387
|
|
|
388 (defvar erc-default-recipients)
|
|
|
389
|
|
|
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)))
|
|
|
401
|
|
|
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
|
|
|
433 0
|
|
|
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))))
|
|
|
440
|
|
|
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
|
|
|
456 str
|
|
|
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))
|
|
|
469 str
|
|
|
470 candidate))))
|
|
|
471 strings))
|
|
|
472
|
|
|
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))
|
|
|
484
|
|
|
485 ;;; Test:
|
|
|
486
|
|
87952
|
487 (assert
|
|
68451
|
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))
|
|
|
548 1))
|
|
|
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))
|
|
|
556 2))
|
|
|
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"))))))
|
|
|
577
|
|
76856
|
578 ;;; Minor mode
|
|
|
579
|
|
|
580 ;; Play nice with other IRC clients (and Emacs development rules) by
|
|
|
581 ;; making this a minor mode
|
|
|
582
|
|
|
583 (defvar erc-track-minor-mode-map (make-sparse-keymap)
|
|
|
584 "Keymap for rcirc track minor mode.")
|
|
|
585
|
|
|
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)
|
|
|
589
|
|
|
590 ;;;###autoload
|
|
|
591 (define-minor-mode erc-track-minor-mode
|
|
|
592 "Global minor mode for tracking ERC buffers and showing activity in the
|
|
|
593 mode line.
|
|
|
594
|
|
|
595 This exists for the sole purpose of providing the C-c C-SPC and
|
|
|
596 C-c C-@ keybindings. Make sure that you have enabled the track
|
|
|
597 module, otherwise the keybindings will not do anything useful."
|
|
|
598 :init-value nil
|
|
|
599 :lighter ""
|
|
|
600 :keymap erc-track-minor-mode-map
|
|
|
601 :global t
|
|
|
602 :group 'erc-track)
|
|
|
603
|
|
87952
|
604 (defun erc-track-minor-mode-maybe (&optional buffer)
|
|
76856
|
605 "Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'."
|
|
87952
|
606 (when (and (not erc-track-minor-mode)
|
|
|
607 ;; don't start the minor mode until we have an ERC
|
|
|
608 ;; process running, because we don't want to prompt the
|
|
|
609 ;; user while starting Emacs
|
|
|
610 (or (and (buffer-live-p buffer)
|
|
|
611 (with-current-buffer buffer (eq major-mode 'erc-mode)))
|
|
|
612 (erc-buffer-list)))
|
|
76856
|
613 (cond ((eq erc-track-enable-keybindings 'ask)
|
|
|
614 (let ((key (or (and (key-binding (kbd "C-c C-SPC")) "C-SPC")
|
|
|
615 (and (key-binding (kbd "C-c C-@")) "C-@"))))
|
|
|
616 (if key
|
|
|
617 (if (y-or-n-p
|
|
|
618 (concat "The C-c " key " binding is in use;"
|
|
|
619 " override it for tracking? "))
|
|
|
620 (progn
|
|
|
621 (message (concat "Will change it; set"
|
|
|
622 " `erc-track-enable-keybindings'"
|
|
|
623 " to disable this message"))
|
|
|
624 (sleep-for 3)
|
|
|
625 (erc-track-minor-mode 1))
|
|
|
626 (message (concat "Not changing it; set"
|
|
|
627 " `erc-track-enable-keybindings'"
|
|
|
628 " to disable this message"))
|
|
|
629 (sleep-for 3))
|
|
|
630 (erc-track-minor-mode 1))))
|
|
|
631 ((eq erc-track-enable-keybindings t)
|
|
|
632 (erc-track-minor-mode 1))
|
|
|
633 (t nil))))
|
|
|
634
|
|
68451
|
635 ;;; Module
|
|
|
636
|
|
|
637 ;;;###autoload (autoload 'erc-track-mode "erc-track" nil t)
|
|
76856
|
638 (define-erc-module track nil
|
|
68451
|
639 "This mode tracks ERC channel buffers with activity."
|
|
76856
|
640 ;; Enable:
|
|
|
641 ((when (boundp 'erc-track-when-inactive)
|
|
|
642 (if erc-track-when-inactive
|
|
|
643 (progn
|
|
|
644 (if (featurep 'xemacs)
|
|
|
645 (defadvice switch-to-buffer (after erc-update-when-inactive
|
|
|
646 (&rest args) activate)
|
|
|
647 (erc-user-is-active))
|
|
|
648 (add-hook 'window-configuration-change-hook 'erc-user-is-active))
|
|
|
649 (add-hook 'erc-send-completed-hook 'erc-user-is-active)
|
|
|
650 (add-hook 'erc-server-001-functions 'erc-user-is-active))
|
|
|
651 (erc-track-add-to-mode-line erc-track-position-in-mode-line)
|
|
|
652 (setq erc-modified-channels-object (erc-modified-channels-object nil))
|
|
|
653 (erc-update-mode-line)
|
|
|
654 (if (featurep 'xemacs)
|
|
|
655 (defadvice switch-to-buffer (after erc-update (&rest args) activate)
|
|
|
656 (erc-modified-channels-update))
|
|
|
657 (add-hook 'window-configuration-change-hook
|
|
|
658 'erc-modified-channels-update))
|
|
|
659 (add-hook 'erc-insert-post-hook 'erc-track-modified-channels)
|
|
|
660 (add-hook 'erc-disconnected-hook 'erc-modified-channels-update))
|
|
|
661 ;; enable the tracking keybindings
|
|
87952
|
662 (add-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
|
|
76856
|
663 (erc-track-minor-mode-maybe)))
|
|
|
664 ;; Disable:
|
|
|
665 ((when (boundp 'erc-track-when-inactive)
|
|
|
666 (erc-track-remove-from-mode-line)
|
|
|
667 (if erc-track-when-inactive
|
|
|
668 (progn
|
|
|
669 (if (featurep 'xemacs)
|
|
|
670 (ad-disable-advice 'switch-to-buffer 'after
|
|
|
671 'erc-update-when-inactive)
|
|
|
672 (remove-hook 'window-configuration-change-hook
|
|
|
673 'erc-user-is-active))
|
|
|
674 (remove-hook 'erc-send-completed-hook 'erc-user-is-active)
|
|
|
675 (remove-hook 'erc-server-001-functions 'erc-user-is-active)
|
|
|
676 (remove-hook 'erc-timer-hook 'erc-user-is-active))
|
|
|
677 (if (featurep 'xemacs)
|
|
|
678 (ad-disable-advice 'switch-to-buffer 'after 'erc-update)
|
|
|
679 (remove-hook 'window-configuration-change-hook
|
|
|
680 'erc-modified-channels-update))
|
|
|
681 (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update)
|
|
|
682 (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels))
|
|
|
683 ;; disable the tracking keybindings
|
|
87952
|
684 (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
|
|
76856
|
685 (when erc-track-minor-mode
|
|
|
686 (erc-track-minor-mode -1)))))
|
|
68451
|
687
|
|
76856
|
688 (defcustom erc-track-when-inactive nil
|
|
|
689 "Enable channel tracking even for visible buffers, if you are
|
|
|
690 inactive."
|
|
|
691 :group 'erc-track
|
|
|
692 :type 'boolean
|
|
|
693 :set (lambda (sym val)
|
|
|
694 (if erc-track-mode
|
|
|
695 (progn
|
|
|
696 (erc-track-disable)
|
|
|
697 (set sym val)
|
|
|
698 (erc-track-enable))
|
|
|
699 (set sym val))))
|
|
68451
|
700
|
|
|
701 ;;; Visibility
|
|
|
702
|
|
|
703 (defvar erc-buffer-activity nil
|
|
|
704 "Last time the user sent something.")
|
|
|
705
|
|
|
706 (defvar erc-buffer-activity-timeout 10
|
|
|
707 "How many seconds of inactivity by the user
|
|
|
708 to consider when `erc-track-visibility' is set to
|
|
|
709 only consider active buffers visible.")
|
|
|
710
|
|
|
711 (defun erc-user-is-active (&rest ignore)
|
|
|
712 "Set `erc-buffer-activity'."
|
|
86836
|
713 (when erc-server-connected
|
|
|
714 (setq erc-buffer-activity (erc-current-time))
|
|
|
715 (erc-track-modified-channels)))
|
|
68451
|
716
|
|
84387
|
717 (defun erc-track-get-buffer-window (buffer frame-param)
|
|
|
718 (if (eq frame-param 'selected-visible)
|
|
|
719 (if (eq (frame-visible-p (selected-frame)) t)
|
|
|
720 (get-buffer-window buffer nil)
|
|
|
721 nil)
|
|
|
722 (get-buffer-window buffer frame-param)))
|
|
68451
|
723
|
|
|
724 (defun erc-buffer-visible (buffer)
|
|
|
725 "Return non-nil when the buffer is visible."
|
|
76856
|
726 (if erc-track-when-inactive
|
|
68451
|
727 (when erc-buffer-activity; could be nil
|
|
84387
|
728 (and (erc-track-get-buffer-window buffer erc-track-visibility)
|
|
68451
|
729 (<= (erc-time-diff erc-buffer-activity (erc-current-time))
|
|
|
730 erc-buffer-activity-timeout)))
|
|
84387
|
731 (erc-track-get-buffer-window buffer erc-track-visibility)))
|
|
68451
|
732
|
|
|
733 ;;; Tracking the channel modifications
|
|
|
734
|
|
|
735 (defvar erc-modified-channels-update-inside nil
|
|
|
736 "Variable to prevent running `erc-modified-channels-update' multiple
|
|
|
737 times. Without it, you cannot debug `erc-modified-channels-display',
|
|
|
738 because the debugger also cases changes to the window-configuration.")
|
|
|
739
|
|
|
740 (defun erc-modified-channels-update (&rest args)
|
|
|
741 "This function updates the information in `erc-modified-channels-alist'
|
|
|
742 according to buffer visibility. It calls
|
|
|
743 `erc-modified-channels-display' at the end. This should usually be
|
|
|
744 called via `window-configuration-change-hook'.
|
|
|
745 ARGS are ignored."
|
|
|
746 (interactive)
|
|
|
747 (unless erc-modified-channels-update-inside
|
|
84387
|
748 (let ((erc-modified-channels-update-inside t)
|
|
|
749 (removed-channel nil))
|
|
85233
|
750 (mapc (lambda (elt)
|
|
|
751 (let ((buffer (car elt)))
|
|
|
752 (when (or (not (bufferp buffer))
|
|
|
753 (not (buffer-live-p buffer))
|
|
|
754 (erc-buffer-visible buffer)
|
|
|
755 (and erc-track-remove-disconnected-buffers
|
|
|
756 (not (with-current-buffer buffer
|
|
|
757 erc-server-connected))))
|
|
|
758 (setq removed-channel t)
|
|
|
759 (erc-modified-channels-remove-buffer buffer))))
|
|
|
760 erc-modified-channels-alist)
|
|
84387
|
761 (when removed-channel
|
|
68451
|
762 (erc-modified-channels-display)
|
|
84387
|
763 (force-mode-line-update t)))))
|
|
68451
|
764
|
|
74093
|
765 (defvar erc-track-mouse-face (if (featurep 'xemacs)
|
|
|
766 'modeline-mousable
|
|
|
767 'mode-line-highlight)
|
|
|
768 "The face to use when mouse is over channel names in the mode line.")
|
|
|
769
|
|
68451
|
770 (defun erc-make-mode-line-buffer-name (string buffer &optional faces count)
|
|
|
771 "Return STRING as a button that switches to BUFFER when clicked.
|
|
|
772 If FACES are provided, color STRING with them."
|
|
|
773 ;; We define a new sparse keymap every time, because 1. this data
|
|
|
774 ;; structure is very small, the alternative would require us to
|
|
|
775 ;; defvar a keymap, 2. the user is not interested in customizing it
|
|
|
776 ;; (really?), 3. the defun needs to switch to BUFFER, so we would
|
|
|
777 ;; need to save that value somewhere.
|
|
|
778 (let ((map (make-sparse-keymap))
|
|
|
779 (name (if erc-track-showcount
|
|
|
780 (concat string
|
|
|
781 erc-track-showcount-string
|
|
|
782 (int-to-string count))
|
|
|
783 (copy-sequence string))))
|
|
|
784 (define-key map (vector 'mode-line 'mouse-2)
|
|
|
785 `(lambda (e)
|
|
|
786 (interactive "e")
|
|
|
787 (save-selected-window
|
|
|
788 (select-window
|
|
|
789 (posn-window (event-start e)))
|
|
|
790 (switch-to-buffer ,buffer))))
|
|
|
791 (define-key map (vector 'mode-line 'mouse-3)
|
|
|
792 `(lambda (e)
|
|
|
793 (interactive "e")
|
|
|
794 (save-selected-window
|
|
|
795 (select-window
|
|
|
796 (posn-window (event-start e)))
|
|
|
797 (switch-to-buffer-other-window ,buffer))))
|
|
|
798 (put-text-property 0 (length name) 'local-map map name)
|
|
74093
|
799 (put-text-property
|
|
|
800 0 (length name)
|
|
|
801 'help-echo (concat "mouse-2: switch to buffer, "
|
|
|
802 "mouse-3: switch to buffer in other window")
|
|
|
803 name)
|
|
|
804 (put-text-property 0 (length name) 'mouse-face erc-track-mouse-face name)
|
|
68451
|
805 (when (and faces erc-track-use-faces)
|
|
|
806 (put-text-property 0 (length name) 'face faces name))
|
|
|
807 name))
|
|
|
808
|
|
|
809 (defun erc-modified-channels-display ()
|
|
|
810 "Set `erc-modified-channels-object'
|
|
|
811 according to `erc-modified-channels-alist'.
|
|
|
812 Use `erc-make-mode-line-buffer-name' to create buttons."
|
|
84387
|
813 (cond ((or (eq 'mostactive erc-track-switch-direction)
|
|
|
814 (eq 'leastactive erc-track-switch-direction))
|
|
|
815 (erc-track-sort-by-activest))
|
|
|
816 ((eq 'importance erc-track-switch-direction)
|
|
|
817 (erc-track-sort-by-importance)))
|
|
|
818 (run-hooks 'erc-track-list-changed-hook)
|
|
|
819 (unless (eq erc-track-position-in-mode-line nil)
|
|
68451
|
820 (if (null erc-modified-channels-alist)
|
|
|
821 (setq erc-modified-channels-object (erc-modified-channels-object nil))
|
|
|
822 ;; erc-modified-channels-alist contains all the data we need. To
|
|
|
823 ;; better understand what is going on, we split things up into
|
|
|
824 ;; four lists: BUFFERS, COUNTS, SHORT-NAMES, and FACES. These
|
|
|
825 ;; four lists we use to create a new
|
|
|
826 ;; `erc-modified-channels-object' using
|
|
|
827 ;; `erc-make-mode-line-buffer-name'.
|
|
|
828 (let* ((buffers (mapcar 'car erc-modified-channels-alist))
|
|
|
829 (counts (mapcar 'cadr erc-modified-channels-alist))
|
|
|
830 (faces (mapcar 'cddr erc-modified-channels-alist))
|
|
|
831 (long-names (mapcar #'(lambda (buf)
|
|
|
832 (or (buffer-name buf)
|
|
|
833 ""))
|
|
|
834 buffers))
|
|
|
835 (short-names (if (functionp erc-track-shorten-function)
|
|
|
836 (funcall erc-track-shorten-function
|
|
|
837 long-names)
|
|
|
838 long-names))
|
|
|
839 strings)
|
|
|
840 (while buffers
|
|
|
841 (when (car short-names)
|
|
|
842 (setq strings (cons (erc-make-mode-line-buffer-name
|
|
|
843 (car short-names)
|
|
|
844 (car buffers)
|
|
|
845 (car faces)
|
|
|
846 (car counts))
|
|
|
847 strings)))
|
|
|
848 (setq short-names (cdr short-names)
|
|
|
849 buffers (cdr buffers)
|
|
|
850 counts (cdr counts)
|
|
|
851 faces (cdr faces)))
|
|
|
852 (when (featurep 'xemacs)
|
|
|
853 (erc-modified-channels-object nil))
|
|
|
854 (setq erc-modified-channels-object
|
|
92128
|
855 (erc-modified-channels-object strings))))))
|
|
68451
|
856
|
|
|
857 (defun erc-modified-channels-remove-buffer (buffer)
|
|
|
858 "Remove BUFFER from `erc-modified-channels-alist'."
|
|
|
859 (interactive "bBuffer: ")
|
|
|
860 (setq erc-modified-channels-alist
|
|
|
861 (delete (assq buffer erc-modified-channels-alist)
|
|
|
862 erc-modified-channels-alist))
|
|
|
863 (when (interactive-p)
|
|
|
864 (erc-modified-channels-display)))
|
|
|
865
|
|
|
866 (defun erc-track-find-face (faces)
|
|
|
867 "Return the face to use in the modeline from the faces in FACES.
|
|
92128
|
868 If `erc-track-faces-priority-list' is set, the one from FACES who
|
|
|
869 is first in that list will be used. If nothing matches or if
|
|
|
870 `erc-track-faces-priority-list' is not set, the default mode-line
|
|
|
871 faces will be used.
|
|
87952
|
872
|
|
|
873 If `erc-track-faces-normal-list' is non-nil, use it to produce a
|
|
|
874 blinking effect that indicates channel activity when the first
|
|
|
875 element in FACES and the highest-ranking face among the rest of
|
|
|
876 FACES are both members of `erc-track-faces-normal-list'.
|
|
|
877
|
|
|
878 If one of the faces is a list, then it will be ranked according
|
|
|
879 to its highest-tanking face member. A list of faces including
|
|
|
880 that member will take priority over just the single member
|
|
|
881 element."
|
|
|
882 (let ((choice (catch 'face
|
|
|
883 (dolist (candidate erc-track-faces-priority-list)
|
|
|
884 (when (member candidate faces)
|
|
|
885 (throw 'face candidate)))))
|
|
|
886 (no-first (and erc-track-faces-normal-list
|
|
|
887 (catch 'face
|
|
|
888 (dolist (candidate erc-track-faces-priority-list)
|
|
|
889 (when (member candidate (cdr faces))
|
|
|
890 (throw 'face candidate)))))))
|
|
|
891 (cond ((null choice)
|
|
92128
|
892 nil)
|
|
87952
|
893 ((and (member choice erc-track-faces-normal-list)
|
|
|
894 (member no-first erc-track-faces-normal-list))
|
|
|
895 no-first)
|
|
|
896 (t
|
|
|
897 choice))))
|
|
68451
|
898
|
|
|
899 (defun erc-track-modified-channels ()
|
|
|
900 "Hook function for `erc-insert-post-hook' to check if the current
|
|
|
901 buffer should be added to the modeline as a hidden, modified
|
|
|
902 channel. Assumes it will only be called when current-buffer
|
|
|
903 is in `erc-mode'."
|
|
|
904 (let ((this-channel (or (erc-default-target)
|
|
|
905 (buffer-name (current-buffer)))))
|
|
|
906 (if (and (not (erc-buffer-visible (current-buffer)))
|
|
|
907 (not (member this-channel erc-track-exclude))
|
|
|
908 (not (and erc-track-exclude-server-buffer
|
|
84387
|
909 (erc-server-buffer-p)))
|
|
68451
|
910 (not (erc-message-type-member
|
|
|
911 (or (erc-find-parsed-property)
|
|
|
912 (point-min))
|
|
|
913 erc-track-exclude-types)))
|
|
|
914 ;; If the active buffer is not visible (not shown in a
|
|
|
915 ;; window), and not to be excluded, determine the kinds of
|
|
|
916 ;; faces used in the current message, and unless the user
|
|
|
917 ;; wants to ignore changes in certain channels where there
|
|
|
918 ;; are no faces corresponding to `erc-track-faces-priority-list',
|
|
|
919 ;; and the faces in the current message are found in said
|
|
|
920 ;; priority list, add the buffer to the erc-modified-channels-alist,
|
|
|
921 ;; if it is not already there. If the buffer is already on the list
|
|
|
922 ;; (in the car), change its face attribute (in the cddr) if
|
|
|
923 ;; necessary. See `erc-modified-channels-alist' for the
|
|
|
924 ;; exact data structure used.
|
|
|
925 (let ((faces (erc-faces-in (buffer-string))))
|
|
|
926 (unless (and
|
|
|
927 (or (eq erc-track-priority-faces-only 'all)
|
|
|
928 (member this-channel erc-track-priority-faces-only))
|
|
|
929 (not (catch 'found
|
|
|
930 (dolist (f faces)
|
|
|
931 (when (member f erc-track-faces-priority-list)
|
|
|
932 (throw 'found t))))))
|
|
|
933 (if (not (assq (current-buffer) erc-modified-channels-alist))
|
|
|
934 ;; Add buffer, faces and counts
|
|
|
935 (setq erc-modified-channels-alist
|
|
|
936 (cons (cons (current-buffer)
|
|
|
937 (cons 1 (erc-track-find-face faces)))
|
|
|
938 erc-modified-channels-alist))
|
|
|
939 ;; Else modify the face for the buffer, if necessary.
|
|
|
940 (when faces
|
|
|
941 (let* ((cell (assq (current-buffer)
|
|
|
942 erc-modified-channels-alist))
|
|
|
943 (old-face (cddr cell))
|
|
|
944 (new-face (erc-track-find-face
|
|
|
945 (if old-face
|
|
|
946 (cons old-face faces)
|
|
|
947 faces))))
|
|
|
948 (setcdr cell (cons (1+ (cadr cell)) new-face)))))
|
|
|
949 ;; And display it
|
|
|
950 (erc-modified-channels-display)))
|
|
|
951 ;; Else if the active buffer is the current buffer, remove it
|
|
|
952 ;; from our list.
|
|
84387
|
953 (when (and (or (erc-buffer-visible (current-buffer))
|
|
68451
|
954 (and this-channel
|
|
|
955 (member this-channel erc-track-exclude)))
|
|
84387
|
956 (assq (current-buffer) erc-modified-channels-alist))
|
|
68451
|
957 ;; Remove it from mode-line if buffer is visible or
|
|
|
958 ;; channel was added to erc-track-exclude recently.
|
|
|
959 (erc-modified-channels-remove-buffer (current-buffer))
|
|
|
960 (erc-modified-channels-display)))))
|
|
|
961
|
|
|
962 (defun erc-faces-in (str)
|
|
|
963 "Return a list of all faces used in STR."
|
|
|
964 (let ((i 0)
|
|
|
965 (m (length str))
|
|
87952
|
966 (faces (erc-list (get-text-property 0 'face str)))
|
|
|
967 cur)
|
|
68451
|
968 (while (and (setq i (next-single-property-change i 'face str m))
|
|
|
969 (not (= i m)))
|
|
87952
|
970 (when (setq cur (get-text-property i 'face str))
|
|
|
971 (add-to-list 'faces cur)))
|
|
68451
|
972 faces))
|
|
|
973
|
|
87952
|
974 (assert
|
|
68451
|
975 (let ((str "is bold"))
|
|
|
976 (put-text-property 3 (length str)
|
|
|
977 'face '(bold erc-current-nick-face)
|
|
|
978 str)
|
|
|
979 (erc-faces-in str)))
|
|
|
980
|
|
|
981 ;;; Buffer switching
|
|
|
982
|
|
|
983 (defvar erc-track-last-non-erc-buffer nil
|
|
|
984 "Stores the name of the last buffer you were in before activating
|
|
|
985 `erc-track-switch-buffers'")
|
|
|
986
|
|
|
987 (defun erc-track-sort-by-activest ()
|
|
|
988 "Sort erc-modified-channels-alist by activity.
|
|
|
989 That means the number of unseen messages in a channel."
|
|
|
990 (setq erc-modified-channels-alist
|
|
|
991 (sort erc-modified-channels-alist
|
|
|
992 (lambda (a b) (> (nth 1 a) (nth 1 b))))))
|
|
|
993
|
|
84387
|
994 (defun erc-track-face-priority (face)
|
|
|
995 "Return a number indicating the priority of FACE in
|
|
|
996 `erc-track-faces-priority-list'. Lower number means higher
|
|
|
997 priority.
|
|
|
998
|
|
|
999 If face is not in `erc-track-faces-priority-list', it will have a
|
|
|
1000 higher number than any other face in that list."
|
|
|
1001 (let ((count 0))
|
|
|
1002 (catch 'done
|
|
|
1003 (dolist (item erc-track-faces-priority-list)
|
|
87952
|
1004 (if (equal item face)
|
|
84387
|
1005 (throw 'done t)
|
|
|
1006 (setq count (1+ count)))))
|
|
|
1007 count))
|
|
|
1008
|
|
|
1009 (defun erc-track-sort-by-importance ()
|
|
|
1010 "Sort erc-modified-channels-alist by importance.
|
|
|
1011 That means the position of the face in `erc-track-faces-priority-list'."
|
|
|
1012 (setq erc-modified-channels-alist
|
|
|
1013 (sort erc-modified-channels-alist
|
|
|
1014 (lambda (a b) (< (erc-track-face-priority (cddr a))
|
|
|
1015 (erc-track-face-priority (cddr b)))))))
|
|
|
1016
|
|
68451
|
1017 (defun erc-track-get-active-buffer (arg)
|
|
|
1018 "Return the buffer name of ARG in `erc-modified-channels-alist'.
|
|
|
1019 Negative arguments index in the opposite direction. This direction is
|
|
|
1020 relative to `erc-track-switch-direction'"
|
|
|
1021 (let ((dir erc-track-switch-direction)
|
|
|
1022 offset)
|
|
|
1023 (when (< arg 0)
|
|
|
1024 (setq dir (case dir
|
|
|
1025 (oldest 'newest)
|
|
|
1026 (newest 'oldest)
|
|
|
1027 (mostactive 'leastactive)
|
|
84387
|
1028 (leastactive 'mostactive)
|
|
|
1029 (importance 'oldest)))
|
|
68451
|
1030 (setq arg (- arg)))
|
|
|
1031 (setq offset (case dir
|
|
|
1032 ((oldest leastactive)
|
|
|
1033 (- (length erc-modified-channels-alist) arg))
|
|
|
1034 (t (1- arg))))
|
|
|
1035 ;; normalise out of range user input
|
|
|
1036 (cond ((>= offset (length erc-modified-channels-alist))
|
|
|
1037 (setq offset (1- (length erc-modified-channels-alist))))
|
|
|
1038 ((< offset 0)
|
|
|
1039 (setq offset 0)))
|
|
|
1040 (car (nth offset erc-modified-channels-alist))))
|
|
|
1041
|
|
|
1042 (defun erc-track-switch-buffer (arg)
|
|
|
1043 "Switch to the next active ERC buffer, or if there are no active buffers,
|
|
|
1044 switch back to the last non-ERC buffer visited. Next is defined by
|
|
|
1045 `erc-track-switch-direction', a negative argument will reverse this."
|
|
|
1046 (interactive "p")
|
|
76856
|
1047 (if (not erc-track-mode)
|
|
|
1048 (message (concat "Enable the ERC track module if you want to use the"
|
|
|
1049 " tracking minor mode"))
|
|
68451
|
1050 (cond (erc-modified-channels-alist
|
|
|
1051 ;; if we're not in erc-mode, set this buffer to return to
|
|
|
1052 (unless (eq major-mode 'erc-mode)
|
|
|
1053 (setq erc-track-last-non-erc-buffer (current-buffer)))
|
|
|
1054 ;; and jump to the next active channel
|
|
|
1055 (switch-to-buffer (erc-track-get-active-buffer arg)))
|
|
|
1056 ;; if no active channels, switch back to what we were doing before
|
|
|
1057 ((and erc-track-last-non-erc-buffer
|
|
|
1058 erc-track-switch-from-erc
|
|
|
1059 (buffer-live-p erc-track-last-non-erc-buffer))
|
|
|
1060 (switch-to-buffer erc-track-last-non-erc-buffer)))))
|
|
|
1061
|
|
|
1062 (provide 'erc-track)
|
|
|
1063
|
|
|
1064 ;;; erc-track.el ends here
|
|
|
1065 ;;
|
|
|
1066 ;; Local Variables:
|
|
|
1067 ;; indent-tabs-mode: t
|
|
|
1068 ;; tab-width: 8
|
|
|
1069 ;; End:
|
|
|
1070
|
|
|
1071 ;; arch-tag: 11b439f5-e5d7-4c6c-bb3f-eda98f9b0ac1
|
