code.delx.au - gnu-emacs/blob - lisp/erc/erc-backend.el

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