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