lisp/erc/erc-backend.el

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