1 ;;; erc-nicklist.el --- Display channel nicknames in a side buffer.
3 ;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
5 ;; Filename: erc-nicklist.el
6 ;; Author: Lawrence Mitchell <wence@gmx.li>
8 ;; Keywords: IRC chat client Internet
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 2, 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 ;; This provides a minimal mIRC style nicklist buffer for ERC. To
30 ;; activate, do M-x erc-nicklist RET in the channel buffer you want
31 ;; the nicklist to appear for. To close and quit the nicklist
32 ;; buffer, do M-x erc-nicklist-quit RET from within the nicklist buffer.
35 ;; o Somehow associate nicklist windows with channel windows so they
36 ;; appear together, and if one gets buried, then the other does.
38 ;; o Make "Query" and "Message" work.
40 ;; o Prettify the actual list of nicks in some way.
42 ;; o Add a proper erc-module that people can turn on and off, figure
43 ;; out a way of creating the nicklist window at an appropriate time
44 ;; --- probably in `erc-join-hook'.
46 ;; o Ensure XEmacs compatibility --- the mouse-menu support is likely
49 ;; o Add option to display in a separate frame --- will again need to
50 ;; be able to associate the nicklist with the currently active
51 ;; channel buffer or something similar.
53 ;; o Allow toggling of visibility of nicklist via ERC commands.
58 ;; Changes by Edgar Gonçalves <edgar.goncalves@inesc-id.pt>
60 ;; - images are changed to a standard set of names.
61 ;; - /images now contain gaim's status icons.
63 ;; - tooltips are improved. they try to access bbdb for a nice nick!
65 ;; - erc-nicklist-channel-users-info was fixed (sorting bug)
66 ;; - Away names don't need parenthesis when using icons
68 ;; - nicks can display icons of their connection type (msn, icq, for now)
70 ;; - nicks now are different for unvoiced and op users
71 ;; - nicks now have tooltips displaying more info
73 ;; - queries now work ok, both on menu and keyb shortcut RET.
74 ;; - nicklist is now sorted ignoring the case. Voiced nicks will
75 ;; appear according to `erc-nicklist-voiced-position'.
83 (eval-when-compile (require 'cl
))
85 (defgroup erc-nicklist nil
86 "Display a list of nicknames in a separate window."
89 (defcustom erc-nicklist-use-icons t
90 "*If non-nil, display an icon instead of the name of the chat medium.
91 By \"chat medium\", we mean IRC, AOL, MSN, ICQ, etc."
95 (defcustom erc-nicklist-icons-directory
96 (concat default-directory
"images/")
97 "*Directory of the PNG files for chat icons.
98 Icons are displayed if `erc-nicklist-use-icons' is non-nil."
102 (defcustom erc-nicklist-voiced-position
'bottom
103 "*Position of voiced nicks in the nicklist.
104 The value can be `top', `bottom' or nil (don't sort)."
107 (const :tag
"Top" 'top
)
108 (const :tag
"Bottom" 'bottom
)
109 (const :tag
"Mixed" nil
)))
111 (defcustom erc-nicklist-window-size
20.0
112 "*The size of the nicklist window.
114 This specifies a percentage of the channel window width.
116 A negative value means the nicklist window appears on the left of the
117 channel window, and vice versa."
122 (defun erc-nicklist-buffer-name (&optional buffer
)
123 "Return the buffer name for a nicklist associated with BUFFER.
125 If BUFFER is nil, use the value of `current-buffer'."
126 (format " *%s-nicklist*" (buffer-name (or buffer
(current-buffer)))))
128 (defun erc-nicklist-make-window ()
129 "Create an ERC nicklist window.
131 See also `erc-nicklist-window-size'."
132 (let ((width (floor (* (window-width) (/ erc-nicklist-window-size
100.0))))
133 (buffer (erc-nicklist-buffer-name))
135 (split-window-horizontally (- width
))
136 (setq window
(next-window))
137 (set-window-buffer window
(get-buffer-create buffer
))
138 (with-current-buffer buffer
139 (set-window-dedicated-p window t
))))
142 (defvar erc-nicklist-images-alist
'()
143 "Alist that maps a connection type to an icon.")
145 (defun erc-nicklist-insert-medium-name-or-icon (host channel is-away
)
146 "Inserts an icon or a string identifying the current host type.
147 This is configured using `erc-nicklist-use-icons' and
148 `erc-nicklist-icons-directory'."
149 ;; identify the network (for bitlebee usage):
150 (let ((bitlbee-p (save-match-data
151 (string-match "\\`&bitlbee\\b"
152 (buffer-name channel
)))))
153 (cond ((and bitlbee-p
154 (string= "login.icq.com" host
))
155 (if erc-nicklist-use-icons
157 (insert-image (cdr (assoc 'icq-away
158 erc-nicklist-images-alist
)))
159 (insert-image (cdr (assoc 'icq
160 erc-nicklist-images-alist
))))
163 (if erc-nicklist-use-icons
165 (insert-image (cdr (assoc 'msn-away
166 erc-nicklist-images-alist
)))
167 (insert-image (cdr (assoc 'msn
168 erc-nicklist-images-alist
))))
171 (if erc-nicklist-use-icons
173 (insert-image (cdr (assoc 'irc-away
174 erc-nicklist-images-alist
)))
175 (insert-image (cdr (assoc 'irc
176 erc-nicklist-images-alist
))))
180 (defun erc-nicklist-search-for-nick (finger-host)
181 "Return the bitlbee-nick field for this contact given FINGER-HOST.
182 Seach for the BBDB record of this contact. If not found, return nil."
183 (when (boundp 'erc-bbdb-bitlbee-name-field
)
187 (let ((fingers (bbdb-record-finger-host r
)))
189 (string-match finger-host
190 (car (bbdb-record-finger-host r
))))))
193 (bbdb-get-field record erc-bbdb-bitlbee-name-field
)))))
195 (defun erc-nicklist-insert-contents (channel)
196 "Insert the nicklist contents, with text properties and the optional images."
197 (setq buffer-read-only nil
)
199 (dolist (u (erc-nicklist-channel-users-info channel
))
200 (let* ((server-user (car u
))
201 (channel-user (cdr u
))
202 (nick (erc-server-user-nickname server-user
))
203 (host (erc-server-user-host server-user
))
204 (login (erc-server-user-login server-user
))
205 (full-name(erc-server-user-full-name server-user
))
206 (info (erc-server-user-info server-user
))
207 (channels (erc-server-user-buffers server-user
))
208 (op (erc-channel-user-op channel-user
))
209 (voice (erc-channel-user-voice channel-user
))
210 (bbdb-nick (or (erc-nicklist-search-for-nick
211 (concat login
"@" host
))
213 (away-status (if voice
"" "\n(Away)"))
214 (balloon-text (concat bbdb-nick
(if (string= "" bbdb-nick
)
216 "Login: " login
"@" host
218 (erc-nicklist-insert-medium-name-or-icon host channel
(not voice
))
219 (unless (or voice erc-nicklist-use-icons
)
220 (setq nick
(concat "(" nick
")")))
222 (setq nick
(concat nick
" (OP)")))
223 (insert (erc-propertize nick
224 'erc-nicklist-nick nick
225 'mouse-face
'highlight
226 'erc-nicklist-channel channel
227 'help-echo balloon-text
)
232 (defun erc-nicklist ()
233 "Create an ERC nicklist buffer."
235 (let ((channel (current-buffer)))
236 (unless (or (not erc-nicklist-use-icons
)
237 erc-nicklist-images-alist
)
238 (setq erc-nicklist-images-alist
239 `((msn .
,(create-image (concat erc-nicklist-icons-directory
241 (msn-away .
,(create-image (concat erc-nicklist-icons-directory
243 (irc .
,(create-image (concat erc-nicklist-icons-directory
245 (irc-away .
,(create-image (concat erc-nicklist-icons-directory
247 (icq .
,(create-image (concat erc-nicklist-icons-directory
249 (icq-away .
,(create-image (concat erc-nicklist-icons-directory
250 "icq-offline.png"))))))
251 (erc-nicklist-make-window)
252 (with-current-buffer (get-buffer (erc-nicklist-buffer-name channel
))
253 (erc-nicklist-insert-contents channel
)))
254 (add-hook 'erc-channel-members-changed-hook
#'erc-nicklist-update
))
256 (defun erc-nicklist-update ()
257 "Update the ERC nicklist buffer."
258 (let ((b (get-buffer (erc-nicklist-buffer-name)))
259 (channel (current-buffer)))
261 (with-current-buffer b
262 (erc-nicklist-insert-contents channel
)))))
264 (defvar erc-nicklist-mode-map
265 (let ((map (make-sparse-keymap)))
266 (define-key map
(kbd "<down-mouse-3>") 'erc-nicklist-menu
)
267 (define-key map
"\C-j" 'erc-nicklist-kbd-menu
)
268 (define-key map
"q" 'erc-nicklist-quit
)
269 (define-key map
(kbd "RET") 'erc-nicklist-kbd-cmd-QUERY
)
271 "Keymap for `erc-nicklist-mode'.")
273 (define-derived-mode erc-nicklist-mode fundamental-mode
275 "Major mode for the ERC nicklist buffer."
276 (setq buffer-read-only t
))
278 (defun erc-nicklist-call-erc-command (command point buffer window
)
279 "Call an ERC COMMAND.
281 Depending on what COMMAND is, it's called with one of POINT, BUFFER,
282 or WINDOW as arguments."
284 (let* ((p (text-properties-at point
))
285 (b (plist-get p
'erc-nicklist-channel
)))
286 (if (memq command
'(erc-nicklist-quit ignore
))
287 (funcall command window
)
288 ;; EEEK! Horrble, but it's the only way we can ensure the
289 ;; response goes to the correct buffer.
290 (erc-set-active-buffer b
)
291 (switch-to-buffer-other-window b
)
292 (funcall command
(plist-get p
'erc-nicklist-nick
))))))
294 (defun erc-nicklist-cmd-QUERY (user &optional server
)
295 "Opens a query buffer with USER."
296 ;; FIXME: find a way to switch to that buffer afterwards...
297 (let ((send (if server
298 (format "QUERY %s %s" user server
)
299 (format "QUERY %s" user
))))
303 (defun erc-nicklist-kbd-cmd-QUERY (&optional window
)
305 (let* ((p (text-properties-at (point)))
306 (server (plist-get p
'erc-nicklist-channel
))
307 (nick (plist-get p
'erc-nicklist-nick
))
308 (nick (or (and (string-match "(\\(.*\\))" nick
)
309 (match-string 1 nick
))
311 (nick (or (and (string-match "\\+\\(.*\\)" nick
)
312 (match-string 1 nick
))
314 (send (format "QUERY %s %s" nick server
)))
315 (switch-to-buffer-other-window server
)
316 (erc-cmd-QUERY nick
)))
319 (defvar erc-nicklist-menu
320 (let ((map (make-sparse-keymap "Action")))
321 (define-key map
[erc-cmd-WHOIS
]
322 '("Whois" . erc-cmd-WHOIS
))
323 (define-key map
[erc-cmd-DEOP
]
324 '("Deop" . erc-cmd-DEOP
))
325 (define-key map
[erc-cmd-MSG
]
326 '("Message" . erc-cmd-MSG
)) ;; TODO!
327 (define-key map
[erc-nicklist-cmd-QUERY
]
328 '("Query" . erc-nicklist-kbd-cmd-QUERY
))
329 (define-key map
[ignore]
330 '("Cancel" . ignore))
331 (define-key map [erc-nicklist-quit]
332 '("Close nicklist" . erc-nicklist-quit))
334 "Menu keymap for the ERC nicklist.")
336 (defun erc-nicklist-quit (&optional window)
337 "Delete the ERC nicklist.
339 Deletes WINDOW and stops updating the nicklist buffer."
341 (let ((b (window-buffer window)))
342 (with-current-buffer b
343 (set-buffer-modified-p nil)
345 (remove-hook 'erc-channel-members-changed-hook 'erc-nicklist-update))))
348 (defun erc-nicklist-kbd-menu ()
349 "Show the ERC nicklist menu."
351 (let* ((point (point))
352 (window (selected-window))
353 (buffer (current-buffer)))
354 (with-current-buffer buffer
355 (erc-nicklist-call-erc-command
356 (car (x-popup-menu point
362 (defun erc-nicklist-menu (&optional arg)
363 "Show the ERC nicklist menu.
365 ARG is a parametrized event (see `interactive')."
367 (let* ((point (nth 1 (cadr arg)))
368 (window (car (cadr arg)))
369 (buffer (window-buffer window)))
370 (with-current-buffer buffer
371 (erc-nicklist-call-erc-command
372 (car (x-popup-menu arg
379 (defun erc-nicklist-channel-users-info (channel)
380 "Return a nick-sorted list of all users on CHANNEL.
381 Result are elements in the form (SERVER-USER . CHANNEL-USER). The
382 list has all the voiced users according to
383 `erc-nicklist-voiced-position'."
384 (let* ((nicks (erc-sort-channel-users-alphabetically
385 (with-current-buffer channel (erc-get-channel-user-list)))))
386 (if erc-nicklist-voiced-position
387 (let ((voiced-nicks (erc-remove-if-not
389 (null (erc-channel-user-voice (cdr x))))
391 (devoiced-nicks (erc-remove-if-not
393 (erc-channel-user-voice
396 (cond ((eq erc-nicklist-voiced-position 'top)
397 (append devoiced-nicks voiced-nicks))
398 ((eq erc-nicklist-voiced-position 'bottom)
399 (append voiced-nicks devoiced-nicks))))
404 (provide 'erc-nicklist)
406 ;;; erc-nicklist.el ends here
409 ;; indent-tabs-mode: t
414 ;; arch-tag: db37a256-87a7-4544-bd90-e5f16c9f5ca5