mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-15 09:47:20 +00:00
412 lines
14 KiB
EmacsLisp
412 lines
14 KiB
EmacsLisp
;;; 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
|