Update copyright notices for 2013.
[bpt/emacs.git] / lisp / erc / erc-backend.el
CommitLineData
597993cf
MB
1;;; erc-backend.el --- Backend network communication for ERC
2
ab422c4d 3;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
597993cf
MB
4
5;; Filename: erc-backend.el
6;; Author: Lawrence Mitchell <wence@gmx.li>
df5d5f59 7;; Maintainer: FSF
597993cf
MB
8;; Created: 2004-05-7
9;; Keywords: IRC chat client internet
10
11;; This file is part of GNU Emacs.
12
4ee57b2a 13;; GNU Emacs is free software: you can redistribute it and/or modify
597993cf 14;; it under the terms of the GNU General Public License as published by
4ee57b2a
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
597993cf
MB
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
4ee57b2a 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
597993cf
MB
25
26;;; Commentary:
27
28;; This file defines backend network communication handlers for ERC.
29;;
30;; How things work:
31;;
32;; You define a new handler with `define-erc-response-handler'. This
33;; defines a function, a corresponding hook variable, and populates a
34;; global hash table `erc-server-responses' with a map from response
35;; to hook variable. See the function documentation for more
36;; information.
37;;
38;; Upon receiving a line from the server, `erc-parse-server-response'
39;; is called on it.
40;;
41;; A line generally looks like:
42;;
43;; LINE := ':' SENDER ' ' COMMAND ' ' (COMMAND-ARGS ' ')* ':' CONTENTS
44;; SENDER := Not ':' | ' '
45;; COMMAND := Not ':' | ' '
46;; COMMAND-ARGS := Not ':' | ' '
47;;
48;; This gets parsed and stuffed into an `erc-response' struct. You
49;; can access the fields of the struct with:
50;;
51;; COMMAND --- `erc-response.command'
52;; COMMAND-ARGS --- `erc-response.command-args'
53;; CONTENTS --- `erc-response.contents'
54;; SENDER --- `erc-response.sender'
55;; LINE --- `erc-response.unparsed'
56;;
57;; WARNING, WARNING!!
58;; It's probably not a good idea to destructively modify the list
59;; of command-args in your handlers, since other functions down the
60;; line may well need to access the arguments too.
61;;
62;; That is, unless you're /absolutely/ sure that your handler doesn't
63;; invoke some other function that needs to use COMMAND-ARGS, don't do
64;; something like
65;;
66;; (while (erc-response.command-args parsed)
67;; (let ((a (pop (erc-response.command-args parsed))))
68;; ...))
69;;
70;; The parsed response is handed over to
71;; `erc-handle-parsed-server-response', which checks whether it should
72;; carry out duplicate suppression, and then runs `erc-call-hooks'.
73;; `erc-call-hooks' retrieves the relevant hook variable from
74;; `erc-server-responses' and runs it.
75;;
76;; Most handlers then destructure the parsed response in some way
77;; (depending on what the handler is, the arguments have different
78;; meanings), and generally display something, usually using
79;; `erc-display-message'.
80
81;;; TODO:
82
f6b1b0a8 83;; o Generalize the display-line code so that we can use it to
597993cf
MB
84;; display the stuff we send, as well as the stuff we receive.
85;; Then, move all display-related code into another backend-like
86;; file, erc-display.el, say.
87;;
88;; o Clean up the handlers using new display code (has to be written
89;; first).
90
91;;; History:
92
93;; 2004/05/10 -- Handler bodies taken out of erc.el and ported to new
94;; interface.
95
96;; 2005-08-13 -- Moved sending commands from erc.el.
97
98;;; Code:
99
100(require 'erc-compat)
101(eval-when-compile (require 'cl))
393e94fa
SM
102;; There's a fairly strong mutual dependency between erc.el and erc-backend.el.
103;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the
104;; reverse is true:
3bb08684 105(eval-when-compile (provide 'erc-backend) (require 'erc))
597993cf
MB
106
107;;;; Variables and options
108
109(defvar erc-server-responses (make-hash-table :test #'equal)
110 "Hashtable mapping server responses to their handler hooks.")
111
112(defstruct (erc-response (:conc-name erc-response.))
113 (unparsed "" :type string)
114 (sender "" :type string)
115 (command "" :type string)
116 (command-args '() :type list)
117 (contents "" :type string))
118
119;;; User data
120
121(defvar erc-server-current-nick nil
122 "Nickname on the current server.
123Use `erc-current-nick' to access this.")
124(make-variable-buffer-local 'erc-server-current-nick)
125
126;;; Server attributes
127
128(defvar erc-server-process nil
129 "The process object of the corresponding server connection.")
130(make-variable-buffer-local 'erc-server-process)
131
132(defvar erc-session-server nil
133 "The server name used to connect to for this session.")
134(make-variable-buffer-local 'erc-session-server)
135
361bbf57
CY
136(defvar erc-session-connector nil
137 "The function used to connect to this session (nil for the default).")
138(make-variable-buffer-local 'erc-session-connector)
139
597993cf
MB
140(defvar erc-session-port nil
141 "The port used to connect to.")
142(make-variable-buffer-local 'erc-session-port)
143
144(defvar erc-server-announced-name nil
145 "The name the server announced to use.")
146(make-variable-buffer-local 'erc-server-announced-name)
147
148(defvar erc-server-version nil
149 "The name and version of the server's ircd.")
150(make-variable-buffer-local 'erc-server-version)
151
152(defvar erc-server-parameters nil
153 "Alist listing the supported server parameters.
154
155This is only set if the server sends 005 messages saying what is
156supported on the server.
157
158Entries are of the form:
159 (PARAMETER . VALUE)
160or
161 (PARAMETER) if no value is provided.
162
163Some examples of possible parameters sent by servers:
164CHANMODES=b,k,l,imnpst - list of supported channel modes
165CHANNELLEN=50 - maximum length of channel names
166CHANTYPES=#&!+ - supported channel prefixes
167CHARMAPPING=rfc1459 - character mapping used for nickname and channels
168KICKLEN=160 - maximum allowed kick message length
169MAXBANS=30 - maximum number of bans per channel
170MAXCHANNELS=10 - maximum number of channels allowed to join
171NETWORK=EFnet - the network identifier
172NICKLEN=9 - maximum allowed length of nicknames
173PREFIX=(ov)@+ - list of channel modes and the user prefixes if user has mode
174RFC2812 - server supports RFC 2812 features
175SILENCE=10 - supports the SILENCE command, maximum allowed number of entries
176TOPICLEN=160 - maximum allowed topic length
177WALLCHOPS - supports sending messages to all operators in a channel")
178(make-variable-buffer-local 'erc-server-parameters)
179
180;;; Server and connection state
181
ff59d266
MB
182(defvar erc-server-ping-timer-alist nil
183 "Mapping of server buffers to their specific ping timer.")
184
597993cf 185(defvar erc-server-connected nil
ff59d266
MB
186 "Non-nil if the current buffer has been used by ERC to establish
187an IRC connection.
188
189If you wish to determine whether an IRC connection is currently
190active, use the `erc-server-process-alive' function instead.")
597993cf
MB
191(make-variable-buffer-local 'erc-server-connected)
192
10dc9f9e
MB
193(defvar erc-server-reconnect-count 0
194 "Number of times we have failed to reconnect to the current server.")
195(make-variable-buffer-local 'erc-server-reconnect-count)
196
597993cf
MB
197(defvar erc-server-quitting nil
198 "Non-nil if the user requests a quit.")
199(make-variable-buffer-local 'erc-server-quitting)
200
ff59d266
MB
201(defvar erc-server-reconnecting nil
202 "Non-nil if the user requests an explicit reconnect, and the
203current IRC process is still alive.")
204(make-variable-buffer-local 'erc-server-reconnecting)
205
206(defvar erc-server-timed-out nil
207 "Non-nil if the IRC server failed to respond to a ping.")
208(make-variable-buffer-local 'erc-server-timed-out)
209
10dc9f9e
MB
210(defvar erc-server-banned nil
211 "Non-nil if the user is denied access because of a server ban.")
212(make-variable-buffer-local 'erc-server-banned)
213
ff59d266
MB
214(defvar erc-server-error-occurred nil
215 "Non-nil if the user triggers some server error.")
216(make-variable-buffer-local 'erc-server-error-occurred)
217
597993cf
MB
218(defvar erc-server-lines-sent nil
219 "Line counter.")
220(make-variable-buffer-local 'erc-server-lines-sent)
221
222(defvar erc-server-last-peers '(nil . nil)
223 "Last peers used, both sender and receiver.
224Those are used for /MSG destination shortcuts.")
225(make-variable-buffer-local 'erc-server-last-peers)
226
227(defvar erc-server-last-sent-time nil
228 "Time the message was sent.
229This is useful for flood protection.")
230(make-variable-buffer-local 'erc-server-last-sent-time)
231
232(defvar erc-server-last-ping-time nil
233 "Time the last ping was sent.
234This is useful for flood protection.")
235(make-variable-buffer-local 'erc-server-last-ping-time)
236
ff59d266
MB
237(defvar erc-server-last-received-time nil
238 "Time the last message was received from the server.
239This is useful for detecting hung connections.")
240(make-variable-buffer-local 'erc-server-last-received-time)
241
597993cf
MB
242(defvar erc-server-lag nil
243 "Calculated server lag time in seconds.
244This variable is only set in a server buffer.")
245(make-variable-buffer-local 'erc-server-lag)
246
247(defvar erc-server-filter-data nil
248 "The data that arrived from the server
249but has not been processed yet.")
250(make-variable-buffer-local 'erc-server-filter-data)
251
252(defvar erc-server-duplicates (make-hash-table :test 'equal)
253 "Internal variable used to track duplicate messages.")
254(make-variable-buffer-local 'erc-server-duplicates)
255
256;; From Circe
257(defvar erc-server-processing-p nil
258 "Non-nil when we're currently processing a message.
259
260When ERC receives a private message, it sets up a new buffer for
261this query. These in turn, though, do start flyspell. This
262involves starting an external process, in which case Emacs will
263wait - and when it waits, it does accept other stuff from, say,
264network exceptions. So, if someone sends you two messages
265quickly after each other, ispell is started for the first, but
266might take long enough for the second message to be processed
267first.")
268(make-variable-buffer-local 'erc-server-processing-p)
269
270(defvar erc-server-flood-last-message 0
271 "When we sent the last message.
272See `erc-server-flood-margin' for an explanation of the flood
273protection algorithm.")
274(make-variable-buffer-local 'erc-server-flood-last-message)
275
276(defvar erc-server-flood-queue nil
277 "The queue of messages waiting to be sent to the server.
278See `erc-server-flood-margin' for an explanation of the flood
279protection algorithm.")
280(make-variable-buffer-local 'erc-server-flood-queue)
281
282(defvar erc-server-flood-timer nil
283 "The timer to resume sending.")
284(make-variable-buffer-local 'erc-server-flood-timer)
285
286;;; IRC protocol and misc options
287
288(defgroup erc-server nil
289 "Parameters for dealing with IRC servers."
290 :group 'erc)
291
292(defcustom erc-server-auto-reconnect t
293 "Non-nil means that ERC will attempt to reestablish broken connections.
294
295Reconnection will happen automatically for any unexpected disconnection."
296 :group 'erc-server
297 :type 'boolean)
298
10dc9f9e
MB
299(defcustom erc-server-reconnect-attempts 2
300 "The number of times that ERC will attempt to reestablish a
301broken connection, or t to always attempt to reconnect.
302
303This only has an effect if `erc-server-auto-reconnect' is non-nil."
304 :group 'erc-server
305 :type '(choice (const :tag "Always reconnect" t)
306 integer))
307
308(defcustom erc-server-reconnect-timeout 1
309 "The amount of time, in seconds, that ERC will wait between
310successive reconnect attempts.
311
312If a key is pressed while ERC is waiting, it will stop waiting."
313 :group 'erc-server
314 :type 'number)
315
597993cf 316(defcustom erc-split-line-length 440
fb7ada5f 317 "The maximum length of a single message.
597993cf
MB
318If a message exceeds this size, it is broken into multiple ones.
319
320IRC allows for lines up to 512 bytes. Two of them are CR LF.
321And a typical message looks like this:
322
323 :nicky!uhuser@host212223.dialin.fnordisp.net PRIVMSG #lazybastards :Hello!
324
325You can limit here the maximum length of the \"Hello!\" part.
326Good luck."
327 :type 'integer
328 :group 'erc-server)
329
5c0c0f77
LMI
330(defcustom erc-coding-system-precedence '(utf-8 undecided)
331 "List of coding systems to be preferred when receiving a string from the server.
332This will only be consulted if the coding system in
333`erc-server-coding-system' is `undecided'."
334 :group 'erc-server
c4077254 335 :version "24.1"
5c0c0f77
LMI
336 :type '(repeat coding-system))
337
597993cf
MB
338(defcustom erc-server-coding-system (if (and (fboundp 'coding-system-p)
339 (coding-system-p 'undecided)
340 (coding-system-p 'utf-8))
341 '(utf-8 . undecided)
342 nil)
343 "The default coding system for incoming and outgoing text.
344This is either a coding system, a cons, a function, or nil.
345
346If a cons, the encoding system for outgoing text is in the car
347and the decoding system for incoming text is in the cdr. The most
5c0c0f77
LMI
348interesting use for this is to put `undecided' in the cdr. This
349means that `erc-coding-system-precedence' will be consulted, and the
350first match there will be used.
5e56b3fb
MO
351
352If a function, it is called with the argument `target' and should
353return a coding system or a cons as described above.
597993cf
MB
354
355If you need to send non-ASCII text to people not using a client that
356does decoding on its own, you must tell ERC what encoding to use.
357Emacs cannot guess it, since it does not know what the people on the
358other end of the line are using."
359 :group 'erc-server
360 :type '(choice (const :tag "None" nil)
361 coding-system
362 (cons (coding-system :tag "encoding" :value utf-8)
363 (coding-system :tag "decoding" :value undecided))
364 function))
365
366(defcustom erc-encoding-coding-alist nil
367 "Alist of target regexp and coding-system pairs to use.
368This overrides `erc-server-coding-system' depending on the
369current target as returned by `erc-default-target'.
370
371Example: If you know that the channel #linux-ru uses the coding-system
372`cyrillic-koi8', then add '(\"#linux-ru\" . cyrillic-koi8) to the
373alist."
374 :group 'erc-server
375 :type '(repeat (cons (string :tag "Target")
376 coding-system)))
377
21bc768b 378(defcustom erc-server-connect-function 'open-network-stream
597993cf
MB
379 "Function used to initiate a connection.
380It should take same arguments as `open-network-stream' does."
381 :group 'erc-server
382 :type 'function)
383
384(defcustom erc-server-prevent-duplicates '("301")
fb7ada5f 385 "Either nil or a list of strings.
597993cf
MB
386Each string is a IRC message type, like PRIVMSG or NOTICE.
387All Message types in that list of subjected to duplicate prevention."
388 :type '(choice (const nil) (list string))
389 :group 'erc-server)
390
391(defcustom erc-server-duplicate-timeout 60
fb7ada5f 392 "The time allowed in seconds between duplicate messages.
597993cf
MB
393
394If two identical messages arrive within this value of one another, the second
395isn't displayed."
396 :type 'integer
397 :group 'erc-server)
398
56551c43 399(defcustom erc-server-timestamp-format "%Y-%m-%d %T"
16245de5 400 "Timestamp format used with server response messages.
56551c43 401This string is processed using `format-time-string'."
2a1e2476 402 :version "24.3"
56551c43
TL
403 :type 'string
404 :group 'erc-server)
405
597993cf
MB
406;;; Flood-related
407
408;; Most of this is courtesy of Jorgen Schaefer and Circe
409;; (http://www.nongnu.org/circe)
410
411(defcustom erc-server-flood-margin 10
fb7ada5f 412 "A margin on how much excess data we send.
597993cf
MB
413The flood protection algorithm of ERC works like the one
414detailed in RFC 2813, section 5.8 \"Flood control of clients\".
415
416 * If `erc-server-flood-last-message' is less than the current
417 time, set it equal.
418 * While `erc-server-flood-last-message' is less than
419 `erc-server-flood-margin' seconds ahead of the current
420 time, send a message, and increase
421 `erc-server-flood-last-message' by
422 `erc-server-flood-penalty' for each message."
423 :type 'integer
424 :group 'erc-server)
425
426(defcustom erc-server-flood-penalty 3
427 "How much we penalize a message.
428See `erc-server-flood-margin' for an explanation of the flood
429protection algorithm."
430 :type 'integer
431 :group 'erc-server)
432
433;; Ping handling
434
ff59d266 435(defcustom erc-server-send-ping-interval 30
fb7ada5f 436 "Interval of sending pings to the server, in seconds.
597993cf
MB
437If this is set to nil, pinging the server is disabled."
438 :group 'erc-server
ff59d266
MB
439 :type '(choice (const :tag "Disabled" nil)
440 (integer :tag "Seconds")))
441
442(defcustom erc-server-send-ping-timeout 120
fb7ada5f 443 "If the time between ping and response is greater than this, reconnect.
ff59d266
MB
444The time is in seconds.
445
446This must be greater than or equal to the value for
447`erc-server-send-ping-interval'.
448
449If this is set to nil, never try to reconnect."
450 :group 'erc-server
451 :type '(choice (const :tag "Disabled" nil)
452 (integer :tag "Seconds")))
597993cf
MB
453
454(defvar erc-server-ping-handler nil
455 "This variable holds the periodic ping timer.")
456(make-variable-buffer-local 'erc-server-ping-handler)
457
458;;;; Helper functions
459
460;; From Circe
461(defun erc-split-line (longline)
462 "Return a list of lines which are not too long for IRC.
463The length is specified in `erc-split-line-length'.
464
465Currently this is called by `erc-send-input'."
466 (if (< (length longline)
467 erc-split-line-length)
468 (list longline)
469 (with-temp-buffer
470 (insert longline)
471 (let ((fill-column erc-split-line-length))
472 (fill-region (point-min) (point-max)
473 nil t))
474 (split-string (buffer-string) "\n"))))
475
476;; Used by CTCP functions
477(defun erc-upcase-first-word (str)
478 "Upcase the first word in STR."
479 (with-temp-buffer
480 (insert str)
481 (goto-char (point-min))
482 (upcase-word 1)
483 (buffer-string)))
484
ff59d266
MB
485(defun erc-server-setup-periodical-ping (buffer)
486 "Set up a timer to periodically ping the current server.
487The current buffer is given by BUFFER."
488 (with-current-buffer buffer
489 (and erc-server-ping-handler (erc-cancel-timer erc-server-ping-handler))
490 (when erc-server-send-ping-interval
491 (setq erc-server-ping-handler (run-with-timer
492 4 erc-server-send-ping-interval
493 #'erc-server-send-ping
494 buffer))
495 (setq erc-server-ping-timer-alist (cons (cons buffer
496 erc-server-ping-handler)
497 erc-server-ping-timer-alist)))))
597993cf
MB
498
499(defun erc-server-process-alive ()
500 "Return non-nil when `erc-server-process' is open or running."
83dc6995 501 (and erc-server-process
597993cf
MB
502 (processp erc-server-process)
503 (memq (process-status erc-server-process) '(run open))))
504
505;;;; Connecting to a server
506
ff59d266
MB
507(defun erc-server-connect (server port buffer)
508 "Perform the connection and login using the specified SERVER and PORT.
509We will store server variables in the buffer given by BUFFER."
597993cf
MB
510 (let ((msg (erc-format-message 'connect ?S server ?p port)))
511 (message "%s" msg)
ff59d266
MB
512 (let ((process (funcall erc-server-connect-function
513 (format "erc-%s-%s" server port)
514 nil server port)))
5e56b3fb
MO
515 (unless (processp process)
516 (error "Connection attempt failed"))
ff59d266
MB
517 (message "%s...done" msg)
518 ;; Misc server variables
519 (with-current-buffer buffer
520 (setq erc-server-process process)
521 (setq erc-server-quitting nil)
522 (setq erc-server-reconnecting nil)
523 (setq erc-server-timed-out nil)
524 (setq erc-server-banned nil)
525 (setq erc-server-error-occurred nil)
526 (let ((time (erc-current-time)))
527 (setq erc-server-last-sent-time time)
528 (setq erc-server-last-ping-time time)
529 (setq erc-server-last-received-time time))
530 (setq erc-server-lines-sent 0)
531 ;; last peers (sender and receiver)
532 (setq erc-server-last-peers '(nil . nil)))
533 ;; we do our own encoding and decoding
534 (when (fboundp 'set-process-coding-system)
535 (set-process-coding-system process 'raw-text))
536 ;; process handlers
537 (set-process-sentinel process 'erc-process-sentinel)
538 (set-process-filter process 'erc-server-filter-function)
539 (set-process-buffer process buffer)))
597993cf 540 (erc-log "\n\n\n********************************************\n")
274f1353 541 (message "%s" (erc-format-message
ff59d266
MB
542 'login ?n
543 (with-current-buffer buffer (erc-current-nick))))
597993cf
MB
544 ;; wait with script loading until we receive a confirmation (first
545 ;; MOTD line)
546 (if (eq erc-server-connect-function 'open-network-stream-nowait)
547 ;; it's a bit unclear otherwise that it's attempting to establish a
548 ;; connection
ff59d266 549 (erc-display-message nil nil buffer "Opening connection..\n")
597993cf
MB
550 (erc-login)))
551
10dc9f9e
MB
552(defun erc-server-reconnect ()
553"Reestablish the current IRC connection.
554Make sure you are in an ERC buffer when running this."
526dc846
MO
555 (let ((buffer (erc-server-buffer)))
556 (unless (buffer-live-p buffer)
557 (if (eq major-mode 'erc-mode)
558 (setq buffer (current-buffer))
559 (error "Reconnect must be run from an ERC buffer")))
560 (with-current-buffer buffer
10dc9f9e
MB
561 (erc-update-mode-line)
562 (erc-set-active-buffer (current-buffer))
563 (setq erc-server-last-sent-time 0)
564 (setq erc-server-lines-sent 0)
361bbf57
CY
565 (let ((erc-server-connect-function (or erc-session-connector
566 'open-network-stream)))
567 (erc-open erc-session-server erc-session-port erc-server-current-nick
568 erc-session-user-full-name t erc-session-password)))))
10dc9f9e 569
597993cf
MB
570(defun erc-server-filter-function (process string)
571 "The process filter for the ERC server."
572 (with-current-buffer (process-buffer process)
ff59d266 573 (setq erc-server-last-received-time (erc-current-time))
597993cf
MB
574 ;; If you think this is written in a weird way - please refer to the
575 ;; docstring of `erc-server-processing-p'
576 (if erc-server-processing-p
577 (setq erc-server-filter-data
578 (if erc-server-filter-data
579 (concat erc-server-filter-data string)
580 string))
581 ;; This will be true even if another process is spawned!
582 (let ((erc-server-processing-p t))
583 (setq erc-server-filter-data (if erc-server-filter-data
584 (concat erc-server-filter-data
585 string)
586 string))
587 (while (and erc-server-filter-data
588 (string-match "[\n\r]+" erc-server-filter-data))
589 (let ((line (substring erc-server-filter-data
590 0 (match-beginning 0))))
591 (setq erc-server-filter-data
592 (if (= (match-end 0)
593 (length erc-server-filter-data))
594 nil
595 (substring erc-server-filter-data
596 (match-end 0))))
5997e340 597 (erc-log-irc-protocol line nil)
597993cf
MB
598 (erc-parse-server-response process line)))))))
599
10dc9f9e
MB
600(defsubst erc-server-reconnect-p (event)
601 "Return non-nil if ERC should attempt to reconnect automatically.
602EVENT is the message received from the closed connection process."
ff59d266
MB
603 (or erc-server-reconnecting
604 (and erc-server-auto-reconnect
605 (not erc-server-banned)
606 (not erc-server-error-occurred)
607 ;; make sure we don't infinitely try to reconnect, unless the
608 ;; user wants that
609 (or (eq erc-server-reconnect-attempts t)
610 (and (integerp erc-server-reconnect-attempts)
611 (< erc-server-reconnect-count
612 erc-server-reconnect-attempts)))
613 (or erc-server-timed-out
614 (not (string-match "^deleted" event)))
615 ;; open-network-stream-nowait error for connection refused
616 (not (string-match "^failed with code 111" event)))))
10dc9f9e 617
526dc846
MO
618(defun erc-process-sentinel-2 (event buffer)
619 "Called when `erc-process-sentinel-1' has detected an unexpected disconnect."
620 (if (not (buffer-live-p buffer))
621 (erc-update-mode-line)
622 (with-current-buffer buffer
623 (let ((reconnect-p (erc-server-reconnect-p event)))
624 (erc-display-message nil 'error (current-buffer)
625 (if reconnect-p 'disconnected
626 'disconnected-noreconnect))
627 (if (not reconnect-p)
628 ;; terminate, do not reconnect
629 (progn
630 (erc-display-message nil 'error (current-buffer)
631 'terminated ?e event)
632 ;; Update mode line indicators
633 (erc-update-mode-line)
634 (set-buffer-modified-p nil))
635 ;; reconnect
636 (condition-case err
637 (progn
638 (setq erc-server-reconnecting nil)
639 (erc-server-reconnect)
640 (setq erc-server-reconnect-count 0))
641 (error (when (buffer-live-p buffer)
642 (set-buffer buffer)
643 (if (integerp erc-server-reconnect-attempts)
644 (setq erc-server-reconnect-count
645 (1+ erc-server-reconnect-count))
646 (message "%s ... %s"
647 "Reconnecting until we succeed"
648 "kill the ERC server buffer to stop"))
649 (if (numberp erc-server-reconnect-timeout)
650 (run-at-time erc-server-reconnect-timeout nil
651 #'erc-process-sentinel-2
652 event buffer)
653 (error (concat "`erc-server-reconnect-timeout`"
654 " must be a number")))))))))))
655
656(defun erc-process-sentinel-1 (event buffer)
10dc9f9e
MB
657 "Called when `erc-process-sentinel' has decided that we're disconnecting.
658Determine whether user has quit or whether erc has been terminated.
659Conditionally try to reconnect and take appropriate action."
526dc846
MO
660 (with-current-buffer buffer
661 (if erc-server-quitting
662 ;; normal quit
663 (progn
664 (erc-display-message nil 'error (current-buffer) 'finished)
665 ;; Update mode line indicators
666 (erc-update-mode-line)
667 ;; Kill server buffer if user wants it
597993cf 668 (set-buffer-modified-p nil)
526dc846
MO
669 (when erc-kill-server-buffer-on-quit
670 (kill-buffer (current-buffer))))
671 ;; unexpected disconnect
672 (erc-process-sentinel-2 event buffer))))
597993cf
MB
673
674(defun erc-process-sentinel (cproc event)
675 "Sentinel function for ERC process."
6bb55f7c
JD
676 (let ((buf (process-buffer cproc)))
677 (when (buffer-live-p buf)
678 (with-current-buffer buf
679 (erc-log (format
680 "SENTINEL: proc: %S status: %S event: %S (quitting: %S)"
681 cproc (process-status cproc) event erc-server-quitting))
682 (if (string-match "^open" event)
683 ;; newly opened connection (no wait)
684 (erc-login)
685 ;; assume event is 'failed
686 (erc-with-all-buffers-of-server cproc nil
687 (setq erc-server-connected nil))
688 (when erc-server-ping-handler
689 (progn (erc-cancel-timer erc-server-ping-handler)
690 (setq erc-server-ping-handler nil)))
691 (run-hook-with-args 'erc-disconnected-hook
692 (erc-current-nick) (system-name) "")
693 ;; Remove the prompt
694 (goto-char (or (marker-position erc-input-marker) (point-max)))
695 (forward-line 0)
696 (erc-remove-text-properties-region (point) (point-max))
697 (delete-region (point) (point-max))
698 ;; Decide what to do with the buffer
699 ;; Restart if disconnected
700 (erc-process-sentinel-1 event buf))))))
597993cf
MB
701
702;;;; Sending messages
703
704(defun erc-coding-system-for-target (target)
705 "Return the coding system or cons cell appropriate for TARGET.
706This is determined via `erc-encoding-coding-alist' or
707`erc-server-coding-system'."
ff59d266 708 (unless target (setq target (erc-default-target)))
2e3ef421
MB
709 (or (when target
710 (let ((case-fold-search t))
711 (catch 'match
712 (dolist (pat erc-encoding-coding-alist)
713 (when (string-match (car pat) target)
714 (throw 'match (cdr pat)))))))
597993cf 715 (and (functionp erc-server-coding-system)
5e56b3fb 716 (funcall erc-server-coding-system target))
597993cf
MB
717 erc-server-coding-system))
718
719(defun erc-decode-string-from-target (str target)
720 "Decode STR as appropriate for TARGET.
721This is indicated by `erc-encoding-coding-alist', defaulting to the value of
722`erc-server-coding-system'."
723 (unless (stringp str)
724 (setq str ""))
725 (let ((coding (erc-coding-system-for-target target)))
726 (when (consp coding)
727 (setq coding (cdr coding)))
5c0c0f77
LMI
728 (when (eq coding 'undecided)
729 (let ((codings (detect-coding-string str))
730 (precedence erc-coding-system-precedence))
731 (while (and precedence
732 (not (memq (car precedence) codings)))
733 (pop precedence))
734 (when precedence
735 (setq coding (car precedence)))))
597993cf
MB
736 (erc-decode-coding-string str coding)))
737
738;; proposed name, not used by anything yet
739(defun erc-send-line (text display-fn)
740 "Send TEXT to the current server. Wrapping and flood control apply.
741Use DISPLAY-FN to show the results."
742 (mapc (lambda (line)
743 (erc-server-send line)
744 (funcall display-fn))
745 (erc-split-line text)))
746
747;; From Circe, with modifications
748(defun erc-server-send (string &optional forcep target)
749 "Send STRING to the current server.
750If FORCEP is non-nil, no flood protection is done - the string is
751sent directly. This might cause the messages to arrive in a wrong
752order.
753
754If TARGET is specified, look up encoding information for that
755channel in `erc-encoding-coding-alist' or
756`erc-server-coding-system'.
757
758See `erc-server-flood-margin' for an explanation of the flood
759protection algorithm."
760 (erc-log (concat "erc-server-send: " string "(" (buffer-name) ")"))
761 (setq erc-server-last-sent-time (erc-current-time))
ff59d266 762 (let ((encoding (erc-coding-system-for-target target)))
597993cf
MB
763 (when (consp encoding)
764 (setq encoding (car encoding)))
ff59d266
MB
765 (if (erc-server-process-alive)
766 (erc-with-server-buffer
597993cf
MB
767 (let ((str (concat string "\r\n")))
768 (if forcep
769 (progn
770 (setq erc-server-flood-last-message
771 (+ erc-server-flood-penalty
772 erc-server-flood-last-message))
773 (erc-log-irc-protocol str 'outbound)
774 (condition-case err
775 (progn
776 ;; Set encoding just before sending the string
777 (when (fboundp 'set-process-coding-system)
778 (set-process-coding-system erc-server-process
779 'raw-text encoding))
780 (process-send-string erc-server-process str))
781 ;; See `erc-server-send-queue' for full
782 ;; explanation of why we need this condition-case
783 (error nil)))
784 (setq erc-server-flood-queue
785 (append erc-server-flood-queue
786 (list (cons str encoding))))
787 (erc-server-send-queue (current-buffer))))
788 t)
789 (message "ERC: No process running")
790 nil)))
791
afa803d5
GM
792(defun erc-server-send-ping (buf)
793 "Send a ping to the IRC server buffer in BUF.
794Additionally, detect whether the IRC process has hung."
795 (if (buffer-live-p buf)
796 (with-current-buffer buf
797 (if (and erc-server-send-ping-timeout
798 (>
799 (erc-time-diff (erc-current-time)
800 erc-server-last-received-time)
801 erc-server-send-ping-timeout))
802 (progn
803 ;; if the process is hung, kill it
804 (setq erc-server-timed-out t)
805 (delete-process erc-server-process))
806 (erc-server-send (format "PING %.0f" (erc-current-time)))))
807 ;; remove timer if the server buffer has been killed
808 (let ((timer (assq buf erc-server-ping-timer-alist)))
809 (when timer
810 (erc-cancel-timer (cdr timer))
811 (setcdr timer nil)))))
812
597993cf
MB
813;; From Circe
814(defun erc-server-send-queue (buffer)
815 "Send messages in `erc-server-flood-queue'.
816See `erc-server-flood-margin' for an explanation of the flood
817protection algorithm."
818 (with-current-buffer buffer
819 (let ((now (erc-current-time)))
820 (when erc-server-flood-timer
821 (erc-cancel-timer erc-server-flood-timer)
822 (setq erc-server-flood-timer nil))
823 (when (< erc-server-flood-last-message
824 now)
825 (setq erc-server-flood-last-message now))
826 (while (and erc-server-flood-queue
827 (< erc-server-flood-last-message
828 (+ now erc-server-flood-margin)))
829 (let ((msg (caar erc-server-flood-queue))
830 (encoding (cdar erc-server-flood-queue)))
831 (setq erc-server-flood-queue (cdr erc-server-flood-queue)
832 erc-server-flood-last-message
833 (+ erc-server-flood-last-message
834 erc-server-flood-penalty))
835 (erc-log-irc-protocol msg 'outbound)
836 (erc-log (concat "erc-server-send-queue: "
837 msg "(" (buffer-name buffer) ")"))
838 (when (erc-server-process-alive)
839 (condition-case err
840 ;; Set encoding just before sending the string
841 (progn
842 (when (fboundp 'set-process-coding-system)
843 (set-process-coding-system erc-server-process
844 'raw-text encoding))
845 (process-send-string erc-server-process msg))
846 ;; Sometimes the send can occur while the process is
847 ;; being killed, which results in a weird SIGPIPE error.
848 ;; Catch this and ignore it.
849 (error nil)))))
850 (when erc-server-flood-queue
851 (setq erc-server-flood-timer
83dc6995
MB
852 (run-at-time (+ 0.2 erc-server-flood-penalty)
853 nil #'erc-server-send-queue buffer))))))
597993cf
MB
854
855(defun erc-message (message-command line &optional force)
856 "Send LINE to the server as a privmsg or a notice.
857MESSAGE-COMMAND should be either \"PRIVMSG\" or \"NOTICE\".
858If the target is \",\", the last person you've got a message from will
859be used. If the target is \".\", the last person you've sent a message
860to will be used."
861 (cond
862 ((string-match "^\\s-*\\(\\S-+\\) ?\\(.*\\)" line)
863 (let ((tgt (match-string 1 line))
864 (s (match-string 2 line)))
865 (erc-log (format "cmd: MSG(%s): [%s] %s" message-command tgt s))
866 (cond
867 ((string= tgt ",")
868 (if (car erc-server-last-peers)
869 (setq tgt (car erc-server-last-peers))
870 (setq tgt nil)))
871 ((string= tgt ".")
872 (if (cdr erc-server-last-peers)
873 (setq tgt (cdr erc-server-last-peers))
874 (setq tgt nil))))
875 (cond
876 (tgt
877 (setcdr erc-server-last-peers tgt)
878 (erc-server-send (format "%s %s :%s" message-command tgt s)
879 force))
880 (t
881 (erc-display-message nil 'error (current-buffer) 'no-target))))
882 t)
883 (t nil)))
884
885;;; CTCP
886
887(defun erc-send-ctcp-message (tgt l &optional force)
888 "Send CTCP message L to TGT.
889
890If TGT is nil the message is not sent.
891The command must contain neither a prefix nor a trailing `\\n'.
892
893See also `erc-server-send'."
894 (let ((l (erc-upcase-first-word l)))
895 (cond
896 (tgt
897 (erc-log (format "erc-send-CTCP-message: [%s] %s" tgt l))
898 (erc-server-send (format "PRIVMSG %s :\C-a%s\C-a" tgt l)
899 force)))))
900
901(defun erc-send-ctcp-notice (tgt l &optional force)
902 "Send CTCP notice L to TGT.
903
904If TGT is nil the message is not sent.
905The command must contain neither a prefix nor a trailing `\\n'.
906
907See also `erc-server-send'."
908 (let ((l (erc-upcase-first-word l)))
909 (cond
910 (tgt
911 (erc-log (format "erc-send-CTCP-notice: [%s] %s" tgt l))
912 (erc-server-send (format "NOTICE %s :\C-a%s\C-a" tgt l)
913 force)))))
914
915;;;; Handling responses
916
917(defun erc-parse-server-response (proc string)
918 "Parse and act upon a complete line from an IRC server.
919PROC is the process (connection) from which STRING was received.
920PROCs `process-buffer' is `current-buffer' when this function is called."
921 (unless (string= string "") ;; Ignore empty strings
922 (save-match-data
923 (let ((posn (if (eq (aref string 0) ?:)
924 (string-match " " string)
925 0))
926 (msg (make-erc-response :unparsed string)))
927
928 (setf (erc-response.sender msg)
929 (if (eq posn 0)
930 erc-session-server
931 (substring string 1 posn)))
932
933 (setf (erc-response.command msg)
21bc768b 934 (let* ((bposn (string-match "[^ \n]" string posn))
597993cf
MB
935 (eposn (string-match " " string bposn)))
936 (setq posn (and eposn
21bc768b 937 (string-match "[^ \n]" string eposn)))
597993cf
MB
938 (substring string bposn eposn)))
939
940 (while (and posn
941 (not (eq (aref string posn) ?:)))
942 (push (let* ((bposn posn)
943 (eposn (string-match " " string bposn)))
944 (setq posn (and eposn
21bc768b 945 (string-match "[^ \n]" string eposn)))
597993cf
MB
946 (substring string bposn eposn))
947 (erc-response.command-args msg)))
948 (when posn
949 (let ((str (substring string (1+ posn))))
950 (push str (erc-response.command-args msg))))
951
952 (setf (erc-response.contents msg)
953 (first (erc-response.command-args msg)))
954
955 (setf (erc-response.command-args msg)
956 (nreverse (erc-response.command-args msg)))
957
958 (erc-decode-parsed-server-response msg)
959
960 (erc-handle-parsed-server-response proc msg)))))
961
962(defun erc-decode-parsed-server-response (parsed-response)
963 "Decode a pre-parsed PARSED-RESPONSE before it can be handled.
964
965If there is a channel name in `erc-response.command-args', decode
966`erc-response' according to this channel name and
967`erc-encoding-coding-alist', or use `erc-server-coding-system'
968for decoding."
969 (let ((args (erc-response.command-args parsed-response))
970 (decode-target nil)
971 (decoded-args ()))
972 (dolist (arg args nil)
973 (when (string-match "^[#&].*" arg)
974 (setq decode-target arg)))
975 (when (stringp decode-target)
976 (setq decode-target (erc-decode-string-from-target decode-target nil)))
977 (setf (erc-response.unparsed parsed-response)
978 (erc-decode-string-from-target
979 (erc-response.unparsed parsed-response)
980 decode-target))
981 (setf (erc-response.sender parsed-response)
982 (erc-decode-string-from-target
983 (erc-response.sender parsed-response)
984 decode-target))
985 (setf (erc-response.command parsed-response)
986 (erc-decode-string-from-target
987 (erc-response.command parsed-response)
988 decode-target))
989 (dolist (arg (nreverse args) nil)
990 (push (erc-decode-string-from-target arg decode-target)
991 decoded-args))
992 (setf (erc-response.command-args parsed-response) decoded-args)
993 (setf (erc-response.contents parsed-response)
994 (erc-decode-string-from-target
995 (erc-response.contents parsed-response)
996 decode-target))))
997
998(defun erc-handle-parsed-server-response (process parsed-response)
999 "Handle a pre-parsed PARSED-RESPONSE from PROCESS.
1000
1001Hands off to helper functions via `erc-call-hooks'."
1002 (if (member (erc-response.command parsed-response)
1003 erc-server-prevent-duplicates)
1004 (let ((m (erc-response.unparsed parsed-response)))
fac916bf 1005 ;; duplicate suppression
597993cf
MB
1006 (if (< (or (gethash m erc-server-duplicates) 0)
1007 (- (erc-current-time) erc-server-duplicate-timeout))
1008 (erc-call-hooks process parsed-response))
1009 (puthash m (erc-current-time) erc-server-duplicates))
1010 ;; Hand off to the relevant handler.
1011 (erc-call-hooks process parsed-response)))
1012
1013(defun erc-get-hook (command)
1014 "Return the hook variable associated with COMMAND.
1015
1016See also `erc-server-responses'."
1017 (gethash (format (if (numberp command) "%03i" "%s") command)
1018 erc-server-responses))
1019
1020(defun erc-call-hooks (process message)
1021 "Call hooks associated with MESSAGE in PROCESS.
1022
1023Finds hooks by looking in the `erc-server-responses' hashtable."
1024 (let ((hook (or (erc-get-hook (erc-response.command message))
1025 'erc-default-server-functions)))
1026 (run-hook-with-args-until-success hook process message)
ff59d266
MB
1027 (erc-with-server-buffer
1028 (run-hook-with-args 'erc-timer-hook (erc-current-time)))))
597993cf
MB
1029
1030(add-hook 'erc-default-server-functions 'erc-handle-unknown-server-response)
1031
1032(defun erc-handle-unknown-server-response (proc parsed)
1033 "Display unknown server response's message."
1034 (let ((line (concat (erc-response.sender parsed)
1035 " "
1036 (erc-response.command parsed)
1037 " "
1038 (mapconcat 'identity (erc-response.command-args parsed)
1039 " "))))
1040 (erc-display-message parsed 'notice proc line)))
1041
1042
1043(put 'define-erc-response-handler 'edebug-form-spec
1044 '(&define :name erc-response-handler
1045 (name &rest name)
1046 &optional sexp sexp def-body))
1047
1048(defmacro* define-erc-response-handler ((name &rest aliases)
1049 &optional extra-fn-doc extra-var-doc
1050 &rest fn-body)
1051 "Define an ERC handler hook/function pair.
1052NAME is the response name as sent by the server (see the IRC RFC for
1053meanings).
1054
1055This creates:
8e663c3b 1056 - a hook variable `erc-server-NAME-functions' initialized to `erc-server-NAME'.
597993cf
MB
1057 - a function `erc-server-NAME' with body FN-BODY.
1058
1059If ALIASES is non-nil, each alias in ALIASES is `defalias'ed to
1060`erc-server-NAME'.
1061Alias hook variables are created as `erc-server-ALIAS-functions' and
8e663c3b 1062initialized to the same default value as `erc-server-NAME-functions'.
597993cf
MB
1063
1064FN-BODY is the body of `erc-server-NAME' it may refer to the two
1065function arguments PROC and PARSED.
1066
1067If EXTRA-FN-DOC is non-nil, it is inserted at the beginning of the
1068defined function's docstring.
1069
1070If EXTRA-VAR-DOC is non-nil, it is inserted at the beginning of the
1071defined variable's docstring.
1072
1073As an example:
1074
1075 (define-erc-response-handler (311 WHOIS WI)
1076 \"Some non-generic function documentation.\"
1077 \"Some non-generic variable documentation.\"
1078 (do-stuff-with-whois proc parsed))
1079
1080Would expand to:
1081
1082 (prog2
1083 (defvar erc-server-311-functions 'erc-server-311
1084 \"Some non-generic variable documentation.
1085
1086 Hook called upon receiving a 311 server response.
1087 Each function is called with two arguments, the process associated
1088 with the response and the parsed response.
1089 See also `erc-server-311'.\")
1090
1091 (defun erc-server-311 (proc parsed)
1092 \"Some non-generic function documentation.
1093
1094 Handler for a 311 server response.
1095 PROC is the server process which returned the response.
1096 PARSED is the actual response as an `erc-response' struct.
1097 If you want to add responses don't modify this function, but rather
1098 add things to `erc-server-311-functions' instead.\"
1099 (do-stuff-with-whois proc parsed))
1100
1101 (puthash \"311\" 'erc-server-311-functions erc-server-responses)
1102 (puthash \"WHOIS\" 'erc-server-WHOIS-functions erc-server-responses)
1103 (puthash \"WI\" 'erc-server-WI-functions erc-server-responses)
1104
1105 (defalias 'erc-server-WHOIS 'erc-server-311)
1106 (defvar erc-server-WHOIS-functions 'erc-server-311
1107 \"Some non-generic variable documentation.
1108
1109 Hook called upon receiving a WHOIS server response.
526dc846 1110
597993cf 1111 Each function is called with two arguments, the process associated
526dc846
MO
1112 with the response and the parsed response. If the function returns
1113 non-nil, stop processing the hook. Otherwise, continue.
1114
597993cf
MB
1115 See also `erc-server-311'.\")
1116
1117 (defalias 'erc-server-WI 'erc-server-311)
1118 (defvar erc-server-WI-functions 'erc-server-311
1119 \"Some non-generic variable documentation.
1120
1121 Hook called upon receiving a WI server response.
1122 Each function is called with two arguments, the process associated
526dc846
MO
1123 with the response and the parsed response. If the function returns
1124 non-nil, stop processing the hook. Otherwise, continue.
1125
597993cf
MB
1126 See also `erc-server-311'.\"))
1127
1128\(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)"
1129 (if (numberp name) (setq name (intern (format "%03i" name))))
1130 (setq aliases (mapcar (lambda (a)
1131 (if (numberp a)
1132 (format "%03i" a)
1133 a))
1134 aliases))
1135 (let* ((hook-name (intern (format "erc-server-%s-functions" name)))
1136 (fn-name (intern (format "erc-server-%s" name)))
1137 (hook-doc (format "%sHook called upon receiving a %%s server response.
1138Each function is called with two arguments, the process associated
526dc846
MO
1139with the response and the parsed response. If the function returns
1140non-nil, stop processing the hook. Otherwise, continue.
1141
597993cf
MB
1142See also `%s'."
1143 (if extra-var-doc
1144 (concat extra-var-doc "\n\n")
1145 "")
1146 fn-name))
1147 (fn-doc (format "%sHandler for a %s server response.
1148PROC is the server process which returned the response.
1149PARSED is the actual response as an `erc-response' struct.
1150If you want to add responses don't modify this function, but rather
1151add things to `%s' instead."
1152 (if extra-fn-doc
1153 (concat extra-fn-doc "\n\n")
1154 "")
1155 name hook-name))
1156 (fn-alternates
1157 (loop for alias in aliases
1158 collect (intern (format "erc-server-%s" alias))))
1159 (var-alternates
1160 (loop for alias in aliases
1161 collect (intern (format "erc-server-%s-functions" alias)))))
1162 `(prog2
1163 ;; Normal hook variable.
1164 (defvar ,hook-name ',fn-name ,(format hook-doc name))
1165 ;; Handler function
1166 (defun ,fn-name (proc parsed)
1167 ,fn-doc
1168 ,@fn-body)
1169
1170 ;; Make find-function and find-variable find them
1171 (put ',fn-name 'definition-name ',name)
1172 (put ',hook-name 'definition-name ',name)
1173
1174 ;; Hashtable map of responses to hook variables
1175 ,@(loop for response in (cons name aliases)
1176 for var in (cons hook-name var-alternates)
1177 collect `(puthash ,(format "%s" response) ',var
1178 erc-server-responses))
1179 ;; Alternates.
1180 ;; Functions are defaliased, hook variables are defvared so we
1181 ;; can add hooks to one alias, but not another.
1182 ,@(loop for fn in fn-alternates
1183 for var in var-alternates
1184 for a in aliases
1185 nconc (list `(defalias ',fn ',fn-name)
1186 `(defvar ,var ',fn-name ,(format hook-doc a))
1187 `(put ',var 'definition-name ',hook-name))))))
1188
1189(define-erc-response-handler (ERROR)
1190 "Handle an ERROR command from the server." nil
ff59d266 1191 (setq erc-server-error-occurred t)
597993cf
MB
1192 (erc-display-message
1193 parsed 'error nil 'ERROR
1194 ?s (erc-response.sender parsed) ?c (erc-response.contents parsed)))
1195
1196(define-erc-response-handler (INVITE)
1197 "Handle invitation messages."
1198 nil
1199 (let ((target (first (erc-response.command-args parsed)))
1200 (chnl (erc-response.contents parsed)))
1201 (multiple-value-bind (nick login host)
7db26af0 1202 (values-list (erc-parse-user (erc-response.sender parsed)))
597993cf
MB
1203 (setq erc-invitation chnl)
1204 (when (string= target (erc-current-nick))
1205 (erc-display-message
1206 parsed 'notice 'active
1207 'INVITE ?n nick ?u login ?h host ?c chnl)))))
1208
1209
1210(define-erc-response-handler (JOIN)
1211 "Handle join messages."
1212 nil
1213 (let ((chnl (erc-response.contents parsed))
1214 (buffer nil))
1215 (multiple-value-bind (nick login host)
7db26af0 1216 (values-list (erc-parse-user (erc-response.sender parsed)))
597993cf
MB
1217 ;; strip the stupid combined JOIN facility (IRC 2.9)
1218 (if (string-match "^\\(.*\\)?\^g.*$" chnl)
1219 (setq chnl (match-string 1 chnl)))
1220 (save-excursion
1221 (let* ((str (cond
1222 ;; If I have joined a channel
1223 ((erc-current-nick-p nick)
83dc6995
MB
1224 (setq buffer (erc-open erc-session-server erc-session-port
1225 nick erc-session-user-full-name
1226 nil nil
7de0e003 1227 (list chnl) chnl
83dc6995 1228 erc-server-process))
597993cf
MB
1229 (when buffer
1230 (set-buffer buffer)
1231 (erc-add-default-channel chnl)
1232 (erc-server-send (format "MODE %s" chnl)))
1233 (erc-with-buffer (chnl proc)
1234 (erc-channel-begin-receiving-names))
1235 (erc-update-mode-line)
1236 (run-hooks 'erc-join-hook)
1237 (erc-make-notice
1238 (erc-format-message 'JOIN-you ?c chnl)))
1239 (t
1240 (setq buffer (erc-get-buffer chnl proc))
1241 (erc-make-notice
1242 (erc-format-message
1243 'JOIN ?n nick ?u login ?h host ?c chnl))))))
1244 (when buffer (set-buffer buffer))
1245 (erc-update-channel-member chnl nick nick t nil nil host login)
1246 ;; on join, we want to stay in the new channel buffer
1247 ;;(set-buffer ob)
1248 (erc-display-message parsed nil buffer str))))))
1249
1250(define-erc-response-handler (KICK)
1251 "Handle kick messages received from the server." nil
1252 (let* ((ch (first (erc-response.command-args parsed)))
1253 (tgt (second (erc-response.command-args parsed)))
1254 (reason (erc-trim-string (erc-response.contents parsed)))
1255 (buffer (erc-get-buffer ch proc)))
1256 (multiple-value-bind (nick login host)
7db26af0 1257 (values-list (erc-parse-user (erc-response.sender parsed)))
597993cf
MB
1258 (erc-remove-channel-member buffer tgt)
1259 (cond
1260 ((string= tgt (erc-current-nick))
1261 (erc-display-message
1262 parsed 'notice buffer
1263 'KICK-you ?n nick ?u login ?h host ?c ch ?r reason)
1264 (run-hook-with-args 'erc-kick-hook buffer)
1265 (erc-with-buffer
1266 (buffer)
1267 (erc-remove-channel-users))
1268 (erc-delete-default-channel ch buffer)
1269 (erc-update-mode-line buffer))
1270 ((string= nick (erc-current-nick))
1271 (erc-display-message
1272 parsed 'notice buffer
1273 'KICK-by-you ?k tgt ?c ch ?r reason))
1274 (t (erc-display-message
1275 parsed 'notice buffer
1276 'KICK ?k tgt ?n nick ?u login ?h host ?c ch ?r reason))))))
1277
1278(define-erc-response-handler (MODE)
1279 "Handle server mode changes." nil
1280 (let ((tgt (first (erc-response.command-args parsed)))
1281 (mode (mapconcat 'identity (cdr (erc-response.command-args parsed))
1282 " ")))
1283 (multiple-value-bind (nick login host)
7db26af0 1284 (values-list (erc-parse-user (erc-response.sender parsed)))
597993cf
MB
1285 (erc-log (format "MODE: %s -> %s: %s" nick tgt mode))
1286 ;; dirty hack
1287 (let ((buf (cond ((erc-channel-p tgt)
1288 (erc-get-buffer tgt proc))
1289 ((string= tgt (erc-current-nick)) nil)
1290 ((erc-active-buffer) (erc-active-buffer))
1291 (t (erc-get-buffer tgt)))))
1292 (with-current-buffer (or buf
1293 (current-buffer))
1294 (erc-update-modes tgt mode nick host login))
1295 (if (or (string= login "") (string= host ""))
1296 (erc-display-message parsed 'notice buf
1297 'MODE-nick ?n nick
1298 ?t tgt ?m mode)
1299 (erc-display-message parsed 'notice buf
1300 'MODE ?n nick ?u login
1301 ?h host ?t tgt ?m mode)))
1302 (erc-banlist-update proc parsed))))
1303
1304(define-erc-response-handler (NICK)
1305 "Handle nick change messages." nil
1306 (let ((nn (erc-response.contents parsed))
1307 bufs)
1308 (multiple-value-bind (nick login host)
7db26af0 1309 (values-list (erc-parse-user (erc-response.sender parsed)))
597993cf
MB
1310 (setq bufs (erc-buffer-list-with-nick nick proc))
1311 (erc-log (format "NICK: %s -> %s" nick nn))
1312 ;; if we had a query with this user, make sure future messages will be
1313 ;; sent to the correct nick. also add to bufs, since the user will want
1314 ;; to see the nick change in the query, and if it's a newly begun query,
1315 ;; erc-channel-users won't contain it
1316 (erc-buffer-filter
1317 (lambda ()
1318 (when (equal (erc-default-target) nick)
1319 (setq erc-default-recipients
1320 (cons nn (cdr erc-default-recipients)))
87a95afe 1321 (rename-buffer nn t) ; bug#12002
597993cf
MB
1322 (erc-update-mode-line)
1323 (add-to-list 'bufs (current-buffer)))))
1324 (erc-update-user-nick nick nn host nil nil login)
1325 (cond
1326 ((string= nick (erc-current-nick))
1327 (add-to-list 'bufs (erc-server-buffer))
1328 (erc-set-current-nick nn)
1329 (erc-update-mode-line)
1330 (setq erc-nick-change-attempt-count 0)
1331 (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
1332 (erc-display-message
1333 parsed 'notice bufs
1334 'NICK-you ?n nick ?N nn)
1335 (run-hook-with-args 'erc-nick-changed-functions nn nick))
1336 (t
1337 (erc-handle-user-status-change 'nick (list nick login host) (list nn))
1338 (erc-display-message parsed 'notice bufs 'NICK ?n nick
1339 ?u login ?h host ?N nn))))))
1340
1341(define-erc-response-handler (PART)
1342 "Handle part messages." nil
1343 (let* ((chnl (first (erc-response.command-args parsed)))
1344 (reason (erc-trim-string (erc-response.contents parsed)))
1345 (buffer (erc-get-buffer chnl proc)))
1346 (multiple-value-bind (nick login host)
7db26af0 1347 (values-list (erc-parse-user (erc-response.sender parsed)))
597993cf
MB
1348 (erc-remove-channel-member buffer nick)
1349 (erc-display-message parsed 'notice buffer
1350 'PART ?n nick ?u login
1351 ?h host ?c chnl ?r (or reason ""))
1352 (when (string= nick (erc-current-nick))
1353 (run-hook-with-args 'erc-part-hook buffer)
1354 (erc-with-buffer
1355 (buffer)
1356 (erc-remove-channel-users))
1357 (erc-delete-default-channel chnl buffer)
1358 (erc-update-mode-line buffer)
1359 (when erc-kill-buffer-on-part
1360 (kill-buffer buffer))))))
1361
1362(define-erc-response-handler (PING)
1363 "Handle ping messages." nil
1364 (let ((pinger (first (erc-response.command-args parsed))))
1365 (erc-log (format "PING: %s" pinger))
1366 ;; ping response to the server MUST be forced, or you can lose big
1367 (erc-server-send (format "PONG :%s" pinger) t)
1368 (when erc-verbose-server-ping
1369 (erc-display-message
1370 parsed 'error proc
1371 'PING ?s (erc-time-diff erc-server-last-ping-time (erc-current-time))))
1372 (setq erc-server-last-ping-time (erc-current-time))))
1373
1374(define-erc-response-handler (PONG)
1375 "Handle pong messages." nil
1376 (let ((time (string-to-number (erc-response.contents parsed))))
1377 (when (> time 0)
1378 (setq erc-server-lag (erc-time-diff time (erc-current-time)))
1379 (when erc-verbose-server-ping
1380 (erc-display-message
1381 parsed 'notice proc 'PONG
1382 ?h (first (erc-response.command-args parsed)) ?i erc-server-lag
1383 ?s (if (/= erc-server-lag 1) "s" "")))
1384 (erc-update-mode-line))))
1385
1386(define-erc-response-handler (PRIVMSG NOTICE)
712e2b05 1387 "Handle private messages, including messages in channels." nil
597993cf
MB
1388 (let ((sender-spec (erc-response.sender parsed))
1389 (cmd (erc-response.command parsed))
1390 (tgt (car (erc-response.command-args parsed)))
1391 (msg (erc-response.contents parsed)))
1392 (if (or (erc-ignored-user-p sender-spec)
1393 (erc-ignored-reply-p msg tgt proc))
1394 (when erc-minibuffer-ignored
1395 (message "Ignored %s from %s to %s" cmd sender-spec tgt))
1396 (let* ((sndr (erc-parse-user sender-spec))
1397 (nick (nth 0 sndr))
1398 (login (nth 1 sndr))
1399 (host (nth 2 sndr))
1400 (msgp (string= cmd "PRIVMSG"))
1401 (noticep (string= cmd "NOTICE"))
1402 ;; S.B. downcase *both* tgt and current nick
1403 (privp (erc-current-nick-p tgt))
1404 s buffer
1405 fnick)
1406 (setf (erc-response.contents parsed) msg)
1407 (setq buffer (erc-get-buffer (if privp nick tgt) proc))
1408 (when buffer
1409 (with-current-buffer buffer
1410 ;; update the chat partner info. Add to the list if private
cfa61b85 1411 ;; message. We will accumulate private identities indefinitely
597993cf
MB
1412 ;; at this point.
1413 (erc-update-channel-member (if privp nick tgt) nick nick
1414 privp nil nil host login nil nil t)
1415 (let ((cdata (erc-get-channel-user nick)))
1416 (setq fnick (funcall erc-format-nick-function
1417 (car cdata) (cdr cdata))))))
1418 (cond
1419 ((erc-is-message-ctcp-p msg)
1420 (setq s (if msgp
1421 (erc-process-ctcp-query proc parsed nick login host)
1422 (erc-process-ctcp-reply proc parsed nick login host
1423 (match-string 1 msg)))))
1424 (t
1425 (setcar erc-server-last-peers nick)
1426 (setq s (erc-format-privmessage
1427 (or fnick nick) msg
1428 ;; If buffer is a query buffer,
1429 ;; format the nick as for a channel.
1430 (and (not (and buffer
1431 (erc-query-buffer-p buffer)
1432 erc-format-query-as-channel-p))
1433 privp)
1434 msgp))))
1435 (when s
1436 (if (and noticep privp)
1437 (progn
1438 (run-hook-with-args 'erc-echo-notice-always-hook
1439 s parsed buffer nick)
1440 (run-hook-with-args-until-success
1441 'erc-echo-notice-hook s parsed buffer nick))
1442 (erc-display-message parsed nil buffer s)))
1443 (when (string= cmd "PRIVMSG")
1444 (erc-auto-query proc parsed))))))
1445
cd1181db 1446;; FIXME: need clean way of specifying extra hooks in
597993cf
MB
1447;; define-erc-response-handler.
1448(add-hook 'erc-server-PRIVMSG-functions 'erc-auto-query)
1449
1450(define-erc-response-handler (QUIT)
712e2b05 1451 "Another user has quit IRC." nil
597993cf
MB
1452 (let ((reason (erc-response.contents parsed))
1453 bufs)
1454 (multiple-value-bind (nick login host)
7db26af0 1455 (values-list (erc-parse-user (erc-response.sender parsed)))
597993cf
MB
1456 (setq bufs (erc-buffer-list-with-nick nick proc))
1457 (erc-remove-user nick)
1458 (setq reason (erc-wash-quit-reason reason nick login host))
1459 (erc-display-message parsed 'notice bufs
1460 'QUIT ?n nick ?u login
1461 ?h host ?r reason))))
1462
1463(define-erc-response-handler (TOPIC)
712e2b05 1464 "The channel topic has changed." nil
597993cf
MB
1465 (let* ((ch (first (erc-response.command-args parsed)))
1466 (topic (erc-trim-string (erc-response.contents parsed)))
56551c43
TL
1467 (time (format-time-string erc-server-timestamp-format
1468 (current-time))))
597993cf 1469 (multiple-value-bind (nick login host)
7db26af0 1470 (values-list (erc-parse-user (erc-response.sender parsed)))
597993cf
MB
1471 (erc-update-channel-member ch nick nick nil nil nil host login)
1472 (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time))
1473 (erc-display-message parsed 'notice (erc-get-buffer ch proc)
1474 'TOPIC ?n nick ?u login ?h host
1475 ?c ch ?T topic))))
1476
1477(define-erc-response-handler (WALLOPS)
712e2b05 1478 "Display a WALLOPS message." nil
597993cf
MB
1479 (let ((message (erc-response.contents parsed)))
1480 (multiple-value-bind (nick login host)
7db26af0 1481 (values-list (erc-parse-user (erc-response.sender parsed)))
597993cf
MB
1482 (erc-display-message
1483 parsed 'notice nil
1484 'WALLOPS ?n nick ?m message))))
1485
1486(define-erc-response-handler (001)
1487 "Set `erc-server-current-nick' to reflect server settings and display the welcome message."
1488 nil
1489 (erc-set-current-nick (first (erc-response.command-args parsed)))
1490 (erc-update-mode-line) ; needed here?
1491 (setq erc-nick-change-attempt-count 0)
1492 (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
1493 (erc-display-message
1494 parsed 'notice 'active (erc-response.contents parsed)))
1495
1496(define-erc-response-handler (MOTD 002 003 371 372 374 375)
1497 "Display the server's message of the day." nil
1498 (erc-handle-login)
1499 (erc-display-message
1500 parsed 'notice (if erc-server-connected 'active proc)
1501 (erc-response.contents parsed)))
1502
1503(define-erc-response-handler (376 422)
712e2b05 1504 "End of MOTD/MOTD is missing." nil
597993cf
MB
1505 (erc-server-MOTD proc parsed)
1506 (erc-connection-established proc parsed))
1507
1508(define-erc-response-handler (004)
712e2b05 1509 "Display the server's identification." nil
597993cf 1510 (multiple-value-bind (server-name server-version)
7db26af0 1511 (values-list (cdr (erc-response.command-args parsed)))
597993cf
MB
1512 (setq erc-server-version server-version)
1513 (setq erc-server-announced-name server-name)
1514 (erc-update-mode-line-buffer (process-buffer proc))
1515 (erc-display-message
1516 parsed 'notice proc
1517 's004 ?s server-name ?v server-version
1518 ?U (fourth (erc-response.command-args parsed))
1519 ?C (fifth (erc-response.command-args parsed)))))
1520
1521(define-erc-response-handler (005)
1522 "Set the variable `erc-server-parameters' and display the received message.
1523
1524According to RFC 2812, suggests alternate servers on the network.
1525Many servers, however, use this code to show which parameters they have set,
1526for example, the network identifier, maximum allowed topic length, whether
cfa61b85 1527certain commands are accepted and more. See documentation for
597993cf
MB
1528`erc-server-parameters' for more information on the parameters sent.
1529
1530A server may send more than one 005 message."
1531 nil
1532 (let ((line (mapconcat 'identity
1533 (setf (erc-response.command-args parsed)
1534 (cdr (erc-response.command-args parsed)))
1535 " ")))
1536 (while (erc-response.command-args parsed)
1537 (let ((section (pop (erc-response.command-args parsed))))
1538 ;; fill erc-server-parameters
1539 (when (string-match "^\\([A-Z]+\\)\=\\(.*\\)$\\|^\\([A-Z]+\\)$"
1540 section)
1541 (add-to-list 'erc-server-parameters
1542 `(,(or (match-string 1 section)
1543 (match-string 3 section))
1544 .
1545 ,(match-string 2 section))))))
1546 (erc-display-message parsed 'notice proc line)))
1547
1548(define-erc-response-handler (221)
712e2b05 1549 "Display the current user modes." nil
597993cf
MB
1550 (let* ((nick (first (erc-response.command-args parsed)))
1551 (modes (mapconcat 'identity
1552 (cdr (erc-response.command-args parsed)) " ")))
1553 (erc-set-modes nick modes)
1554 (erc-display-message parsed 'notice 'active 's221 ?n nick ?m modes)))
1555
1556(define-erc-response-handler (252)
1557 "Display the number of IRC operators online." nil
1558 (erc-display-message parsed 'notice 'active 's252
1559 ?i (second (erc-response.command-args parsed))))
1560
1561(define-erc-response-handler (253)
1562 "Display the number of unknown connections." nil
1563 (erc-display-message parsed 'notice 'active 's253
1564 ?i (second (erc-response.command-args parsed))))
1565
1566(define-erc-response-handler (254)
1567 "Display the number of channels formed." nil
1568 (erc-display-message parsed 'notice 'active 's254
1569 ?i (second (erc-response.command-args parsed))))
1570
1571(define-erc-response-handler (250 251 255 256 257 258 259 265 266 377 378)
1572 "Generic display of server messages as notices.
1573
1574See `erc-display-server-message'." nil
1575 (erc-display-server-message proc parsed))
1576
1c36df97
MO
1577(define-erc-response-handler (275)
1578 "Display secure connection message." nil
1579 (multiple-value-bind (nick user message)
7db26af0 1580 (values-list (cdr (erc-response.command-args parsed)))
1c36df97
MO
1581 (erc-display-message
1582 parsed 'notice 'active 's275
1583 ?n nick
1584 ?m (mapconcat 'identity (cddr (erc-response.command-args parsed))
1585 " "))))
1586
ff59d266
MB
1587(define-erc-response-handler (290)
1588 "Handle dancer-ircd CAPAB messages." nil nil)
1589
597993cf
MB
1590(define-erc-response-handler (301)
1591 "AWAY notice." nil
1592 (erc-display-message parsed 'notice 'active 's301
1593 ?n (second (erc-response.command-args parsed))
1594 ?r (erc-response.contents parsed)))
1595
1596(define-erc-response-handler (303)
1597 "ISON reply" nil
1598 (erc-display-message parsed 'notice 'active 's303
1599 ?n (second (erc-response.command-args parsed))))
1600
1601(define-erc-response-handler (305)
1602 "Return from AWAYness." nil
1603 (erc-process-away proc nil)
1604 (erc-display-message parsed 'notice 'active
1605 's305 ?m (erc-response.contents parsed)))
1606
1607(define-erc-response-handler (306)
1608 "Set AWAYness." nil
1609 (erc-process-away proc t)
1610 (erc-display-message parsed 'notice 'active
1611 's306 ?m (erc-response.contents parsed)))
1612
2131c501
MO
1613(define-erc-response-handler (307)
1614 "Display nick-identified message." nil
1615 (multiple-value-bind (nick user message)
7db26af0 1616 (values-list (cdr (erc-response.command-args parsed)))
2131c501
MO
1617 (erc-display-message
1618 parsed 'notice 'active 's307
1619 ?n nick
1620 ?m (mapconcat 'identity (cddr (erc-response.command-args parsed))
1621 " "))))
1622
597993cf
MB
1623(define-erc-response-handler (311 314)
1624 "WHOIS/WHOWAS notices." nil
1625 (let ((fname (erc-response.contents parsed))
1626 (catalog-entry (intern (format "s%s" (erc-response.command parsed)))))
1627 (multiple-value-bind (nick user host)
7db26af0 1628 (values-list (cdr (erc-response.command-args parsed)))
597993cf
MB
1629 (erc-update-user-nick nick nick host nil fname user)
1630 (erc-display-message
1631 parsed 'notice 'active catalog-entry
1632 ?n nick ?f fname ?u user ?h host))))
1633
1634(define-erc-response-handler (312)
712e2b05 1635 "Server name response in WHOIS." nil
597993cf 1636 (multiple-value-bind (nick server-host)
7db26af0 1637 (values-list (cdr (erc-response.command-args parsed)))
597993cf
MB
1638 (erc-display-message
1639 parsed 'notice 'active 's312
1640 ?n nick ?s server-host ?c (erc-response.contents parsed))))
1641
1642(define-erc-response-handler (313)
1643 "IRC Operator response in WHOIS." nil
1644 (erc-display-message
1645 parsed 'notice 'active 's313
1646 ?n (second (erc-response.command-args parsed))))
1647
1648(define-erc-response-handler (315 318 323 369)
1649 ;; 315 - End of WHO
1650 ;; 318 - End of WHOIS list
1651 ;; 323 - End of channel LIST
1652 ;; 369 - End of WHOWAS
712e2b05 1653 "End of WHO/WHOIS/LIST/WHOWAS notices." nil
597993cf
MB
1654 (ignore proc parsed))
1655
1656(define-erc-response-handler (317)
1657 "IDLE notice." nil
1658 (multiple-value-bind (nick seconds-idle on-since time)
7db26af0 1659 (values-list (cdr (erc-response.command-args parsed)))
597993cf 1660 (setq time (when on-since
56551c43 1661 (format-time-string erc-server-timestamp-format
597993cf
MB
1662 (erc-string-to-emacs-time on-since))))
1663 (erc-update-user-nick nick nick nil nil nil
1664 (and time (format "on since %s" time)))
1665 (if time
1666 (erc-display-message
1667 parsed 'notice 'active 's317-on-since
1668 ?n nick ?i (erc-sec-to-time (string-to-number seconds-idle)) ?t time)
1669 (erc-display-message
1670 parsed 'notice 'active 's317
1671 ?n nick ?i (erc-sec-to-time (string-to-number seconds-idle))))))
1672
1673(define-erc-response-handler (319)
712e2b05 1674 "Channel names in WHOIS response." nil
597993cf
MB
1675 (erc-display-message
1676 parsed 'notice 'active 's319
1677 ?n (second (erc-response.command-args parsed))
1678 ?c (erc-response.contents parsed)))
1679
1680(define-erc-response-handler (320)
1681 "Identified user in WHOIS." nil
1682 (erc-display-message
1683 parsed 'notice 'active 's320
1684 ?n (second (erc-response.command-args parsed))))
1685
1686(define-erc-response-handler (321)
1687 "LIST header." nil
5e56b3fb
MO
1688 (setq erc-channel-list nil))
1689
1690(defun erc-server-321-message (proc parsed)
1691 "Display a message for the 321 event."
1692 (erc-display-message parsed 'notice proc 's321)
1693 nil)
1694(add-hook 'erc-server-321-functions 'erc-server-321-message t)
597993cf
MB
1695
1696(define-erc-response-handler (322)
1697 "LIST notice." nil
1698 (let ((topic (erc-response.contents parsed)))
1699 (multiple-value-bind (channel num-users)
7db26af0 1700 (values-list (cdr (erc-response.command-args parsed)))
597993cf 1701 (add-to-list 'erc-channel-list (list channel))
5e56b3fb
MO
1702 (erc-update-channel-topic channel topic))))
1703
1704(defun erc-server-322-message (proc parsed)
1705 "Display a message for the 322 event."
1706 (let ((topic (erc-response.contents parsed)))
1707 (multiple-value-bind (channel num-users)
7db26af0 1708 (values-list (cdr (erc-response.command-args parsed)))
597993cf 1709 (erc-display-message
6904f7fe 1710 parsed 'notice proc 's322
597993cf 1711 ?c channel ?u num-users ?t (or topic "")))))
5e56b3fb 1712(add-hook 'erc-server-322-functions 'erc-server-322-message t)
597993cf
MB
1713
1714(define-erc-response-handler (324)
1715 "Channel or nick modes." nil
1716 (let ((channel (second (erc-response.command-args parsed)))
1717 (modes (mapconcat 'identity (cddr (erc-response.command-args parsed))
1718 " ")))
1719 (erc-set-modes channel modes)
1720 (erc-display-message
1721 parsed 'notice (erc-get-buffer channel proc)
1722 's324 ?c channel ?m modes)))
1723
40ef8242
MO
1724(define-erc-response-handler (328)
1725 "Channel URL (on freenode network)." nil
1726 (let ((channel (second (erc-response.command-args parsed)))
1727 (url (erc-response.contents parsed)))
1728 (erc-display-message parsed 'notice (erc-get-buffer channel proc)
1729 's328 ?c channel ?u url)))
1730
597993cf
MB
1731(define-erc-response-handler (329)
1732 "Channel creation date." nil
1733 (let ((channel (second (erc-response.command-args parsed)))
1734 (time (erc-string-to-emacs-time
1735 (third (erc-response.command-args parsed)))))
1736 (erc-display-message
1737 parsed 'notice (erc-get-buffer channel proc)
56551c43
TL
1738 's329 ?c channel ?t (format-time-string erc-server-timestamp-format
1739 time))))
597993cf
MB
1740
1741(define-erc-response-handler (330)
712e2b05 1742 "Nick is authed as (on Quakenet network)." nil
597993cf
MB
1743 ;; FIXME: I don't know what the magic numbers mean. Mummy, make
1744 ;; the magic numbers go away.
1745 ;; No seriously, I have no clue about the format of this command,
1746 ;; and don't sit on Quakenet, so can't test. Originally we had:
1747 ;; nick == (aref parsed 3)
1748 ;; authaccount == (aref parsed 4)
1749 ;; authmsg == (aref parsed 5)
1750 ;; The guesses below are, well, just that. -- Lawrence 2004/05/10
1751 (let ((nick (second (erc-response.command-args parsed)))
1752 (authaccount (third (erc-response.command-args parsed)))
1753 (authmsg (erc-response.contents parsed)))
1754 (erc-display-message parsed 'notice 'active 's330
1755 ?n nick ?a authmsg ?i authaccount)))
1756
1757(define-erc-response-handler (331)
712e2b05 1758 "No topic set for channel." nil
597993cf
MB
1759 (let ((channel (second (erc-response.command-args parsed)))
1760 (topic (erc-response.contents parsed)))
597993cf
MB
1761 (erc-display-message parsed 'notice (erc-get-buffer channel proc)
1762 's331 ?c channel)))
1763
1764(define-erc-response-handler (332)
1765 "TOPIC notice." nil
1766 (let ((channel (second (erc-response.command-args parsed)))
1767 (topic (erc-response.contents parsed)))
1768 (erc-update-channel-topic channel topic)
1769 (erc-display-message parsed 'notice (erc-get-buffer channel proc)
1770 's332 ?c channel ?T topic)))
1771
1772(define-erc-response-handler (333)
712e2b05 1773 "Who set the topic, and when." nil
597993cf 1774 (multiple-value-bind (channel nick time)
7db26af0 1775 (values-list (cdr (erc-response.command-args parsed)))
56551c43 1776 (setq time (format-time-string erc-server-timestamp-format
597993cf
MB
1777 (erc-string-to-emacs-time time)))
1778 (erc-update-channel-topic channel
1779 (format "\C-o (%s, %s)" nick time)
1780 'append)
1781 (erc-display-message parsed 'notice (erc-get-buffer channel proc)
1782 's333 ?c channel ?n nick ?t time)))
1783
1784(define-erc-response-handler (341)
1785 "Let user know when an INVITE attempt has been sent successfully."
1786 nil
1787 (multiple-value-bind (nick channel)
7db26af0 1788 (values-list (cdr (erc-response.command-args parsed)))
597993cf
MB
1789 (erc-display-message parsed 'notice (erc-get-buffer channel proc)
1790 's341 ?n nick ?c channel)))
1791
1792(define-erc-response-handler (352)
1793 "WHO notice." nil
1794 (multiple-value-bind (channel user host server nick away-flag)
7db26af0 1795 (values-list (cdr (erc-response.command-args parsed)))
597993cf
MB
1796 (let ((full-name (erc-response.contents parsed))
1797 hopcount)
1798 (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name)
1799 (setq hopcount (match-string 1 full-name))
1800 (setq full-name (match-string 2 full-name)))
1801 (erc-update-channel-member channel nick nick nil nil nil host
1802 user full-name)
1803 (erc-display-message parsed 'notice 'active 's352
1804 ?c channel ?n nick ?a away-flag
1805 ?u user ?h host ?f full-name))))
1806
1807(define-erc-response-handler (353)
1808 "NAMES notice." nil
1809 (let ((channel (third (erc-response.command-args parsed)))
1810 (users (erc-response.contents parsed)))
597993cf
MB
1811 (erc-display-message parsed 'notice (or (erc-get-buffer channel proc)
1812 'active)
83dc6995
MB
1813 's353 ?c channel ?u users)
1814 (erc-with-buffer (channel proc)
1815 (erc-channel-receive-names users))))
597993cf
MB
1816
1817(define-erc-response-handler (366)
1818 "End of NAMES." nil
1819 (erc-with-buffer ((second (erc-response.command-args parsed)) proc)
1820 (erc-channel-end-receiving-names)))
1821
1822(define-erc-response-handler (367)
712e2b05 1823 "Channel ban list entries." nil
597993cf 1824 (multiple-value-bind (channel banmask setter time)
7db26af0 1825 (values-list (cdr (erc-response.command-args parsed)))
83dc6995
MB
1826 ;; setter and time are not standard
1827 (if setter
1828 (erc-display-message parsed 'notice 'active 's367-set-by
1829 ?c channel
1830 ?b banmask
1831 ?s setter
1832 ?t (or time ""))
1833 (erc-display-message parsed 'notice 'active 's367
1834 ?c channel
1835 ?b banmask))))
597993cf
MB
1836
1837(define-erc-response-handler (368)
712e2b05 1838 "End of channel ban list." nil
597993cf
MB
1839 (let ((channel (second (erc-response.command-args parsed))))
1840 (erc-display-message parsed 'notice 'active 's368
1841 ?c channel)))
1842
1843(define-erc-response-handler (379)
1844 "Forwarding to another channel." nil
1845 ;; FIXME: Yet more magic numbers in original code, I'm guessing this
1846 ;; command takes two arguments, and doesn't have any "contents". --
1847 ;; Lawrence 2004/05/10
1848 (multiple-value-bind (from to)
7db26af0 1849 (values-list (cdr (erc-response.command-args parsed)))
597993cf
MB
1850 (erc-display-message parsed 'notice 'active
1851 's379 ?c from ?f to)))
1852
1853(define-erc-response-handler (391)
712e2b05 1854 "Server's time string." nil
597993cf
MB
1855 (erc-display-message
1856 parsed 'notice 'active
1857 's391 ?s (second (erc-response.command-args parsed))
1858 ?t (third (erc-response.command-args parsed))))
1859
1860(define-erc-response-handler (401)
1861 "No such nick/channel." nil
1862 (let ((nick/channel (second (erc-response.command-args parsed))))
1863 (when erc-whowas-on-nosuchnick
1864 (erc-log (format "cmd: WHOWAS: %s" nick/channel))
1865 (erc-server-send (format "WHOWAS %s 1" nick/channel)))
1866 (erc-display-message parsed '(notice error) 'active
1867 's401 ?n nick/channel)))
1868
1869(define-erc-response-handler (403)
1870 "No such channel." nil
1871 (erc-display-message parsed '(notice error) 'active
1872 's403 ?c (second (erc-response.command-args parsed))))
1873
1874(define-erc-response-handler (404)
1875 "Cannot send to channel." nil
1876 (erc-display-message parsed '(notice error) 'active
1877 's404 ?c (second (erc-response.command-args parsed))))
1878
1879
1880(define-erc-response-handler (405)
712e2b05 1881 "Can't join that many channels." nil
597993cf
MB
1882 (erc-display-message parsed '(notice error) 'active
1883 's405 ?c (second (erc-response.command-args parsed))))
1884
1885(define-erc-response-handler (406)
712e2b05 1886 "No such nick." nil
597993cf
MB
1887 (erc-display-message parsed '(notice error) 'active
1888 's406 ?n (second (erc-response.command-args parsed))))
1889
1890(define-erc-response-handler (412)
712e2b05 1891 "No text to send." nil
597993cf
MB
1892 (erc-display-message parsed '(notice error) 'active 's412))
1893
1894(define-erc-response-handler (421)
712e2b05 1895 "Unknown command." nil
597993cf
MB
1896 (erc-display-message parsed '(notice error) 'active 's421
1897 ?c (second (erc-response.command-args parsed))))
1898
1899(define-erc-response-handler (432)
712e2b05 1900 "Bad nick." nil
597993cf
MB
1901 (erc-display-message parsed '(notice error) 'active 's432
1902 ?n (second (erc-response.command-args parsed))))
1903
1904(define-erc-response-handler (433)
712e2b05 1905 "Login-time \"nick in use\"." nil
597993cf
MB
1906 (erc-nickname-in-use (second (erc-response.command-args parsed))
1907 "already in use"))
1908
1909(define-erc-response-handler (437)
712e2b05 1910 "Nick temporarily unavailable (on IRCnet)." nil
597993cf
MB
1911 (let ((nick/channel (second (erc-response.command-args parsed))))
1912 (unless (erc-channel-p nick/channel)
1913 (erc-nickname-in-use nick/channel "temporarily unavailable"))))
1914
1915(define-erc-response-handler (442)
712e2b05 1916 "Not on channel." nil
597993cf
MB
1917 (erc-display-message parsed '(notice error) 'active 's442
1918 ?c (second (erc-response.command-args parsed))))
1919
1920(define-erc-response-handler (461)
712e2b05 1921 "Not enough parameters for command." nil
597993cf
MB
1922 (erc-display-message parsed '(notice error) 'active 's461
1923 ?c (second (erc-response.command-args parsed))
1924 ?m (erc-response.contents parsed)))
1925
10dc9f9e
MB
1926(define-erc-response-handler (465)
1927 "You are banned from this server." nil
1928 (setq erc-server-banned t)
1929 ;; show the server's message, as a reason might be provided
1930 (erc-display-error-notice
1931 parsed
1932 (erc-response.contents parsed)))
1933
597993cf 1934(define-erc-response-handler (474)
712e2b05 1935 "Banned from channel errors." nil
597993cf
MB
1936 (erc-display-message parsed '(notice error) nil
1937 (intern (format "s%s"
1938 (erc-response.command parsed)))
1939 ?c (second (erc-response.command-args parsed))))
1940
1941(define-erc-response-handler (475)
1942 "Channel key needed." nil
1943 (erc-display-message parsed '(notice error) nil 's475
1944 ?c (second (erc-response.command-args parsed)))
1945 (when erc-prompt-for-channel-key
1946 (let ((channel (second (erc-response.command-args parsed)))
1947 (key (read-from-minibuffer
1948 (format "Channel %s is mode +k. Enter key (RET to cancel): "
1949 (second (erc-response.command-args parsed))))))
1950 (when (and key (> (length key) 0))
1951 (erc-cmd-JOIN channel key)))))
1952
1953(define-erc-response-handler (477)
712e2b05 1954 "Channel doesn't support modes." nil
597993cf
MB
1955 (let ((channel (second (erc-response.command-args parsed)))
1956 (message (erc-response.contents parsed)))
1957 (erc-display-message parsed 'notice (erc-get-buffer channel proc)
1958 (format "%s: %s" channel message))))
1959
1960(define-erc-response-handler (482)
712e2b05 1961 "You need to be a channel operator to do that." nil
597993cf
MB
1962 (let ((channel (second (erc-response.command-args parsed)))
1963 (message (erc-response.contents parsed)))
1964 (erc-display-message parsed '(error notice) 'active 's482
1965 ?c channel ?m message)))
1966
f927985e
JD
1967(define-erc-response-handler (671)
1968 "Secure connection response in WHOIS." nil
1969 (let ((nick (second (erc-response.command-args parsed)))
1970 (securemsg (erc-response.contents parsed)))
1971 (erc-display-message parsed 'notice 'active 's671
1972 ?n nick ?a securemsg)))
1973
10dc9f9e 1974(define-erc-response-handler (431 445 446 451 462 463 464 481 483 484 485
597993cf
MB
1975 491 501 502)
1976 ;; 431 - No nickname given
1977 ;; 445 - SUMMON has been disabled
1978 ;; 446 - USERS has been disabled
1979 ;; 451 - You have not registered
1980 ;; 462 - Unauthorized command (already registered)
1981 ;; 463 - Your host isn't among the privileged
1982 ;; 464 - Password incorrect
597993cf
MB
1983 ;; 481 - Need IRCop privileges
1984 ;; 483 - You can't kill a server!
1985 ;; 484 - Your connection is restricted!
1986 ;; 485 - You're not the original channel operator
1987 ;; 491 - No O-lines for your host
1988 ;; 501 - Unknown MODE flag
1989 ;; 502 - Cannot change mode for other users
712e2b05
MO
1990 "Generic display of server error messages.
1991
1992See `erc-display-error-notice'." nil
597993cf
MB
1993 (erc-display-error-notice
1994 parsed
1995 (intern (format "s%s" (erc-response.command parsed)))))
1996
1997;; FIXME: These are yet to be implemented, they're just stubs for now
1998;; -- Lawrence 2004/05/12
1999
2000;; response numbers left here for reference
2001
2002;; (define-erc-response-handler (323 364 365 381 382 392 393 394 395
2003;; 200 201 202 203 204 205 206 208 209 211 212 213
2004;; 214 215 216 217 218 219 241 242 243 244 249 261
2005;; 262 302 342 351 402 407 409 411 413 414 415
2006;; 423 424 436 441 443 444 467 471 472 473 KILL)
2007;; nil nil
2008;; (ignore proc parsed))
2009
2010(provide 'erc-backend)
2011
2012;;; erc-backend.el ends here
2013;; Local Variables:
2014;; indent-tabs-mode: nil
2015;; End: