aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAmin Bandali2020-09-09 23:20:34 -0400
committerAmin Bandali2020-09-10 00:19:37 -0400
commitdcab4d0f0c3e480846c4337ff231dc55eb26124f (patch)
tree93ce6abef96b136410391da1e0044b16aaf8e2e5
parent931b9f5953013c1e8844d0c723411b87ccfedb1a (diff)
downloademacs-scratch/erc-oldies.tar.gz
emacs-scratch/erc-oldies.zip
Import erc-bbdb.el, erc-chess.el, erc-nicklist.el, and erc-speak.elscratch/erc-oldies
* 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.
-rw-r--r--lisp/erc/erc-bbdb.el269
-rw-r--r--lisp/erc/erc-chess.el181
-rw-r--r--lisp/erc/erc-nicklist.el417
-rw-r--r--lisp/erc/erc-speak.el230
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 @@
1;;; erc-bbdb.el --- Integrating the BBDB into ERC
2
3;; Copyright (C) 2001, 2002, 2004, 2005, 2006, 2007
4;; 2008, 2009 Free Software Foundation, Inc.
5
6;; Author: Andreas Fuchs <asf@void.at>
7;; Maintainer: Mario Lang <mlang@delysid.org>
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; This mode connects the BBDB to ERC. Whenever a known nick
29;; connects, the corresponding BBDB record pops up. To identify
30;; users, use the irc-nick field. Define it, if BBDB asks you about
31;; that. When you use /WHOIS on a known nick, the corresponding
32;; record will be updated.
33
34;;; History
35
36;; Andreas Fuchs <asf@void.at> wrote zenirc-bbdb-whois.el, which was
37;; adapted for ERC by Mario Lang <mlang@delysid.org>.
38
39;; Changes by Edgar Gonçalves <edgar.goncalves@inesc-id.pt>
40;; May 31 2005:
41;; - new variable: erc-bbdb-bitlbee-name-field - the field name for the
42;; msn/icq/etc nick
43;; - nick doesn't go the the name. now it asks for an existing record to
44;; merge with. If none, then create a new one with the nick as name.
45
46;;; Code:
47
48(require 'erc)
49(require 'bbdb)
50(require 'bbdb-com)
51(require 'bbdb-gui)
52(require 'bbdb-hooks)
53
54(defgroup erc-bbdb nil
55 "Variables related to BBDB usage."
56 :group 'erc)
57
58(defcustom erc-bbdb-auto-create-on-whois-p nil
59 "*If nil, don't create bbdb records automatically when a WHOIS is done.
60Leaving this at nil is a good idea, but you can turn it
61on if you want to have lots of People named \"John Doe\" in your BBDB."
62 :group 'erc-bbdb
63 :type 'boolean)
64
65(defcustom erc-bbdb-auto-create-on-join-p nil
66 "*If nil, don't create bbdb records automatically when a person joins a channel.
67Leaving this at nil is a good idea, but you can turn it
68on if you want to have lots of People named \"John Doe\" in your BBDB."
69 :group 'erc-bbdb
70 :type 'boolean)
71
72(defcustom erc-bbdb-auto-create-on-nick-p nil
73 "*If nil, don't create bbdb records automatically when a person changes her nick.
74Leaving this at nil is a good idea, but you can turn it
75on if you want to have lots of People named \"John Doe\" in your BBDB."
76 :group 'erc-bbdb
77 :type 'boolean)
78
79(defcustom erc-bbdb-popup-type 'visible
80 "*If t, pop up a BBDB buffer showing the record of a WHOISed person
81or the person who has just joined a channel.
82
83If set to 'visible, the BBDB buffer only pops up when someone was WHOISed
84or a person joined a channel visible on any frame.
85
86If set to nil, never pop up a BBDD buffer."
87 :group 'erc-bbdb
88 :type '(choice (const :tag "When visible" visible)
89 (const :tag "When joining" t)
90 (const :tag "Never" nil)))
91
92(defcustom erc-bbdb-irc-nick-field 'irc-nick
93 "The notes field name to use for annotating IRC nicknames."
94 :group 'erc-bbdb
95 :type 'symbol)
96
97(defcustom erc-bbdb-irc-channel-field 'irc-channel
98 "The notes field name to use for annotating IRC channels."
99 :group 'erc-bbdb
100 :type 'symbol)
101
102(defcustom erc-bbdb-irc-highlight-field 'irc-highlight
103 "The notes field name to use for highlighting a person's messages."
104 :group 'erc-bbdb
105 :type 'symbol)
106
107(defcustom erc-bbdb-bitlbee-name-field 'bitlbee-name
108 "The notes field name to use for annotating bitlbee displayed name.
109This is the name that a bitlbee (AIM/MSN/ICQ) contact provides as
110their \"displayed name\"."
111 :group 'erc-bbdb
112 :type 'symbol)
113
114(defcustom erc-bbdb-elide-display nil
115 "*If t, show BBDB popup buffer elided."
116 :group 'erc-bbdb
117 :type 'boolean)
118
119(defcustom erc-bbdb-electric-p nil
120 "*If t, BBDB popup buffer is electric."
121 :group 'erc-bbdb
122 :type 'boolean)
123
124(defun erc-bbdb-search-name-and-create (create-p name nick finger-host silent)
125 (let* ((ircnick (cons erc-bbdb-irc-nick-field (concat "^"
126 (regexp-quote nick))))
127 (finger (cons bbdb-finger-host-field (regexp-quote finger-host)))
128 (record (or (bbdb-search (bbdb-records) nil nil nil ircnick)
129 (and name (bbdb-search-simple name nil))
130 (bbdb-search (bbdb-records) nil nil nil finger)
131 (unless silent
132 (bbdb-completing-read-one-record
133 "Merge using record of (C-g to skip, RET for new): "))
134 (when create-p
135 (bbdb-create-internal (or name
136 "John Doe")
137 nil nil nil nil nil)))))
138 ;; sometimes, the record will be a list. I don't know why.
139 (if (listp record)
140 (car record)
141 record)))
142
143(defun erc-bbdb-show-entry (record channel proc)
144 (let ((bbdb-display-layout (bbdb-grovel-elide-arg erc-bbdb-elide-display))
145 (bbdb-electric-p erc-bbdb-electric-p))
146 (when (and record (or (eq erc-bbdb-popup-type t)
147 (and (eq erc-bbdb-popup-type 'visible)
148 (and channel
149 (or (eq channel t)
150 (get-buffer-window (erc-get-buffer
151 channel proc)
152 'visible))))))
153 (bbdb-display-records (list record)))))
154
155(defun erc-bbdb-insinuate-and-show-entry-1 (create-p proc nick name finger-host silent &optional chan new-nick)
156 (let ((record (erc-bbdb-search-name-and-create
157 create-p nil nick finger-host silent))) ;; don't search for a name
158 (when record
159 (bbdb-annotate-notes record (or new-nick nick) erc-bbdb-irc-nick-field)
160 (bbdb-annotate-notes record finger-host bbdb-finger-host-field)
161 (and name
162 (bbdb-annotate-notes record name erc-bbdb-bitlbee-name-field t))
163 (and chan
164 (not (eq chan t))
165 (bbdb-annotate-notes record chan erc-bbdb-irc-channel-field))
166 (erc-bbdb-highlight-record record)
167 (erc-bbdb-show-entry record chan proc))))
168
169(defun erc-bbdb-insinuate-and-show-entry (create-p proc nick name finger-host silent &optional chan new-nick)
170 ;; run this outside of the IRC filter process, to avoid an annoying
171 ;; error when the user hits C-g
172 (run-at-time 0.1 nil
173 #'erc-bbdb-insinuate-and-show-entry-1
174 create-p proc nick name finger-host silent chan new-nick))
175
176(defun erc-bbdb-whois (proc parsed)
177 (let (; We could use server name too, probably
178 (nick (second (erc-response.command-args parsed)))
179 (name (erc-response.contents parsed))
180 (finger-host (concat (third (erc-response.command-args parsed))
181 "@"
182 (fourth (erc-response.command-args parsed)))))
183 (erc-bbdb-insinuate-and-show-entry erc-bbdb-auto-create-on-whois-p proc
184 nick name finger-host nil t)))
185
186(defun erc-bbdb-JOIN (proc parsed)
187 (let* ((sender (erc-parse-user (erc-response.sender parsed)))
188 (nick (nth 0 sender)))
189 (unless (string= nick (erc-current-nick))
190 (let* ((channel (erc-response.contents parsed))
191 (finger-host (concat (nth 1 sender) "@" (nth 2 sender))))
192 (erc-bbdb-insinuate-and-show-entry
193 erc-bbdb-auto-create-on-join-p proc
194 nick nil finger-host t channel)))))
195
196(defun erc-bbdb-NICK (proc parsed)
197 "Annotate new nick name to a record in case it already exists."
198 (let* ((sender (erc-parse-user (erc-response.sender parsed)))
199 (nick (nth 0 sender)))
200 (unless (string= nick (erc-current-nick))
201 (let* ((finger-host (concat (nth 1 sender) "@" (nth 2 sender))))
202 (erc-bbdb-insinuate-and-show-entry
203 erc-bbdb-auto-create-on-nick-p proc
204 nick nil finger-host t nil (erc-response.contents parsed))))))
205
206(defun erc-bbdb-init-highlighting-hook-fun (proc parsed)
207 (erc-bbdb-init-highlighting))
208
209(defun erc-bbdb-init-highlighting ()
210 "Initialize the highlighting based on BBDB fields.
211This function typically gets called on a successful server connect.
212The field name in the BBDB which controls highlighting is specified by
213`erc-bbdb-irc-highlight-field'. Fill in either \"pal\"
214\"dangerous-host\" or \"fool\". They work exactly like their
215counterparts `erc-pals', `erc-dangerous-hosts' and `erc-fools'."
216 (let* ((irc-highlight (cons erc-bbdb-irc-highlight-field
217 ".+"))
218 (matching-records (bbdb-search (bbdb-records)
219 nil nil nil irc-highlight)))
220 (mapcar 'erc-bbdb-highlight-record matching-records)))
221
222(defun erc-bbdb-highlight-record (record)
223 (let* ((notes (bbdb-record-raw-notes record))
224 (highlight-field (assoc erc-bbdb-irc-highlight-field notes))
225 (nick-field (assoc erc-bbdb-irc-nick-field notes)))
226 (if (and highlight-field
227 nick-field)
228 (let ((highlight-types (split-string (cdr highlight-field)
229 bbdb-notes-default-separator))
230 (nick-names (split-string (cdr nick-field)
231 (concat "\\(\n\\|"
232 bbdb-notes-default-separator
233 "\\)"))))
234 (mapcar
235 (lambda (highlight-type)
236 (mapcar
237 (lambda (nick-name)
238 (if (member highlight-type
239 '("pal" "dangerous-host" "fool"))
240 (add-to-list (intern (concat "erc-" highlight-type "s"))
241 (regexp-quote nick-name))
242 (error (format "\"%s\" (in \"%s\") is not a valid highlight type!"
243 highlight-type nick-name))))
244 nick-names))
245 highlight-types)))))
246
247;;;###autoload (autoload 'erc-bbdb-mode "erc-bbdb")
248(define-erc-module bbdb nil
249 "In ERC BBDB mode, you can directly interact with your BBDB."
250 ((add-hook 'erc-server-311-functions 'erc-bbdb-whois t)
251 (add-hook 'erc-server-JOIN-functions 'erc-bbdb-JOIN t)
252 (add-hook 'erc-server-NICK-functions 'erc-bbdb-NICK t)
253 (add-hook 'erc-server-376-functions 'erc-bbdb-init-highlighting-hook-fun t))
254 ((remove-hook 'erc-server-311-functions 'erc-bbdb-whois)
255 (remove-hook 'erc-server-JOIN-functions 'erc-bbdb-JOIN)
256 (remove-hook 'erc-server-NICK-functions 'erc-bbdb-NICK)
257 (remove-hook 'erc-server-376-functions 'erc-bbdb-init-highlighting-hook-fun)))
258
259(provide 'erc-bbdb)
260
261;;; erc-bbdb.el ends here
262;;
263;; Local Variables:
264;; indent-tabs-mode: t
265;; tab-width: 8
266;; coding: utf-8
267;; End:
268
269;; 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 @@
1;;; erc-chess.el --- CTCP chess playing support for ERC
2
3;; Copyright (C) 2002, 2004, 2007, 2008, 2009 Free Software Foundation, Inc.
4
5;; Author: Mario Lang <mlang@delysid.org>
6;; Keywords: games, comm
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 3, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; This module requires chess.el by John Wiegley.
28;; You need to have chess.el installed (load-path properly set)
29
30;;; Code:
31
32(require 'erc)
33(require 'chess-network)
34(require 'chess-display)
35(require 'chess)
36
37;;;; Variables
38
39(defgroup erc-chess nil
40 "Playing chess over IRC."
41 :group 'erc)
42
43(defcustom erc-chess-verbose-flag nil
44 "*If non-nil, inform about bogus CTCP CHESS messages in the server buffer."
45 :group 'erc-chess
46 :type 'boolean)
47
48(defcustom erc-chess-debug-flag t
49 "*If non-nil, print all chess CTCP messages received in the server buffer."
50 :group 'erc-chess
51 :type 'boolean)
52
53;;;###autoload
54(defvar erc-ctcp-query-CHESS-hook '(erc-chess-ctcp-query-handler))
55
56(defvar erc-chess-alist nil
57 "Alist of chess sessions. It has the form of (NICK ENGINE)")
58(make-variable-buffer-local 'erc-chess-alist)
59
60(defvar erc-chess-regexp-alist chess-network-regexp-alist)
61(defvar erc-chess-partner)
62(make-variable-buffer-local 'erc-chess-partner)
63
64;;;; Catalog messages
65
66(erc-define-catalog
67 'english
68 '((ctcp-chess-debug . "CTCPchess: %n (%u@%h) sent: '%m'")
69 (ctcp-chess-quit . "Chess game with %n (%u@%h) quit")))
70
71
72(defun erc-chess-response-handler (event &rest args)
73 (when (and (eq event 'accept)
74 (eq chess-engine-pending-offer 'match))
75 (let ((display (chess-game-data (chess-engine-game nil) 'display)))
76 (chess-display-enable-popup display)
77 (chess-display-popup display)))
78
79 (apply 'chess-engine-default-handler event args))
80
81
82(defun erc-chess-handler (game event &rest args)
83 "Handle erc-chess events.
84This is the main handler for the erc-chess module."
85 (cond
86 ((eq event 'initialize)
87 (setq erc-chess-partner (car args))
88 (setq erc-server-process (nth 1 args))
89 t)
90
91 ((eq event 'send)
92 ;; Transmit the string given in `(car args)' to the nick
93 ;; saved in `erc-chess-partner'.
94 (let ((nick erc-chess-partner)
95 (msg (substring (car args) 0 (1- (length (car args))))))
96 (erc-with-server-buffer
97 (erc-send-ctcp-message nick (concat "CHESS " msg) t))))
98
99 (t
100 (cond
101 ((eq event 'accept)
102 (let ((display (chess-game-data (chess-engine-game nil) 'display)))
103 (chess-display-enable-popup display)
104 (chess-display-popup display)))
105
106 ((eq event 'destroy)
107 (let* ((buf (process-buffer erc-server-process))
108 (nick (erc-downcase erc-chess-partner))
109 (engine (current-buffer)))
110 (erc-with-server-buffer
111 (let ((elt (assoc nick erc-chess-alist)))
112 (when (and elt (eq (nth 1 elt) engine))
113 (message "Removed from erc-chess-alist in destroy event")
114 (setq erc-chess-alist (delq elt erc-chess-alist))))))))
115
116 ;; Pass all other events down to chess-network
117 (apply 'chess-network-handler game event args))))
118
119;;;; Game initialisation
120
121(defun erc-chess-engine-create (nick)
122 "Initialize a game for a particular nick.
123This function adds to `erc-chess-alist' too."
124 ;; Maybe move that into the connect callback?
125 (let* ((objects (chess-session 'erc-chess t 'erc-chess-response-handler
126 nick erc-server-process))
127 (engine (car objects))
128 (display (cadr objects)))
129 (when engine
130 (if display
131 (chess-game-set-data (chess-display-game display)
132 'display display))
133 (push (list (erc-downcase nick) engine) erc-chess-alist)
134 engine)))
135
136;;;; IRC /commands
137
138;;;###autoload
139(defun erc-cmd-CHESS (line &optional force)
140 "Initiate a chess game via CTCP to NICK.
141NICK should be the first and only arg to /chess"
142 (cond
143 ((string-match (concat "^\\s-*\\(" erc-valid-nick-regexp "\\)\\s-*$") line)
144 (let ((nick (match-string 1 line)))
145 (erc-with-server-buffer
146 (if (assoc (erc-downcase nick) erc-chess-alist)
147 ;; Maybe check for correctly connected game, and switch here.
148 (erc-display-message
149 nil 'notice 'active
150 (concat "Invitation for a game already sent to " nick))
151 (with-current-buffer (erc-chess-engine-create nick)
152 (erc-chess-handler nil 'match)
153 t)))))
154 (t nil)))
155
156;;; CTCP handler
157;;;###autoload
158(defun erc-chess-ctcp-query-handler (proc nick login host to msg)
159 (if erc-chess-debug-flag
160 (erc-display-message
161 nil 'notice (current-buffer)
162 'ctcp-chess-debug ?n nick ?m msg ?u login ?h host))
163 (when (string-match "^CHESS\\s-+\\(.*\\)$" msg)
164 (let ((str (concat (match-string 1 msg) "\n"))
165 (elt (assoc (erc-downcase nick) erc-chess-alist)))
166 (if (not elt)
167 (chess-engine-submit (erc-chess-engine-create nick) str)
168 (if (buffer-live-p (nth 1 elt))
169 (chess-engine-submit (nth 1 elt) str)
170 (setq erc-chess-alist (delq elt erc-chess-alist)))))))
171
172(provide 'erc-chess)
173
174;;; erc-chess.el ends here
175;;
176;; Local Variables:
177;; indent-tabs-mode: t
178;; tab-width: 8
179;; End:
180
181;; 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 @@
1;;; erc-nicklist.el --- Display channel nicknames in a side buffer.
2
3;; Copyright (C) 2004, 2005, 2006, 2007, 2008,
4;; 2009 Free Software Foundation, Inc.
5
6;; Filename: erc-nicklist.el
7;; Author: Lawrence Mitchell <wence@gmx.li>
8;; Created: 2004-04-30
9;; Keywords: IRC chat client Internet
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 3, or (at your option)
16;; any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING. If not, write to the
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
27
28;;; Commentary:
29;;
30;; This provides a minimal mIRC style nicklist buffer for ERC. To
31;; activate, do M-x erc-nicklist RET in the channel buffer you want
32;; the nicklist to appear for. To close and quit the nicklist
33;; buffer, do M-x erc-nicklist-quit RET from within the nicklist buffer.
34;;
35;; TODO:
36;; o Somehow associate nicklist windows with channel windows so they
37;; appear together, and if one gets buried, then the other does.
38;;
39;; o Make "Query" and "Message" work.
40;;
41;; o Prettify the actual list of nicks in some way.
42;;
43;; o Add a proper erc-module that people can turn on and off, figure
44;; out a way of creating the nicklist window at an appropriate time
45;; --- probably in `erc-join-hook'.
46;;
47;; o Ensure XEmacs compatibility --- the mouse-menu support is likely
48;; broken.
49;;
50;; o Add option to display in a separate frame --- will again need to
51;; be able to associate the nicklist with the currently active
52;; channel buffer or something similar.
53;;
54;; o Allow toggling of visibility of nicklist via ERC commands.
55
56;;; History:
57;;
58
59;; Changes by Edgar Gonçalves <edgar.goncalves@inesc-id.pt>
60;; Jun 25 2005:
61;; - images are changed to a standard set of names.
62;; - /images now contain gaim's status icons.
63;; May 31 2005:
64;; - tooltips are improved. they try to access bbdb for a nice nick!
65;; Apr 26 2005:
66;; - erc-nicklist-channel-users-info was fixed (sorting bug)
67;; - Away names don't need parenthesis when using icons
68;; Apr 26 2005:
69;; - nicks can display icons of their connection type (msn, icq, for now)
70;; Mar 15 2005:
71;; - nicks now are different for unvoiced and op users
72;; - nicks now have tooltips displaying more info
73;; Mar 18 2005:
74;; - queries now work ok, both on menu and keyb shortcut RET.
75;; - nicklist is now sorted ignoring the case. Voiced nicks will
76;; appear according to `erc-nicklist-voiced-position'.
77
78;;; Code:
79
80(require 'erc)
81(condition-case nil
82 (require 'erc-bbdb)
83 (error nil))
84(eval-when-compile (require 'cl))
85
86(defgroup erc-nicklist nil
87 "Display a list of nicknames in a separate window."
88 :group 'erc)
89
90(defcustom erc-nicklist-use-icons t
91 "*If non-nil, display an icon instead of the name of the chat medium.
92By \"chat medium\", we mean IRC, AOL, MSN, ICQ, etc."
93 :group 'erc-nicklist
94 :type 'boolean)
95
96(defcustom erc-nicklist-icons-directory
97 (let ((dir (locate-library "erc-nicklist.el")))
98 (when dir
99 (concat (file-name-directory dir) "images/")))
100 "*Directory of the PNG files for chat icons.
101Icons are displayed if `erc-nicklist-use-icons' is non-nil."
102 :group 'erc-nicklist
103 :type 'directory)
104
105(defcustom erc-nicklist-voiced-position 'bottom
106 "*Position of voiced nicks in the nicklist.
107The value can be `top', `bottom' or nil (don't sort)."
108 :group 'erc-nicklist
109 :type '(choice
110 (const :tag "Top" top)
111 (const :tag "Bottom" bottom)
112 (const :tag "Mixed" nil)))
113
114(defcustom erc-nicklist-window-size 20.0
115 "*The size of the nicklist window.
116
117This specifies a percentage of the channel window width.
118
119A negative value means the nicklist window appears on the left of the
120channel window, and vice versa."
121 :group 'erc-nicklist
122 :type 'float)
123
124
125(defun erc-nicklist-buffer-name (&optional buffer)
126 "Return the buffer name for a nicklist associated with BUFFER.
127
128If BUFFER is nil, use the value of `current-buffer'."
129 (format " *%s-nicklist*" (buffer-name (or buffer (current-buffer)))))
130
131(defun erc-nicklist-make-window ()
132 "Create an ERC nicklist window.
133
134See also `erc-nicklist-window-size'."
135 (let ((width (floor (* (window-width) (/ erc-nicklist-window-size 100.0))))
136 (buffer (erc-nicklist-buffer-name))
137 window)
138 (split-window-horizontally (- width))
139 (setq window (next-window))
140 (set-window-buffer window (get-buffer-create buffer))
141 (with-current-buffer buffer
142 (set-window-dedicated-p window t))))
143
144
145(defvar erc-nicklist-images-alist '()
146 "Alist that maps a connection type to an icon.")
147
148(defun erc-nicklist-insert-medium-name-or-icon (host channel is-away)
149 "Inserts an icon or a string identifying the current host type.
150This is configured using `erc-nicklist-use-icons' and
151`erc-nicklist-icons-directory'."
152 ;; identify the network (for bitlebee usage):
153 (let ((bitlbee-p (save-match-data
154 (string-match "\\`&bitlbee\\b"
155 (buffer-name channel)))))
156 (cond ((and bitlbee-p
157 (string= "login.icq.com" host))
158 (if erc-nicklist-use-icons
159 (if is-away
160 (insert-image (cdr (assoc 'icq-away
161 erc-nicklist-images-alist)))
162 (insert-image (cdr (assoc 'icq
163 erc-nicklist-images-alist))))
164 (insert "ICQ")))
165 (bitlbee-p
166 (if erc-nicklist-use-icons
167 (if is-away
168 (insert-image (cdr (assoc 'msn-away
169 erc-nicklist-images-alist)))
170 (insert-image (cdr (assoc 'msn
171 erc-nicklist-images-alist))))
172 (insert "MSN")))
173 (t
174 (if erc-nicklist-use-icons
175 (if is-away
176 (insert-image (cdr (assoc 'irc-away
177 erc-nicklist-images-alist)))
178 (insert-image (cdr (assoc 'irc
179 erc-nicklist-images-alist))))
180 (insert "IRC"))))
181 (insert " ")))
182
183(defun erc-nicklist-search-for-nick (finger-host)
184 "Return the bitlbee-nick field for this contact given FINGER-HOST.
185Seach for the BBDB record of this contact. If not found, return nil."
186 (when (boundp 'erc-bbdb-bitlbee-name-field)
187 (let ((record (car
188 (erc-member-if
189 #'(lambda (r)
190 (let ((fingers (bbdb-record-finger-host r)))
191 (when fingers
192 (string-match finger-host
193 (car (bbdb-record-finger-host r))))))
194 (bbdb-records)))))
195 (when record
196 (bbdb-get-field record erc-bbdb-bitlbee-name-field)))))
197
198(defun erc-nicklist-insert-contents (channel)
199 "Insert the nicklist contents, with text properties and the optional images."
200 (setq buffer-read-only nil)
201 (erase-buffer)
202 (dolist (u (erc-nicklist-channel-users-info channel))
203 (let* ((server-user (car u))
204 (channel-user (cdr u))
205 (nick (erc-server-user-nickname server-user))
206 (host (erc-server-user-host server-user))
207 (login (erc-server-user-login server-user))
208 (full-name(erc-server-user-full-name server-user))
209 (info (erc-server-user-info server-user))
210 (channels (erc-server-user-buffers server-user))
211 (op (erc-channel-user-op channel-user))
212 (voice (erc-channel-user-voice channel-user))
213 (bbdb-nick (or (erc-nicklist-search-for-nick
214 (concat login "@" host))
215 ""))
216 (away-status (if voice "" "\n(Away)"))
217 (balloon-text (concat bbdb-nick (if (string= "" bbdb-nick)
218 "" "\n")
219 "Login: " login "@" host
220 away-status)))
221 (erc-nicklist-insert-medium-name-or-icon host channel (not voice))
222 (unless (or voice erc-nicklist-use-icons)
223 (setq nick (concat "(" nick ")")))
224 (when op
225 (setq nick (concat nick " (OP)")))
226 (insert (erc-propertize nick
227 'erc-nicklist-nick nick
228 'mouse-face 'highlight
229 'erc-nicklist-channel channel
230 'help-echo balloon-text)
231 "\n")))
232 (erc-nicklist-mode))
233
234
235(defun erc-nicklist ()
236 "Create an ERC nicklist buffer."
237 (interactive)
238 (let ((channel (current-buffer)))
239 (unless (or (not erc-nicklist-use-icons)
240 erc-nicklist-images-alist)
241 (setq erc-nicklist-images-alist
242 `((msn . ,(create-image (concat erc-nicklist-icons-directory
243 "msn-online.png")))
244 (msn-away . ,(create-image (concat erc-nicklist-icons-directory
245 "msn-offline.png")))
246 (irc . ,(create-image (concat erc-nicklist-icons-directory
247 "irc-online.png")))
248 (irc-away . ,(create-image (concat erc-nicklist-icons-directory
249 "irc-offline.png")))
250 (icq . ,(create-image (concat erc-nicklist-icons-directory
251 "icq-online.png")))
252 (icq-away . ,(create-image (concat erc-nicklist-icons-directory
253 "icq-offline.png"))))))
254 (erc-nicklist-make-window)
255 (with-current-buffer (get-buffer (erc-nicklist-buffer-name channel))
256 (erc-nicklist-insert-contents channel)))
257 (add-hook 'erc-channel-members-changed-hook #'erc-nicklist-update))
258
259(defun erc-nicklist-update ()
260 "Update the ERC nicklist buffer."
261 (let ((b (get-buffer (erc-nicklist-buffer-name)))
262 (channel (current-buffer)))
263 (when b
264 (with-current-buffer b
265 (erc-nicklist-insert-contents channel)))))
266
267(defvar erc-nicklist-mode-map
268 (let ((map (make-sparse-keymap)))
269 (define-key map (kbd "<down-mouse-3>") 'erc-nicklist-menu)
270 (define-key map "\C-j" 'erc-nicklist-kbd-menu)
271 (define-key map "q" 'erc-nicklist-quit)
272 (define-key map (kbd "RET") 'erc-nicklist-kbd-cmd-QUERY)
273 map)
274 "Keymap for `erc-nicklist-mode'.")
275
276(define-derived-mode erc-nicklist-mode fundamental-mode
277 "Nicklist"
278 "Major mode for the ERC nicklist buffer."
279 (setq buffer-read-only t))
280
281(defun erc-nicklist-call-erc-command (command point buffer window)
282 "Call an ERC COMMAND.
283
284Depending on what COMMAND is, it's called with one of POINT, BUFFER,
285or WINDOW as arguments."
286 (when command
287 (let* ((p (text-properties-at point))
288 (b (plist-get p 'erc-nicklist-channel)))
289 (if (memq command '(erc-nicklist-quit ignore))
290 (funcall command window)
291 ;; EEEK! Horrble, but it's the only way we can ensure the
292 ;; response goes to the correct buffer.
293 (erc-set-active-buffer b)
294 (switch-to-buffer-other-window b)
295 (funcall command (plist-get p 'erc-nicklist-nick))))))
296
297(defun erc-nicklist-cmd-QUERY (user &optional server)
298 "Opens a query buffer with USER."
299 ;; FIXME: find a way to switch to that buffer afterwards...
300 (let ((send (if server
301 (format "QUERY %s %s" user server)
302 (format "QUERY %s" user))))
303 (erc-cmd-QUERY user)
304 t))
305
306(defun erc-nicklist-kbd-cmd-QUERY (&optional window)
307 (interactive)
308 (let* ((p (text-properties-at (point)))
309 (server (plist-get p 'erc-nicklist-channel))
310 (nick (plist-get p 'erc-nicklist-nick))
311 (nick (or (and (string-match "(\\(.*\\))" nick)
312 (match-string 1 nick))
313 nick))
314 (nick (or (and (string-match "\\+\\(.*\\)" nick)
315 (match-string 1 nick))
316 nick))
317 (send (format "QUERY %s %s" nick server)))
318 (switch-to-buffer-other-window server)
319 (erc-cmd-QUERY nick)))
320
321
322(defvar erc-nicklist-menu
323 (let ((map (make-sparse-keymap "Action")))
324 (define-key map [erc-cmd-WHOIS]
325 '("Whois" . erc-cmd-WHOIS))
326 (define-key map [erc-cmd-DEOP]
327 '("Deop" . erc-cmd-DEOP))
328 (define-key map [erc-cmd-MSG]
329 '("Message" . erc-cmd-MSG)) ;; TODO!
330 (define-key map [erc-nicklist-cmd-QUERY]
331 '("Query" . erc-nicklist-kbd-cmd-QUERY))
332 (define-key map [ignore]
333 '("Cancel" . ignore))
334 (define-key map [erc-nicklist-quit]
335 '("Close nicklist" . erc-nicklist-quit))
336 map)
337 "Menu keymap for the ERC nicklist.")
338
339(defun erc-nicklist-quit (&optional window)
340 "Delete the ERC nicklist.
341
342Deletes WINDOW and stops updating the nicklist buffer."
343 (interactive)
344 (let ((b (window-buffer window)))
345 (with-current-buffer b
346 (set-buffer-modified-p nil)
347 (kill-this-buffer)
348 (remove-hook 'erc-channel-members-changed-hook 'erc-nicklist-update))))
349
350
351(defun erc-nicklist-kbd-menu ()
352 "Show the ERC nicklist menu."
353 (interactive)
354 (let* ((point (point))
355 (window (selected-window))
356 (buffer (current-buffer)))
357 (with-current-buffer buffer
358 (erc-nicklist-call-erc-command
359 (car (x-popup-menu point
360 erc-nicklist-menu))
361 point
362 buffer
363 window))))
364
365(defun erc-nicklist-menu (&optional arg)
366 "Show the ERC nicklist menu.
367
368ARG is a parametrized event (see `interactive')."
369 (interactive "e")
370 (let* ((point (nth 1 (cadr arg)))
371 (window (car (cadr arg)))
372 (buffer (window-buffer window)))
373 (with-current-buffer buffer
374 (erc-nicklist-call-erc-command
375 (car (x-popup-menu arg
376 erc-nicklist-menu))
377 point
378 buffer
379 window))))
380
381
382(defun erc-nicklist-channel-users-info (channel)
383 "Return a nick-sorted list of all users on CHANNEL.
384Result are elements in the form (SERVER-USER . CHANNEL-USER). The
385list has all the voiced users according to
386`erc-nicklist-voiced-position'."
387 (let* ((nicks (erc-sort-channel-users-alphabetically
388 (with-current-buffer channel (erc-get-channel-user-list)))))
389 (if erc-nicklist-voiced-position
390 (let ((voiced-nicks (erc-remove-if-not
391 #'(lambda (x)
392 (null (erc-channel-user-voice (cdr x))))
393 nicks))
394 (devoiced-nicks (erc-remove-if-not
395 #'(lambda (x)
396 (erc-channel-user-voice
397 (cdr x)))
398 nicks)))
399 (cond ((eq erc-nicklist-voiced-position 'top)
400 (append devoiced-nicks voiced-nicks))
401 ((eq erc-nicklist-voiced-position 'bottom)
402 (append voiced-nicks devoiced-nicks))))
403 nicks)))
404
405
406
407(provide 'erc-nicklist)
408
409;;; erc-nicklist.el ends here
410;;
411;; Local Variables:
412;; indent-tabs-mode: t
413;; tab-width: 8
414;; coding: utf-8
415;; End:
416
417;; 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 @@
1;;; erc-speak.el --- Speech-enable the ERC chat client
2
3;; Copyright 2001, 2002, 2003, 2004, 2007,
4;; 2008, 2009 Free Software Foundation, Inc.
5
6;; This file is part of GNU Emacs.
7
8;; GNU Emacs is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation; either version 3, or (at your option)
11;; any later version.
12
13;; GNU Emacs is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with GNU Emacs; see the file COPYING. If not, write to the
20;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21;; Boston, MA 02110-1301, USA.
22
23;;; Commentary:
24
25;; This file contains code to speech enable ERC using Emacspeak's functionality
26;; to access a speech synthesizer.
27;;
28;; It tries to be intelligent and produce actually understandable
29;; audio streams :). Hopefully it does. I use it on #debian at irc.debian.org
30;; with about 200 users, and I am amazed how easy it works.
31;;
32;; Currently, erc-speak is only written to listen to channels.
33;; There is no special functionality for interaction in the erc buffers.
34;; Although this shouldn't be hard. Look at the Todo list, there are
35;; definitely many things this script could do nicely to make a better
36;; IRC experience for anyone.
37;;
38;; More info? Read the code. It isn't that complicated.
39;;
40
41;;; Installation:
42
43;; Put erc.el and erc-speak.el somewhere in your load-path and
44;; (require 'erc-speak) in your .emacs. Remember to require only erc-speak
45;; because otherwise you get conflicts with emacspeak.
46
47;;; Bugs:
48
49;; erc-speak-rate doesn't seem to work here on outloud. Can anyone enlighten
50;; me on the use of dtk-interp-queue-set-rate or equivalent?
51
52;;; Code:
53
54(require 'emacspeak)
55(provide 'emacspeak-erc)
56(require 'erc)
57(require 'erc-button)
58
59(defgroup erc-speak nil
60 "Enable speech synthesis with the ERC chat client using Emacspeak"
61 :group 'erc)
62
63(defcustom erc-speak-personalities '((erc-default-face paul)
64 (erc-direct-msg-face paul-animated)
65 (erc-input-face paul-smooth)
66 (erc-bold-face paul-bold)
67 (erc-inverse-face betty)
68 (erc-underline-face ursula)
69 (erc-prompt-face harry)
70 (erc-notice-face paul-italic)
71 (erc-action-face paul-monotone)
72 (erc-error-face kid)
73 (erc-dangerous-host-face paul-surprized)
74 (erc-pal-face paul-animated)
75 (erc-fool-face paul-angry)
76 (erc-keyword-face paul-animated))
77 "Maps faces used in erc to speaker personalities in emacspeak."
78 :group 'erc-speak
79 :type '(repeat
80 (list :tag "mapping"
81 (symbol :tag "face")
82 (symbol :tag "personality"))))
83
84(add-hook 'erc-mode-hook (lambda () (setq voice-lock-mode t)))
85
86;; Override the definition in erc.el
87(defun erc-put-text-property (start end property value &optional object)
88 "This function sets the appropriate personality on the specified
89region in addition to setting the requested face."
90 (put-text-property start end property value object)
91 (when (eq property 'face)
92 (put-text-property start end
93 'personality
94 (cadr (assq value erc-speak-personalities))
95 object)))
96
97(add-hook 'erc-insert-post-hook 'erc-speak-region)
98(add-hook 'erc-send-post-hook 'erc-speak-region)
99
100(defcustom erc-speak-filter-host t
101 "Set to t if you want to filter out user@host constructs."
102 :group 'erc-speak
103 :type 'bool)
104
105(defcustom erc-speak-filter-timestamp t
106 "If non-nil, try to filter out the timestamp when speaking arriving messages.
107
108Note, your erc-timestamp-format variable needs to start with a [
109and end with ]."
110 :group 'erc-speak
111 :type 'bool)
112
113(defcustom erc-speak-acronyms '(("brb" "be right back")
114 ("btw" "by the way")
115 ("wtf" "what the fuck")
116 ("rotfl" "rolling on the floor and laughing")
117 ("afaik" "as far as I know")
118 ("afaics" "as far as I can see")
119 ("iirc" "if I remember correctly"))
120 "List of acronyms to expand."
121 :group 'erc-speak
122 :type '(repeat sexp))
123
124(defun erc-speak-acronym-replace (string)
125 "Replace acronyms in the current buffer."
126 (let ((case-fold-search nil))
127 (dolist (ac erc-speak-acronyms string)
128 (while (string-match (car ac) string)
129 (setq string (replace-match (cadr ac) nil t string))))))
130
131(defcustom erc-speak-smileys '((":-)" "smiling face")
132 (":)" "smiling face")
133 (":-(" "sad face")
134 (":(" "sad face"))
135;; please add more, send me patches, mlang@home.delysid.org tnx
136 "List of smileys and their textual description."
137 :group 'erc-speak
138 :type '(repeat (list 'symbol 'symbol)))
139
140(defcustom erc-speak-smiley-personality 'harry
141 "Personality used for smiley announcements."
142 :group 'erc-speak
143 :type 'symbol)
144
145(defun erc-speak-smiley-replace (string)
146 "Replace smileys with textual description."
147 (let ((case-fold-search nil))
148 (dolist (smiley erc-speak-smileys string)
149 (while (string-match (car smiley) string)
150 (let ((repl (cadr smiley)))
151 (put-text-property 0 (length repl) 'personality
152 erc-speak-smiley-personality repl)
153 (setq string (replace-match repl nil t string)))))))
154
155(defcustom erc-speak-channel-personality 'harry
156 "*Personality to announce channel names with."
157 :group 'erc-speak
158 :type 'symbol)
159
160(defun erc-speak-region ()
161 "Speak a region containing one IRC message using Emacspeak.
162This function tries to translate common IRC forms into
163intelligent speech."
164 (let ((target (if (erc-channel-p (erc-default-target))
165 (erc-propertize
166 (erc-default-target)
167 'personality erc-speak-channel-personality)
168 ""))
169 (dtk-stop-immediately nil))
170 (emacspeak-auditory-icon 'progress)
171 (when erc-speak-filter-timestamp
172 (save-excursion
173 (goto-char (point-min))
174 (when (re-search-forward "^\\[[a-zA-Z:,;.0-9 \t-]+\\]" nil t)
175 (narrow-to-region (point) (point-max)))))
176 (save-excursion
177 (goto-char (point-min))
178 (cond ((re-search-forward (concat "^<\\([^>]+\\)> "
179 (concat "\\("
180 erc-valid-nick-regexp
181 "\\)[;,:]")) nil t)
182 (let ((from (match-string 1))
183 (to (match-string 2))
184 (text (buffer-substring (match-end 2) (point-max))))
185 (tts-with-punctuations
186 "some"
187 (dtk-speak (concat (erc-propertize
188 (concat target " " from " to " to)
189 'personality erc-speak-channel-personality)
190 (erc-speak-smiley-replace
191 (erc-speak-acronym-replace text)))))))
192 ((re-search-forward "^<\\([^>]+\\)> " nil t)
193 (let ((from (match-string 1))
194 (msg (buffer-substring (match-end 0) (point-max))))
195 (tts-with-punctuations
196 "some"
197 (dtk-speak (concat target " " from " "
198 (erc-speak-smiley-replace
199 (erc-speak-acronym-replace msg)))))))
200 ((re-search-forward (concat "^" (regexp-quote erc-notice-prefix)
201 "\\(.+\\)")
202 (point-max) t)
203 (let ((notice (buffer-substring (match-beginning 1) (point-max))))
204 (tts-with-punctuations
205 "all"
206 (dtk-speak
207 (with-temp-buffer
208 (insert notice)
209 (when erc-speak-filter-host
210 (goto-char (point-min))
211 (when (re-search-forward "([^)@]+@[^)@]+)" nil t)
212 (replace-match "")))
213 (buffer-string))))))
214 (t (let ((msg (buffer-substring (point-min) (point-max))))
215 (tts-with-punctuations
216 "some"
217 (dtk-speak (concat target " "
218 (erc-speak-smiley-replace
219 (erc-speak-acronym-replace msg)))))))))))
220
221(provide 'erc-speak)
222
223;;; erc-speak.el ends here
224;;
225;; Local Variables:
226;; indent-tabs-mode: t
227;; tab-width: 8
228;; End:
229
230;; arch-tag: 4499cd13-2829-43b8-83de-d313481531c4