1;;; erc-nicklist.el --- Display channel nicknames in a side buffer.
2
3;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
5;; Filename: erc-nicklist.el
6;; Author: Lawrence Mitchell <wence@gmx.li>
7;; Created: 2004-04-30
8;; Keywords: IRC chat client Internet
9
10;; This file is part of GNU Emacs.
11
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)
15;; any later version.
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
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.
26
27;;; Commentary:
28;;
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.
33;;
34;; TODO:
35;; o Somehow associate nicklist windows with channel windows so they
36;;   appear together, and if one gets buried, then the other does.
37;;
38;; o Make "Query" and "Message" work.
39;;
40;; o Prettify the actual list of nicks in some way.
41;;
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'.
45;;
46;; o Ensure XEmacs compatibility --- the mouse-menu support is likely
47;;   broken.
48;;
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.
52;;
53;; o Allow toggling of visibility of nicklist via ERC commands.
54
55;;; History:
56;;
57
58;; Changes by Edgar Gonçalves <edgar.goncalves@inesc-id.pt>
59;; Jun 25 2005:
60;;     - images are changed to a standard set of names.
61;;     - /images now contain gaim's status icons.
62;; May 31 2005:
63;;     - tooltips are improved. they try to access bbdb for a nice nick!
64;; Apr 26 2005:
65;;     - erc-nicklist-channel-users-info was fixed (sorting bug)
66;;     - Away names don't need parenthesis when using icons
67;; Apr 26 2005:
68;;     - nicks can display icons of their connection type (msn, icq, for now)
69;; Mar 15 2005:
70;;     - nicks now are different for unvoiced and op users
71;;     - nicks now have tooltips displaying more info
72;; Mar 18 2005:
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'.
76
77;;; Code:
78
79(require 'erc)
80(condition-case nil
81    (require 'erc-bbdb)
82  (error nil))
83(eval-when-compile (require 'cl))
84
85(defgroup erc-nicklist nil
86  "Display a list of nicknames in a separate window."
87  :group 'erc)
88
89(defcustom erc-nicklist-use-icons t
90  "*If non-nil, display an icon instead of the name of the chat medium.
91By \"chat medium\", we mean IRC, AOL, MSN, ICQ, etc."
92  :group 'erc-nicklist
93  :type 'boolean)
94
95(defcustom erc-nicklist-icons-directory
96  (concat default-directory "images/")
97  "*Directory of the PNG files for chat icons.
98Icons are displayed if `erc-nicklist-use-icons' is non-nil."
99  :group 'erc-nicklist
100  :type 'directory)
101
102(defcustom erc-nicklist-voiced-position 'bottom
103  "*Position of voiced nicks in the nicklist.
104The value can be `top', `bottom' or nil (don't sort)."
105  :group 'erc-nicklist
106  :type  '(choice
107	   (const :tag "Top" 'top)
108	   (const :tag "Bottom" 'bottom)
109	   (const :tag "Mixed" nil)))
110
111(defcustom erc-nicklist-window-size 20.0
112  "*The size of the nicklist window.
113
114This specifies a percentage of the channel window width.
115
116A negative value means the nicklist window appears on the left of the
117channel window, and vice versa."
118  :group 'erc-nicklist
119  :type 'float)
120
121
122(defun erc-nicklist-buffer-name (&optional buffer)
123  "Return the buffer name for a nicklist associated with BUFFER.
124
125If BUFFER is nil, use the value of `current-buffer'."
126  (format " *%s-nicklist*" (buffer-name (or buffer (current-buffer)))))
127
128(defun erc-nicklist-make-window ()
129  "Create an ERC nicklist window.
130
131See also `erc-nicklist-window-size'."
132  (let ((width (floor (* (window-width) (/ erc-nicklist-window-size 100.0))))
133	(buffer (erc-nicklist-buffer-name))
134	window)
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))))
140
141
142(defvar erc-nicklist-images-alist '()
143  "Alist that maps a connection type to an icon.")
144
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.
147This 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
156	       (if is-away
157		   (insert-image (cdr (assoc 'icq-away
158					     erc-nicklist-images-alist)))
159		 (insert-image (cdr (assoc 'icq
160					   erc-nicklist-images-alist))))
161	     (insert "ICQ")))
162	  (bitlbee-p
163	   (if erc-nicklist-use-icons
164	       (if is-away
165		   (insert-image (cdr (assoc 'msn-away
166					     erc-nicklist-images-alist)))
167		 (insert-image (cdr (assoc 'msn
168					   erc-nicklist-images-alist))))
169	     (insert "MSN")))
170	  (t
171	   (if erc-nicklist-use-icons
172	       (if is-away
173		   (insert-image (cdr (assoc 'irc-away
174					     erc-nicklist-images-alist)))
175		 (insert-image (cdr (assoc 'irc
176					   erc-nicklist-images-alist))))
177	     (insert "IRC"))))
178    (insert " ")))
179
180(defun erc-nicklist-search-for-nick (finger-host)
181  "Return the bitlbee-nick field for this contact given FINGER-HOST.
182Seach for the BBDB record of this contact.  If not found, return nil."
183  (when (boundp 'erc-bbdb-bitlbee-name-field)
184    (let ((record (car
185		   (erc-member-if
186		    #'(lambda (r)
187			(let ((fingers (bbdb-record-finger-host r)))
188			  (when fingers
189			    (string-match finger-host
190					  (car (bbdb-record-finger-host r))))))
191		    (bbdb-records)))))
192      (when record
193	(bbdb-get-field record erc-bbdb-bitlbee-name-field)))))
194
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)
198  (erase-buffer)
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))
212			  ""))
213	   (away-status (if voice "" "\n(Away)"))
214	   (balloon-text (concat bbdb-nick (if (string= "" bbdb-nick)
215					       "" "\n")
216				 "Login: " login "@" host
217				 away-status)))
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 ")")))
221      (when op
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)
228	      "\n")))
229  (erc-nicklist-mode))
230
231
232(defun erc-nicklist ()
233  "Create an ERC nicklist buffer."
234  (interactive)
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
240						 "msn-online.png")))
241	      (msn-away . ,(create-image (concat erc-nicklist-icons-directory
242						 "msn-offline.png")))
243	      (irc      . ,(create-image (concat erc-nicklist-icons-directory
244						 "irc-online.png")))
245	      (irc-away . ,(create-image (concat erc-nicklist-icons-directory
246						 "irc-offline.png")))
247	      (icq      . ,(create-image (concat erc-nicklist-icons-directory
248						 "icq-online.png")))
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))
255
256(defun erc-nicklist-update ()
257  "Update the ERC nicklist buffer."
258  (let ((b (get-buffer (erc-nicklist-buffer-name)))
259	(channel (current-buffer)))
260    (when b
261      (with-current-buffer b
262	(erc-nicklist-insert-contents channel)))))
263
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)
270    map)
271  "Keymap for `erc-nicklist-mode'.")
272
273(define-derived-mode erc-nicklist-mode fundamental-mode
274  "Nicklist"
275  "Major mode for the ERC nicklist buffer."
276  (setq buffer-read-only t))
277
278(defun erc-nicklist-call-erc-command (command point buffer window)
279  "Call an ERC COMMAND.
280
281Depending on what COMMAND is, it's called with one of POINT, BUFFER,
282or WINDOW as arguments."
283  (when command
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))))))
293
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))))
300    (erc-cmd-QUERY user)
301    t))
302
303(defun erc-nicklist-kbd-cmd-QUERY (&optional window)
304  (interactive)
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))
310		     nick))
311	 (nick   (or (and (string-match "\\+\\(.*\\)" nick)
312			  (match-string 1 nick))
313		     nick))
314	 (send   (format "QUERY %s %s" nick server)))
315    (switch-to-buffer-other-window server)
316    (erc-cmd-QUERY nick)))
317
318
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))
333    map)
334  "Menu keymap for the ERC nicklist.")
335
336(defun erc-nicklist-quit (&optional window)
337  "Delete the ERC nicklist.
338
339Deletes WINDOW and stops updating the nicklist buffer."
340  (interactive)
341  (let ((b (window-buffer window)))
342    (with-current-buffer b
343      (set-buffer-modified-p nil)
344      (kill-this-buffer)
345      (remove-hook 'erc-channel-members-changed-hook 'erc-nicklist-update))))
346
347
348(defun erc-nicklist-kbd-menu ()
349  "Show the ERC nicklist menu."
350  (interactive)
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
357			  erc-nicklist-menu))
358       point
359       buffer
360       window))))
361
362(defun erc-nicklist-menu (&optional arg)
363  "Show the ERC nicklist menu.
364
365ARG is a parametrized event (see `interactive')."
366  (interactive "e")
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
373			  erc-nicklist-menu))
374       point
375       buffer
376       window))))
377
378
379(defun erc-nicklist-channel-users-info (channel)
380  "Return a nick-sorted list of all users on CHANNEL.
381Result are elements in the form (SERVER-USER . CHANNEL-USER). The
382list 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
388			     #'(lambda (x)
389				 (null (erc-channel-user-voice (cdr x))))
390			     nicks))
391	      (devoiced-nicks (erc-remove-if-not
392			       #'(lambda (x)
393				   (erc-channel-user-voice
394				    (cdr x)))
395			       nicks)))
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))))
400      nicks)))
401
402
403
404(provide 'erc-nicklist)
405
406;;; erc-nicklist.el ends here
407;;
408;; Local Variables:
409;; indent-tabs-mode: t
410;; tab-width: 8
411;; coding: utf-8
412;; End:
413
414;; arch-tag: db37a256-87a7-4544-bd90-e5f16c9f5ca5
415