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