lisp/erc/erc-backend.el

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