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.
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 (erc-nicklist-search-for-nick (concat login
"@" host
)))
211 (away-status (if voice
"" "\n(Away)"))
212 (balloon-text (concat bbdb-nick
(if (string= "" bbdb-nick
)
214 "Login: " login
"@" host
216 (erc-nicklist-insert-medium-name-or-icon host channel
(not voice
))
217 (unless (or voice erc-nicklist-use-icons
)
218 (setq nick
(concat "(" nick
")")))
220 (setq nick
(concat nick
" (OP)")))
221 (insert (erc-propertize nick
222 'erc-nicklist-nick nick
223 'mouse-face
'highlight
224 'erc-nicklist-channel channel
225 'help-echo balloon-text
)
230 (defun erc-nicklist ()
231 "Create an ERC nicklist buffer."
233 (let ((channel (current-buffer)))
234 (unless (or (not erc-nicklist-use-icons
)
235 erc-nicklist-images-alist
)
236 (setq erc-nicklist-images-alist
237 `((msn .
,(create-image (concat erc-nicklist-icons-directory
239 (msn-away .
,(create-image (concat erc-nicklist-icons-directory
241 (irc .
,(create-image (concat erc-nicklist-icons-directory
243 (irc-away .
,(create-image (concat erc-nicklist-icons-directory
245 (icq .
,(create-image (concat erc-nicklist-icons-directory
247 (icq-away .
,(create-image (concat erc-nicklist-icons-directory
248 "icq-offline.png"))))))
249 (erc-nicklist-make-window)
250 (with-current-buffer (get-buffer (erc-nicklist-buffer-name channel
))
251 (erc-nicklist-insert-contents channel
)))
252 (add-hook 'erc-channel-members-changed-hook
#'erc-nicklist-update
))
254 (defun erc-nicklist-update ()
255 "Update the ERC nicklist buffer."
256 (let ((b (get-buffer (erc-nicklist-buffer-name)))
257 (channel (current-buffer)))
259 (with-current-buffer b
260 (erc-nicklist-insert-contents channel
)))))
262 (defvar erc-nicklist-mode-map
263 (let ((map (make-sparse-keymap)))
264 (define-key map
(kbd "<down-mouse-3>") 'erc-nicklist-menu
)
265 (define-key map
"\C-j" 'erc-nicklist-kbd-menu
)
266 (define-key map
"q" 'erc-nicklist-quit
)
267 (define-key map
(kbd "RET") 'erc-nicklist-kbd-cmd-QUERY
)
269 "Keymap for `erc-nicklist-mode'.")
271 (define-derived-mode erc-nicklist-mode fundamental-mode
273 "Major mode for the ERC nicklist buffer."
274 (setq buffer-read-only t
))
276 (defun erc-nicklist-call-erc-command (command point buffer window
)
277 "Call an ERC COMMAND.
279 Depending on what COMMAND is, it's called with one of POINT, BUFFER,
280 or WINDOW as arguments."
282 (let* ((p (text-properties-at point
))
283 (b (plist-get p
'erc-nicklist-channel
)))
284 (if (memq command
'(erc-nicklist-quit ignore
))
285 (funcall command window
)
286 ;; EEEK! Horrble, but it's the only way we can ensure the
287 ;; response goes to the correct buffer.
288 (erc-set-active-buffer b
)
289 (switch-to-buffer-other-window b
)
290 (funcall command
(plist-get p
'erc-nicklist-nick
))))))
292 (defun erc-nicklist-cmd-QUERY (user &optional server
)
293 "Opens a query buffer with USER."
294 ;; FIXME: find a way to switch to that buffer afterwards...
295 (let ((send (if server
296 (format "QUERY %s %s" user server
)
297 (format "QUERY %s" user
))))
301 (defun erc-nicklist-kbd-cmd-QUERY (&optional window
)
303 (let* ((p (text-properties-at (point)))
304 (server (plist-get p
'erc-nicklist-channel
))
305 (nick (plist-get p
'erc-nicklist-nick
))
306 (nick (or (and (string-match "(\\(.*\\))" nick
)
307 (match-string 1 nick
))
309 (nick (or (and (string-match "\\+\\(.*\\)" nick
)
310 (match-string 1 nick
))
312 (send (format "QUERY %s %s" nick server
)))
313 (switch-to-buffer-other-window server
)
314 (erc-cmd-QUERY nick
)))
317 (defvar erc-nicklist-menu
318 (let ((map (make-sparse-keymap "Action")))
319 (define-key map
[erc-cmd-WHOIS
]
320 '("Whois" . erc-cmd-WHOIS
))
321 (define-key map
[erc-cmd-DEOP
]
322 '("Deop" . erc-cmd-DEOP
))
323 (define-key map
[erc-cmd-MSG
]
324 '("Message" . erc-cmd-MSG
)) ;; TODO!
325 (define-key map
[erc-nicklist-cmd-QUERY
]
326 '("Query" . erc-nicklist-kbd-cmd-QUERY
))
327 (define-key map
[ignore]
328 '("Cancel" . ignore))
329 (define-key map [erc-nicklist-quit]
330 '("Close nicklist" . erc-nicklist-quit))
332 "Menu keymap for the ERC nicklist.")
334 (defun erc-nicklist-quit (&optional window)
335 "Delete the ERC nicklist.
337 Deletes WINDOW and stops updating the nicklist buffer."
339 (let ((b (window-buffer window)))
340 (with-current-buffer b
341 (set-buffer-modified-p nil)
343 (remove-hook 'erc-channel-members-changed-hook 'erc-nicklist-update))))
346 (defun erc-nicklist-kbd-menu ()
347 "Show the ERC nicklist menu."
349 (let* ((point (point))
350 (window (selected-window))
351 (buffer (current-buffer)))
352 (with-current-buffer buffer
353 (erc-nicklist-call-erc-command
354 (car (x-popup-menu point
360 (defun erc-nicklist-menu (&optional arg)
361 "Show the ERC nicklist menu.
363 ARG is a parametrized event (see `interactive')."
365 (let* ((point (nth 1 (cadr arg)))
366 (window (car (cadr arg)))
367 (buffer (window-buffer window)))
368 (with-current-buffer buffer
369 (erc-nicklist-call-erc-command
370 (car (x-popup-menu arg
377 (defun erc-nicklist-channel-users-info (channel)
378 "Return a nick-sorted list of all users on CHANNEL.
379 Result are elements in the form (SERVER-USER . CHANNEL-USER). The
380 list has all the voiced users according to
381 `erc-nicklist-voiced-position'."
382 (let* ((nicks (erc-sort-channel-users-alphabetically
383 (with-current-buffer channel (erc-get-channel-user-list)))))
384 (if erc-nicklist-voiced-position
385 (let ((voiced-nicks (erc-remove-if-not
387 (null (erc-channel-user-voice (cdr x))))
389 (devoiced-nicks (erc-remove-if-not
391 (erc-channel-user-voice
394 (cond ((eq erc-nicklist-voiced-position 'top)
395 (append devoiced-nicks voiced-nicks))
396 ((eq erc-nicklist-voiced-position 'bottom)
397 (append voiced-nicks devoiced-nicks))))
402 (provide 'erc-nicklist)
404 ;;; erc-nicklist.el ends here
407 ;; indent-tabs-mode: t
411 ;; arch-tag: db37a256-87a7-4544-bd90-e5f16c9f5ca5