--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
projects / emacs.git / commitdiff