cgit.sxemacs.org Git - packages/blob - xemacs-packages/erc/erc-nicklist.el

   1 ;;; erc-nicklist.el --- Display channel nicknames in a side buffer.
   2
   3 ;; Copyright (C) 2004, 2005, 2006 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.
  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 (defconst erc-nicklist-version "$Revision: 1.14.2.1 $"
  86   "ERC Nicklist version.")
  87
  88 (defgroup erc-nicklist nil
  89   "Display a list of nicknames in a separate window."
  90   :group 'erc)
  91
  92 (defcustom erc-nicklist-use-icons t
  93   "*If non-nil, display an icon instead of the name of the chat medium.
  94 By \"chat medium\", we mean IRC, AOL, MSN, ICQ, etc."
  95   :group 'erc-nicklist
  96   :type 'boolean)
  97
  98 (defcustom erc-nicklist-icons-directory
  99   (concat default-directory "images/")
 100   "*Directory of the PNG files for chat icons.
 101 Icons are displayed if `erc-nicklist-use-icons' is non-nil."
 102   :group 'erc-nicklist
 103   :type 'string)
 104
 105 (defcustom erc-nicklist-voiced-position 'bottom
 106   "*Position of voiced nicks in the nicklist.
 107 The value can be `top', `bottom' or nil (don't sort)."
 108   :group 'erc-nicklist
 109   :type  '(choice
 110            (const :tag "Top" 'top)
 111            (const :tag "Bottom" 'bottom)
 112            (const :tag "Mixed" nil)))
 113
 114 (defcustom erc-nicklist-window-size 20.0
 115   "*The size of the nicklist window.
 116
 117 This specifies a percentage of the channel window width.
 118
 119 A negative value means the nicklist window appears on the left of the
 120 channel window, and vice versa."
 121   :group 'erc-nicklist
 122   :type 'float)
 123
 124
 125 (defun erc-nicklist-buffer-name (&optional buffer)
 126   "Return the buffer name for a nicklist associated with BUFFER.
 127
 128 If BUFFER is nil, use the value of `current-buffer'."
 129   (format " *%s-nicklist*" (buffer-name (or buffer (current-buffer)))))
 130
 131 (defun erc-nicklist-make-window ()
 132   "Create an ERC nicklist window.
 133
 134 See also `erc-nicklist-window-size'."
 135   (let ((width (floor (* (window-width) (/ erc-nicklist-window-size 100.0))))
 136         (buffer (erc-nicklist-buffer-name))
 137         window)
 138     (split-window-horizontally (- width))
 139     (setq window (next-window))
 140     (set-window-buffer window (get-buffer-create buffer))
 141     (with-current-buffer buffer
 142       (set-window-dedicated-p window t))))
 143
 144
 145 (defvar erc-nicklist-images-alist '()
 146   "Alist that maps a connection type to an icon.")
 147
 148 (defun erc-nicklist-insert-medium-name-or-icon (host channel is-away)
 149   "Inserts an icon or a string identifying the current host type.
 150 This is configured using `erc-nicklist-use-icons' and
 151 `erc-nicklist-icons-directory'."
 152   ;; identify the network (for bitlebee usage):
 153   (let ((bitlbee-p (save-match-data
 154                      (string-match "\\`&bitlbee\\b"
 155                                    (buffer-name channel)))))
 156     (cond ((and bitlbee-p
 157                 (string= "login.icq.com" host))
 158            (if erc-nicklist-use-icons
 159                (if is-away
 160                    (insert-image (cdr (assoc 'icq-away
 161                                              erc-nicklist-images-alist)))
 162                  (insert-image (cdr (assoc 'icq
 163                                            erc-nicklist-images-alist))))
 164              (insert "ICQ")))
 165           (bitlbee-p
 166            (if erc-nicklist-use-icons
 167                (if is-away
 168                    (insert-image (cdr (assoc 'msn-away
 169                                              erc-nicklist-images-alist)))
 170                  (insert-image (cdr (assoc 'msn
 171                                            erc-nicklist-images-alist))))
 172              (insert "MSN")))
 173           (t
 174            (if erc-nicklist-use-icons
 175                (if is-away
 176                    (insert-image (cdr (assoc 'irc-away
 177                                              erc-nicklist-images-alist)))
 178                  (insert-image (cdr (assoc 'irc
 179                                            erc-nicklist-images-alist))))
 180              (insert "IRC"))))
 181     (insert " ")))
 182
 183 (defun erc-nicklist-search-for-nick (finger-host)
 184   "Return the bitlbee-nick field for this contact given FINGER-HOST.
 185 Seach for the BBDB record of this contact.  If not found, return nil."
 186   (when (boundp 'erc-bbdb-bitlbee-name-field)
 187     (let ((record (car
 188                    (erc-member-if
 189                     #'(lambda (r)
 190                         (let ((fingers (bbdb-record-finger-host r)))
 191                           (when fingers
 192                             (string-match finger-host
 193                                           (car (bbdb-record-finger-host r))))))
 194                     (bbdb-records)))))
 195       (when record
 196         (bbdb-get-field record erc-bbdb-bitlbee-name-field)))))
 197
 198 (defun erc-nicklist-insert-contents (channel)
 199   "Insert the nicklist contents, with text properties and the optional images."
 200   (setq buffer-read-only nil)
 201   (erase-buffer)
 202   (dolist (u (erc-nicklist-channel-users-info channel))
 203     (let* ((server-user (car u))
 204            (channel-user (cdr u))
 205            (nick     (erc-server-user-nickname server-user))
 206            (host     (erc-server-user-host server-user))
 207            (login    (erc-server-user-login server-user))
 208            (full-name(erc-server-user-full-name server-user))
 209            (info     (erc-server-user-info server-user))
 210            (channels (erc-server-user-buffers server-user))
 211            (op       (erc-channel-user-op channel-user))
 212            (voice    (erc-channel-user-voice channel-user))
 213            (bbdb-nick (erc-nicklist-search-for-nick (concat login "@" host)))
 214            (away-status (if voice "" "\n(Away)"))
 215            (balloon-text (concat bbdb-nick (if (string= "" bbdb-nick)
 216                                                "" "\n")
 217                                  "Login: " login "@" host
 218                                  away-status)))
 219       (erc-nicklist-insert-medium-name-or-icon host channel (not voice))
 220       (unless (or voice erc-nicklist-use-icons)
 221         (setq nick (concat "(" nick ")")))
 222       (when op
 223         (setq nick (concat nick " (OP)")))
 224       (insert (erc-propertize nick
 225                               'erc-nicklist-nick nick
 226                               'mouse-face 'highlight
 227                               'erc-nicklist-channel channel
 228                               'help-echo balloon-text)
 229               "\n")))
 230   (erc-nicklist-mode))
 231
 232
 233 (defun erc-nicklist ()
 234   "Create an ERC nicklist buffer."
 235   (interactive)
 236   (let ((channel (current-buffer)))
 237     (unless (or (not erc-nicklist-use-icons)
 238                 erc-nicklist-images-alist)
 239       (setq erc-nicklist-images-alist
 240             `((msn      . ,(create-image (concat erc-nicklist-icons-directory
 241                                                  "msn-online.png")))
 242               (msn-away . ,(create-image (concat erc-nicklist-icons-directory
 243                                                  "msn-offline.png")))
 244               (irc      . ,(create-image (concat erc-nicklist-icons-directory
 245                                                  "irc-online.png")))
 246               (irc-away . ,(create-image (concat erc-nicklist-icons-directory
 247                                                  "irc-offline.png")))
 248               (icq      . ,(create-image (concat erc-nicklist-icons-directory
 249                                                  "icq-online.png")))
 250               (icq-away . ,(create-image (concat erc-nicklist-icons-directory
 251                                                  "icq-offline.png"))))))
 252     (erc-nicklist-make-window)
 253     (with-current-buffer (get-buffer (erc-nicklist-buffer-name channel))
 254       (erc-nicklist-insert-contents channel)))
 255   (add-hook 'erc-channel-members-changed-hook #'erc-nicklist-update))
 256
 257 (defun erc-nicklist-update ()
 258   "Update the ERC nicklist buffer."
 259   (let ((b (get-buffer (erc-nicklist-buffer-name)))
 260         (channel (current-buffer)))
 261     (when b
 262       (with-current-buffer b
 263         (erc-nicklist-insert-contents channel)))))
 264
 265 (defvar erc-nicklist-mode-map
 266   (let ((map (make-sparse-keymap)))
 267     (define-key map (kbd "<down-mouse-3>") 'erc-nicklist-menu)
 268     (define-key map "\C-j" 'erc-nicklist-kbd-menu)
 269     (define-key map "q"  'erc-nicklist-quit)
 270     (define-key map (kbd "RET") 'erc-nicklist-kbd-cmd-QUERY)
 271     map)
 272   "Keymap for `erc-nicklist-mode'.")
 273
 274 (define-derived-mode erc-nicklist-mode fundamental-mode
 275   "Nicklist"
 276   "Major mode for the ERC nicklist buffer."
 277   (setq buffer-read-only t))
 278
 279 (defun erc-nicklist-call-erc-command (command point buffer window)
 280   "Call an ERC COMMAND.
 281
 282 Depending on what COMMAND is, it's called with one of POINT, BUFFER,
 283 or WINDOW as arguments."
 284   (when command
 285     (let* ((p (text-properties-at point))
 286            (b (plist-get p 'erc-nicklist-channel)))
 287       (if (memq command '(erc-nicklist-quit ignore))
 288           (funcall command window)
 289         ;; EEEK!  Horrble, but it's the only way we can ensure the
 290         ;; response goes to the correct buffer.
 291         (erc-set-active-buffer b)
 292         (switch-to-buffer-other-window b)
 293         (funcall command (plist-get p 'erc-nicklist-nick))))))
 294
 295 (defun erc-nicklist-cmd-QUERY (user &optional server)
 296   "Opens a query buffer with USER."
 297   ;; FIXME: find a way to switch to that buffer afterwards...
 298   (let ((send (if server
 299                   (format "QUERY %s %s" user server)
 300                   (format "QUERY %s" user))))
 301     (erc-cmd-QUERY user)
 302     t))
 303
 304 (defun erc-nicklist-kbd-cmd-QUERY (&optional window)
 305   (interactive)
 306   (let* ((p      (text-properties-at (point)))
 307          (server (plist-get p 'erc-nicklist-channel))
 308          (nick   (plist-get p 'erc-nicklist-nick))
 309          (nick   (or (and (string-match "(\\(.*\\))" nick)
 310                           (match-string 1 nick))
 311                      nick))
 312          (nick   (or (and (string-match "\\+\\(.*\\)" nick)
 313                           (match-string 1 nick))
 314                      nick))
 315          (send   (format "QUERY %s %s" nick server)))
 316     (switch-to-buffer-other-window server)
 317     (erc-cmd-QUERY nick)))
 318
 319
 320 (defvar erc-nicklist-menu
 321   (let ((map (make-sparse-keymap "Action")))
 322     (define-key map [erc-cmd-WHOIS]
 323       '("Whois" . erc-cmd-WHOIS))
 324     (define-key map [erc-cmd-DEOP]
 325       '("Deop" . erc-cmd-DEOP))
 326     (define-key map [erc-cmd-MSG]
 327       '("Message" . erc-cmd-MSG)) ;; TODO!
 328     (define-key map [erc-nicklist-cmd-QUERY]
 329       '("Query" . erc-nicklist-kbd-cmd-QUERY))
 330     (define-key map [ignore]
 331       '("Cancel" . ignore))
 332     (define-key map [erc-nicklist-quit]
 333       '("Close nicklist" . erc-nicklist-quit))
 334     map)
 335   "Menu keymap for the ERC nicklist.")
 336
 337 (defun erc-nicklist-quit (&optional window)
 338   "Delete the ERC nicklist.
 339
 340 Deletes WINDOW and stops updating the nicklist buffer."
 341   (interactive)
 342   (let ((b (window-buffer window)))
 343     (with-current-buffer b
 344       (set-buffer-modified-p nil)
 345       (kill-this-buffer)
 346       (remove-hook 'erc-channel-members-changed-hook 'erc-nicklist-update))))
 347
 348
 349 (defun erc-nicklist-kbd-menu ()
 350   "Show the ERC nicklist menu."
 351   (interactive)
 352   (let* ((point (point))
 353          (window (selected-window))
 354          (buffer (current-buffer)))
 355     (with-current-buffer buffer
 356       (erc-nicklist-call-erc-command
 357        (car (x-popup-menu point
 358                           erc-nicklist-menu))
 359        point
 360        buffer
 361        window))))
 362
 363 (defun erc-nicklist-menu (&optional arg)
 364   "Show the ERC nicklist menu.
 365
 366 ARG is a parametrized event (see `interactive')."
 367   (interactive "e")
 368   (let* ((point (nth 1 (cadr arg)))
 369          (window (car (cadr arg)))
 370          (buffer (window-buffer window)))
 371     (with-current-buffer buffer
 372       (erc-nicklist-call-erc-command
 373        (car (x-popup-menu arg
 374                           erc-nicklist-menu))
 375        point
 376        buffer
 377        window))))
 378
 379
 380 (defun erc-nicklist-channel-users-info (channel)
 381   "Return a nick-sorted list of all users on CHANNEL.
 382 Result are elements in the form (SERVER-USER . CHANNEL-USER). The
 383 list has all the voiced users according to
 384 `erc-nicklist-voiced-position'."
 385   (let* ((nicks (erc-sort-channel-users-alphabetically
 386                  (with-current-buffer channel (erc-get-channel-user-list)))))
 387     (if erc-nicklist-voiced-position
 388         (let ((voiced-nicks (erc-remove-if-not
 389                              #'(lambda (x)
 390                                  (null (erc-channel-user-voice (cdr x))))
 391                              nicks))
 392               (devoiced-nicks (erc-remove-if-not
 393                                #'(lambda (x)
 394                                    (erc-channel-user-voice
 395                                     (cdr x)))
 396                                nicks)))
 397           (cond ((eq erc-nicklist-voiced-position 'top)
 398                  (append devoiced-nicks voiced-nicks))
 399                 ((eq erc-nicklist-voiced-position 'bottom)
 400                  (append voiced-nicks devoiced-nicks))))
 401       nicks)))
 402
 403
 404
 405 (provide 'erc-nicklist)
 406
 407 ;;; erc-nicklist.el ends here
 408 ;;
 409 ;; Local Variables:
 410 ;; indent-tabs-mode: t
 411 ;; tab-width: 8
 412 ;; End:
 413
 414 ;; arch-tag: db37a256-87a7-4544-bd90-e5f16c9f5ca5