lisp/erc/erc-backend.el

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