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

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