diff options
| -rw-r--r-- | lisp/erc/erc-bbdb.el | 269 | ||||
| -rw-r--r-- | lisp/erc/erc-chess.el | 181 | ||||
| -rw-r--r-- | lisp/erc/erc-nicklist.el | 417 | ||||
| -rw-r--r-- | lisp/erc/erc-speak.el | 230 |
4 files changed, 1097 insertions, 0 deletions
diff --git a/lisp/erc/erc-bbdb.el b/lisp/erc/erc-bbdb.el new file mode 100644 index 00000000000..7d27f7f4868 --- /dev/null +++ b/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 diff --git a/lisp/erc/erc-chess.el b/lisp/erc/erc-chess.el new file mode 100644 index 00000000000..94715439c99 --- /dev/null +++ b/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 diff --git a/lisp/erc/erc-nicklist.el b/lisp/erc/erc-nicklist.el new file mode 100644 index 00000000000..cc913c5fe93 --- /dev/null +++ b/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 diff --git a/lisp/erc/erc-speak.el b/lisp/erc/erc-speak.el new file mode 100644 index 00000000000..cd176f29fd2 --- /dev/null +++ b/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 |