Source

erc / erc-nicklist.el

Diff from to

File erc-nicklist.el

 ;;; erc-nicklist.el --- Display channel nicknames in a side buffer.
 
-;; Copyright (C) 2004 Free Software Foundation, Inc.
+;; 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
 
-;; 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'.
+;; 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.
 
-;; COPYRIGHT NOTICE
+;; 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.
 
-;; This program 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 of the
-;; License, or (at your option) any later version.
-;;
-;; This program 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. http://www.gnu.org/copyleft/gpl.html
-;;
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If you did not, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave., Cambridge, MA 02139, USA.
+;; 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:
 ;;
 ;;; 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))
-(require 'cl)
+(eval-when-compile (require 'cl))
 
 (defconst erc-nicklist-version "$Revision$"
   "ERC Nicklist version.")
   :type 'float)
 
 
-(defvar erc-nicklist-bitlbee-connected-p nil
-  "Are we connected to bitlbee?")
-
 (defun erc-nicklist-buffer-name (&optional buffer)
   "Return the buffer name for a nicklist associated with BUFFER.
 
 (defvar erc-nicklist-images-alist '()
   "Alist that maps a connection type to an icon.")
 
-(defun erc-nicklist-insert-medium-name-or-icon (host is-away)
+(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'."
-      (cond ((and erc-nicklist-bitlbee-connected-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")))
-	    (erc-nicklist-bitlbee-connected-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 " "))
+  ;; 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
-		   (member-if
-		    (lambda (r)
-		      (let ((fingers (bbdb-record-finger-host r)))
-			(when fingers
-			  (string-match finger-host
-					(car (bbdb-record-finger-host r))))))
+		   (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."
-  (let ((erc-nicklist-bitlbee-connected-p
-	 (and (string-match "^#bitlbee\\b" (buffer-name channel))
-	      (not (string-match "oftc\\.net" (or erc-server-announced-name
-						  erc-session-server
-						  ""))))))
-    (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)))
-	;; identify the network (for bitlebee usage):
-	;; TODO: find out some proper way of doing this
-	(erc-nicklist-insert-medium-name-or-icon host (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)))
+  (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 ()
 ARG is a parametrized event (see `interactive')."
   (interactive "e")
   (let* ((point (nth 1 (cadr arg)))
-	 (window (caadr arg))
+	 (window (car (cadr arg)))
 	 (buffer (window-buffer window)))
     (with-current-buffer buffer
       (erc-nicklist-call-erc-command
   (let* ((nicks (erc-sort-channel-users-alphabetically
 		 (with-current-buffer channel (erc-get-channel-user-list)))))
     (if erc-nicklist-voiced-position
-	(let ((voiced-nicks (remove-if #'(lambda (x)
-					   (erc-channel-user-voice (cdr x)))
-				       nicks))
-	      (devoiced-nicks (remove-if-not #'(lambda (x)
-						 (erc-channel-user-voice
-						  (cdr x)))
-					     nicks)))
+	(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)
 ;; indent-tabs-mode: t
 ;; tab-width: 8
 ;; End:
+
+;; arch-tag: db37a256-87a7-4544-bd90-e5f16c9f5ca5