lisp/erc/erc-backend.el

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