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