Import erc-bbdb.el, erc-chess.el, erc-nicklist.el, and erc-speak.el

* lisp/erc/erc-bbdb.el, lisp/erc/erc-chess.el,
lisp/erc/erc-nicklist.el, lisp/erc/erc-speak.el: Import these files
from commit 9497cc92bf1feb63c24425c46b1e033265c2cea9 of
https://git.savannah.gnu.org/cgit/erc.git, the old ERC repository
outside the GNU Emacs source tree.  These FSF-copyrighted files were
part of ERC before erc.git was (for the most part) folded into
emacs.git, but they were left out largely due to depending on packages
outside Emacs.  It is worth noting that their dependencies are all
free software, and bbdb and chess are actually available on GNU ELPA.

lisp/erc/erc-bbdb.el

@@ -0,0 +1,269 @@
+;;; erc-bbdb.el --- Integrating the BBDB into ERC
+
+;; Copyright (C) 2001, 2002, 2004, 2005, 2006, 2007
+;;   2008, 2009 Free Software Foundation, Inc.
+
+;; Author: Andreas Fuchs <asf@void.at>
+;; Maintainer: Mario Lang <mlang@delysid.org>
+
+;; 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 3, 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 mode connects the BBDB to ERC.  Whenever a known nick
+;; connects, the corresponding BBDB record pops up.  To identify
+;; users, use the irc-nick field.  Define it, if BBDB asks you about
+;; that.  When you use /WHOIS on a known nick, the corresponding
+;; record will be updated.
+
+;;; History
+
+;; Andreas Fuchs <asf@void.at> wrote zenirc-bbdb-whois.el, which was
+;; adapted for ERC by Mario Lang <mlang@delysid.org>.
+
+;; Changes by Edgar Gonçalves <edgar.goncalves@inesc-id.pt>
+;; May 31 2005:
+;;     - new variable: erc-bbdb-bitlbee-name-field - the field name for the
+;;       msn/icq/etc nick
+;;     - nick doesn't go the the name. now it asks for an existing record to
+;;       merge with. If none, then create a new one with the nick as name.
+
+;;; Code:
+
+(require 'erc)
+(require 'bbdb)
+(require 'bbdb-com)
+(require 'bbdb-gui)
+(require 'bbdb-hooks)
+
+(defgroup erc-bbdb nil
+  "Variables related to BBDB usage."
+  :group 'erc)
+
+(defcustom erc-bbdb-auto-create-on-whois-p nil
+  "*If nil, don't create bbdb records automatically when a WHOIS is done.
+Leaving this at nil is a good idea, but you can turn it
+on if you want to have lots of People named \"John Doe\" in your BBDB."
+  :group 'erc-bbdb
+  :type 'boolean)
+
+(defcustom erc-bbdb-auto-create-on-join-p nil
+  "*If nil, don't create bbdb records automatically when a person joins a channel.
+Leaving this at nil is a good idea, but you can turn it
+on if you want to have lots of People named \"John Doe\" in your BBDB."
+  :group 'erc-bbdb
+  :type 'boolean)
+
+(defcustom erc-bbdb-auto-create-on-nick-p nil
+  "*If nil, don't create bbdb records automatically when a person changes her nick.
+Leaving this at nil is a good idea, but you can turn it
+on if you want to have lots of People named \"John Doe\" in your BBDB."
+  :group 'erc-bbdb
+  :type 'boolean)
+
+(defcustom erc-bbdb-popup-type 'visible
+  "*If t, pop up a BBDB buffer showing the record of a WHOISed person
+or the person who has just joined a channel.
+
+If set to 'visible, the BBDB buffer only pops up when someone was WHOISed
+or a person joined a channel visible on any frame.
+
+If set to nil, never pop up a BBDD buffer."
+  :group 'erc-bbdb
+  :type '(choice (const :tag "When visible" visible)
+		 (const :tag "When joining" t)
+		 (const :tag "Never" nil)))
+
+(defcustom erc-bbdb-irc-nick-field 'irc-nick
+  "The notes field name to use for annotating IRC nicknames."
+  :group 'erc-bbdb
+  :type 'symbol)
+
+(defcustom erc-bbdb-irc-channel-field 'irc-channel
+  "The notes field name to use for annotating IRC channels."
+  :group 'erc-bbdb
+  :type 'symbol)
+
+(defcustom erc-bbdb-irc-highlight-field 'irc-highlight
+  "The notes field name to use for highlighting a person's messages."
+  :group 'erc-bbdb
+  :type 'symbol)
+
+(defcustom erc-bbdb-bitlbee-name-field 'bitlbee-name
+  "The notes field name to use for annotating bitlbee displayed name.
+This is the name that a bitlbee (AIM/MSN/ICQ) contact provides as
+their \"displayed name\"."
+  :group 'erc-bbdb
+  :type 'symbol)
+
+(defcustom erc-bbdb-elide-display nil
+  "*If t, show BBDB popup buffer elided."
+  :group 'erc-bbdb
+  :type 'boolean)
+
+(defcustom erc-bbdb-electric-p nil
+  "*If t, BBDB popup buffer is electric."
+  :group 'erc-bbdb
+  :type 'boolean)
+
+(defun erc-bbdb-search-name-and-create (create-p name nick finger-host silent)
+  (let* ((ircnick (cons erc-bbdb-irc-nick-field (concat "^"
+							(regexp-quote nick))))
+	 (finger (cons bbdb-finger-host-field (regexp-quote finger-host)))
+	 (record (or (bbdb-search (bbdb-records) nil nil nil ircnick)
+		     (and name (bbdb-search-simple name nil))
+		     (bbdb-search (bbdb-records) nil nil nil finger)
+		     (unless silent
+		       (bbdb-completing-read-one-record
+			"Merge using record of (C-g to skip, RET for new): "))
+		     (when create-p
+		       (bbdb-create-internal (or name
+						 "John Doe")
+					     nil nil nil nil nil)))))
+    ;; sometimes, the record will be a list. I don't know why.
+    (if (listp record)
+	(car record)
+      record)))
+
+(defun erc-bbdb-show-entry (record channel proc)
+  (let ((bbdb-display-layout (bbdb-grovel-elide-arg erc-bbdb-elide-display))
+	(bbdb-electric-p erc-bbdb-electric-p))
+    (when (and record (or (eq erc-bbdb-popup-type t)
+			  (and (eq erc-bbdb-popup-type 'visible)
+			       (and channel
+				    (or (eq channel t)
+					(get-buffer-window (erc-get-buffer
+							    channel proc)
+							   'visible))))))
+      (bbdb-display-records (list record)))))
+
+(defun erc-bbdb-insinuate-and-show-entry-1 (create-p proc nick name finger-host silent &optional chan new-nick)
+  (let ((record (erc-bbdb-search-name-and-create
+		 create-p nil nick finger-host silent))) ;; don't search for a name
+    (when record
+      (bbdb-annotate-notes record (or new-nick nick) erc-bbdb-irc-nick-field)
+      (bbdb-annotate-notes record finger-host bbdb-finger-host-field)
+      (and name
+	   (bbdb-annotate-notes record name erc-bbdb-bitlbee-name-field t))
+      (and chan
+	   (not (eq chan t))
+	   (bbdb-annotate-notes record chan erc-bbdb-irc-channel-field))
+      (erc-bbdb-highlight-record record)
+      (erc-bbdb-show-entry record chan proc))))
+
+(defun erc-bbdb-insinuate-and-show-entry (create-p proc nick name finger-host silent &optional chan new-nick)
+  ;; run this outside of the IRC filter process, to avoid an annoying
+  ;; error when the user hits C-g
+  (run-at-time 0.1 nil
+	       #'erc-bbdb-insinuate-and-show-entry-1
+	       create-p proc nick name finger-host silent chan new-nick))
+
+(defun erc-bbdb-whois (proc parsed)
+  (let (; We could use server name too, probably
+	(nick (second (erc-response.command-args parsed)))
+	(name (erc-response.contents parsed))
+	(finger-host (concat (third (erc-response.command-args parsed))
+			     "@"
+			     (fourth (erc-response.command-args parsed)))))
+    (erc-bbdb-insinuate-and-show-entry erc-bbdb-auto-create-on-whois-p proc
+				       nick name finger-host nil t)))
+
+(defun erc-bbdb-JOIN (proc parsed)
+  (let* ((sender (erc-parse-user (erc-response.sender parsed)))
+	 (nick (nth 0 sender)))
+    (unless (string= nick (erc-current-nick))
+      (let* ((channel (erc-response.contents parsed))
+	     (finger-host (concat (nth 1 sender) "@" (nth 2 sender))))
+	  (erc-bbdb-insinuate-and-show-entry
+	   erc-bbdb-auto-create-on-join-p proc
+	   nick nil finger-host t channel)))))
+
+(defun erc-bbdb-NICK (proc parsed)
+  "Annotate new nick name to a record in case it already exists."
+  (let* ((sender (erc-parse-user (erc-response.sender parsed)))
+	 (nick (nth 0 sender)))
+    (unless (string= nick (erc-current-nick))
+      (let* ((finger-host (concat (nth 1 sender) "@" (nth 2 sender))))
+	(erc-bbdb-insinuate-and-show-entry
+	 erc-bbdb-auto-create-on-nick-p proc
+	 nick nil finger-host t nil (erc-response.contents parsed))))))
+
+(defun erc-bbdb-init-highlighting-hook-fun (proc parsed)
+  (erc-bbdb-init-highlighting))
+
+(defun erc-bbdb-init-highlighting ()
+  "Initialize the highlighting based on BBDB fields.
+This function typically gets called on a successful server connect.
+The field name in the BBDB which controls highlighting is specified by
+`erc-bbdb-irc-highlight-field'. Fill in either \"pal\"
+\"dangerous-host\" or \"fool\". They work exactly like their
+counterparts `erc-pals', `erc-dangerous-hosts' and `erc-fools'."
+  (let* ((irc-highlight (cons erc-bbdb-irc-highlight-field
+			      ".+"))
+	(matching-records (bbdb-search (bbdb-records)
+				       nil nil nil irc-highlight)))
+    (mapcar 'erc-bbdb-highlight-record matching-records)))
+
+(defun erc-bbdb-highlight-record (record)
+  (let* ((notes (bbdb-record-raw-notes record))
+	 (highlight-field (assoc erc-bbdb-irc-highlight-field notes))
+	 (nick-field      (assoc erc-bbdb-irc-nick-field notes)))
+    (if (and highlight-field
+	     nick-field)
+	(let ((highlight-types (split-string (cdr highlight-field)
+					     bbdb-notes-default-separator))
+	      (nick-names (split-string (cdr nick-field)
+					(concat "\\(\n\\|"
+						bbdb-notes-default-separator
+						"\\)"))))
+	  (mapcar
+	   (lambda (highlight-type)
+	     (mapcar
+	      (lambda (nick-name)
+		(if (member highlight-type
+			    '("pal" "dangerous-host" "fool"))
+		    (add-to-list (intern (concat "erc-" highlight-type "s"))
+				 (regexp-quote nick-name))
+		  (error (format "\"%s\" (in \"%s\") is not a valid highlight type!"
+				 highlight-type nick-name))))
+	      nick-names))
+	   highlight-types)))))
+
+;;;###autoload (autoload 'erc-bbdb-mode "erc-bbdb")
+(define-erc-module bbdb nil
+  "In ERC BBDB mode, you can directly interact with your BBDB."
+  ((add-hook 'erc-server-311-functions 'erc-bbdb-whois t)
+   (add-hook 'erc-server-JOIN-functions 'erc-bbdb-JOIN t)
+   (add-hook 'erc-server-NICK-functions 'erc-bbdb-NICK t)
+   (add-hook 'erc-server-376-functions 'erc-bbdb-init-highlighting-hook-fun t))
+  ((remove-hook 'erc-server-311-functions 'erc-bbdb-whois)
+   (remove-hook 'erc-server-JOIN-functions 'erc-bbdb-JOIN)
+   (remove-hook 'erc-server-NICK-functions 'erc-bbdb-NICK)
+   (remove-hook 'erc-server-376-functions 'erc-bbdb-init-highlighting-hook-fun)))
+
+(provide 'erc-bbdb)
+
+;;; erc-bbdb.el ends here
+;;
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; coding: utf-8
+;; End:
+
+;; arch-tag: 1edf3729-cd49-47dc-aced-70fcfc28c815

lisp/erc/erc-chess.el

@@ -0,0 +1,181 @@
+;;; erc-chess.el --- CTCP chess playing support for ERC
+
+;; Copyright (C) 2002, 2004, 2007, 2008, 2009 Free Software Foundation, Inc.
+
+;; Author: Mario Lang <mlang@delysid.org>
+;; Keywords: games, comm
+
+;; 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 3, 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 module requires chess.el by John Wiegley.
+;; You need to have chess.el installed (load-path properly set)
+
+;;; Code:
+
+(require 'erc)
+(require 'chess-network)
+(require 'chess-display)
+(require 'chess)
+
+;;;; Variables
+
+(defgroup erc-chess nil
+  "Playing chess over IRC."
+  :group 'erc)
+
+(defcustom erc-chess-verbose-flag nil
+  "*If non-nil, inform about bogus CTCP CHESS messages in the server buffer."
+  :group 'erc-chess
+  :type 'boolean)
+
+(defcustom erc-chess-debug-flag t
+  "*If non-nil, print all chess CTCP messages received in the server buffer."
+  :group 'erc-chess
+  :type 'boolean)
+
+;;;###autoload
+(defvar erc-ctcp-query-CHESS-hook '(erc-chess-ctcp-query-handler))
+
+(defvar erc-chess-alist nil
+  "Alist of chess sessions. It has the form of (NICK ENGINE)")
+(make-variable-buffer-local 'erc-chess-alist)
+
+(defvar erc-chess-regexp-alist chess-network-regexp-alist)
+(defvar erc-chess-partner)
+(make-variable-buffer-local 'erc-chess-partner)
+
+;;;; Catalog messages
+
+(erc-define-catalog
+ 'english
+ '((ctcp-chess-debug   . "CTCPchess: %n (%u@%h) sent: '%m'")
+   (ctcp-chess-quit    . "Chess game with %n (%u@%h) quit")))
+
+
+(defun erc-chess-response-handler (event &rest args)
+  (when (and (eq event 'accept)
+	     (eq chess-engine-pending-offer 'match))
+    (let ((display (chess-game-data (chess-engine-game nil) 'display)))
+      (chess-display-enable-popup display)
+      (chess-display-popup display)))
+
+  (apply 'chess-engine-default-handler event args))
+
+
+(defun erc-chess-handler (game event &rest args)
+  "Handle erc-chess events.
+This is the main handler for the erc-chess module."
+  (cond
+   ((eq event 'initialize)
+    (setq erc-chess-partner (car args))
+    (setq erc-server-process (nth 1 args))
+    t)
+
+   ((eq event 'send)
+    ;; Transmit the string given in `(car args)' to the nick
+    ;; saved in `erc-chess-partner'.
+    (let ((nick erc-chess-partner)
+	  (msg (substring (car args) 0 (1- (length (car args))))))
+      (erc-with-server-buffer
+	(erc-send-ctcp-message nick (concat "CHESS " msg) t))))
+
+   (t
+    (cond
+     ((eq event 'accept)
+      (let ((display (chess-game-data (chess-engine-game nil) 'display)))
+	(chess-display-enable-popup display)
+	(chess-display-popup display)))
+
+     ((eq event 'destroy)
+      (let* ((buf (process-buffer erc-server-process))
+	     (nick (erc-downcase erc-chess-partner))
+	     (engine (current-buffer)))
+	(erc-with-server-buffer
+	  (let ((elt (assoc nick erc-chess-alist)))
+	    (when (and elt (eq (nth 1 elt) engine))
+	      (message "Removed from erc-chess-alist in destroy event")
+	      (setq erc-chess-alist (delq elt erc-chess-alist))))))))
+
+    ;; Pass all other events down to chess-network
+    (apply 'chess-network-handler game event args))))
+
+;;;; Game initialisation
+
+(defun erc-chess-engine-create (nick)
+  "Initialize a game for a particular nick.
+This function adds to `erc-chess-alist' too."
+  ;; Maybe move that into the connect callback?
+  (let* ((objects (chess-session 'erc-chess t 'erc-chess-response-handler
+				 nick erc-server-process))
+	 (engine (car objects))
+	 (display (cadr objects)))
+    (when engine
+      (if display
+	  (chess-game-set-data (chess-display-game display)
+			       'display display))
+      (push (list (erc-downcase nick) engine) erc-chess-alist)
+      engine)))
+
+;;;; IRC /commands
+
+;;;###autoload
+(defun erc-cmd-CHESS (line &optional force)
+  "Initiate a chess game via CTCP to NICK.
+NICK should be the first and only arg to /chess"
+  (cond
+   ((string-match (concat "^\\s-*\\(" erc-valid-nick-regexp "\\)\\s-*$") line)
+    (let ((nick (match-string 1 line)))
+      (erc-with-server-buffer
+	(if (assoc (erc-downcase nick) erc-chess-alist)
+	    ;; Maybe check for correctly connected game, and switch here.
+	    (erc-display-message
+	     nil 'notice 'active
+	     (concat "Invitation for a game already sent to " nick))
+	  (with-current-buffer (erc-chess-engine-create nick)
+	    (erc-chess-handler nil 'match)
+	    t)))))
+   (t nil)))
+
+;;; CTCP handler
+;;;###autoload
+(defun erc-chess-ctcp-query-handler (proc nick login host to msg)
+  (if erc-chess-debug-flag
+      (erc-display-message
+       nil 'notice (current-buffer)
+       'ctcp-chess-debug ?n nick ?m msg ?u login ?h host))
+  (when (string-match "^CHESS\\s-+\\(.*\\)$" msg)
+    (let ((str (concat (match-string 1 msg) "\n"))
+	  (elt (assoc (erc-downcase nick) erc-chess-alist)))
+      (if (not elt)
+	    (chess-engine-submit (erc-chess-engine-create nick) str)
+	(if (buffer-live-p (nth 1 elt))
+	    (chess-engine-submit (nth 1 elt) str)
+	  (setq erc-chess-alist (delq elt erc-chess-alist)))))))
+
+(provide 'erc-chess)
+
+;;; erc-chess.el ends here
+;;
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
+
+;; arch-tag: beb148d1-db16-48da-8145-9f3a7ff27b7b

lisp/erc/erc-nicklist.el

@@ -0,0 +1,417 @@
+;;; erc-nicklist.el --- Display channel nicknames in a side buffer.
+
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008,
+;;   2009 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 3, 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 from within the nicklist buffer.
+;;
+;; 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
+  (let ((dir (locate-library "erc-nicklist.el")))
+    (when dir
+      (concat (file-name-directory dir) "images/")))
+  "*Directory of the PNG files for chat icons.
+Icons are displayed if `erc-nicklist-use-icons' is non-nil."
+  :group 'erc-nicklist
+  :type 'directory)
+
+(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 (or (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
+;; coding: utf-8
+;; End:
+
+;; arch-tag: db37a256-87a7-4544-bd90-e5f16c9f5ca5

lisp/erc/erc-speak.el

@@ -0,0 +1,230 @@
+;;; erc-speak.el --- Speech-enable the ERC chat client
+
+;; Copyright 2001, 2002, 2003, 2004, 2007,
+;;    2008, 2009 Free Software Foundation, Inc.
+
+;; 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 3, 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 file contains code to speech enable ERC using Emacspeak's functionality
+;; to access a speech synthesizer.
+;;
+;; It tries to be intelligent and produce actually understandable
+;; audio streams :). Hopefully it does. I use it on #debian at irc.debian.org
+;; with about 200 users, and I am amazed how easy it works.
+;;
+;; Currently, erc-speak is only written to listen to channels.
+;; There is no special functionality for interaction in the erc buffers.
+;; Although this shouldn't be hard. Look at the Todo list, there are
+;; definitely many things this script could do nicely to make a better
+;; IRC experience for anyone.
+;;
+;; More info? Read the code. It isn't that complicated.
+;;
+
+;;; Installation:
+
+;; Put erc.el and erc-speak.el somewhere in your load-path and
+;; (require 'erc-speak) in your .emacs. Remember to require only erc-speak
+;; because otherwise you get conflicts with emacspeak.
+
+;;; Bugs:
+
+;; erc-speak-rate doesn't seem to work here on outloud. Can anyone enlighten
+;; me on the use of dtk-interp-queue-set-rate or equivalent?
+
+;;; Code:
+
+(require 'emacspeak)
+(provide 'emacspeak-erc)
+(require 'erc)
+(require 'erc-button)
+
+(defgroup erc-speak nil
+  "Enable speech synthesis with the ERC chat client using Emacspeak"
+  :group 'erc)
+
+(defcustom erc-speak-personalities '((erc-default-face paul)
+				     (erc-direct-msg-face paul-animated)
+				     (erc-input-face paul-smooth)
+				     (erc-bold-face paul-bold)
+				     (erc-inverse-face betty)
+				     (erc-underline-face ursula)
+				     (erc-prompt-face harry)
+				     (erc-notice-face paul-italic)
+				     (erc-action-face paul-monotone)
+				     (erc-error-face kid)
+				     (erc-dangerous-host-face paul-surprized)
+				     (erc-pal-face paul-animated)
+				     (erc-fool-face paul-angry)
+				     (erc-keyword-face paul-animated))
+  "Maps faces used in erc to speaker personalities in emacspeak."
+  :group 'erc-speak
+  :type '(repeat
+	  (list :tag "mapping"
+		(symbol :tag "face")
+		(symbol :tag "personality"))))
+
+(add-hook 'erc-mode-hook (lambda () (setq voice-lock-mode t)))
+
+;; Override the definition in erc.el
+(defun erc-put-text-property (start end property value &optional object)
+  "This function sets the appropriate personality on the specified
+region in addition to setting the requested face."
+  (put-text-property start end property value object)
+  (when (eq property 'face)
+    (put-text-property start end
+		       'personality
+		       (cadr (assq value erc-speak-personalities))
+		       object)))
+
+(add-hook 'erc-insert-post-hook 'erc-speak-region)
+(add-hook 'erc-send-post-hook 'erc-speak-region)
+
+(defcustom erc-speak-filter-host t
+  "Set to t if you want to filter out user@host constructs."
+  :group 'erc-speak
+  :type 'bool)
+
+(defcustom erc-speak-filter-timestamp t
+  "If non-nil, try to filter out the timestamp when speaking arriving messages.
+
+Note, your erc-timestamp-format variable needs to start with a [
+and end with ]."
+  :group 'erc-speak
+  :type 'bool)
+
+(defcustom erc-speak-acronyms '(("brb" "be right back")
+				("btw" "by the way")
+				("wtf" "what the fuck")
+				("rotfl" "rolling on the floor and laughing")
+				("afaik" "as far as I know")
+				("afaics" "as far as I can see")
+				("iirc" "if I remember correctly"))
+  "List of acronyms to expand."
+  :group 'erc-speak
+  :type '(repeat sexp))
+
+(defun erc-speak-acronym-replace (string)
+  "Replace acronyms in the current buffer."
+  (let ((case-fold-search nil))
+    (dolist (ac erc-speak-acronyms string)
+      (while (string-match (car ac) string)
+	(setq string (replace-match (cadr ac) nil t string))))))
+
+(defcustom erc-speak-smileys '((":-)" "smiling face")
+			       (":)" "smiling face")
+			       (":-(" "sad face")
+			       (":(" "sad face"))
+;; please add more, send me patches, mlang@home.delysid.org tnx
+  "List of smileys and their textual description."
+  :group 'erc-speak
+  :type '(repeat (list 'symbol 'symbol)))
+
+(defcustom erc-speak-smiley-personality 'harry
+  "Personality used for smiley announcements."
+  :group 'erc-speak
+  :type 'symbol)
+
+(defun erc-speak-smiley-replace (string)
+  "Replace smileys with textual description."
+  (let ((case-fold-search nil))
+    (dolist (smiley erc-speak-smileys string)
+      (while (string-match (car smiley) string)
+	(let ((repl (cadr smiley)))
+	  (put-text-property 0 (length repl) 'personality
+			     erc-speak-smiley-personality repl)
+	  (setq string (replace-match repl nil t string)))))))
+
+(defcustom erc-speak-channel-personality 'harry
+  "*Personality to announce channel names with."
+  :group 'erc-speak
+  :type 'symbol)
+
+(defun erc-speak-region ()
+  "Speak a region containing one IRC message using Emacspeak.
+This function tries to translate common IRC forms into
+intelligent speech."
+  (let ((target (if (erc-channel-p (erc-default-target))
+		    (erc-propertize
+		     (erc-default-target)
+		     'personality erc-speak-channel-personality)
+		  ""))
+	(dtk-stop-immediately nil))
+    (emacspeak-auditory-icon 'progress)
+    (when erc-speak-filter-timestamp
+      (save-excursion
+	(goto-char (point-min))
+	(when (re-search-forward "^\\[[a-zA-Z:,;.0-9 \t-]+\\]" nil t)
+	  (narrow-to-region (point) (point-max)))))
+    (save-excursion
+      (goto-char (point-min))
+      (cond ((re-search-forward (concat "^<\\([^>]+\\)> "
+					(concat "\\("
+						erc-valid-nick-regexp
+						"\\)[;,:]")) nil t)
+	     (let ((from (match-string 1))
+		   (to (match-string 2))
+		   (text (buffer-substring (match-end 2) (point-max))))
+	       (tts-with-punctuations
+		"some"
+		(dtk-speak (concat (erc-propertize
+				    (concat target " " from " to " to)
+				    'personality erc-speak-channel-personality)
+				   (erc-speak-smiley-replace
+				    (erc-speak-acronym-replace text)))))))
+	    ((re-search-forward "^<\\([^>]+\\)> " nil t)
+	     (let ((from (match-string 1))
+		   (msg (buffer-substring (match-end 0) (point-max))))
+	       (tts-with-punctuations
+		"some"
+		(dtk-speak (concat target " " from " "
+				   (erc-speak-smiley-replace
+				    (erc-speak-acronym-replace msg)))))))
+	    ((re-search-forward (concat "^" (regexp-quote erc-notice-prefix)
+					"\\(.+\\)")
+				(point-max) t)
+	     (let ((notice (buffer-substring (match-beginning 1) (point-max))))
+	       (tts-with-punctuations
+		"all"
+		(dtk-speak
+		 (with-temp-buffer
+		   (insert notice)
+		   (when erc-speak-filter-host
+		     (goto-char (point-min))
+		     (when (re-search-forward "([^)@]+@[^)@]+)" nil t)
+		       (replace-match "")))
+		   (buffer-string))))))
+	    (t (let ((msg (buffer-substring (point-min) (point-max))))
+		 (tts-with-punctuations
+		  "some"
+		  (dtk-speak (concat target " "
+				     (erc-speak-smiley-replace
+				      (erc-speak-acronym-replace msg)))))))))))
+
+(provide 'erc-speak)
+
+;;; erc-speak.el ends here
+;;
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
+
+;; arch-tag: 4499cd13-2829-43b8-83de-d313481531c4