diff options
Diffstat (limited to 'lisp/erc/erc-nicklist.el')
| -rw-r--r-- | lisp/erc/erc-nicklist.el | 411 |
1 files changed, 411 insertions, 0 deletions
diff --git a/lisp/erc/erc-nicklist.el b/lisp/erc/erc-nicklist.el new file mode 100644 index 00000000000..5599565844b --- /dev/null +++ b/lisp/erc/erc-nicklist.el @@ -0,0 +1,411 @@ +;;; erc-nicklist.el --- Display channel nicknames in a side buffer. + +;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. + +;; Filename: erc-nicklist.el +;; Author: Lawrence Mitchell <wence@gmx.li> +;; Created: 2004-04-30 +;; Keywords: IRC chat client Internet + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; This provides a minimal mIRC style nicklist buffer for ERC. To +;; activate, do M-x erc-nicklist RET in the channel buffer you want +;; the nicklist to appear for. To close and quit the nicklist +;; buffer, do M-x erc-nicklist-quit RET. +;; +;; TODO: +;; o Somehow associate nicklist windows with channel windows so they +;; appear together, and if one gets buried, then the other does. +;; +;; o Make "Query" and "Message" work. +;; +;; o Prettify the actual list of nicks in some way. +;; +;; o Add a proper erc-module that people can turn on and off, figure +;; out a way of creating the nicklist window at an appropriate time +;; --- probably in `erc-join-hook'. +;; +;; o Ensure XEmacs compatibility --- the mouse-menu support is likely +;; broken. +;; +;; o Add option to display in a separate frame --- will again need to +;; be able to associate the nicklist with the currently active +;; channel buffer or something similar. +;; +;; o Allow toggling of visibility of nicklist via ERC commands. + +;;; History: +;; + +;; Changes by Edgar Gonçalves <edgar.goncalves@inesc-id.pt> +;; Jun 25 2005: +;; - images are changed to a standard set of names. +;; - /images now contain gaim's status icons. +;; May 31 2005: +;; - tooltips are improved. they try to access bbdb for a nice nick! +;; Apr 26 2005: +;; - erc-nicklist-channel-users-info was fixed (sorting bug) +;; - Away names don't need parenthesis when using icons +;; Apr 26 2005: +;; - nicks can display icons of their connection type (msn, icq, for now) +;; Mar 15 2005: +;; - nicks now are different for unvoiced and op users +;; - nicks now have tooltips displaying more info +;; Mar 18 2005: +;; - queries now work ok, both on menu and keyb shortcut RET. +;; - nicklist is now sorted ignoring the case. Voiced nicks will +;; appear according to `erc-nicklist-voiced-position'. + +;;; Code: + +(require 'erc) +(condition-case nil + (require 'erc-bbdb) + (error nil)) +(eval-when-compile (require 'cl)) + +(defgroup erc-nicklist nil + "Display a list of nicknames in a separate window." + :group 'erc) + +(defcustom erc-nicklist-use-icons t + "*If non-nil, display an icon instead of the name of the chat medium. +By \"chat medium\", we mean IRC, AOL, MSN, ICQ, etc." + :group 'erc-nicklist + :type 'boolean) + +(defcustom erc-nicklist-icons-directory + (concat default-directory "images/") + "*Directory of the PNG files for chat icons. +Icons are displayed if `erc-nicklist-use-icons' is non-nil." + :group 'erc-nicklist + :type 'string) + +(defcustom erc-nicklist-voiced-position 'bottom + "*Position of voiced nicks in the nicklist. +The value can be `top', `bottom' or nil (don't sort)." + :group 'erc-nicklist + :type '(choice + (const :tag "Top" 'top) + (const :tag "Bottom" 'bottom) + (const :tag "Mixed" nil))) + +(defcustom erc-nicklist-window-size 20.0 + "*The size of the nicklist window. + +This specifies a percentage of the channel window width. + +A negative value means the nicklist window appears on the left of the +channel window, and vice versa." + :group 'erc-nicklist + :type 'float) + + +(defun erc-nicklist-buffer-name (&optional buffer) + "Return the buffer name for a nicklist associated with BUFFER. + +If BUFFER is nil, use the value of `current-buffer'." + (format " *%s-nicklist*" (buffer-name (or buffer (current-buffer))))) + +(defun erc-nicklist-make-window () + "Create an ERC nicklist window. + +See also `erc-nicklist-window-size'." + (let ((width (floor (* (window-width) (/ erc-nicklist-window-size 100.0)))) + (buffer (erc-nicklist-buffer-name)) + window) + (split-window-horizontally (- width)) + (setq window (next-window)) + (set-window-buffer window (get-buffer-create buffer)) + (with-current-buffer buffer + (set-window-dedicated-p window t)))) + + +(defvar erc-nicklist-images-alist '() + "Alist that maps a connection type to an icon.") + +(defun erc-nicklist-insert-medium-name-or-icon (host channel is-away) + "Inserts an icon or a string identifying the current host type. +This is configured using `erc-nicklist-use-icons' and +`erc-nicklist-icons-directory'." + ;; identify the network (for bitlebee usage): + (let ((bitlbee-p (save-match-data + (string-match "\\`&bitlbee\\b" + (buffer-name channel))))) + (cond ((and bitlbee-p + (string= "login.icq.com" host)) + (if erc-nicklist-use-icons + (if is-away + (insert-image (cdr (assoc 'icq-away + erc-nicklist-images-alist))) + (insert-image (cdr (assoc 'icq + erc-nicklist-images-alist)))) + (insert "ICQ"))) + (bitlbee-p + (if erc-nicklist-use-icons + (if is-away + (insert-image (cdr (assoc 'msn-away + erc-nicklist-images-alist))) + (insert-image (cdr (assoc 'msn + erc-nicklist-images-alist)))) + (insert "MSN"))) + (t + (if erc-nicklist-use-icons + (if is-away + (insert-image (cdr (assoc 'irc-away + erc-nicklist-images-alist))) + (insert-image (cdr (assoc 'irc + erc-nicklist-images-alist)))) + (insert "IRC")))) + (insert " "))) + +(defun erc-nicklist-search-for-nick (finger-host) + "Return the bitlbee-nick field for this contact given FINGER-HOST. +Seach for the BBDB record of this contact. If not found, return nil." + (when (boundp 'erc-bbdb-bitlbee-name-field) + (let ((record (car + (erc-member-if + #'(lambda (r) + (let ((fingers (bbdb-record-finger-host r))) + (when fingers + (string-match finger-host + (car (bbdb-record-finger-host r)))))) + (bbdb-records))))) + (when record + (bbdb-get-field record erc-bbdb-bitlbee-name-field))))) + +(defun erc-nicklist-insert-contents (channel) + "Insert the nicklist contents, with text properties and the optional images." + (setq buffer-read-only nil) + (erase-buffer) + (dolist (u (erc-nicklist-channel-users-info channel)) + (let* ((server-user (car u)) + (channel-user (cdr u)) + (nick (erc-server-user-nickname server-user)) + (host (erc-server-user-host server-user)) + (login (erc-server-user-login server-user)) + (full-name(erc-server-user-full-name server-user)) + (info (erc-server-user-info server-user)) + (channels (erc-server-user-buffers server-user)) + (op (erc-channel-user-op channel-user)) + (voice (erc-channel-user-voice channel-user)) + (bbdb-nick (erc-nicklist-search-for-nick (concat login "@" host))) + (away-status (if voice "" "\n(Away)")) + (balloon-text (concat bbdb-nick (if (string= "" bbdb-nick) + "" "\n") + "Login: " login "@" host + away-status))) + (erc-nicklist-insert-medium-name-or-icon host channel (not voice)) + (unless (or voice erc-nicklist-use-icons) + (setq nick (concat "(" nick ")"))) + (when op + (setq nick (concat nick " (OP)"))) + (insert (erc-propertize nick + 'erc-nicklist-nick nick + 'mouse-face 'highlight + 'erc-nicklist-channel channel + 'help-echo balloon-text) + "\n"))) + (erc-nicklist-mode)) + + +(defun erc-nicklist () + "Create an ERC nicklist buffer." + (interactive) + (let ((channel (current-buffer))) + (unless (or (not erc-nicklist-use-icons) + erc-nicklist-images-alist) + (setq erc-nicklist-images-alist + `((msn . ,(create-image (concat erc-nicklist-icons-directory + "msn-online.png"))) + (msn-away . ,(create-image (concat erc-nicklist-icons-directory + "msn-offline.png"))) + (irc . ,(create-image (concat erc-nicklist-icons-directory + "irc-online.png"))) + (irc-away . ,(create-image (concat erc-nicklist-icons-directory + "irc-offline.png"))) + (icq . ,(create-image (concat erc-nicklist-icons-directory + "icq-online.png"))) + (icq-away . ,(create-image (concat erc-nicklist-icons-directory + "icq-offline.png")))))) + (erc-nicklist-make-window) + (with-current-buffer (get-buffer (erc-nicklist-buffer-name channel)) + (erc-nicklist-insert-contents channel))) + (add-hook 'erc-channel-members-changed-hook #'erc-nicklist-update)) + +(defun erc-nicklist-update () + "Update the ERC nicklist buffer." + (let ((b (get-buffer (erc-nicklist-buffer-name))) + (channel (current-buffer))) + (when b + (with-current-buffer b + (erc-nicklist-insert-contents channel))))) + +(defvar erc-nicklist-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "<down-mouse-3>") 'erc-nicklist-menu) + (define-key map "\C-j" 'erc-nicklist-kbd-menu) + (define-key map "q" 'erc-nicklist-quit) + (define-key map (kbd "RET") 'erc-nicklist-kbd-cmd-QUERY) + map) + "Keymap for `erc-nicklist-mode'.") + +(define-derived-mode erc-nicklist-mode fundamental-mode + "Nicklist" + "Major mode for the ERC nicklist buffer." + (setq buffer-read-only t)) + +(defun erc-nicklist-call-erc-command (command point buffer window) + "Call an ERC COMMAND. + +Depending on what COMMAND is, it's called with one of POINT, BUFFER, +or WINDOW as arguments." + (when command + (let* ((p (text-properties-at point)) + (b (plist-get p 'erc-nicklist-channel))) + (if (memq command '(erc-nicklist-quit ignore)) + (funcall command window) + ;; EEEK! Horrble, but it's the only way we can ensure the + ;; response goes to the correct buffer. + (erc-set-active-buffer b) + (switch-to-buffer-other-window b) + (funcall command (plist-get p 'erc-nicklist-nick)))))) + +(defun erc-nicklist-cmd-QUERY (user &optional server) + "Opens a query buffer with USER." + ;; FIXME: find a way to switch to that buffer afterwards... + (let ((send (if server + (format "QUERY %s %s" user server) + (format "QUERY %s" user)))) + (erc-cmd-QUERY user) + t)) + +(defun erc-nicklist-kbd-cmd-QUERY (&optional window) + (interactive) + (let* ((p (text-properties-at (point))) + (server (plist-get p 'erc-nicklist-channel)) + (nick (plist-get p 'erc-nicklist-nick)) + (nick (or (and (string-match "(\\(.*\\))" nick) + (match-string 1 nick)) + nick)) + (nick (or (and (string-match "\\+\\(.*\\)" nick) + (match-string 1 nick)) + nick)) + (send (format "QUERY %s %s" nick server))) + (switch-to-buffer-other-window server) + (erc-cmd-QUERY nick))) + + +(defvar erc-nicklist-menu + (let ((map (make-sparse-keymap "Action"))) + (define-key map [erc-cmd-WHOIS] + '("Whois" . erc-cmd-WHOIS)) + (define-key map [erc-cmd-DEOP] + '("Deop" . erc-cmd-DEOP)) + (define-key map [erc-cmd-MSG] + '("Message" . erc-cmd-MSG)) ;; TODO! + (define-key map [erc-nicklist-cmd-QUERY] + '("Query" . erc-nicklist-kbd-cmd-QUERY)) + (define-key map [ignore] + '("Cancel" . ignore)) + (define-key map [erc-nicklist-quit] + '("Close nicklist" . erc-nicklist-quit)) + map) + "Menu keymap for the ERC nicklist.") + +(defun erc-nicklist-quit (&optional window) + "Delete the ERC nicklist. + +Deletes WINDOW and stops updating the nicklist buffer." + (interactive) + (let ((b (window-buffer window))) + (with-current-buffer b + (set-buffer-modified-p nil) + (kill-this-buffer) + (remove-hook 'erc-channel-members-changed-hook 'erc-nicklist-update)))) + + +(defun erc-nicklist-kbd-menu () + "Show the ERC nicklist menu." + (interactive) + (let* ((point (point)) + (window (selected-window)) + (buffer (current-buffer))) + (with-current-buffer buffer + (erc-nicklist-call-erc-command + (car (x-popup-menu point + erc-nicklist-menu)) + point + buffer + window)))) + +(defun erc-nicklist-menu (&optional arg) + "Show the ERC nicklist menu. + +ARG is a parametrized event (see `interactive')." + (interactive "e") + (let* ((point (nth 1 (cadr arg))) + (window (car (cadr arg))) + (buffer (window-buffer window))) + (with-current-buffer buffer + (erc-nicklist-call-erc-command + (car (x-popup-menu arg + erc-nicklist-menu)) + point + buffer + window)))) + + +(defun erc-nicklist-channel-users-info (channel) + "Return a nick-sorted list of all users on CHANNEL. +Result are elements in the form (SERVER-USER . CHANNEL-USER). The +list has all the voiced users according to +`erc-nicklist-voiced-position'." + (let* ((nicks (erc-sort-channel-users-alphabetically + (with-current-buffer channel (erc-get-channel-user-list))))) + (if erc-nicklist-voiced-position + (let ((voiced-nicks (erc-remove-if-not + #'(lambda (x) + (null (erc-channel-user-voice (cdr x)))) + nicks)) + (devoiced-nicks (erc-remove-if-not + #'(lambda (x) + (erc-channel-user-voice + (cdr x))) + nicks))) + (cond ((eq erc-nicklist-voiced-position 'top) + (append devoiced-nicks voiced-nicks)) + ((eq erc-nicklist-voiced-position 'bottom) + (append voiced-nicks devoiced-nicks)))) + nicks))) + + + +(provide 'erc-nicklist) + +;;; erc-nicklist.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: db37a256-87a7-4544-bd90-e5f16c9f5ca5 |