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