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