diff lisp/erc/erc-nicklist.el @ 68451:fc745b05e928

Revision: [e-mail]/emacs--devo--0--patch-22 Creator: Michael Olson <[e-mail]> Install ERC.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/erc/erc-nicklist.el	Sun Jan 29 13:08:58 2006 +0000
@@ -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 <[e-mail]>
+;; 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 <[e-mail]>
+;; 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