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