lisp/erc/erc-nicklist.el

   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.
  91 By \"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.
  98 Icons 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.
 104 The 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
 114 This specifies a percentage of the channel window width.
 115
 116 A negative value means the nicklist window appears on the left of the
 117 channel 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
 125 If 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
 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))
 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.
 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
 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.
 182 Seach 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
 281 Depending on what COMMAND is, it's called with one of POINT, BUFFER,
 282 or 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
 339 Deletes 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
 365 ARG 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.
 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
 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