1 ;;; erc-backend.el --- Backend network communication for ERC
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5 ;; Filename: erc-backend.el
6 ;; Author: Lawrence Mitchell <wence@gmx.li>
8 ;; Keywords: IRC chat client internet
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 3, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
29 ;; This file defines backend network communication handlers for ERC.
33 ;; You define a new handler with `define-erc-response-handler'. This
34 ;; defines a function, a corresponding hook variable, and populates a
35 ;; global hash table `erc-server-responses' with a map from response
36 ;; to hook variable. See the function documentation for more
39 ;; Upon receiving a line from the server, `erc-parse-server-response'
42 ;; A line generally looks like:
44 ;; LINE := ':' SENDER ' ' COMMAND ' ' (COMMAND-ARGS ' ')* ':' CONTENTS
45 ;; SENDER := Not ':' | ' '
46 ;; COMMAND := Not ':' | ' '
47 ;; COMMAND-ARGS := Not ':' | ' '
49 ;; This gets parsed and stuffed into an `erc-response' struct. You
50 ;; can access the fields of the struct with:
52 ;; COMMAND --- `erc-response.command'
53 ;; COMMAND-ARGS --- `erc-response.command-args'
54 ;; CONTENTS --- `erc-response.contents'
55 ;; SENDER --- `erc-response.sender'
56 ;; LINE --- `erc-response.unparsed'
59 ;; It's probably not a good idea to destructively modify the list
60 ;; of command-args in your handlers, since other functions down the
61 ;; line may well need to access the arguments too.
63 ;; That is, unless you're /absolutely/ sure that your handler doesn't
64 ;; invoke some other function that needs to use COMMAND-ARGS, don't do
67 ;; (while (erc-response.command-args parsed)
68 ;; (let ((a (pop (erc-response.command-args parsed))))
71 ;; The parsed response is handed over to
72 ;; `erc-handle-parsed-server-response', which checks whether it should
73 ;; carry out duplicate suppression, and then runs `erc-call-hooks'.
74 ;; `erc-call-hooks' retrieves the relevant hook variable from
75 ;; `erc-server-responses' and runs it.
77 ;; Most handlers then destructure the parsed response in some way
78 ;; (depending on what the handler is, the arguments have different
79 ;; meanings), and generally display something, usually using
80 ;; `erc-display-message'.
84 ;; o Generalise the display-line code so that we can use it to
85 ;; display the stuff we send, as well as the stuff we receive.
86 ;; Then, move all display-related code into another backend-like
87 ;; file, erc-display.el, say.
89 ;; o Clean up the handlers using new display code (has to be written
94 ;; 2004/05/10 -- Handler bodies taken out of erc.el and ported to new
97 ;; 2005-08-13 -- Moved sending commands from erc.el.
101 (require 'erc-compat
)
102 (eval-when-compile (require 'cl
))
103 (autoload 'erc-with-buffer
"erc" nil nil
'macro
)
104 (autoload 'erc-log
"erc" nil nil
'macro
)
106 ;;;; Variables and options
108 (defvar erc-server-responses
(make-hash-table :test
#'equal
)
109 "Hashtable mapping server responses to their handler hooks.")
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
))
120 (defvar erc-server-current-nick nil
121 "Nickname on the current server.
122 Use `erc-current-nick' to access this.")
123 (make-variable-buffer-local 'erc-server-current-nick
)
125 ;;; Server attributes
127 (defvar erc-server-process nil
128 "The process object of the corresponding server connection.")
129 (make-variable-buffer-local 'erc-server-process
)
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
)
135 (defvar erc-session-port nil
136 "The port used to connect to.")
137 (make-variable-buffer-local 'erc-session-port
)
139 (defvar erc-server-announced-name nil
140 "The name the server announced to use.")
141 (make-variable-buffer-local 'erc-server-announced-name
)
143 (defvar erc-server-version nil
144 "The name and version of the server's ircd.")
145 (make-variable-buffer-local 'erc-server-version
)
147 (defvar erc-server-parameters nil
148 "Alist listing the supported server parameters.
150 This is only set if the server sends 005 messages saying what is
151 supported on the server.
153 Entries are of the form:
156 (PARAMETER) if no value is provided.
158 Some examples of possible parameters sent by servers:
159 CHANMODES=b,k,l,imnpst - list of supported channel modes
160 CHANNELLEN=50 - maximum length of channel names
161 CHANTYPES=#&!+ - supported channel prefixes
162 CHARMAPPING=rfc1459 - character mapping used for nickname and channels
163 KICKLEN=160 - maximum allowed kick message length
164 MAXBANS=30 - maximum number of bans per channel
165 MAXCHANNELS=10 - maximum number of channels allowed to join
166 NETWORK=EFnet - the network identifier
167 NICKLEN=9 - maximum allowed length of nicknames
168 PREFIX=(ov)@+ - list of channel modes and the user prefixes if user has mode
169 RFC2812 - server supports RFC 2812 features
170 SILENCE=10 - supports the SILENCE command, maximum allowed number of entries
171 TOPICLEN=160 - maximum allowed topic length
172 WALLCHOPS - supports sending messages to all operators in a channel")
173 (make-variable-buffer-local 'erc-server-parameters
)
175 ;;; Server and connection state
177 (defvar erc-server-ping-timer-alist nil
178 "Mapping of server buffers to their specific ping timer.")
180 (defvar erc-server-connected nil
181 "Non-nil if the current buffer has been used by ERC to establish
184 If you wish to determine whether an IRC connection is currently
185 active, use the `erc-server-process-alive' function instead.")
186 (make-variable-buffer-local 'erc-server-connected
)
188 (defvar erc-server-reconnect-count
0
189 "Number of times we have failed to reconnect to the current server.")
190 (make-variable-buffer-local 'erc-server-reconnect-count
)
192 (defvar erc-server-quitting nil
193 "Non-nil if the user requests a quit.")
194 (make-variable-buffer-local 'erc-server-quitting
)
196 (defvar erc-server-reconnecting nil
197 "Non-nil if the user requests an explicit reconnect, and the
198 current IRC process is still alive.")
199 (make-variable-buffer-local 'erc-server-reconnecting
)
201 (defvar erc-server-timed-out nil
202 "Non-nil if the IRC server failed to respond to a ping.")
203 (make-variable-buffer-local 'erc-server-timed-out
)
205 (defvar erc-server-banned nil
206 "Non-nil if the user is denied access because of a server ban.")
207 (make-variable-buffer-local 'erc-server-banned
)
209 (defvar erc-server-error-occurred nil
210 "Non-nil if the user triggers some server error.")
211 (make-variable-buffer-local 'erc-server-error-occurred
)
213 (defvar erc-server-lines-sent nil
215 (make-variable-buffer-local 'erc-server-lines-sent
)
217 (defvar erc-server-last-peers
'(nil . nil
)
218 "Last peers used, both sender and receiver.
219 Those are used for /MSG destination shortcuts.")
220 (make-variable-buffer-local 'erc-server-last-peers
)
222 (defvar erc-server-last-sent-time nil
223 "Time the message was sent.
224 This is useful for flood protection.")
225 (make-variable-buffer-local 'erc-server-last-sent-time
)
227 (defvar erc-server-last-ping-time nil
228 "Time the last ping was sent.
229 This is useful for flood protection.")
230 (make-variable-buffer-local 'erc-server-last-ping-time
)
232 (defvar erc-server-last-received-time nil
233 "Time the last message was received from the server.
234 This is useful for detecting hung connections.")
235 (make-variable-buffer-local 'erc-server-last-received-time
)
237 (defvar erc-server-lag nil
238 "Calculated server lag time in seconds.
239 This variable is only set in a server buffer.")
240 (make-variable-buffer-local 'erc-server-lag
)
242 (defvar erc-server-filter-data nil
243 "The data that arrived from the server
244 but has not been processed yet.")
245 (make-variable-buffer-local 'erc-server-filter-data
)
247 (defvar erc-server-duplicates
(make-hash-table :test
'equal
)
248 "Internal variable used to track duplicate messages.")
249 (make-variable-buffer-local 'erc-server-duplicates
)
252 (defvar erc-server-processing-p nil
253 "Non-nil when we're currently processing a message.
255 When ERC receives a private message, it sets up a new buffer for
256 this query. These in turn, though, do start flyspell. This
257 involves starting an external process, in which case Emacs will
258 wait - and when it waits, it does accept other stuff from, say,
259 network exceptions. So, if someone sends you two messages
260 quickly after each other, ispell is started for the first, but
261 might take long enough for the second message to be processed
263 (make-variable-buffer-local 'erc-server-processing-p
)
265 (defvar erc-server-flood-last-message
0
266 "When we sent the last message.
267 See `erc-server-flood-margin' for an explanation of the flood
268 protection algorithm.")
269 (make-variable-buffer-local 'erc-server-flood-last-message
)
271 (defvar erc-server-flood-queue nil
272 "The queue of messages waiting to be sent to the server.
273 See `erc-server-flood-margin' for an explanation of the flood
274 protection algorithm.")
275 (make-variable-buffer-local 'erc-server-flood-queue
)
277 (defvar erc-server-flood-timer nil
278 "The timer to resume sending.")
279 (make-variable-buffer-local 'erc-server-flood-timer
)
281 ;;; IRC protocol and misc options
283 (defgroup erc-server nil
284 "Parameters for dealing with IRC servers."
287 (defcustom erc-server-auto-reconnect t
288 "Non-nil means that ERC will attempt to reestablish broken connections.
290 Reconnection will happen automatically for any unexpected disconnection."
294 (defcustom erc-server-reconnect-attempts
2
295 "The number of times that ERC will attempt to reestablish a
296 broken connection, or t to always attempt to reconnect.
298 This only has an effect if `erc-server-auto-reconnect' is non-nil."
300 :type
'(choice (const :tag
"Always reconnect" t
)
303 (defcustom erc-server-reconnect-timeout
1
304 "The amount of time, in seconds, that ERC will wait between
305 successive reconnect attempts.
307 If a key is pressed while ERC is waiting, it will stop waiting."
311 (defcustom erc-split-line-length
440
312 "*The maximum length of a single message.
313 If a message exceeds this size, it is broken into multiple ones.
315 IRC allows for lines up to 512 bytes. Two of them are CR LF.
316 And a typical message looks like this:
318 :nicky!uhuser@host212223.dialin.fnordisp.net PRIVMSG #lazybastards :Hello!
320 You can limit here the maximum length of the \"Hello!\" part.
325 (defcustom erc-server-coding-system
(if (and (fboundp 'coding-system-p
)
326 (coding-system-p 'undecided
)
327 (coding-system-p 'utf-8
))
330 "The default coding system for incoming and outgoing text.
331 This is either a coding system, a cons, a function, or nil.
333 If a cons, the encoding system for outgoing text is in the car
334 and the decoding system for incoming text is in the cdr. The most
335 interesting use for this is to put `undecided' in the cdr. If a
336 function, it is called with no arguments and should return a
337 coding system or a cons as described above. Note that you can use
338 the dynamically bound variable `target' to get the current
339 target. See `erc-coding-system-for-target'.
341 If you need to send non-ASCII text to people not using a client that
342 does decoding on its own, you must tell ERC what encoding to use.
343 Emacs cannot guess it, since it does not know what the people on the
344 other end of the line are using."
346 :type
'(choice (const :tag
"None" nil
)
348 (cons (coding-system :tag
"encoding" :value utf-8
)
349 (coding-system :tag
"decoding" :value undecided
))
352 (defcustom erc-encoding-coding-alist nil
353 "Alist of target regexp and coding-system pairs to use.
354 This overrides `erc-server-coding-system' depending on the
355 current target as returned by `erc-default-target'.
357 Example: If you know that the channel #linux-ru uses the coding-system
358 `cyrillic-koi8', then add '(\"#linux-ru\" . cyrillic-koi8) to the
361 :type
'(repeat (cons (string :tag
"Target")
364 (defcustom erc-server-connect-function
'open-network-stream
365 "Function used to initiate a connection.
366 It should take same arguments as `open-network-stream' does."
370 (defcustom erc-server-prevent-duplicates
'("301")
371 "*Either nil or a list of strings.
372 Each string is a IRC message type, like PRIVMSG or NOTICE.
373 All Message types in that list of subjected to duplicate prevention."
374 :type
'(choice (const nil
) (list string
))
377 (defcustom erc-server-duplicate-timeout
60
378 "*The time allowed in seconds between duplicate messages.
380 If two identical messages arrive within this value of one another, the second
387 ;; Most of this is courtesy of Jorgen Schaefer and Circe
388 ;; (http://www.nongnu.org/circe)
390 (defcustom erc-server-flood-margin
10
391 "*A margin on how much excess data we send.
392 The flood protection algorithm of ERC works like the one
393 detailed in RFC 2813, section 5.8 \"Flood control of clients\".
395 * If `erc-server-flood-last-message' is less than the current
397 * While `erc-server-flood-last-message' is less than
398 `erc-server-flood-margin' seconds ahead of the current
399 time, send a message, and increase
400 `erc-server-flood-last-message' by
401 `erc-server-flood-penalty' for each message."
405 (defcustom erc-server-flood-penalty
3
406 "How much we penalize a message.
407 See `erc-server-flood-margin' for an explanation of the flood
408 protection algorithm."
414 (defcustom erc-server-send-ping-interval
30
415 "*Interval of sending pings to the server, in seconds.
416 If this is set to nil, pinging the server is disabled."
418 :type
'(choice (const :tag
"Disabled" nil
)
419 (integer :tag
"Seconds")))
421 (defcustom erc-server-send-ping-timeout
120
422 "*If the time between ping and response is greater than this, reconnect.
423 The time is in seconds.
425 This must be greater than or equal to the value for
426 `erc-server-send-ping-interval'.
428 If this is set to nil, never try to reconnect."
430 :type
'(choice (const :tag
"Disabled" nil
)
431 (integer :tag
"Seconds")))
433 (defvar erc-server-ping-handler nil
434 "This variable holds the periodic ping timer.")
435 (make-variable-buffer-local 'erc-server-ping-handler
)
437 ;;;; Helper functions
440 (defun erc-split-line (longline)
441 "Return a list of lines which are not too long for IRC.
442 The length is specified in `erc-split-line-length'.
444 Currently this is called by `erc-send-input'."
445 (if (< (length longline
)
446 erc-split-line-length
)
450 (let ((fill-column erc-split-line-length
))
451 (fill-region (point-min) (point-max)
453 (split-string (buffer-string) "\n"))))
455 ;; Used by CTCP functions
456 (defun erc-upcase-first-word (str)
457 "Upcase the first word in STR."
460 (goto-char (point-min))
464 (defun erc-server-send-ping (buf)
465 "Send a ping to the IRC server buffer in BUF.
466 Additionally, detect whether the IRC process has hung."
467 (if (buffer-live-p buf
)
468 (with-current-buffer buf
469 (if (and erc-server-send-ping-timeout
471 (erc-time-diff (erc-current-time)
472 erc-server-last-received-time
)
473 erc-server-send-ping-timeout
))
475 ;; if the process is hung, kill it
476 (setq erc-server-timed-out t
)
477 (delete-process erc-server-process
))
478 (erc-server-send (format "PING %.0f" (erc-current-time)))))
479 ;; remove timer if the server buffer has been killed
480 (let ((timer (assq buf erc-server-ping-timer-alist
)))
482 (erc-cancel-timer (cdr timer
))
483 (setcdr timer nil
)))))
485 (defun erc-server-setup-periodical-ping (buffer)
486 "Set up a timer to periodically ping the current server.
487 The current buffer is given by BUFFER."
488 (with-current-buffer buffer
489 (and erc-server-ping-handler
(erc-cancel-timer erc-server-ping-handler
))
490 (when erc-server-send-ping-interval
491 (setq erc-server-ping-handler
(run-with-timer
492 4 erc-server-send-ping-interval
493 #'erc-server-send-ping
495 (setq erc-server-ping-timer-alist
(cons (cons buffer
496 erc-server-ping-handler
)
497 erc-server-ping-timer-alist
)))))
499 (defun erc-server-process-alive ()
500 "Return non-nil when `erc-server-process' is open or running."
501 (and erc-server-process
502 (processp erc-server-process
)
503 (memq (process-status erc-server-process
) '(run open
))))
505 ;;;; Connecting to a server
507 (defun erc-server-connect (server port buffer
)
508 "Perform the connection and login using the specified SERVER and PORT.
509 We will store server variables in the buffer given by BUFFER."
510 (let ((msg (erc-format-message 'connect ?S server ?p port
)))
512 (let ((process (funcall erc-server-connect-function
513 (format "erc-%s-%s" server port
)
515 (message "%s...done" msg
)
516 ;; Misc server variables
517 (with-current-buffer buffer
518 (setq erc-server-process process
)
519 (setq erc-server-quitting nil
)
520 (setq erc-server-reconnecting nil
)
521 (setq erc-server-timed-out nil
)
522 (setq erc-server-banned nil
)
523 (setq erc-server-error-occurred nil
)
524 (let ((time (erc-current-time)))
525 (setq erc-server-last-sent-time time
)
526 (setq erc-server-last-ping-time time
)
527 (setq erc-server-last-received-time time
))
528 (setq erc-server-lines-sent
0)
529 ;; last peers (sender and receiver)
530 (setq erc-server-last-peers
'(nil . nil
)))
531 ;; we do our own encoding and decoding
532 (when (fboundp 'set-process-coding-system
)
533 (set-process-coding-system process
'raw-text
))
535 (set-process-sentinel process
'erc-process-sentinel
)
536 (set-process-filter process
'erc-server-filter-function
)
537 (set-process-buffer process buffer
)))
538 (erc-log "\n\n\n********************************************\n")
539 (message (erc-format-message
541 (with-current-buffer buffer
(erc-current-nick))))
542 ;; wait with script loading until we receive a confirmation (first
544 (if (eq erc-server-connect-function
'open-network-stream-nowait
)
545 ;; it's a bit unclear otherwise that it's attempting to establish a
547 (erc-display-message nil nil buffer
"Opening connection..\n")
550 (defun erc-server-reconnect ()
551 "Reestablish the current IRC connection.
552 Make sure you are in an ERC buffer when running this."
553 (let ((server (erc-server-buffer)))
555 (buffer-live-p server
))
556 (error "Couldn't switch to server buffer"))
557 (with-current-buffer server
558 (erc-update-mode-line)
559 (erc-set-active-buffer (current-buffer))
560 (setq erc-server-last-sent-time
0)
561 (setq erc-server-lines-sent
0)
562 (erc-open erc-session-server erc-session-port erc-server-current-nick
563 erc-session-user-full-name t erc-session-password
))))
565 (defun erc-server-filter-function (process string
)
566 "The process filter for the ERC server."
567 (with-current-buffer (process-buffer process
)
568 (setq erc-server-last-received-time
(erc-current-time))
569 ;; If you think this is written in a weird way - please refer to the
570 ;; docstring of `erc-server-processing-p'
571 (if erc-server-processing-p
572 (setq erc-server-filter-data
573 (if erc-server-filter-data
574 (concat erc-server-filter-data string
)
576 ;; This will be true even if another process is spawned!
577 (let ((erc-server-processing-p t
))
578 (setq erc-server-filter-data
(if erc-server-filter-data
579 (concat erc-server-filter-data
582 (while (and erc-server-filter-data
583 (string-match "[\n\r]+" erc-server-filter-data
))
584 (let ((line (substring erc-server-filter-data
585 0 (match-beginning 0))))
586 (setq erc-server-filter-data
588 (length erc-server-filter-data
))
590 (substring erc-server-filter-data
592 (erc-parse-server-response process line
)))))))
594 (defsubst erc-server-reconnect-p
(event)
595 "Return non-nil if ERC should attempt to reconnect automatically.
596 EVENT is the message received from the closed connection process."
597 (or erc-server-reconnecting
598 (and erc-server-auto-reconnect
599 (not erc-server-banned
)
600 (not erc-server-error-occurred
)
601 ;; make sure we don't infinitely try to reconnect, unless the
603 (or (eq erc-server-reconnect-attempts t
)
604 (and (integerp erc-server-reconnect-attempts
)
605 (< erc-server-reconnect-count
606 erc-server-reconnect-attempts
)))
607 (or erc-server-timed-out
608 (not (string-match "^deleted" event
)))
609 ;; open-network-stream-nowait error for connection refused
610 (not (string-match "^failed with code 111" event
)))))
612 (defun erc-process-sentinel-1 (event)
613 "Called when `erc-process-sentinel' has decided that we're disconnecting.
614 Determine whether user has quit or whether erc has been terminated.
615 Conditionally try to reconnect and take appropriate action."
616 (if erc-server-quitting
619 (erc-display-message nil
'error
(current-buffer) 'finished
)
620 (when erc-kill-server-buffer-on-quit
621 (set-buffer-modified-p nil
)
622 (kill-buffer (current-buffer))))
623 ;; unexpected disconnect
627 (erc-display-message nil
'error
(current-buffer)
628 (if (erc-server-reconnect-p event
)
630 'disconnected-noreconnect
))
631 (if (erc-server-reconnect-p event
)
634 (setq erc-server-reconnecting nil
)
635 (erc-server-reconnect)
636 (setq erc-server-reconnect-count
0))
637 (error (when (integerp erc-server-reconnect-attempts
)
638 (setq erc-server-reconnect-count
639 (1+ erc-server-reconnect-count
))
640 (sit-for erc-server-reconnect-timeout
)
642 ;; terminate, do not reconnect
643 (erc-display-message nil
'error
(current-buffer)
644 'terminated ?e event
))))))
646 (defun erc-process-sentinel (cproc event
)
647 "Sentinel function for ERC process."
648 (with-current-buffer (process-buffer cproc
)
650 "SENTINEL: proc: %S status: %S event: %S (quitting: %S)"
651 cproc
(process-status cproc
) event erc-server-quitting
))
652 (if (string-match "^open" event
)
653 ;; newly opened connection (no wait)
655 ;; assume event is 'failed
656 (let ((buf (process-buffer cproc
)))
657 (erc-with-all-buffers-of-server cproc nil
658 (setq erc-server-connected nil
))
659 (when erc-server-ping-handler
660 (progn (erc-cancel-timer erc-server-ping-handler
)
661 (setq erc-server-ping-handler nil
)))
662 (run-hook-with-args 'erc-disconnected-hook
663 (erc-current-nick) (system-name) "")
665 (goto-char (or (marker-position erc-input-marker
) (point-max)))
667 (erc-remove-text-properties-region (point) (point-max))
668 (delete-region (point) (point-max))
669 ;; Decide what to do with the buffer
670 ;; Restart if disconnected
671 (erc-process-sentinel-1 event
)
672 ;; Make sure we don't write to the buffer if it has been
674 (when (buffer-live-p buf
)
675 (erc-update-mode-line)
676 (set-buffer-modified-p nil
))))))
678 ;;;; Sending messages
680 (defun erc-coding-system-for-target (target)
681 "Return the coding system or cons cell appropriate for TARGET.
682 This is determined via `erc-encoding-coding-alist' or
683 `erc-server-coding-system'."
684 (unless target
(setq target
(erc-default-target)))
686 (let ((case-fold-search t
))
688 (dolist (pat erc-encoding-coding-alist
)
689 (when (string-match (car pat
) target
)
690 (throw 'match
(cdr pat
)))))))
691 (and (functionp erc-server-coding-system
)
692 (funcall erc-server-coding-system
))
693 erc-server-coding-system
))
695 (defun erc-decode-string-from-target (str target
)
696 "Decode STR as appropriate for TARGET.
697 This is indicated by `erc-encoding-coding-alist', defaulting to the value of
698 `erc-server-coding-system'."
699 (unless (stringp str
)
701 (let ((coding (erc-coding-system-for-target target
)))
703 (setq coding
(cdr coding
)))
704 (erc-decode-coding-string str coding
)))
706 ;; proposed name, not used by anything yet
707 (defun erc-send-line (text display-fn
)
708 "Send TEXT to the current server. Wrapping and flood control apply.
709 Use DISPLAY-FN to show the results."
711 (erc-server-send line
)
712 (funcall display-fn
))
713 (erc-split-line text
)))
715 ;; From Circe, with modifications
716 (defun erc-server-send (string &optional forcep target
)
717 "Send STRING to the current server.
718 If FORCEP is non-nil, no flood protection is done - the string is
719 sent directly. This might cause the messages to arrive in a wrong
722 If TARGET is specified, look up encoding information for that
723 channel in `erc-encoding-coding-alist' or
724 `erc-server-coding-system'.
726 See `erc-server-flood-margin' for an explanation of the flood
727 protection algorithm."
728 (erc-log (concat "erc-server-send: " string
"(" (buffer-name) ")"))
729 (setq erc-server-last-sent-time
(erc-current-time))
730 (let ((encoding (erc-coding-system-for-target target
)))
731 (when (consp encoding
)
732 (setq encoding
(car encoding
)))
733 (if (erc-server-process-alive)
734 (erc-with-server-buffer
735 (let ((str (concat string
"\r\n")))
738 (setq erc-server-flood-last-message
739 (+ erc-server-flood-penalty
740 erc-server-flood-last-message
))
741 (erc-log-irc-protocol str
'outbound
)
744 ;; Set encoding just before sending the string
745 (when (fboundp 'set-process-coding-system
)
746 (set-process-coding-system erc-server-process
748 (process-send-string erc-server-process str
))
749 ;; See `erc-server-send-queue' for full
750 ;; explanation of why we need this condition-case
752 (setq erc-server-flood-queue
753 (append erc-server-flood-queue
754 (list (cons str encoding
))))
755 (erc-server-send-queue (current-buffer))))
757 (message "ERC: No process running")
761 (defun erc-server-send-queue (buffer)
762 "Send messages in `erc-server-flood-queue'.
763 See `erc-server-flood-margin' for an explanation of the flood
764 protection algorithm."
765 (with-current-buffer buffer
766 (let ((now (erc-current-time)))
767 (when erc-server-flood-timer
768 (erc-cancel-timer erc-server-flood-timer
)
769 (setq erc-server-flood-timer nil
))
770 (when (< erc-server-flood-last-message
772 (setq erc-server-flood-last-message now
))
773 (while (and erc-server-flood-queue
774 (< erc-server-flood-last-message
775 (+ now erc-server-flood-margin
)))
776 (let ((msg (caar erc-server-flood-queue
))
777 (encoding (cdar erc-server-flood-queue
)))
778 (setq erc-server-flood-queue
(cdr erc-server-flood-queue
)
779 erc-server-flood-last-message
780 (+ erc-server-flood-last-message
781 erc-server-flood-penalty
))
782 (erc-log-irc-protocol msg
'outbound
)
783 (erc-log (concat "erc-server-send-queue: "
784 msg
"(" (buffer-name buffer
) ")"))
785 (when (erc-server-process-alive)
787 ;; Set encoding just before sending the string
789 (when (fboundp 'set-process-coding-system
)
790 (set-process-coding-system erc-server-process
792 (process-send-string erc-server-process msg
))
793 ;; Sometimes the send can occur while the process is
794 ;; being killed, which results in a weird SIGPIPE error.
795 ;; Catch this and ignore it.
797 (when erc-server-flood-queue
798 (setq erc-server-flood-timer
799 (run-at-time (+ 0.2 erc-server-flood-penalty
)
800 nil
#'erc-server-send-queue buffer
))))))
802 (defun erc-message (message-command line
&optional force
)
803 "Send LINE to the server as a privmsg or a notice.
804 MESSAGE-COMMAND should be either \"PRIVMSG\" or \"NOTICE\".
805 If the target is \",\", the last person you've got a message from will
806 be used. If the target is \".\", the last person you've sent a message
809 ((string-match "^\\s-*\\(\\S-+\\) ?\\(.*\\)" line
)
810 (let ((tgt (match-string 1 line
))
811 (s (match-string 2 line
)))
812 (erc-log (format "cmd: MSG(%s): [%s] %s" message-command tgt s
))
815 (if (car erc-server-last-peers
)
816 (setq tgt
(car erc-server-last-peers
))
819 (if (cdr erc-server-last-peers
)
820 (setq tgt
(cdr erc-server-last-peers
))
824 (setcdr erc-server-last-peers tgt
)
825 (erc-server-send (format "%s %s :%s" message-command tgt s
)
828 (erc-display-message nil
'error
(current-buffer) 'no-target
))))
834 (defun erc-send-ctcp-message (tgt l
&optional force
)
835 "Send CTCP message L to TGT.
837 If TGT is nil the message is not sent.
838 The command must contain neither a prefix nor a trailing `\\n'.
840 See also `erc-server-send'."
841 (let ((l (erc-upcase-first-word l
)))
844 (erc-log (format "erc-send-CTCP-message: [%s] %s" tgt l
))
845 (erc-server-send (format "PRIVMSG %s :\C-a%s\C-a" tgt l
)
848 (defun erc-send-ctcp-notice (tgt l
&optional force
)
849 "Send CTCP notice L to TGT.
851 If TGT is nil the message is not sent.
852 The command must contain neither a prefix nor a trailing `\\n'.
854 See also `erc-server-send'."
855 (let ((l (erc-upcase-first-word l
)))
858 (erc-log (format "erc-send-CTCP-notice: [%s] %s" tgt l
))
859 (erc-server-send (format "NOTICE %s :\C-a%s\C-a" tgt l
)
862 ;;;; Handling responses
864 (defun erc-parse-server-response (proc string
)
865 "Parse and act upon a complete line from an IRC server.
866 PROC is the process (connection) from which STRING was received.
867 PROCs `process-buffer' is `current-buffer' when this function is called."
868 (unless (string= string
"") ;; Ignore empty strings
870 (let ((posn (if (eq (aref string
0) ?
:)
871 (string-match " " string
)
873 (msg (make-erc-response :unparsed string
)))
875 (setf (erc-response.sender msg
)
878 (substring string
1 posn
)))
880 (setf (erc-response.command msg
)
881 (let* ((bposn (string-match "[^ \n]" string posn
))
882 (eposn (string-match " " string bposn
)))
883 (setq posn
(and eposn
884 (string-match "[^ \n]" string eposn
)))
885 (substring string bposn eposn
)))
888 (not (eq (aref string posn
) ?
:)))
889 (push (let* ((bposn posn
)
890 (eposn (string-match " " string bposn
)))
891 (setq posn
(and eposn
892 (string-match "[^ \n]" string eposn
)))
893 (substring string bposn eposn
))
894 (erc-response.command-args msg
)))
896 (let ((str (substring string
(1+ posn
))))
897 (push str
(erc-response.command-args msg
))))
899 (setf (erc-response.contents msg
)
900 (first (erc-response.command-args msg
)))
902 (setf (erc-response.command-args msg
)
903 (nreverse (erc-response.command-args msg
)))
905 (erc-decode-parsed-server-response msg
)
907 (erc-handle-parsed-server-response proc msg
)))))
909 (defun erc-decode-parsed-server-response (parsed-response)
910 "Decode a pre-parsed PARSED-RESPONSE before it can be handled.
912 If there is a channel name in `erc-response.command-args', decode
913 `erc-response' according to this channel name and
914 `erc-encoding-coding-alist', or use `erc-server-coding-system'
916 (let ((args (erc-response.command-args parsed-response
))
919 (dolist (arg args nil
)
920 (when (string-match "^[#&].*" arg
)
921 (setq decode-target arg
)))
922 (when (stringp decode-target
)
923 (setq decode-target
(erc-decode-string-from-target decode-target nil
)))
924 (setf (erc-response.unparsed parsed-response
)
925 (erc-decode-string-from-target
926 (erc-response.unparsed parsed-response
)
928 (setf (erc-response.sender parsed-response
)
929 (erc-decode-string-from-target
930 (erc-response.sender parsed-response
)
932 (setf (erc-response.command parsed-response
)
933 (erc-decode-string-from-target
934 (erc-response.command parsed-response
)
936 (dolist (arg (nreverse args
) nil
)
937 (push (erc-decode-string-from-target arg decode-target
)
939 (setf (erc-response.command-args parsed-response
) decoded-args
)
940 (setf (erc-response.contents parsed-response
)
941 (erc-decode-string-from-target
942 (erc-response.contents parsed-response
)
945 (defun erc-handle-parsed-server-response (process parsed-response
)
946 "Handle a pre-parsed PARSED-RESPONSE from PROCESS.
948 Hands off to helper functions via `erc-call-hooks'."
949 (if (member (erc-response.command parsed-response
)
950 erc-server-prevent-duplicates
)
951 (let ((m (erc-response.unparsed parsed-response
)))
952 ;; duplicate supression
953 (if (< (or (gethash m erc-server-duplicates
) 0)
954 (- (erc-current-time) erc-server-duplicate-timeout
))
955 (erc-call-hooks process parsed-response
))
956 (puthash m
(erc-current-time) erc-server-duplicates
))
957 ;; Hand off to the relevant handler.
958 (erc-call-hooks process parsed-response
)))
960 (defun erc-get-hook (command)
961 "Return the hook variable associated with COMMAND.
963 See also `erc-server-responses'."
964 (gethash (format (if (numberp command
) "%03i" "%s") command
)
965 erc-server-responses
))
967 (defun erc-call-hooks (process message
)
968 "Call hooks associated with MESSAGE in PROCESS.
970 Finds hooks by looking in the `erc-server-responses' hashtable."
971 (let ((hook (or (erc-get-hook (erc-response.command message
))
972 'erc-default-server-functions
)))
973 (run-hook-with-args-until-success hook process message
)
974 (erc-with-server-buffer
975 (run-hook-with-args 'erc-timer-hook
(erc-current-time)))))
977 (add-hook 'erc-default-server-functions
'erc-handle-unknown-server-response
)
979 (defun erc-handle-unknown-server-response (proc parsed
)
980 "Display unknown server response's message."
981 (let ((line (concat (erc-response.sender parsed
)
983 (erc-response.command parsed
)
985 (mapconcat 'identity
(erc-response.command-args parsed
)
987 (erc-display-message parsed
'notice proc line
)))
990 (put 'define-erc-response-handler
'edebug-form-spec
991 '(&define
:name erc-response-handler
993 &optional sexp sexp def-body
))
995 (defmacro* define-erc-response-handler
((name &rest aliases
)
996 &optional extra-fn-doc extra-var-doc
998 "Define an ERC handler hook/function pair.
999 NAME is the response name as sent by the server (see the IRC RFC for
1003 - a hook variable `erc-server-NAME-functions' initialized to `erc-server-NAME'.
1004 - a function `erc-server-NAME' with body FN-BODY.
1006 If ALIASES is non-nil, each alias in ALIASES is `defalias'ed to
1008 Alias hook variables are created as `erc-server-ALIAS-functions' and
1009 initialized to the same default value as `erc-server-NAME-functions'.
1011 FN-BODY is the body of `erc-server-NAME' it may refer to the two
1012 function arguments PROC and PARSED.
1014 If EXTRA-FN-DOC is non-nil, it is inserted at the beginning of the
1015 defined function's docstring.
1017 If EXTRA-VAR-DOC is non-nil, it is inserted at the beginning of the
1018 defined variable's docstring.
1022 (define-erc-response-handler (311 WHOIS WI)
1023 \"Some non-generic function documentation.\"
1024 \"Some non-generic variable documentation.\"
1025 (do-stuff-with-whois proc parsed))
1030 (defvar erc-server-311-functions 'erc-server-311
1031 \"Some non-generic variable documentation.
1033 Hook called upon receiving a 311 server response.
1034 Each function is called with two arguments, the process associated
1035 with the response and the parsed response.
1036 See also `erc-server-311'.\")
1038 (defun erc-server-311 (proc parsed)
1039 \"Some non-generic function documentation.
1041 Handler for a 311 server response.
1042 PROC is the server process which returned the response.
1043 PARSED is the actual response as an `erc-response' struct.
1044 If you want to add responses don't modify this function, but rather
1045 add things to `erc-server-311-functions' instead.\"
1046 (do-stuff-with-whois proc parsed))
1048 (puthash \"311\" 'erc-server-311-functions erc-server-responses)
1049 (puthash \"WHOIS\" 'erc-server-WHOIS-functions erc-server-responses)
1050 (puthash \"WI\" 'erc-server-WI-functions erc-server-responses)
1052 (defalias 'erc-server-WHOIS 'erc-server-311)
1053 (defvar erc-server-WHOIS-functions 'erc-server-311
1054 \"Some non-generic variable documentation.
1056 Hook called upon receiving a WHOIS server response.
1057 Each function is called with two arguments, the process associated
1058 with the response and the parsed response.
1059 See also `erc-server-311'.\")
1061 (defalias 'erc-server-WI 'erc-server-311)
1062 (defvar erc-server-WI-functions 'erc-server-311
1063 \"Some non-generic variable documentation.
1065 Hook called upon receiving a WI server response.
1066 Each function is called with two arguments, the process associated
1067 with the response and the parsed response.
1068 See also `erc-server-311'.\"))
1070 \(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)"
1071 (if (numberp name
) (setq name
(intern (format "%03i" name
))))
1072 (setq aliases
(mapcar (lambda (a)
1077 (let* ((hook-name (intern (format "erc-server-%s-functions" name
)))
1078 (fn-name (intern (format "erc-server-%s" name
)))
1079 (hook-doc (format "%sHook called upon receiving a %%s server response.
1080 Each function is called with two arguments, the process associated
1081 with the response and the parsed response.
1084 (concat extra-var-doc
"\n\n")
1087 (fn-doc (format "%sHandler for a %s server response.
1088 PROC is the server process which returned the response.
1089 PARSED is the actual response as an `erc-response' struct.
1090 If you want to add responses don't modify this function, but rather
1091 add things to `%s' instead."
1093 (concat extra-fn-doc
"\n\n")
1097 (loop for alias in aliases
1098 collect
(intern (format "erc-server-%s" alias
))))
1100 (loop for alias in aliases
1101 collect
(intern (format "erc-server-%s-functions" alias
)))))
1103 ;; Normal hook variable.
1104 (defvar ,hook-name
',fn-name
,(format hook-doc name
))
1106 (defun ,fn-name
(proc parsed
)
1110 ;; Make find-function and find-variable find them
1111 (put ',fn-name
'definition-name
',name
)
1112 (put ',hook-name
'definition-name
',name
)
1114 ;; Hashtable map of responses to hook variables
1115 ,@(loop for response in
(cons name aliases
)
1116 for var in
(cons hook-name var-alternates
)
1117 collect
`(puthash ,(format "%s" response
) ',var
1118 erc-server-responses
))
1120 ;; Functions are defaliased, hook variables are defvared so we
1121 ;; can add hooks to one alias, but not another.
1122 ,@(loop for fn in fn-alternates
1123 for var in var-alternates
1125 nconc
(list `(defalias ',fn
',fn-name
)
1126 `(defvar ,var
',fn-name
,(format hook-doc a
))
1127 `(put ',var
'definition-name
',hook-name
))))))
1129 (define-erc-response-handler (ERROR)
1130 "Handle an ERROR command from the server." nil
1131 (setq erc-server-error-occurred t
)
1132 (erc-display-message
1133 parsed
'error nil
'ERROR
1134 ?s
(erc-response.sender parsed
) ?c
(erc-response.contents parsed
)))
1136 (define-erc-response-handler (INVITE)
1137 "Handle invitation messages."
1139 (let ((target (first (erc-response.command-args parsed
)))
1140 (chnl (erc-response.contents parsed
)))
1141 (multiple-value-bind (nick login host
)
1142 (erc-parse-user (erc-response.sender parsed
))
1143 (setq erc-invitation chnl
)
1144 (when (string= target
(erc-current-nick))
1145 (erc-display-message
1146 parsed
'notice
'active
1147 'INVITE ?n nick ?u login ?h host ?c chnl
)))))
1150 (define-erc-response-handler (JOIN)
1151 "Handle join messages."
1153 (let ((chnl (erc-response.contents parsed
))
1155 (multiple-value-bind (nick login host
)
1156 (erc-parse-user (erc-response.sender parsed
))
1157 ;; strip the stupid combined JOIN facility (IRC 2.9)
1158 (if (string-match "^\\(.*\\)?\^g.*$" chnl
)
1159 (setq chnl
(match-string 1 chnl
)))
1162 ;; If I have joined a channel
1163 ((erc-current-nick-p nick
)
1164 (setq buffer
(erc-open erc-session-server erc-session-port
1165 nick erc-session-user-full-name
1167 erc-default-recipients chnl
1168 erc-server-process
))
1171 (erc-add-default-channel chnl
)
1172 (erc-server-send (format "MODE %s" chnl
)))
1173 (erc-with-buffer (chnl proc
)
1174 (erc-channel-begin-receiving-names))
1175 (erc-update-mode-line)
1176 (run-hooks 'erc-join-hook
)
1178 (erc-format-message 'JOIN-you ?c chnl
)))
1180 (setq buffer
(erc-get-buffer chnl proc
))
1183 'JOIN ?n nick ?u login ?h host ?c chnl
))))))
1184 (when buffer
(set-buffer buffer
))
1185 (erc-update-channel-member chnl nick nick t nil nil host login
)
1186 ;; on join, we want to stay in the new channel buffer
1188 (erc-display-message parsed nil buffer str
))))))
1190 (define-erc-response-handler (KICK)
1191 "Handle kick messages received from the server." nil
1192 (let* ((ch (first (erc-response.command-args parsed
)))
1193 (tgt (second (erc-response.command-args parsed
)))
1194 (reason (erc-trim-string (erc-response.contents parsed
)))
1195 (buffer (erc-get-buffer ch proc
)))
1196 (multiple-value-bind (nick login host
)
1197 (erc-parse-user (erc-response.sender parsed
))
1198 (erc-remove-channel-member buffer tgt
)
1200 ((string= tgt
(erc-current-nick))
1201 (erc-display-message
1202 parsed
'notice buffer
1203 'KICK-you ?n nick ?u login ?h host ?c ch ?r reason
)
1204 (run-hook-with-args 'erc-kick-hook buffer
)
1207 (erc-remove-channel-users))
1208 (erc-delete-default-channel ch buffer
)
1209 (erc-update-mode-line buffer
))
1210 ((string= nick
(erc-current-nick))
1211 (erc-display-message
1212 parsed
'notice buffer
1213 'KICK-by-you ?k tgt ?c ch ?r reason
))
1214 (t (erc-display-message
1215 parsed
'notice buffer
1216 'KICK ?k tgt ?n nick ?u login ?h host ?c ch ?r reason
))))))
1218 (define-erc-response-handler (MODE)
1219 "Handle server mode changes." nil
1220 (let ((tgt (first (erc-response.command-args parsed
)))
1221 (mode (mapconcat 'identity
(cdr (erc-response.command-args parsed
))
1223 (multiple-value-bind (nick login host
)
1224 (erc-parse-user (erc-response.sender parsed
))
1225 (erc-log (format "MODE: %s -> %s: %s" nick tgt mode
))
1227 (let ((buf (cond ((erc-channel-p tgt
)
1228 (erc-get-buffer tgt proc
))
1229 ((string= tgt
(erc-current-nick)) nil
)
1230 ((erc-active-buffer) (erc-active-buffer))
1231 (t (erc-get-buffer tgt
)))))
1232 (with-current-buffer (or buf
1234 (erc-update-modes tgt mode nick host login
))
1235 (if (or (string= login
"") (string= host
""))
1236 (erc-display-message parsed
'notice buf
1239 (erc-display-message parsed
'notice buf
1240 'MODE ?n nick ?u login
1241 ?h host ?t tgt ?m mode
)))
1242 (erc-banlist-update proc parsed
))))
1244 (define-erc-response-handler (NICK)
1245 "Handle nick change messages." nil
1246 (let ((nn (erc-response.contents parsed
))
1248 (multiple-value-bind (nick login host
)
1249 (erc-parse-user (erc-response.sender parsed
))
1250 (setq bufs
(erc-buffer-list-with-nick nick proc
))
1251 (erc-log (format "NICK: %s -> %s" nick nn
))
1252 ;; if we had a query with this user, make sure future messages will be
1253 ;; sent to the correct nick. also add to bufs, since the user will want
1254 ;; to see the nick change in the query, and if it's a newly begun query,
1255 ;; erc-channel-users won't contain it
1258 (when (equal (erc-default-target) nick
)
1259 (setq erc-default-recipients
1260 (cons nn
(cdr erc-default-recipients
)))
1262 (erc-update-mode-line)
1263 (add-to-list 'bufs
(current-buffer)))))
1264 (erc-update-user-nick nick nn host nil nil login
)
1266 ((string= nick
(erc-current-nick))
1267 (add-to-list 'bufs
(erc-server-buffer))
1268 (erc-set-current-nick nn
)
1269 (erc-update-mode-line)
1270 (setq erc-nick-change-attempt-count
0)
1271 (setq erc-default-nicks
(if (consp erc-nick
) erc-nick
(list erc-nick
)))
1272 (erc-display-message
1274 'NICK-you ?n nick ?N nn
)
1275 (run-hook-with-args 'erc-nick-changed-functions nn nick
))
1277 (erc-handle-user-status-change 'nick
(list nick login host
) (list nn
))
1278 (erc-display-message parsed
'notice bufs
'NICK ?n nick
1279 ?u login ?h host ?N nn
))))))
1281 (define-erc-response-handler (PART)
1282 "Handle part messages." nil
1283 (let* ((chnl (first (erc-response.command-args parsed
)))
1284 (reason (erc-trim-string (erc-response.contents parsed
)))
1285 (buffer (erc-get-buffer chnl proc
)))
1286 (multiple-value-bind (nick login host
)
1287 (erc-parse-user (erc-response.sender parsed
))
1288 (erc-remove-channel-member buffer nick
)
1289 (erc-display-message parsed
'notice buffer
1290 'PART ?n nick ?u login
1291 ?h host ?c chnl ?r
(or reason
""))
1292 (when (string= nick
(erc-current-nick))
1293 (run-hook-with-args 'erc-part-hook buffer
)
1296 (erc-remove-channel-users))
1297 (erc-delete-default-channel chnl buffer
)
1298 (erc-update-mode-line buffer
)
1299 (when erc-kill-buffer-on-part
1300 (kill-buffer buffer
))))))
1302 (define-erc-response-handler (PING)
1303 "Handle ping messages." nil
1304 (let ((pinger (first (erc-response.command-args parsed
))))
1305 (erc-log (format "PING: %s" pinger
))
1306 ;; ping response to the server MUST be forced, or you can lose big
1307 (erc-server-send (format "PONG :%s" pinger
) t
)
1308 (when erc-verbose-server-ping
1309 (erc-display-message
1311 'PING ?s
(erc-time-diff erc-server-last-ping-time
(erc-current-time))))
1312 (setq erc-server-last-ping-time
(erc-current-time))))
1314 (define-erc-response-handler (PONG)
1315 "Handle pong messages." nil
1316 (let ((time (string-to-number (erc-response.contents parsed
))))
1318 (setq erc-server-lag
(erc-time-diff time
(erc-current-time)))
1319 (when erc-verbose-server-ping
1320 (erc-display-message
1321 parsed
'notice proc
'PONG
1322 ?h
(first (erc-response.command-args parsed
)) ?i erc-server-lag
1323 ?s
(if (/= erc-server-lag
1) "s" "")))
1324 (erc-update-mode-line))))
1326 (define-erc-response-handler (PRIVMSG NOTICE
)
1328 (let ((sender-spec (erc-response.sender parsed
))
1329 (cmd (erc-response.command parsed
))
1330 (tgt (car (erc-response.command-args parsed
)))
1331 (msg (erc-response.contents parsed
)))
1332 (if (or (erc-ignored-user-p sender-spec
)
1333 (erc-ignored-reply-p msg tgt proc
))
1334 (when erc-minibuffer-ignored
1335 (message "Ignored %s from %s to %s" cmd sender-spec tgt
))
1336 (let* ((sndr (erc-parse-user sender-spec
))
1338 (login (nth 1 sndr
))
1340 (msgp (string= cmd
"PRIVMSG"))
1341 (noticep (string= cmd
"NOTICE"))
1342 ;; S.B. downcase *both* tgt and current nick
1343 (privp (erc-current-nick-p tgt
))
1346 (setf (erc-response.contents parsed
) msg
)
1347 (setq buffer
(erc-get-buffer (if privp nick tgt
) proc
))
1349 (with-current-buffer buffer
1350 ;; update the chat partner info. Add to the list if private
1351 ;; message. We will accumulate private identities indefinitely
1353 (erc-update-channel-member (if privp nick tgt
) nick nick
1354 privp nil nil host login nil nil t
)
1355 (let ((cdata (erc-get-channel-user nick
)))
1356 (setq fnick
(funcall erc-format-nick-function
1357 (car cdata
) (cdr cdata
))))))
1359 ((erc-is-message-ctcp-p msg
)
1361 (erc-process-ctcp-query proc parsed nick login host
)
1362 (erc-process-ctcp-reply proc parsed nick login host
1363 (match-string 1 msg
)))))
1365 (setcar erc-server-last-peers nick
)
1366 (setq s
(erc-format-privmessage
1368 ;; If buffer is a query buffer,
1369 ;; format the nick as for a channel.
1370 (and (not (and buffer
1371 (erc-query-buffer-p buffer
)
1372 erc-format-query-as-channel-p
))
1376 (if (and noticep privp
)
1378 (run-hook-with-args 'erc-echo-notice-always-hook
1379 s parsed buffer nick
)
1380 (run-hook-with-args-until-success
1381 'erc-echo-notice-hook s parsed buffer nick
))
1382 (erc-display-message parsed nil buffer s
)))
1383 (when (string= cmd
"PRIVMSG")
1384 (erc-auto-query proc parsed
))))))
1386 ;; FIXME: need clean way of specifiying extra hooks in
1387 ;; define-erc-response-handler.
1388 (add-hook 'erc-server-PRIVMSG-functions
'erc-auto-query
)
1390 (define-erc-response-handler (QUIT)
1392 (let ((reason (erc-response.contents parsed
))
1394 (multiple-value-bind (nick login host
)
1395 (erc-parse-user (erc-response.sender parsed
))
1396 (setq bufs
(erc-buffer-list-with-nick nick proc
))
1397 (erc-remove-user nick
)
1398 (setq reason
(erc-wash-quit-reason reason nick login host
))
1399 (erc-display-message parsed
'notice bufs
1400 'QUIT ?n nick ?u login
1401 ?h host ?r reason
))))
1403 (define-erc-response-handler (TOPIC)
1405 (let* ((ch (first (erc-response.command-args parsed
)))
1406 (topic (erc-trim-string (erc-response.contents parsed
)))
1407 (time (format-time-string "%T %m/%d/%y" (current-time))))
1408 (multiple-value-bind (nick login host
)
1409 (erc-parse-user (erc-response.sender parsed
))
1410 (erc-update-channel-member ch nick nick nil nil nil host login
)
1411 (erc-update-channel-topic ch
(format "%s\C-o (%s, %s)" topic nick time
))
1412 (erc-display-message parsed
'notice
(erc-get-buffer ch proc
)
1413 'TOPIC ?n nick ?u login ?h host
1416 (define-erc-response-handler (WALLOPS)
1418 (let ((message (erc-response.contents parsed
)))
1419 (multiple-value-bind (nick login host
)
1420 (erc-parse-user (erc-response.sender parsed
))
1421 (erc-display-message
1423 'WALLOPS ?n nick ?m message
))))
1425 (define-erc-response-handler (001)
1426 "Set `erc-server-current-nick' to reflect server settings and display the welcome message."
1428 (erc-set-current-nick (first (erc-response.command-args parsed
)))
1429 (erc-update-mode-line) ; needed here?
1430 (setq erc-nick-change-attempt-count
0)
1431 (setq erc-default-nicks
(if (consp erc-nick
) erc-nick
(list erc-nick
)))
1432 (erc-display-message
1433 parsed
'notice
'active
(erc-response.contents parsed
)))
1435 (define-erc-response-handler (MOTD 002 003 371 372 374 375)
1436 "Display the server's message of the day." nil
1438 (erc-display-message
1439 parsed
'notice
(if erc-server-connected
'active proc
)
1440 (erc-response.contents parsed
)))
1442 (define-erc-response-handler (376 422)
1444 (erc-server-MOTD proc parsed
)
1445 (erc-connection-established proc parsed
))
1447 (define-erc-response-handler (004)
1449 (multiple-value-bind (server-name server-version
)
1450 (cdr (erc-response.command-args parsed
))
1451 (setq erc-server-version server-version
)
1452 (setq erc-server-announced-name server-name
)
1453 (erc-update-mode-line-buffer (process-buffer proc
))
1454 (erc-display-message
1456 's004 ?s server-name ?v server-version
1457 ?U
(fourth (erc-response.command-args parsed
))
1458 ?C
(fifth (erc-response.command-args parsed
)))))
1460 (define-erc-response-handler (005)
1461 "Set the variable `erc-server-parameters' and display the received message.
1463 According to RFC 2812, suggests alternate servers on the network.
1464 Many servers, however, use this code to show which parameters they have set,
1465 for example, the network identifier, maximum allowed topic length, whether
1466 certain commands are accepted and more. See documentation for
1467 `erc-server-parameters' for more information on the parameters sent.
1469 A server may send more than one 005 message."
1471 (let ((line (mapconcat 'identity
1472 (setf (erc-response.command-args parsed
)
1473 (cdr (erc-response.command-args parsed
)))
1475 (while (erc-response.command-args parsed
)
1476 (let ((section (pop (erc-response.command-args parsed
))))
1477 ;; fill erc-server-parameters
1478 (when (string-match "^\\([A-Z]+\\)\=\\(.*\\)$\\|^\\([A-Z]+\\)$"
1480 (add-to-list 'erc-server-parameters
1481 `(,(or (match-string 1 section
)
1482 (match-string 3 section
))
1484 ,(match-string 2 section
))))))
1485 (erc-display-message parsed
'notice proc line
)))
1487 (define-erc-response-handler (221)
1489 (let* ((nick (first (erc-response.command-args parsed
)))
1490 (modes (mapconcat 'identity
1491 (cdr (erc-response.command-args parsed
)) " ")))
1492 (erc-set-modes nick modes
)
1493 (erc-display-message parsed
'notice
'active
's221 ?n nick ?m modes
)))
1495 (define-erc-response-handler (252)
1496 "Display the number of IRC operators online." nil
1497 (erc-display-message parsed
'notice
'active
's252
1498 ?i
(second (erc-response.command-args parsed
))))
1500 (define-erc-response-handler (253)
1501 "Display the number of unknown connections." nil
1502 (erc-display-message parsed
'notice
'active
's253
1503 ?i
(second (erc-response.command-args parsed
))))
1505 (define-erc-response-handler (254)
1506 "Display the number of channels formed." nil
1507 (erc-display-message parsed
'notice
'active
's254
1508 ?i
(second (erc-response.command-args parsed
))))
1510 (define-erc-response-handler (250 251 255 256 257 258 259 265 266 377 378)
1511 "Generic display of server messages as notices.
1513 See `erc-display-server-message'." nil
1514 (erc-display-server-message proc parsed
))
1516 (define-erc-response-handler (290)
1517 "Handle dancer-ircd CAPAB messages." nil nil
)
1519 (define-erc-response-handler (301)
1521 (erc-display-message parsed
'notice
'active
's301
1522 ?n
(second (erc-response.command-args parsed
))
1523 ?r
(erc-response.contents parsed
)))
1525 (define-erc-response-handler (303)
1527 (erc-display-message parsed
'notice
'active
's303
1528 ?n
(second (erc-response.command-args parsed
))))
1530 (define-erc-response-handler (305)
1531 "Return from AWAYness." nil
1532 (erc-process-away proc nil
)
1533 (erc-display-message parsed
'notice
'active
1534 's305 ?m
(erc-response.contents parsed
)))
1536 (define-erc-response-handler (306)
1538 (erc-process-away proc t
)
1539 (erc-display-message parsed
'notice
'active
1540 's306 ?m
(erc-response.contents parsed
)))
1542 (define-erc-response-handler (311 314)
1543 "WHOIS/WHOWAS notices." nil
1544 (let ((fname (erc-response.contents parsed
))
1545 (catalog-entry (intern (format "s%s" (erc-response.command parsed
)))))
1546 (multiple-value-bind (nick user host
)
1547 (cdr (erc-response.command-args parsed
))
1548 (erc-update-user-nick nick nick host nil fname user
)
1549 (erc-display-message
1550 parsed
'notice
'active catalog-entry
1551 ?n nick ?f fname ?u user ?h host
))))
1553 (define-erc-response-handler (312)
1555 (multiple-value-bind (nick server-host
)
1556 (cdr (erc-response.command-args parsed
))
1557 (erc-display-message
1558 parsed
'notice
'active
's312
1559 ?n nick ?s server-host ?c
(erc-response.contents parsed
))))
1561 (define-erc-response-handler (313)
1562 "IRC Operator response in WHOIS." nil
1563 (erc-display-message
1564 parsed
'notice
'active
's313
1565 ?n
(second (erc-response.command-args parsed
))))
1567 (define-erc-response-handler (315 318 323 369)
1569 ;; 318 - End of WHOIS list
1570 ;; 323 - End of channel LIST
1571 ;; 369 - End of WHOWAS
1573 (ignore proc parsed
))
1575 (define-erc-response-handler (317)
1577 (multiple-value-bind (nick seconds-idle on-since time
)
1578 (cdr (erc-response.command-args parsed
))
1579 (setq time
(when on-since
1580 (format-time-string "%T %Y/%m/%d"
1581 (erc-string-to-emacs-time on-since
))))
1582 (erc-update-user-nick nick nick nil nil nil
1583 (and time
(format "on since %s" time
)))
1585 (erc-display-message
1586 parsed
'notice
'active
's317-on-since
1587 ?n nick ?i
(erc-sec-to-time (string-to-number seconds-idle
)) ?t time
)
1588 (erc-display-message
1589 parsed
'notice
'active
's317
1590 ?n nick ?i
(erc-sec-to-time (string-to-number seconds-idle
))))))
1592 (define-erc-response-handler (319)
1594 (erc-display-message
1595 parsed
'notice
'active
's319
1596 ?n
(second (erc-response.command-args parsed
))
1597 ?c
(erc-response.contents parsed
)))
1599 (define-erc-response-handler (320)
1600 "Identified user in WHOIS." nil
1601 (erc-display-message
1602 parsed
'notice
'active
's320
1603 ?n
(second (erc-response.command-args parsed
))))
1605 (define-erc-response-handler (321)
1607 (setq erc-channel-list nil
)
1608 (erc-display-message parsed
'notice proc
's321
))
1610 (define-erc-response-handler (322)
1612 (let ((topic (erc-response.contents parsed
)))
1613 (multiple-value-bind (channel num-users
)
1614 (cdr (erc-response.command-args parsed
))
1615 (add-to-list 'erc-channel-list
(list channel
))
1616 (erc-update-channel-topic channel topic
)
1617 (erc-display-message
1618 parsed
'notice proc
's322
1619 ?c channel ?u num-users ?t
(or topic
"")))))
1621 (define-erc-response-handler (324)
1622 "Channel or nick modes." nil
1623 (let ((channel (second (erc-response.command-args parsed
)))
1624 (modes (mapconcat 'identity
(cddr (erc-response.command-args parsed
))
1626 (erc-set-modes channel modes
)
1627 (erc-display-message
1628 parsed
'notice
(erc-get-buffer channel proc
)
1629 's324 ?c channel ?m modes
)))
1631 (define-erc-response-handler (329)
1632 "Channel creation date." nil
1633 (let ((channel (second (erc-response.command-args parsed
)))
1634 (time (erc-string-to-emacs-time
1635 (third (erc-response.command-args parsed
)))))
1636 (erc-display-message
1637 parsed
'notice
(erc-get-buffer channel proc
)
1638 's329 ?c channel ?t
(format-time-string "%A %Y/%m/%d %X" time
))))
1640 (define-erc-response-handler (330)
1642 ;; FIXME: I don't know what the magic numbers mean. Mummy, make
1643 ;; the magic numbers go away.
1644 ;; No seriously, I have no clue about the format of this command,
1645 ;; and don't sit on Quakenet, so can't test. Originally we had:
1646 ;; nick == (aref parsed 3)
1647 ;; authaccount == (aref parsed 4)
1648 ;; authmsg == (aref parsed 5)
1649 ;; The guesses below are, well, just that. -- Lawrence 2004/05/10
1650 (let ((nick (second (erc-response.command-args parsed
)))
1651 (authaccount (third (erc-response.command-args parsed
)))
1652 (authmsg (erc-response.contents parsed
)))
1653 (erc-display-message parsed
'notice
'active
's330
1654 ?n nick ?a authmsg ?i authaccount
)))
1656 (define-erc-response-handler (331)
1657 "Channel topic." nil
1658 (let ((channel (second (erc-response.command-args parsed
)))
1659 (topic (erc-response.contents parsed
)))
1660 ;; FIXME: why don't we do anything with the topic? -- Lawrence 2004/05/10
1661 (erc-display-message parsed
'notice
(erc-get-buffer channel proc
)
1664 (define-erc-response-handler (332)
1666 (let ((channel (second (erc-response.command-args parsed
)))
1667 (topic (erc-response.contents parsed
)))
1668 (erc-update-channel-topic channel topic
)
1669 (erc-display-message parsed
'notice
(erc-get-buffer channel proc
)
1670 's332 ?c channel ?T topic
)))
1672 (define-erc-response-handler (333)
1673 ;; Who set the topic, and when
1675 (multiple-value-bind (channel nick time
)
1676 (cdr (erc-response.command-args parsed
))
1677 (setq time
(format-time-string "%T %Y/%m/%d"
1678 (erc-string-to-emacs-time time
)))
1679 (erc-update-channel-topic channel
1680 (format "\C-o (%s, %s)" nick time
)
1682 (erc-display-message parsed
'notice
(erc-get-buffer channel proc
)
1683 's333 ?c channel ?n nick ?t time
)))
1685 (define-erc-response-handler (341)
1686 "Let user know when an INVITE attempt has been sent successfully."
1688 (multiple-value-bind (nick channel
)
1689 (cdr (erc-response.command-args parsed
))
1690 (erc-display-message parsed
'notice
(erc-get-buffer channel proc
)
1691 's341 ?n nick ?c channel
)))
1693 (define-erc-response-handler (352)
1695 (multiple-value-bind (channel user host server nick away-flag
)
1696 (cdr (erc-response.command-args parsed
))
1697 (let ((full-name (erc-response.contents parsed
))
1699 (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name
)
1700 (setq hopcount
(match-string 1 full-name
))
1701 (setq full-name
(match-string 2 full-name
)))
1702 (erc-update-channel-member channel nick nick nil nil nil host
1704 (erc-display-message parsed
'notice
'active
's352
1705 ?c channel ?n nick ?a away-flag
1706 ?u user ?h host ?f full-name
))))
1708 (define-erc-response-handler (353)
1710 (let ((channel (third (erc-response.command-args parsed
)))
1711 (users (erc-response.contents parsed
)))
1712 (erc-display-message parsed
'notice
(or (erc-get-buffer channel proc
)
1714 's353 ?c channel ?u users
)
1715 (erc-with-buffer (channel proc
)
1716 (erc-channel-receive-names users
))))
1718 (define-erc-response-handler (366)
1720 (erc-with-buffer ((second (erc-response.command-args parsed
)) proc
)
1721 (erc-channel-end-receiving-names)))
1723 (define-erc-response-handler (367)
1724 "Channel ban list entries" nil
1725 (multiple-value-bind (channel banmask setter time
)
1726 (cdr (erc-response.command-args parsed
))
1727 ;; setter and time are not standard
1729 (erc-display-message parsed
'notice
'active
's367-set-by
1734 (erc-display-message parsed
'notice
'active
's367
1738 (define-erc-response-handler (368)
1739 "End of channel ban list" nil
1740 (let ((channel (second (erc-response.command-args parsed
))))
1741 (erc-display-message parsed
'notice
'active
's368
1744 (define-erc-response-handler (379)
1745 "Forwarding to another channel." nil
1746 ;; FIXME: Yet more magic numbers in original code, I'm guessing this
1747 ;; command takes two arguments, and doesn't have any "contents". --
1748 ;; Lawrence 2004/05/10
1749 (multiple-value-bind (from to
)
1750 (cdr (erc-response.command-args parsed
))
1751 (erc-display-message parsed
'notice
'active
1752 's379 ?c from ?f to
)))
1754 (define-erc-response-handler (391)
1755 "Server's time string" nil
1756 (erc-display-message
1757 parsed
'notice
'active
1758 's391 ?s
(second (erc-response.command-args parsed
))
1759 ?t
(third (erc-response.command-args parsed
))))
1761 (define-erc-response-handler (401)
1762 "No such nick/channel." nil
1763 (let ((nick/channel
(second (erc-response.command-args parsed
))))
1764 (when erc-whowas-on-nosuchnick
1765 (erc-log (format "cmd: WHOWAS: %s" nick
/channel
))
1766 (erc-server-send (format "WHOWAS %s 1" nick
/channel
)))
1767 (erc-display-message parsed
'(notice error
) 'active
1768 's401 ?n nick
/channel
)))
1770 (define-erc-response-handler (403)
1771 "No such channel." nil
1772 (erc-display-message parsed
'(notice error
) 'active
1773 's403 ?c
(second (erc-response.command-args parsed
))))
1775 (define-erc-response-handler (404)
1776 "Cannot send to channel." nil
1777 (erc-display-message parsed
'(notice error
) 'active
1778 's404 ?c
(second (erc-response.command-args parsed
))))
1781 (define-erc-response-handler (405)
1782 ;; Can't join that many channels.
1784 (erc-display-message parsed
'(notice error
) 'active
1785 's405 ?c
(second (erc-response.command-args parsed
))))
1787 (define-erc-response-handler (406)
1790 (erc-display-message parsed
'(notice error
) 'active
1791 's406 ?n
(second (erc-response.command-args parsed
))))
1793 (define-erc-response-handler (412)
1796 (erc-display-message parsed
'(notice error
) 'active
's412
))
1798 (define-erc-response-handler (421)
1801 (erc-display-message parsed
'(notice error
) 'active
's421
1802 ?c
(second (erc-response.command-args parsed
))))
1804 (define-erc-response-handler (432)
1807 (erc-display-message parsed
'(notice error
) 'active
's432
1808 ?n
(second (erc-response.command-args parsed
))))
1810 (define-erc-response-handler (433)
1811 ;; Login-time "nick in use"
1813 (erc-nickname-in-use (second (erc-response.command-args parsed
))
1816 (define-erc-response-handler (437)
1817 ;; Nick temporarily unavailable (IRCnet)
1819 (let ((nick/channel
(second (erc-response.command-args parsed
))))
1820 (unless (erc-channel-p nick
/channel
)
1821 (erc-nickname-in-use nick
/channel
"temporarily unavailable"))))
1823 (define-erc-response-handler (442)
1826 (erc-display-message parsed
'(notice error
) 'active
's442
1827 ?c
(second (erc-response.command-args parsed
))))
1829 (define-erc-response-handler (461)
1830 ;; Not enough params for command.
1832 (erc-display-message parsed
'(notice error
) 'active
's461
1833 ?c
(second (erc-response.command-args parsed
))
1834 ?m
(erc-response.contents parsed
)))
1836 (define-erc-response-handler (465)
1837 "You are banned from this server." nil
1838 (setq erc-server-banned t
)
1839 ;; show the server's message, as a reason might be provided
1840 (erc-display-error-notice
1842 (erc-response.contents parsed
)))
1844 (define-erc-response-handler (474)
1845 "Banned from channel errors" nil
1846 (erc-display-message parsed
'(notice error
) nil
1847 (intern (format "s%s"
1848 (erc-response.command parsed
)))
1849 ?c
(second (erc-response.command-args parsed
))))
1851 (define-erc-response-handler (475)
1852 "Channel key needed." nil
1853 (erc-display-message parsed
'(notice error
) nil
's475
1854 ?c
(second (erc-response.command-args parsed
)))
1855 (when erc-prompt-for-channel-key
1856 (let ((channel (second (erc-response.command-args parsed
)))
1857 (key (read-from-minibuffer
1858 (format "Channel %s is mode +k. Enter key (RET to cancel): "
1859 (second (erc-response.command-args parsed
))))))
1860 (when (and key
(> (length key
) 0))
1861 (erc-cmd-JOIN channel key
)))))
1863 (define-erc-response-handler (477)
1865 (let ((channel (second (erc-response.command-args parsed
)))
1866 (message (erc-response.contents parsed
)))
1867 (erc-display-message parsed
'notice
(erc-get-buffer channel proc
)
1868 (format "%s: %s" channel message
))))
1870 (define-erc-response-handler (482)
1872 (let ((channel (second (erc-response.command-args parsed
)))
1873 (message (erc-response.contents parsed
)))
1874 (erc-display-message parsed
'(error notice
) 'active
's482
1875 ?c channel ?m message
)))
1877 (define-erc-response-handler (431 445 446 451 462 463 464 481 483 484 485
1879 ;; 431 - No nickname given
1880 ;; 445 - SUMMON has been disabled
1881 ;; 446 - USERS has been disabled
1882 ;; 451 - You have not registered
1883 ;; 462 - Unauthorized command (already registered)
1884 ;; 463 - Your host isn't among the privileged
1885 ;; 464 - Password incorrect
1886 ;; 481 - Need IRCop privileges
1887 ;; 483 - You can't kill a server!
1888 ;; 484 - Your connection is restricted!
1889 ;; 485 - You're not the original channel operator
1890 ;; 491 - No O-lines for your host
1891 ;; 501 - Unknown MODE flag
1892 ;; 502 - Cannot change mode for other users
1894 (erc-display-error-notice
1896 (intern (format "s%s" (erc-response.command parsed
)))))
1898 ;; FIXME: These are yet to be implemented, they're just stubs for now
1899 ;; -- Lawrence 2004/05/12
1901 ;; response numbers left here for reference
1903 ;; (define-erc-response-handler (323 364 365 381 382 392 393 394 395
1904 ;; 200 201 202 203 204 205 206 208 209 211 212 213
1905 ;; 214 215 216 217 218 219 241 242 243 244 249 261
1906 ;; 262 302 342 351 402 407 409 411 413 414 415
1907 ;; 423 424 436 441 443 444 467 471 472 473 KILL)
1909 ;; (ignore proc parsed))
1911 (provide 'erc-backend
)
1913 ;;; erc-backend.el ends here
1915 ;; indent-tabs-mode: nil
1918 ;; arch-tag: a64e6bb7-a780-4efd-8f98-083b18c7c84a