lisp/erc/erc.el

   1 ;; erc.el --- An Emacs Internet Relay Chat client
   2
   3 ;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
   4
   5 ;; Author: Alexander L. Belikoff (alexander@belikoff.net)
   6 ;; Contributors: Sergey Berezin (sergey.berezin@cs.cmu.edu),
   7 ;;               Mario Lang (mlang@delysid.org),
   8 ;;               Alex Schroeder (alex@gnu.org)
   9 ;;               Andreas Fuchs (afs@void.at)
  10 ;;               Gergely Nagy (algernon@midgard.debian.net)
  11 ;;               David Edmondson (dme@dme.org)
  12 ;; Maintainer: FSF
  13 ;; Keywords: IRC, chat, client, Internet
  14 ;; Version: 5.3
  15
  16 ;; This file is part of GNU Emacs.
  17
  18 ;; GNU Emacs is free software: you can redistribute it and/or modify
  19 ;; it under the terms of the GNU General Public License as published by
  20 ;; the Free Software Foundation, either version 3 of the License, or
  21 ;; (at your option) any later version.
  22
  23 ;; GNU Emacs is distributed in the hope that it will be useful,
  24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  26 ;; GNU General Public License for more details.
  27
  28 ;; You should have received a copy of the GNU General Public License
  29 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  30
  31 ;;; Commentary:
  32
  33 ;; ERC is a powerful, modular, and extensible IRC client for Emacs.
  34
  35 ;; For more information, see the following URLs:
  36 ;; * http://sv.gnu.org/projects/erc/
  37 ;; * http://www.emacswiki.org/cgi-bin/wiki/ERC
  38
  39 ;; As of 2006-06-13, ERC development is now hosted on Savannah
  40 ;; (http://sv.gnu.org/projects/erc).  I invite everyone who wants to
  41 ;; hack on it to contact me <mwolson@gnu.org> in order to get write
  42 ;; access to the shared Arch archive.
  43
  44 ;; Installation:
  45
  46 ;; Put erc.el in your load-path, and put (require 'erc) in your .emacs.
  47
  48 ;; Configuration:
  49
  50 ;; Use M-x customize-group RET erc RET to get an overview
  51 ;; of all the variables you can tweak.
  52
  53 ;; Usage:
  54
  55 ;; To connect to an IRC server, do
  56 ;;
  57 ;; M-x erc RET
  58 ;;
  59 ;; After you are connected to a server, you can use C-h m or have a look at
  60 ;; the ERC menu.
  61
  62 ;;; History:
  63 ;;
  64
  65 ;;; Code:
  66
  67 (defconst erc-version-string "Version 5.3"
  68   "ERC version.  This is used by function `erc-version'.")
  69
  70 (eval-when-compile (require 'cl))
  71 (require 'font-lock)
  72 (require 'pp)
  73 (require 'thingatpt)
  74 (require 'auth-source)
  75 (require 'erc-compat)
  76
  77 (defvar erc-official-location
  78   "http://emacswiki.org/cgi-bin/wiki/ERC (mailing list: erc-discuss@gnu.org)"
  79   "Location of the ERC client on the Internet.")
  80
  81 (defgroup erc nil
  82   "Emacs Internet Relay Chat client."
  83   :link '(url-link "http://www.emacswiki.org/cgi-bin/wiki/ERC")
  84   :prefix "erc-"
  85   :group 'applications)
  86
  87 (defgroup erc-buffers nil
  88   "Creating new ERC buffers"
  89   :group 'erc)
  90
  91 (defgroup erc-display nil
  92   "Settings for how various things are displayed"
  93   :group 'erc)
  94
  95 (defgroup erc-mode-line-and-header nil
  96   "Displaying information in the mode-line and header"
  97   :group 'erc-display)
  98
  99 (defgroup erc-ignore nil
 100   "Ignoring certain messages"
 101   :group 'erc)
 102
 103 (defgroup erc-lurker nil
 104   "Hide specified message types sent by lurkers"
 105   :group 'erc-ignore)
 106
 107 (defgroup erc-query nil
 108   "Using separate buffers for private discussions"
 109   :group 'erc)
 110
 111 (defgroup erc-quit-and-part nil
 112   "Quitting and parting channels"
 113   :group 'erc)
 114
 115 (defgroup erc-paranoia nil
 116   "Know what is sent and received; control the display of sensitive data."
 117   :group 'erc)
 118
 119 (defgroup erc-scripts nil
 120   "Running scripts at startup and with /LOAD"
 121   :group 'erc)
 122
 123 (require 'erc-backend)
 124
 125 ;; compatibility with older ERC releases
 126
 127 (if (fboundp 'defvaralias)
 128     (progn
 129       (defvaralias 'erc-announced-server-name 'erc-server-announced-name)
 130       (erc-make-obsolete-variable 'erc-announced-server-name
 131                                   'erc-server-announced-name
 132                                   "ERC 5.1")
 133       (defvaralias 'erc-process 'erc-server-process)
 134       (erc-make-obsolete-variable 'erc-process 'erc-server-process "ERC 5.1")
 135       (defvaralias 'erc-default-coding-system 'erc-server-coding-system)
 136       (erc-make-obsolete-variable 'erc-default-coding-system
 137                                   'erc-server-coding-system
 138                                   "ERC 5.1"))
 139   (message (concat "ERC: The function `defvaralias' is not bound.  See the "
 140                    "NEWS file for variable name changes since ERC 5.0.4.")))
 141
 142 (define-obsolete-function-alias 'erc-send-command
 143   'erc-server-send "ERC 5.1")
 144
 145 ;; tunable connection and authentication parameters
 146
 147 (defcustom erc-server nil
 148   "IRC server to use if one is not provided.
 149 See function `erc-compute-server' for more details on connection
 150 parameters and authentication."
 151   :group 'erc
 152   :type '(choice (const :tag "None" nil)
 153                  (string :tag "Server")))
 154
 155 (defcustom erc-port nil
 156   "IRC port to use if not specified.
 157
 158 This can be either a string or a number."
 159   :group 'erc
 160   :type '(choice (const :tag "None" nil)
 161                  (integer :tag "Port number")
 162                  (string :tag "Port string")))
 163
 164 (defcustom erc-nick nil
 165   "Nickname to use if one is not provided.
 166
 167 This can be either a string, or a list of strings.
 168 In the latter case, if the first nick in the list is already in use,
 169 other nicks are tried in the list order.
 170
 171 See function `erc-compute-nick' for more details on connection
 172 parameters and authentication."
 173   :group 'erc
 174   :type '(choice (const :tag "None" nil)
 175                  (string :tag "Nickname")
 176                  (repeat (string :tag "Nickname"))))
 177
 178 (defcustom erc-nick-uniquifier "`"
 179   "The string to append to the nick if it is already in use."
 180   :group 'erc
 181   :type 'string)
 182
 183 (defcustom erc-try-new-nick-p t
 184   "If the nickname you chose isn't available, and this option is non-nil,
 185 ERC should automatically attempt to connect with another nickname.
 186
 187 You can manually set another nickname with the /NICK command."
 188   :group 'erc
 189   :type 'boolean)
 190
 191 (defcustom erc-user-full-name nil
 192   "User full name.
 193
 194 This can be either a string or a function to call.
 195
 196 See function `erc-compute-full-name' for more details on connection
 197 parameters and authentication."
 198   :group 'erc
 199   :type '(choice (const :tag "No name" nil)
 200                  (string :tag "Name")
 201                  (function :tag "Get from function"))
 202   :set (lambda (sym val)
 203          (if (functionp val)
 204              (set sym (funcall val))
 205            (set sym val))))
 206
 207 (defvar erc-password nil
 208   "Password to use when authenticating to an IRC server.
 209 It is not strictly necessary to provide this, since ERC will
 210 prompt you for it.")
 211
 212 (defcustom erc-user-mode nil
 213   "Initial user modes to be set after a connection is established."
 214   :group 'erc
 215   :type '(choice (const nil) string function))
 216
 217
 218 (defcustom erc-prompt-for-password t
 219   "Asks before using the default password, or whether to enter a new one."
 220   :group 'erc
 221   :type 'boolean)
 222
 223 (defcustom erc-warn-about-blank-lines t
 224   "Warn the user if they attempt to send a blank line."
 225   :group 'erc
 226   :type 'boolean)
 227
 228 (defcustom erc-send-whitespace-lines nil
 229   "If set to non-nil, send lines consisting of only whitespace."
 230   :group 'erc
 231   :type 'boolean)
 232
 233 (defcustom erc-hide-prompt nil
 234   "If non-nil, do not display the prompt for commands.
 235
 236 \(A command is any input starting with a '/').
 237
 238 See also the variables `erc-prompt' and `erc-command-indicator'."
 239   :group 'erc-display
 240   :type 'boolean)
 241
 242 ;; tunable GUI stuff
 243
 244 (defcustom erc-show-my-nick t
 245   "If non-nil, display one's own nickname when sending a message.
 246
 247 If non-nil, \"<nickname>\" will be shown.
 248 If nil, only \"> \" will be shown."
 249   :group 'erc-display
 250   :type 'boolean)
 251
 252 (define-widget 'erc-message-type 'set
 253   "A set of standard IRC Message types."
 254   :args '((const "JOIN")
 255           (const "KICK")
 256           (const "NICK")
 257           (const "PART")
 258           (const "QUIT")
 259           (const "MODE")
 260           (repeat :inline t :tag "Others" (string :tag "IRC Message Type"))))
 261
 262 (defcustom erc-hide-list nil
 263   "List of IRC type messages to hide.
 264 A typical value would be '(\"JOIN\" \"PART\" \"QUIT\")."
 265   :group 'erc-ignore
 266   :type 'erc-message-type)
 267
 268 (defvar erc-session-password nil
 269   "The password used for the current session.")
 270 (make-variable-buffer-local 'erc-session-password)
 271
 272 (defcustom erc-disconnected-hook nil
 273   "Run this hook with arguments (NICK IP REASON) when disconnected.
 274 This happens before automatic reconnection.  Note, that
 275 `erc-server-QUIT-functions' might not be run when we disconnect,
 276 simply because we do not necessarily receive the QUIT event."
 277   :group 'erc-hooks
 278   :type 'hook)
 279
 280 (defcustom erc-complete-functions nil
 281   "These functions get called when the user hits TAB in ERC.
 282 Each function in turn is called until one returns non-nil to
 283 indicate it has handled the input."
 284   :group 'erc-hooks
 285   :type 'hook)
 286
 287 (defcustom erc-join-hook nil
 288   "Hook run when we join a channel.  Hook functions are called
 289 without arguments, with the current buffer set to the buffer of
 290 the new channel.
 291
 292 See also `erc-server-JOIN-functions', `erc-part-hook'."
 293   :group 'erc-hooks
 294   :type 'hook)
 295
 296 (defcustom erc-quit-hook nil
 297   "Hook run when processing a quit command directed at our nick.
 298
 299 The hook receives one argument, the current PROCESS.
 300 See also `erc-server-QUIT-functions' and `erc-disconnected-hook'."
 301   :group 'erc-hooks
 302   :type 'hook)
 303
 304 (defcustom erc-part-hook nil
 305   "Hook run when processing a PART message directed at our nick.
 306
 307 The hook receives one argument, the current BUFFER.
 308 See also `erc-server-QUIT-functions', `erc-quit-hook' and
 309 `erc-disconnected-hook'."
 310   :group 'erc-hooks
 311   :type 'hook)
 312
 313 (defcustom erc-kick-hook nil
 314   "Hook run when processing a KICK message directed at our nick.
 315
 316 The hook receives one argument, the current BUFFER.
 317 See also `erc-server-PART-functions' and `erc-part-hook'."
 318   :group 'erc-hooks
 319   :type 'hook)
 320
 321 (defcustom erc-nick-changed-functions nil
 322   "List of functions run when your nick was successfully changed.
 323
 324 Each function should accept two arguments, NEW-NICK and OLD-NICK."
 325   :group 'erc-hooks
 326   :type 'hook)
 327
 328 (defcustom erc-connect-pre-hook '(erc-initialize-log-marker)
 329   "Hook called just before `erc' calls `erc-connect'.
 330 Functions are passed a buffer as the first argument."
 331   :group 'erc-hooks
 332   :type 'hook)
 333
 334
 335 (defvar erc-channel-users nil
 336   "A hash table of members in the current channel, which
 337 associates nicknames with cons cells of the form:
 338 \(USER . MEMBER-DATA) where USER is a pointer to an
 339 erc-server-user struct, and MEMBER-DATA is a pointer to an
 340 erc-channel-user struct.")
 341 (make-variable-buffer-local 'erc-channel-users)
 342
 343 (defvar erc-server-users nil
 344   "A hash table of users on the current server, which associates
 345 nicknames with erc-server-user struct instances.")
 346 (make-variable-buffer-local 'erc-server-users)
 347
 348 (defun erc-downcase (string)
 349   "Convert STRING to IRC standard conforming downcase."
 350   (let ((s (downcase string))
 351         (c '((?\[ . ?\{)
 352              (?\] . ?\})
 353              (?\\ . ?\|)
 354              (?~  . ?^))))
 355     (save-match-data
 356       (while (string-match "[]\\[~]" s)
 357         (aset s (match-beginning 0)
 358               (cdr (assq (aref s (match-beginning 0)) c)))))
 359     s))
 360
 361 (defmacro erc-with-server-buffer (&rest body)
 362   "Execute BODY in the current ERC server buffer.
 363 If no server buffer exists, return nil."
 364   (let ((buffer (make-symbol "buffer")))
 365     `(let ((,buffer (erc-server-buffer)))
 366        (when (buffer-live-p ,buffer)
 367          (with-current-buffer ,buffer
 368            ,@body)))))
 369 (put 'erc-with-server-buffer 'lisp-indent-function 0)
 370 (put 'erc-with-server-buffer 'edebug-form-spec '(body))
 371
 372 (defstruct (erc-server-user (:type vector) :named)
 373   ;; User data
 374   nickname host login full-name info
 375   ;; Buffers
 376   ;;
 377   ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where
 378   ;; CHANNEL-DATA is either nil or an erc-channel-user struct.
 379   (buffers nil)
 380   )
 381
 382 (defstruct (erc-channel-user (:type vector) :named)
 383   op voice
 384   ;; Last message time (in the form of the return value of
 385   ;; (current-time)
 386   ;;
 387   ;; This is useful for ordered name completion.
 388   (last-message-time nil))
 389
 390 (defsubst erc-get-channel-user (nick)
 391   "Finds the (USER . CHANNEL-DATA) element corresponding to NICK
 392 in the current buffer's `erc-channel-users' hash table."
 393   (gethash (erc-downcase nick) erc-channel-users))
 394
 395 (defsubst erc-get-server-user (nick)
 396   "Finds the USER corresponding to NICK in the current server's
 397 `erc-server-users' hash table."
 398   (erc-with-server-buffer
 399     (gethash (erc-downcase nick) erc-server-users)))
 400
 401 (defsubst erc-add-server-user (nick user)
 402   "This function is for internal use only.
 403
 404 Adds USER with nickname NICK to the `erc-server-users' hash table."
 405   (erc-with-server-buffer
 406     (puthash (erc-downcase nick) user erc-server-users)))
 407
 408 (defsubst erc-remove-server-user (nick)
 409   "This function is for internal use only.
 410
 411 Removes the user with nickname NICK from the `erc-server-users'
 412 hash table.  This user is not removed from the
 413 `erc-channel-users' lists of other buffers.
 414
 415 See also: `erc-remove-user'."
 416   (erc-with-server-buffer
 417     (remhash (erc-downcase nick) erc-server-users)))
 418
 419 (defun erc-change-user-nickname (user new-nick)
 420   "This function is for internal use only.
 421
 422 Changes the nickname of USER to NEW-NICK in the
 423 `erc-server-users' hash table.  The `erc-channel-users' lists of
 424 other buffers are also changed."
 425   (let ((nick (erc-server-user-nickname user)))
 426     (setf (erc-server-user-nickname user) new-nick)
 427     (erc-with-server-buffer
 428       (remhash (erc-downcase nick) erc-server-users)
 429       (puthash (erc-downcase new-nick) user erc-server-users))
 430     (dolist (buf (erc-server-user-buffers user))
 431       (if (buffer-live-p buf)
 432           (with-current-buffer buf
 433             (let ((cdata (erc-get-channel-user nick)))
 434               (remhash (erc-downcase nick) erc-channel-users)
 435               (puthash (erc-downcase new-nick) cdata
 436                        erc-channel-users)))))))
 437
 438 (defun erc-remove-channel-user (nick)
 439   "This function is for internal use only.
 440
 441 Removes the user with nickname NICK from the `erc-channel-users'
 442 list for this channel.  If this user is not in the
 443 `erc-channel-users' list of any other buffers, the user is also
 444 removed from the server's `erc-server-users' list.
 445
 446 See also: `erc-remove-server-user' and `erc-remove-user'."
 447   (let ((channel-data (erc-get-channel-user nick)))
 448     (when channel-data
 449       (let ((user (car channel-data)))
 450         (setf (erc-server-user-buffers user)
 451               (delq (current-buffer)
 452                     (erc-server-user-buffers user)))
 453         (remhash (erc-downcase nick) erc-channel-users)
 454         (if (null (erc-server-user-buffers user))
 455             (erc-remove-server-user nick))))))
 456
 457 (defun erc-remove-user (nick)
 458   "This function is for internal use only.
 459
 460 Removes the user with nickname NICK from the `erc-server-users'
 461 list as well as from all `erc-channel-users' lists.
 462
 463 See also: `erc-remove-server-user' and
 464 `erc-remove-channel-user'."
 465   (let ((user (erc-get-server-user nick)))
 466     (when user
 467       (let ((buffers (erc-server-user-buffers user)))
 468         (dolist (buf buffers)
 469           (if (buffer-live-p buf)
 470               (with-current-buffer buf
 471                 (remhash (erc-downcase nick) erc-channel-users)
 472                 (run-hooks 'erc-channel-members-changed-hook)))))
 473       (erc-remove-server-user nick))))
 474
 475 (defun erc-remove-channel-users ()
 476   "This function is for internal use only.
 477
 478 Removes all users in the current channel.  This is called by
 479 `erc-server-PART' and `erc-server-QUIT'."
 480   (when (and erc-server-connected
 481              (erc-server-process-alive)
 482              (hash-table-p erc-channel-users))
 483     (maphash (lambda (nick cdata)
 484                (erc-remove-channel-user nick))
 485              erc-channel-users)
 486     (clrhash erc-channel-users)))
 487
 488 (defsubst erc-channel-user-op-p (nick)
 489   "Return t if NICK is an operator in the current channel."
 490   (and nick
 491        (hash-table-p erc-channel-users)
 492        (let ((cdata (erc-get-channel-user nick)))
 493          (and cdata (cdr cdata)
 494               (erc-channel-user-op (cdr cdata))))))
 495
 496 (defsubst erc-channel-user-voice-p (nick)
 497   "Return t if NICK has voice in the current channel."
 498   (and nick
 499        (hash-table-p erc-channel-users)
 500        (let ((cdata (erc-get-channel-user nick)))
 501          (and cdata (cdr cdata)
 502               (erc-channel-user-voice (cdr cdata))))))
 503
 504 (defun erc-get-channel-user-list ()
 505   "Returns a list of users in the current channel.  Each element
 506 of the list is of the form (USER . CHANNEL-DATA), where USER is
 507 an erc-server-user struct, and CHANNEL-DATA is either `nil' or an
 508 erc-channel-user struct.
 509
 510 See also: `erc-sort-channel-users-by-activity'"
 511   (let (users)
 512     (if (hash-table-p erc-channel-users)
 513       (maphash (lambda (nick cdata)
 514                  (setq users (cons cdata users)))
 515                erc-channel-users))
 516     users))
 517
 518 (defun erc-get-server-nickname-list ()
 519   "Returns a list of known nicknames on the current server."
 520   (erc-with-server-buffer
 521     (let (nicks)
 522       (when (hash-table-p erc-server-users)
 523         (maphash (lambda (n user)
 524                    (setq nicks
 525                          (cons (erc-server-user-nickname user)
 526                                nicks)))
 527                  erc-server-users)
 528         nicks))))
 529
 530 (defun erc-get-channel-nickname-list ()
 531   "Returns a list of known nicknames on the current channel."
 532   (let (nicks)
 533     (when (hash-table-p erc-channel-users)
 534       (maphash (lambda (n cdata)
 535                  (setq nicks
 536                        (cons (erc-server-user-nickname (car cdata))
 537                              nicks)))
 538                erc-channel-users)
 539       nicks)))
 540
 541 (defun erc-get-server-nickname-alist ()
 542   "Returns an alist of known nicknames on the current server."
 543   (erc-with-server-buffer
 544     (let (nicks)
 545       (when (hash-table-p erc-server-users)
 546         (maphash (lambda (n user)
 547                    (setq nicks
 548                          (cons (cons (erc-server-user-nickname user) nil)
 549                                nicks)))
 550                  erc-server-users)
 551         nicks))))
 552
 553 (defun erc-get-channel-nickname-alist ()
 554   "Returns an alist of known nicknames on the current channel."
 555   (let (nicks)
 556     (when (hash-table-p erc-channel-users)
 557       (maphash (lambda (n cdata)
 558                  (setq nicks
 559                        (cons (cons (erc-server-user-nickname (car cdata)) nil)
 560                              nicks)))
 561                erc-channel-users)
 562       nicks)))
 563
 564 (defun erc-sort-channel-users-by-activity (list)
 565   "Sorts LIST such that users which have spoken most recently are
 566 listed first.  LIST must be of the form (USER . CHANNEL-DATA).
 567
 568 See also: `erc-get-channel-user-list'."
 569   (sort list
 570         (lambda (x y)
 571           (when (and
 572                  (cdr x) (cdr y))
 573             (let ((tx (erc-channel-user-last-message-time (cdr x)))
 574                   (ty (erc-channel-user-last-message-time (cdr y))))
 575               (if tx
 576                   (if ty
 577                       (time-less-p ty tx)
 578                     t)
 579                 nil))))))
 580
 581 (defun erc-sort-channel-users-alphabetically (list)
 582   "Sort LIST so that users' nicknames are in alphabetical order.
 583 LIST must be of the form (USER . CHANNEL-DATA).
 584
 585 See also: `erc-get-channel-user-list'."
 586   (sort list
 587         (lambda (x y)
 588           (when (and
 589                  (cdr x) (cdr y))
 590             (let ((nickx (downcase (erc-server-user-nickname (car x))))
 591                   (nicky (downcase (erc-server-user-nickname (car y)))))
 592               (if nickx
 593                   (if nicky
 594                       (string-lessp nickx nicky)
 595                     t)
 596                 nil))))))
 597
 598 (defvar erc-channel-topic nil
 599   "A topic string for the channel.  Should only be used in channel-buffers.")
 600 (make-variable-buffer-local 'erc-channel-topic)
 601
 602 (defvar erc-channel-modes nil
 603   "List of strings representing channel modes.
 604 E.g. '(\"i\" \"m\" \"s\" \"b Quake!*@*\")
 605 \(not sure the ban list will be here, but why not)")
 606 (make-variable-buffer-local 'erc-channel-modes)
 607
 608 (defvar erc-insert-marker nil
 609   "The place where insertion of new text in erc buffers should happen.")
 610 (make-variable-buffer-local 'erc-insert-marker)
 611
 612 (defvar erc-input-marker nil
 613   "The marker where input should be inserted.")
 614 (make-variable-buffer-local 'erc-input-marker)
 615
 616 (defun erc-string-no-properties (string)
 617   "Return a copy of STRING will all text-properties removed."
 618   (let ((newstring (copy-sequence string)))
 619     (set-text-properties 0 (length newstring) nil newstring)
 620     newstring))
 621
 622 (defcustom erc-prompt "ERC>"
 623   "Prompt used by ERC.  Trailing whitespace is not required."
 624   :group 'erc-display
 625   :type '(choice string function))
 626
 627 (defun erc-prompt ()
 628   "Return the input prompt as a string.
 629
 630 See also the variable `erc-prompt'."
 631   (let ((prompt (if (functionp erc-prompt)
 632                     (funcall erc-prompt)
 633                   erc-prompt)))
 634     (if (> (length prompt) 0)
 635         (concat prompt " ")
 636       prompt)))
 637
 638 (defcustom erc-command-indicator nil
 639   "Indicator used by ERC for showing commands.
 640
 641 If non-nil, this will be used in the ERC buffer to indicate
 642 commands (i.e., input starting with a '/').
 643
 644 If nil, the prompt will be constructed from the variable `erc-prompt'."
 645   :group 'erc-display
 646   :type '(choice (const nil) string function))
 647
 648 (defun erc-command-indicator ()
 649   "Return the command indicator prompt as a string.
 650
 651 This only has any meaning if the variable `erc-command-indicator' is non-nil."
 652   (and erc-command-indicator
 653        (let ((prompt (if (functionp erc-command-indicator)
 654                          (funcall erc-command-indicator)
 655                          erc-command-indicator)))
 656          (if (> (length prompt) 0)
 657              (concat prompt " ")
 658              prompt))))
 659
 660 (defcustom erc-notice-prefix "*** "
 661   "Prefix for all notices."
 662   :group 'erc-display
 663   :type 'string)
 664
 665 (defcustom erc-notice-highlight-type 'all
 666   "Determines how to highlight notices.
 667 See `erc-notice-prefix'.
 668
 669 The following values are allowed:
 670
 671     'prefix - highlight notice prefix only
 672     'all    - highlight the entire notice
 673
 674 Any other value disables notice's highlighting altogether."
 675   :group 'erc-display
 676   :type '(choice (const :tag "highlight notice prefix only" prefix)
 677                  (const :tag "highlight the entire notice" all)
 678                  (const :tag "don't highlight notices at all" nil)))
 679
 680 (defcustom erc-echo-notice-hook nil
 681   "Specifies a list of functions to call to echo a private
 682 notice.  Each function is called with four arguments, the string
 683 to display, the parsed server message, the target buffer (or
 684 nil), and the sender.  The functions are called in order, until a
 685 function evaluates to non-nil.  These hooks are called after
 686 those specified in `erc-echo-notice-always-hook'.
 687
 688 See also: `erc-echo-notice-always-hook',
 689 `erc-echo-notice-in-default-buffer',
 690 `erc-echo-notice-in-target-buffer',
 691 `erc-echo-notice-in-minibuffer',
 692 `erc-echo-notice-in-server-buffer',
 693 `erc-echo-notice-in-active-non-server-buffer',
 694 `erc-echo-notice-in-active-buffer',
 695 `erc-echo-notice-in-user-buffers',
 696 `erc-echo-notice-in-user-and-target-buffers',
 697 `erc-echo-notice-in-first-user-buffer'"
 698   :group 'erc-hooks
 699   :type 'hook
 700   :options '(erc-echo-notice-in-default-buffer
 701              erc-echo-notice-in-target-buffer
 702              erc-echo-notice-in-minibuffer
 703              erc-echo-notice-in-server-buffer
 704              erc-echo-notice-in-active-non-server-buffer
 705              erc-echo-notice-in-active-buffer
 706              erc-echo-notice-in-user-buffers
 707              erc-echo-notice-in-user-and-target-buffers
 708              erc-echo-notice-in-first-user-buffer))
 709
 710 (defcustom erc-echo-notice-always-hook
 711   '(erc-echo-notice-in-default-buffer)
 712   "Specifies a list of functions to call to echo a private
 713 notice.  Each function is called with four arguments, the string
 714 to display, the parsed server message, the target buffer (or
 715 nil), and the sender.  The functions are called in order, and all
 716 functions are called.  These hooks are called before those
 717 specified in `erc-echo-notice-hook'.
 718
 719 See also: `erc-echo-notice-hook',
 720 `erc-echo-notice-in-default-buffer',
 721 `erc-echo-notice-in-target-buffer',
 722 `erc-echo-notice-in-minibuffer',
 723 `erc-echo-notice-in-server-buffer',
 724 `erc-echo-notice-in-active-non-server-buffer',
 725 `erc-echo-notice-in-active-buffer',
 726 `erc-echo-notice-in-user-buffers',
 727 `erc-echo-notice-in-user-and-target-buffers',
 728 `erc-echo-notice-in-first-user-buffer'"
 729   :group 'erc-hooks
 730   :type 'hook
 731   :options '(erc-echo-notice-in-default-buffer
 732              erc-echo-notice-in-target-buffer
 733              erc-echo-notice-in-minibuffer
 734              erc-echo-notice-in-server-buffer
 735              erc-echo-notice-in-active-non-server-buffer
 736              erc-echo-notice-in-active-buffer
 737              erc-echo-notice-in-user-buffers
 738              erc-echo-notice-in-user-and-target-buffers
 739              erc-echo-notice-in-first-user-buffer))
 740
 741 ;; other tunable parameters
 742
 743 (defcustom erc-whowas-on-nosuchnick nil
 744   "If non-nil, do a whowas on a nick if no such nick."
 745   :group 'erc
 746   :type 'boolean)
 747
 748 (defcustom erc-verbose-server-ping nil
 749   "If non-nil, show every time you get a PING or PONG from the server."
 750   :group 'erc-paranoia
 751   :type 'boolean)
 752
 753 (defcustom erc-public-away-p nil
 754   "Let others know you are back when you are no longer marked away.
 755 This happens in this form:
 756 * <nick> is back (gone for <time>)
 757
 758 Many consider it impolite to do so automatically."
 759   :group 'erc
 760   :type 'boolean)
 761
 762 (defcustom erc-away-nickname nil
 763   "The nickname to take when you are marked as being away."
 764   :group 'erc
 765   :type '(choice (const nil)
 766                  string))
 767
 768 (defcustom erc-paranoid nil
 769   "If non-nil, then all incoming CTCP requests will be shown."
 770   :group 'erc-paranoia
 771   :type 'boolean)
 772
 773 (defcustom erc-disable-ctcp-replies nil
 774   "Disable replies to CTCP requests that require a reply.
 775 If non-nil, then all incoming CTCP requests that normally require
 776 an automatic reply (like VERSION or PING) will be ignored.  Good to
 777 set if some hacker is trying to flood you away."
 778   :group 'erc-paranoia
 779   :type 'boolean)
 780
 781 (defcustom erc-anonymous-login t
 782   "Be paranoid, don't give away your machine name."
 783   :group 'erc-paranoia
 784   :type 'boolean)
 785
 786 (defcustom erc-prompt-for-channel-key nil
 787   "Prompt for channel key when using `erc-join-channel' interactively."
 788   :group 'erc
 789   :type 'boolean)
 790
 791 (defcustom erc-email-userid "user"
 792   "Use this as your email user ID."
 793   :group 'erc
 794   :type 'string)
 795
 796 (defcustom erc-system-name nil
 797   "Use this as the name of your system.
 798 If nil, ERC will call `system-name' to get this information."
 799   :group 'erc
 800   :type '(choice (const :tag "Default system name" nil)
 801                  string))
 802
 803 (defcustom erc-ignore-list nil
 804   "List of regexps matching user identifiers to ignore.
 805
 806 A user identifier has the form \"nick!login@host\".  If an
 807 identifier matches, the message from the person will not be
 808 processed."
 809   :group 'erc-ignore
 810   :type '(repeat regexp))
 811 (make-variable-buffer-local 'erc-ignore-list)
 812
 813 (defcustom erc-ignore-reply-list nil
 814   "List of regexps matching user identifiers to ignore completely.
 815
 816 This differs from `erc-ignore-list' in that it also ignores any
 817 messages directed at the user.
 818
 819 A user identifier has the form \"nick!login@host\".
 820
 821 If an identifier matches, or a message is addressed to a nick
 822 whose identifier matches, the message will not be processed.
 823
 824 CAVEAT: ERC doesn't know about the user and host of anyone who
 825 was already in the channel when you joined, but never said
 826 anything, so it won't be able to match the user and host of those
 827 people.  You can update the ERC internal info using /WHO *."
 828   :group 'erc-ignore
 829   :type '(repeat regexp))
 830
 831 (defvar erc-flood-protect t
 832   "If non-nil, flood protection is enabled.
 833 Flooding is sending too much information to the server in too
 834 short of an interval, which may cause the server to terminate the
 835 connection.
 836
 837 See `erc-server-flood-margin' for other flood-related parameters.")
 838
 839 ;; Script parameters
 840
 841 (defcustom erc-startup-file-list
 842   (list (concat erc-user-emacs-directory ".ercrc.el")
 843         (concat erc-user-emacs-directory ".ercrc")
 844         "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc")
 845   "List of files to try for a startup script.
 846 The first existent and readable one will get executed.
 847
 848 If the filename ends with `.el' it is presumed to be an Emacs Lisp
 849 script and it gets (load)ed.  Otherwise it is treated as a bunch of
 850 regular IRC commands."
 851   :group 'erc-scripts
 852   :type '(repeat file))
 853
 854 (defcustom erc-script-path nil
 855   "List of directories to look for a script in /load command.
 856 The script is first searched in the current directory, then in each
 857 directory in the list."
 858   :group 'erc-scripts
 859   :type '(repeat directory))
 860
 861 (defcustom erc-script-echo t
 862   "If non-nil, echo the IRC script commands locally."
 863   :group 'erc-scripts
 864   :type 'boolean)
 865
 866 (defvar erc-last-saved-position nil
 867   "A marker containing the position the current buffer was last saved at.")
 868 (make-variable-buffer-local 'erc-last-saved-position)
 869
 870 (defcustom erc-kill-buffer-on-part nil
 871   "Kill the channel buffer on PART.
 872 This variable should probably stay nil, as ERC can reuse buffers if
 873 you rejoin them later."
 874   :group 'erc-quit-and-part
 875   :type 'boolean)
 876
 877 (defcustom erc-kill-queries-on-quit nil
 878   "Kill all query (also channel) buffers of this server on QUIT.
 879 See the variable `erc-kill-buffer-on-part' for details."
 880   :group 'erc-quit-and-part
 881   :type 'boolean)
 882
 883 (defcustom erc-kill-server-buffer-on-quit nil
 884   "Kill the server buffer of the process on QUIT."
 885   :group 'erc-quit-and-part
 886   :type 'boolean)
 887
 888 (defcustom erc-quit-reason-various-alist nil
 889   "Alist of possible arguments to the /quit command.
 890
 891 Each element has the form:
 892   (REGEXP RESULT)
 893
 894 If REGEXP matches the argument to /quit, then its relevant RESULT
 895 will be used.  RESULT may be either a string, or a function.  If
 896 a function, it should return the quit message as a string.
 897
 898 If no elements match, then the empty string is used.
 899
 900 As an example:
 901   (setq erc-quit-reason-various-alist
 902       '((\"zippy\" erc-quit-reason-zippy)
 903         (\"xmms\" dme:now-playing)
 904         (\"version\" erc-quit-reason-normal)
 905         (\"home\" \"Gone home !\")
 906         (\"^$\" \"Default Reason\")))
 907 If the user types \"/quit zippy\", then a Zippy the Pinhead quotation
 908 will be used as the quit message."
 909   :group 'erc-quit-and-part
 910   :type '(repeat (list regexp (choice (string) (function)))))
 911
 912 (defcustom erc-part-reason-various-alist nil
 913   "Alist of possible arguments to the /part command.
 914
 915 Each element has the form:
 916   (REGEXP RESULT)
 917
 918 If REGEXP matches the argument to /part, then its relevant RESULT
 919 will be used.  RESULT may be either a string, or a function.  If
 920 a function, it should return the part message as a string.
 921
 922 If no elements match, then the empty string is used.
 923
 924 As an example:
 925   (setq erc-part-reason-various-alist
 926       '((\"zippy\" erc-part-reason-zippy)
 927         (\"xmms\" dme:now-playing)
 928         (\"version\" erc-part-reason-normal)
 929         (\"home\" \"Gone home !\")
 930         (\"^$\" \"Default Reason\")))
 931 If the user types \"/part zippy\", then a Zippy the Pinhead quotation
 932 will be used as the part message."
 933   :group 'erc-quit-and-part
 934   :type '(repeat (list regexp (choice (string) (function)))))
 935
 936 (defcustom erc-quit-reason 'erc-quit-reason-normal
 937   "A function which returns the reason for quitting.
 938
 939 The function is passed a single argument, the string typed by the
 940 user after \"/quit\"."
 941   :group 'erc-quit-and-part
 942   :type '(choice (const erc-quit-reason-normal)
 943                  (const erc-quit-reason-zippy)
 944                  (const erc-quit-reason-various)
 945                  (symbol)))
 946
 947 (defcustom erc-part-reason 'erc-part-reason-normal
 948   "A function which returns the reason for parting a channel.
 949
 950 The function is passed a single argument, the string typed by the
 951 user after \"/PART\"."
 952   :group 'erc-quit-and-part
 953   :type '(choice (const erc-part-reason-normal)
 954                  (const erc-part-reason-zippy)
 955                  (const erc-part-reason-various)
 956                  (symbol)))
 957
 958 (defvar erc-grab-buffer-name "*erc-grab*"
 959   "The name of the buffer created by `erc-grab-region'.")
 960
 961 ;; variables available for IRC scripts
 962
 963 (defvar erc-user-information "ERC User"
 964   "USER_INFORMATION IRC variable.")
 965
 966 ;; Hooks
 967
 968 (defgroup erc-hooks nil
 969   "Hook variables for fancy customizations of ERC."
 970   :group 'erc)
 971
 972 (defcustom erc-mode-hook nil
 973   "Hook run after `erc-mode' setup is finished."
 974   :group 'erc-hooks
 975   :type 'hook
 976   :options '(erc-add-scroll-to-bottom))
 977
 978 (defcustom erc-timer-hook nil
 979   "Put functions which should get called more or less periodically here.
 980 The idea is that servers always play ping pong with the client, and so there
 981 is no need for any idle-timer games with Emacs."
 982   :group 'erc-hooks
 983   :type 'hook)
 984
 985 (defcustom erc-insert-pre-hook nil
 986   "Hook called first when some text is inserted through `erc-display-line'.
 987 It gets called with one argument, STRING.
 988 To be able to modify the inserted text, use `erc-insert-modify-hook' instead.
 989 Filtering functions can set `erc-insert-this' to nil to avoid
 990 display of that particular string at all."
 991   :group 'erc-hooks
 992   :type 'hook)
 993
 994 (defcustom erc-send-pre-hook nil
 995   "Hook called first when some text is sent through `erc-send-current-line'.
 996 It gets called with one argument, STRING.
 997
 998 To change the text that will be sent, set the variable STR which is
 999 used in `erc-send-current-line'.
1000
1001 To change the text inserted into the buffer without changing the text
1002 that will be sent, use `erc-send-modify-hook' instead.
1003
1004 Filtering functions can set `erc-send-this' to nil to avoid sending of
1005 that particular string at all and `erc-insert-this' to prevent
1006 inserting that particular string into the buffer.
1007
1008 Note that it's useless to set `erc-send-this' to nil and
1009 `erc-insert-this' to t.  ERC is sane enough to not insert the text
1010 anyway."
1011   :group 'erc-hooks
1012   :type 'hook)
1013
1014 (defvar erc-insert-this t
1015   "Insert the text into the target buffer or not.
1016 Functions on `erc-insert-pre-hook' can set this variable to nil
1017 if they wish to avoid insertion of a particular string.")
1018
1019 (defvar erc-send-this t
1020   "Send the text to the target or not.
1021 Functions on `erc-send-pre-hook' can set this variable to nil
1022 if they wish to avoid sending of a particular string.")
1023
1024 (defcustom erc-insert-modify-hook ()
1025   "Insertion hook for functions that will change the text's appearance.
1026 This hook is called just after `erc-insert-pre-hook' when the value
1027 of `erc-insert-this' is t.
1028 While this hook is run, narrowing is in effect and `current-buffer' is
1029 the buffer where the text got inserted.  One possible value to add here
1030 is `erc-fill'."
1031   :group 'erc-hooks
1032   :type 'hook)
1033
1034 (defcustom erc-insert-post-hook nil
1035   "This hook is called just after `erc-insert-modify-hook'.
1036 At this point, all modifications from prior hook functions are done."
1037   :group 'erc-hooks
1038   :type 'hook
1039   :options '(erc-truncate-buffer
1040              erc-make-read-only
1041              erc-save-buffer-in-logs))
1042
1043 (defcustom erc-send-modify-hook nil
1044   "Sending hook for functions that will change the text's appearance.
1045 This hook is called just after `erc-send-pre-hook' when the values
1046 of `erc-send-this' and `erc-insert-this' are both t.
1047 While this hook is run, narrowing is in effect and `current-buffer' is
1048 the buffer where the text got inserted.
1049
1050 Note that no function in this hook can change the appearance of the
1051 text that is sent.  Only changing the sent text's appearance on the
1052 sending user's screen is possible.  One possible value to add here
1053 is `erc-fill'."
1054   :group 'erc-hooks
1055   :type 'hook)
1056
1057 (defcustom erc-send-post-hook nil
1058   "This hook is called just after `erc-send-modify-hook'.
1059 At this point, all modifications from prior hook functions are done.
1060 NOTE: The functions on this hook are called _before_ sending a command
1061 to the server.
1062
1063 This function is called with narrowing, ala `erc-send-modify-hook'."
1064   :group 'erc-hooks
1065   :type 'hook
1066   :options '(erc-make-read-only))
1067
1068 (defcustom erc-send-completed-hook
1069   (when (featurep 'emacspeak)
1070     (list (byte-compile
1071            (lambda (str)
1072              (emacspeak-auditory-icon 'select-object)))))
1073   "Hook called after a message has been parsed by ERC.
1074
1075 The single argument to the functions is the unmodified string
1076 which the local user typed."
1077   :group 'erc-hooks
1078   :type 'hook)
1079 ;; mode-specific tables
1080
1081 (defvar erc-mode-syntax-table
1082   (let ((syntax-table (make-syntax-table)))
1083     (modify-syntax-entry ?\" ".   " syntax-table)
1084     (modify-syntax-entry ?\\ ".   " syntax-table)
1085     (modify-syntax-entry ?' "w   " syntax-table)
1086     ;; Make dabbrev-expand useful for nick names
1087     (modify-syntax-entry ?< "." syntax-table)
1088     (modify-syntax-entry ?> "." syntax-table)
1089     syntax-table)
1090   "Syntax table used while in ERC mode.")
1091
1092 (defvar erc-mode-abbrev-table nil
1093   "Abbrev table used while in ERC mode.")
1094 (define-abbrev-table 'erc-mode-abbrev-table ())
1095
1096 (defvar erc-mode-map
1097   (let ((map (make-sparse-keymap)))
1098     (define-key map "\C-m" 'erc-send-current-line)
1099     (define-key map "\C-a" 'erc-bol)
1100     (define-key map [home] 'erc-bol)
1101     (define-key map "\C-c\C-a" 'erc-bol)
1102     (define-key map "\C-c\C-b" 'erc-iswitchb)
1103     (define-key map "\C-c\C-c" 'erc-toggle-interpret-controls)
1104     (define-key map "\C-c\C-d" 'erc-input-action)
1105     (define-key map "\C-c\C-e" 'erc-toggle-ctcp-autoresponse)
1106     (define-key map "\C-c\C-f" 'erc-toggle-flood-control)
1107     (define-key map "\C-c\C-i" 'erc-invite-only-mode)
1108     (define-key map "\C-c\C-j" 'erc-join-channel)
1109     (define-key map "\C-c\C-n" 'erc-channel-names)
1110     (define-key map "\C-c\C-o" 'erc-get-channel-mode-from-keypress)
1111     (define-key map "\C-c\C-p" 'erc-part-from-channel)
1112     (define-key map "\C-c\C-q" 'erc-quit-server)
1113     (define-key map "\C-c\C-r" 'erc-remove-text-properties-region)
1114     (define-key map "\C-c\C-t" 'erc-set-topic)
1115     (define-key map "\C-c\C-u" 'erc-kill-input)
1116     (define-key map "\C-c\C-x" 'erc-quit-server)
1117     (define-key map "\M-\t" 'ispell-complete-word)
1118     (define-key map "\t" 'completion-at-point)
1119
1120     ;; Suppress `font-lock-fontify-block' key binding since it
1121     ;; destroys face properties.
1122     (if (fboundp 'command-remapping)
1123         (define-key map [remap font-lock-fontify-block] 'undefined)
1124       (substitute-key-definition
1125        'font-lock-fontify-block 'undefined map global-map))
1126
1127     map)
1128   "ERC keymap.")
1129
1130 ;; Faces
1131
1132 ; Honestly, I have a horrible sense of color and the "defaults" below
1133 ; are supposed to be really bad. But colors ARE required in IRC to
1134 ; convey different parts of conversation. If you think you know better
1135 ; defaults - send them to me.
1136
1137 ;; Now colors are a bit nicer, at least to my eyes.
1138 ;; You may still want to change them to better fit your background.-- S.B.
1139
1140 (defgroup erc-faces nil
1141   "Faces for ERC."
1142   :group 'erc)
1143
1144 (defface erc-default-face '((t))
1145   "ERC default face."
1146   :group 'erc-faces)
1147
1148 (defface erc-direct-msg-face '((t :foreground "IndianRed"))
1149   "ERC face used for messages you receive in the main erc buffer."
1150   :group 'erc-faces)
1151
1152 (defface erc-header-line
1153   '((t :foreground "grey20" :background "grey90"))
1154   "ERC face used for the header line.
1155
1156 This will only be used if `erc-header-line-face-method' is non-nil."
1157   :group 'erc-faces)
1158
1159 (defface erc-input-face '((t :foreground "brown"))
1160   "ERC face used for your input."
1161   :group 'erc-faces)
1162
1163 (defface erc-prompt-face
1164   '((t :weight bold :foreground "Black" :background "lightBlue2"))
1165   "ERC face for the prompt."
1166   :group 'erc-faces)
1167
1168 (defface erc-command-indicator-face
1169   '((t :weight bold))
1170   "ERC face for the command indicator.
1171 See the variable `erc-command-indicator'."
1172   :group 'erc-faces)
1173
1174 (defface erc-notice-face
1175   '((default :weight bold)
1176     (((class color) (min-colors 88)) :foreground "SlateBlue")
1177     (t :foreground "blue"))
1178   "ERC face for notices."
1179   :group 'erc-faces)
1180
1181 (defface erc-action-face '((t :weight bold))
1182   "ERC face for actions generated by /ME."
1183   :group 'erc-faces)
1184
1185 (defface erc-error-face '((t :foreground "red"))
1186   "ERC face for errors."
1187   :group 'erc-faces)
1188
1189 ;; same default color as `erc-input-face'
1190 (defface erc-my-nick-face '((t :weight bold :foreground "brown"))
1191   "ERC face for your current nickname in messages sent by you.
1192 See also `erc-show-my-nick'."
1193   :group 'erc-faces)
1194
1195 (defface erc-nick-default-face '((t :weight bold))
1196   "ERC nickname default face."
1197   :group 'erc-faces)
1198
1199 (defface erc-nick-msg-face '((t :weight bold :foreground "IndianRed"))
1200   "ERC nickname face for private messages."
1201   :group 'erc-faces)
1202
1203 ;; Debugging support
1204
1205 (defvar erc-log-p nil
1206   "When set to t, generate debug messages in a separate debug buffer.")
1207
1208 (defvar erc-debug-log-file (expand-file-name "ERC.debug")
1209   "Debug log file name.")
1210
1211 (defvar erc-dbuf nil)
1212 (make-variable-buffer-local 'erc-dbuf)
1213
1214 (defmacro define-erc-module (name alias doc enable-body disable-body
1215                              &optional local-p)
1216   "Define a new minor mode using ERC conventions.
1217 Symbol NAME is the name of the module.
1218 Symbol ALIAS is the alias to use, or nil.
1219 DOC is the documentation string to use for the minor mode.
1220 ENABLE-BODY is a list of expressions used to enable the mode.
1221 DISABLE-BODY is a list of expressions used to disable the mode.
1222 If LOCAL-P is non-nil, the mode will be created as a buffer-local
1223 mode, rather than a global one.
1224
1225 This will define a minor mode called erc-NAME-mode, possibly
1226 an alias erc-ALIAS-mode, as well as the helper functions
1227 erc-NAME-enable, and erc-NAME-disable.
1228
1229 Example:
1230
1231   ;;;###autoload (autoload 'erc-replace-mode \"erc-replace\")
1232   (define-erc-module replace nil
1233     \"This mode replaces incoming text according to `erc-replace-alist'.\"
1234     ((add-hook 'erc-insert-modify-hook
1235                'erc-replace-insert))
1236     ((remove-hook 'erc-insert-modify-hook
1237                   'erc-replace-insert)))"
1238   (let* ((sn (symbol-name name))
1239          (mode (intern (format "erc-%s-mode" (downcase sn))))
1240          (group (intern (format "erc-%s" (downcase sn))))
1241          (enable (intern (format "erc-%s-enable" (downcase sn))))
1242          (disable (intern (format "erc-%s-disable" (downcase sn)))))
1243     `(progn
1244        (erc-define-minor-mode
1245         ,mode
1246         ,(format "Toggle ERC %S mode.
1247 With a prefix argument ARG, enable %s if ARG is positive,
1248 and disable it otherwise.  If called from Lisp, enable the mode
1249 if ARG is omitted or nil.
1250 %s" name name doc)
1251         nil nil nil
1252         :global ,(not local-p) :group (quote ,group)
1253         (if ,mode
1254             (,enable)
1255           (,disable)))
1256        (defun ,enable ()
1257          ,(format "Enable ERC %S mode."
1258                   name)
1259          (interactive)
1260          (add-to-list 'erc-modules (quote ,name))
1261          (setq ,mode t)
1262          ,@enable-body)
1263        (defun ,disable ()
1264          ,(format "Disable ERC %S mode."
1265                   name)
1266          (interactive)
1267          (setq erc-modules (delq (quote ,name) erc-modules))
1268          (setq ,mode nil)
1269          ,@disable-body)
1270        ,(when (and alias (not (eq name alias)))
1271           `(defalias
1272              (quote
1273               ,(intern
1274                 (format "erc-%s-mode"
1275                         (downcase (symbol-name alias)))))
1276              (quote
1277               ,mode)))
1278        ;; For find-function and find-variable.
1279        (put ',mode    'definition-name ',name)
1280        (put ',enable  'definition-name ',name)
1281        (put ',disable 'definition-name ',name))))
1282
1283 (put 'define-erc-module 'doc-string-elt 3)
1284
1285 (defun erc-once-with-server-event (event &rest forms)
1286   "Execute FORMS the next time EVENT occurs in the `current-buffer'.
1287
1288 You should make sure that `current-buffer' is a server buffer.
1289
1290 This function temporarily adds a function to EVENT's hook to
1291 execute FORMS.  After FORMS are run, the function is removed from
1292 EVENT's hook.  The last expression of FORMS should be either nil
1293 or t, where nil indicates that the other functions on EVENT's hook
1294 should be run too, and t indicates that other functions should
1295 not be run.
1296
1297 Please be sure to use this function in server-buffers.  In
1298 channel-buffers it may not work at all, as it uses the LOCAL
1299 argument of `add-hook' and `remove-hook' to ensure multiserver
1300 capabilities."
1301   (unless (erc-server-buffer-p)
1302     (error
1303      "You should only run `erc-once-with-server-event' in a server buffer"))
1304   (let ((fun (make-symbol "fun"))
1305         (hook (erc-get-hook event)))
1306      (put fun 'erc-original-buffer (current-buffer))
1307      (fset fun `(lambda (proc parsed)
1308                   (with-current-buffer (get ',fun 'erc-original-buffer)
1309                     (remove-hook ',hook ',fun t))
1310                   (fmakunbound ',fun)
1311                   ,@forms))
1312      (add-hook hook fun nil t)
1313      fun))
1314
1315 (defun erc-once-with-server-event-global (event &rest forms)
1316   "Execute FORMS the next time EVENT occurs in any server buffer.
1317
1318 This function temporarily prepends a function to EVENT's hook to
1319 execute FORMS.  After FORMS are run, the function is removed from
1320 EVENT's hook.  The last expression of FORMS should be either nil
1321 or t, where nil indicates that the other functions on EVENT's hook
1322 should be run too, and t indicates that other functions should
1323 not be run.
1324
1325 When FORMS execute, the current buffer is the server buffer associated with the
1326 connection over which the data was received that triggered EVENT."
1327   (let ((fun (make-symbol "fun"))
1328         (hook (erc-get-hook event)))
1329      (fset fun `(lambda (proc parsed)
1330                   (remove-hook ',hook ',fun)
1331                   (fmakunbound ',fun)
1332                   ,@forms))
1333      (add-hook hook fun nil nil)
1334      fun))
1335
1336 (defmacro erc-log (string)
1337   "Logs STRING if logging is on (see `erc-log-p')."
1338   `(when erc-log-p
1339      (erc-log-aux ,string)))
1340
1341 (defun erc-server-buffer ()
1342   "Return the server buffer for the current buffer's process.
1343 The buffer-local variable `erc-server-process' is used to find
1344 the process buffer."
1345   (and (erc-server-buffer-live-p)
1346        (process-buffer erc-server-process)))
1347
1348 (defun erc-server-buffer-live-p ()
1349   "Return t if the server buffer has not been killed."
1350   (and (processp erc-server-process)
1351        (buffer-live-p (process-buffer erc-server-process))))
1352
1353 (defun erc-server-buffer-p (&optional buffer)
1354   "Return non-nil if argument BUFFER is an ERC server buffer.
1355
1356 If BUFFER is nil, the current buffer is used."
1357   (with-current-buffer (or buffer (current-buffer))
1358     (and (eq major-mode 'erc-mode)
1359          (null (erc-default-target)))))
1360
1361 (defun erc-open-server-buffer-p (&optional buffer)
1362   "Return non-nil if argument BUFFER is an ERC server buffer that
1363 has an open IRC process.
1364
1365 If BUFFER is nil, the current buffer is used."
1366   (and (erc-server-buffer-p)
1367        (erc-server-process-alive)))
1368
1369 (defun erc-query-buffer-p (&optional buffer)
1370   "Return non-nil if BUFFER is an ERC query buffer.
1371 If BUFFER is nil, the current buffer is used."
1372   (with-current-buffer (or buffer (current-buffer))
1373     (let ((target (erc-default-target)))
1374       (and (eq major-mode 'erc-mode)
1375            target
1376            (not (memq (aref target 0) '(?# ?& ?+ ?!)))))))
1377
1378 (defun erc-ison-p (nick)
1379   "Return non-nil if NICK is online."
1380   (interactive "sNick: ")
1381   (erc-with-server-buffer
1382     (let ((erc-online-p 'unknown))
1383       (erc-once-with-server-event
1384        303
1385        `(let ((ison (split-string (aref parsed 3))))
1386           (setq erc-online-p (car (erc-member-ignore-case ,nick ison)))
1387           t))
1388       (erc-server-send (format "ISON %s" nick))
1389       (while (eq erc-online-p 'unknown) (accept-process-output))
1390       (if (interactive-p)
1391           (message "%s is %sonline"
1392                    (or erc-online-p nick)
1393                    (if erc-online-p "" "not "))
1394         erc-online-p))))
1395
1396 (defun erc-log-aux (string)
1397   "Do the debug logging of STRING."
1398   (let ((cb (current-buffer))
1399         (point 1)
1400         (was-eob nil)
1401         (session-buffer (erc-server-buffer)))
1402     (if session-buffer
1403         (progn
1404           (set-buffer session-buffer)
1405           (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf)))
1406               (progn
1407                 (setq erc-dbuf (get-buffer-create
1408                                 (concat "*ERC-DEBUG: "
1409                                         erc-session-server "*")))))
1410           (set-buffer erc-dbuf)
1411           (setq point (point))
1412           (setq was-eob (eobp))
1413           (goto-char (point-max))
1414           (insert (concat "** " string "\n"))
1415           (if was-eob (goto-char (point-max))
1416             (goto-char point))
1417           (set-buffer cb))
1418       (message "ERC: ** %s" string))))
1419
1420 ;; Last active buffer, to print server messages in the right place
1421
1422 (defvar erc-active-buffer nil
1423   "The current active buffer, the one where the user typed the last command.
1424 Defaults to the server buffer, and should only be set in the
1425 server buffer.")
1426 (make-variable-buffer-local 'erc-active-buffer)
1427
1428 (defun erc-active-buffer ()
1429   "Return the value of `erc-active-buffer' for the current server.
1430 Defaults to the server buffer."
1431   (erc-with-server-buffer
1432     (if (buffer-live-p erc-active-buffer)
1433         erc-active-buffer
1434       (setq erc-active-buffer (current-buffer)))))
1435
1436 (defun erc-set-active-buffer (buffer)
1437   "Set the value of `erc-active-buffer' to BUFFER."
1438   (cond ((erc-server-buffer)
1439          (with-current-buffer (erc-server-buffer)
1440            (setq erc-active-buffer buffer)))
1441         (t (setq erc-active-buffer buffer))))
1442
1443 ;; Mode activation routines
1444
1445 (define-derived-mode erc-mode fundamental-mode "ERC"
1446   "Major mode for Emacs IRC."
1447   (setq local-abbrev-table erc-mode-abbrev-table)
1448   (when (boundp 'next-line-add-newlines)
1449     (set (make-local-variable 'next-line-add-newlines) nil))
1450   (setq line-move-ignore-invisible t)
1451   (set (make-local-variable 'paragraph-separate)
1452        (concat "\C-l\\|\\(^" (regexp-quote (erc-prompt)) "\\)"))
1453   (set (make-local-variable 'paragraph-start)
1454        (concat "\\(" (regexp-quote (erc-prompt)) "\\)"))
1455   (add-hook 'completion-at-point-functions 'erc-complete-word-at-point nil t))
1456
1457 ;; activation
1458
1459 (defconst erc-default-server "irc.freenode.net"
1460   "IRC server to use if it cannot be detected otherwise.")
1461
1462 (defconst erc-default-port 6667
1463   "IRC port to use if it cannot be detected otherwise.")
1464
1465 (defcustom erc-join-buffer 'buffer
1466   "Determines how to display a newly created IRC buffer.
1467
1468 The available choices are:
1469
1470   'window          - in another window,
1471   'window-noselect - in another window, but don't select that one,
1472   'frame           - in another frame,
1473   'bury            - bury it in a new buffer,
1474   'buffer          - in place of the current buffer,
1475   any other value  - in place of the current buffer."
1476   :group 'erc-buffers
1477   :type '(choice (const :tag "Split window and select" window)
1478                  (const :tag "Split window, don't select" window-noselect)
1479                  (const :tag "New frame" frame)
1480                  (const :tag "Bury in new buffer" bury)
1481                  (const :tag "Use current buffer" buffer)
1482                  (const :tag "Use current buffer" t)))
1483
1484 (defcustom erc-frame-alist nil
1485   "Alist of frame parameters for creating erc frames.
1486 A value of nil means to use `default-frame-alist'."
1487   :group 'erc-buffers
1488   :type '(repeat (cons :format "%v"
1489                        (symbol :tag "Parameter")
1490                        (sexp :tag "Value"))))
1491
1492 (defcustom erc-frame-dedicated-flag nil
1493   "Non-nil means the erc frames are dedicated to that buffer.
1494 This only has effect when `erc-join-buffer' is set to `frame'."
1495   :group 'erc-buffers
1496   :type 'boolean)
1497
1498 (defcustom erc-reuse-frames t
1499   "Determines whether new frames are always created.
1500 Non-nil means that a new frame is not created to display an ERC
1501 buffer if there is already a window displaying it.  This only has
1502 effect when `erc-join-buffer' is set to `frame'."
1503   :group 'erc-buffers
1504   :type 'boolean)
1505
1506 (defun erc-channel-p (channel)
1507   "Return non-nil if CHANNEL seems to be an IRC channel name."
1508   (cond ((stringp channel)
1509          (memq (aref channel 0) '(?# ?& ?+ ?!)))
1510         ((and (bufferp channel) (buffer-live-p channel))
1511          (with-current-buffer channel
1512            (erc-channel-p (erc-default-target))))
1513         (t nil)))
1514
1515 (defcustom erc-reuse-buffers t
1516   "If nil, create new buffers on joining a channel/query.
1517 If non-nil, a new buffer will only be created when you join
1518 channels with same names on different servers, or have query buffers
1519 open with nicks of the same name on different servers.  Otherwise,
1520 the existing buffers will be reused."
1521   :group 'erc-buffers
1522   :type 'boolean)
1523
1524 (defun erc-normalize-port (port)
1525   "Normalize the port specification PORT to integer form.
1526 PORT may be an integer, a string or a symbol.  If it is a string or a
1527 symbol, it may have these values:
1528 * irc         -> 194
1529 * ircs        -> 994
1530 * ircd        -> 6667
1531 * ircd-dalnet -> 7000"
1532   (cond
1533    ((symbolp port)
1534     (erc-normalize-port (symbol-name port)))
1535    ((stringp port)
1536     (let ((port-nr (string-to-number port)))
1537       (cond
1538        ((> port-nr 0)
1539         port-nr)
1540        ((string-equal port "irc")
1541         194)
1542        ((string-equal port "ircs")
1543         994)
1544        ((string-equal port "ircd")
1545         6667)
1546        ((string-equal port "ircd-dalnet")
1547         7000)
1548        (t
1549         nil))))
1550    ((numberp port)
1551     port)
1552    (t
1553     nil)))
1554
1555 (defun erc-port-equal (a b)
1556   "Check whether ports A and B are equal."
1557   (= (erc-normalize-port a) (erc-normalize-port b)))
1558
1559 (defun erc-generate-new-buffer-name (server port target &optional proc)
1560   "Create a new buffer name based on the arguments."
1561   (when (numberp port) (setq port (number-to-string port)))
1562   (let ((buf-name (or target
1563                       (or (let ((name (concat server ":" port)))
1564                             (when (> (length name) 1)
1565                               name))
1566                           ;; This fallback should in fact never happen
1567                           "*erc-server-buffer*")))
1568         buffer-name)
1569     ;; Reuse existing buffers, but not if the buffer is a connected server
1570     ;; buffer and not if its associated with a different server than the
1571     ;; current ERC buffer.
1572     ;; if buf-name is taken by a different connection (or by something !erc)
1573     ;; then see if "buf-name/server" meets the same criteria
1574     (dolist (candidate (list buf-name (concat buf-name "/" server)))
1575       (if (and (not buffer-name)
1576                erc-reuse-buffers
1577                (get-buffer candidate)
1578                (or target
1579                    (with-current-buffer (get-buffer candidate)
1580                      (and (erc-server-buffer-p)
1581                           (not (erc-server-process-alive)))))
1582                (with-current-buffer (get-buffer candidate)
1583                  (and (string= erc-session-server server)
1584                       (erc-port-equal erc-session-port port))))
1585           (setq buffer-name candidate)))
1586     ;; if buffer-name is unset, neither candidate worked out for us,
1587     ;; fallback to the old <N> uniquification method:
1588     (or buffer-name (generate-new-buffer-name buf-name)) ))
1589
1590 (defun erc-get-buffer-create (server port target &optional proc)
1591   "Create a new buffer based on the arguments."
1592   (get-buffer-create (erc-generate-new-buffer-name server port target proc)))
1593
1594
1595 (defun erc-member-ignore-case (string list)
1596   "Return non-nil if STRING is a member of LIST.
1597
1598 All strings are compared according to IRC protocol case rules, see
1599 `erc-downcase'."
1600   (setq string (erc-downcase string))
1601   (catch 'result
1602     (while list
1603       (if (string= string (erc-downcase (car list)))
1604           (throw 'result list)
1605         (setq list (cdr list))))))
1606
1607 (defmacro erc-with-buffer (spec &rest body)
1608   "Execute BODY in the buffer associated with SPEC.
1609
1610 SPEC should have the form
1611
1612  (TARGET [PROCESS])
1613
1614 If TARGET is a buffer, use it.  Otherwise, use the buffer
1615 matching TARGET in the process specified by PROCESS.
1616
1617 If PROCESS is nil, use the current `erc-server-process'.
1618 See `erc-get-buffer' for details.
1619
1620 See also `with-current-buffer'.
1621
1622 \(fn (TARGET [PROCESS]) BODY...)"
1623   (let ((buf (make-symbol "buf"))
1624         (proc (make-symbol "proc"))
1625         (target (make-symbol "target"))
1626         (process (make-symbol "process")))
1627     `(let* ((,target ,(car spec))
1628             (,process ,(cadr spec))
1629             (,buf (if (bufferp ,target)
1630                       ,target
1631                     (let ((,proc (or ,process
1632                                      (and (processp erc-server-process)
1633                                           erc-server-process))))
1634                       (if (and ,target ,proc)
1635                           (erc-get-buffer ,target ,proc))))))
1636        (when (buffer-live-p ,buf)
1637          (with-current-buffer ,buf
1638            ,@body)))))
1639 (put 'erc-with-buffer 'lisp-indent-function 1)
1640 (put 'erc-with-buffer 'edebug-form-spec '((form &optional form) body))
1641
1642 (defun erc-get-buffer (target &optional proc)
1643   "Return the buffer matching TARGET in the process PROC.
1644 If PROC is not supplied, all processes are searched."
1645   (let ((downcased-target (erc-downcase target)))
1646     (catch 'buffer
1647       (erc-buffer-filter
1648        (lambda ()
1649          (let ((current (erc-default-target)))
1650            (and (stringp current)
1651                 (string-equal downcased-target (erc-downcase current))
1652                 (throw 'buffer (current-buffer)))))
1653        proc))))
1654
1655 (defun erc-buffer-filter (predicate &optional proc)
1656   "Return a list of `erc-mode' buffers matching certain criteria.
1657 PREDICATE is a function executed with each buffer, if it returns t, that buffer
1658 is considered a valid match.
1659
1660 PROC is either an `erc-server-process', identifying a certain
1661 server connection, or nil which means all open connections."
1662   (save-excursion
1663     (delq
1664      nil
1665      (mapcar (lambda (buf)
1666                (when (buffer-live-p buf)
1667                  (with-current-buffer buf
1668                    (and (eq major-mode 'erc-mode)
1669                         (or (not proc)
1670                             (eq proc erc-server-process))
1671                         (funcall predicate)
1672                         buf))))
1673              (buffer-list)))))
1674
1675 (defun erc-buffer-list (&optional predicate proc)
1676   "Return a list of ERC buffers.
1677 PREDICATE is a function which executes with every buffer satisfying
1678 the predicate.  If PREDICATE is passed as nil, return a list of all ERC
1679 buffers.  If PROC is given, the buffers local variable `erc-server-process'
1680 needs to match PROC."
1681   (unless predicate
1682     (setq predicate (lambda () t)))
1683   (erc-buffer-filter predicate proc))
1684
1685 (defmacro erc-with-all-buffers-of-server (process pred &rest forms)
1686   "Execute FORMS in all buffers which have same process as this server.
1687 FORMS will be evaluated in all buffers having the process PROCESS and
1688 where PRED matches or in all buffers of the server process if PRED is
1689 nil."
1690   ;; Make the evaluation have the correct order
1691   (let ((pre (make-symbol "pre"))
1692         (pro (make-symbol "pro")))
1693     `(let* ((,pro ,process)
1694             (,pre ,pred)
1695             (res (mapcar (lambda (buffer)
1696                            (with-current-buffer buffer
1697                              ,@forms))
1698                          (erc-buffer-list ,pre
1699                                           ,pro))))
1700        ;; Silence the byte-compiler by binding the result of mapcar to
1701        ;; a variable.
1702        res)))
1703 (put 'erc-with-all-buffers-of-server 'lisp-indent-function 1)
1704 (put 'erc-with-all-buffers-of-server 'edebug-form-spec '(form form body))
1705
1706 ;; (iswitchb-mode) will autoload iswitchb.el
1707 (defvar iswitchb-temp-buflist)
1708 (declare-function iswitchb-read-buffer "iswitchb"
1709                  (prompt &optional default require-match start matches-set))
1710
1711 (defun erc-iswitchb (&optional arg)
1712   "Use `iswitchb-read-buffer' to prompt for a ERC buffer to switch to.
1713 When invoked with prefix argument, use all erc buffers.  Without prefix
1714 ARG, allow only buffers related to same session server.
1715 If `erc-track-mode' is in enabled, put the last element of
1716 `erc-modified-channels-alist' in front of the buffer list.
1717
1718 Due to some yet unresolved reason, global function `iswitchb-mode'
1719 needs to be active for this function to work."
1720   (interactive "P")
1721   (let ((enabled (bound-and-true-p iswitchb-mode)))
1722     (or enabled (iswitchb-mode 1))
1723     (unwind-protect
1724         (let ((iswitchb-make-buflist-hook
1725                (lambda ()
1726                  (setq iswitchb-temp-buflist
1727                        (mapcar 'buffer-name
1728                                (erc-buffer-list
1729                                 nil
1730                                 (when arg erc-server-process)))))))
1731           (switch-to-buffer
1732            (iswitchb-read-buffer
1733             "Switch-to: "
1734             (if (boundp 'erc-modified-channels-alist)
1735                 (buffer-name (caar (last erc-modified-channels-alist)))
1736               nil)
1737             t)))
1738       (or enabled (iswitchb-mode -1)))))
1739
1740 (defun erc-channel-list (proc)
1741   "Return a list of channel buffers.
1742 PROC is the process for the server connection.  If PROC is nil, return
1743 all channel buffers on all servers."
1744   (erc-buffer-filter
1745    (lambda ()
1746      (and (erc-default-target)
1747           (erc-channel-p (erc-default-target))))
1748    proc))
1749
1750 (defun erc-buffer-list-with-nick (nick proc)
1751   "Return buffers containing NICK in the `erc-channel-users' list."
1752   (with-current-buffer (process-buffer proc)
1753     (let ((user (gethash (erc-downcase nick) erc-server-users)))
1754       (if user
1755           (erc-server-user-buffers user)
1756         nil))))
1757
1758 ;; Some local variables
1759
1760 (defvar erc-default-recipients nil
1761   "List of default recipients of the current buffer.")
1762 (make-variable-buffer-local 'erc-default-recipients)
1763
1764 (defvar erc-session-user-full-name nil
1765   "Full name of the user on the current server.")
1766 (make-variable-buffer-local 'erc-session-user-full-name)
1767
1768 (defvar erc-channel-user-limit nil
1769   "Limit of users per channel.")
1770 (make-variable-buffer-local 'erc-channel-user-limit)
1771
1772 (defvar erc-channel-key nil
1773   "Key needed to join channel.")
1774 (make-variable-buffer-local 'erc-channel-key)
1775
1776 (defvar erc-invitation nil
1777   "Last invitation channel.")
1778 (make-variable-buffer-local 'erc-invitation)
1779
1780 (defvar erc-away nil
1781   "Non-nil indicates that we are away.
1782
1783 Use `erc-away-time' to access this if you might be in a channel
1784 buffer rather than a server buffer.")
1785 (make-variable-buffer-local 'erc-away)
1786
1787 (defvar erc-channel-list nil
1788   "Server channel list.")
1789 (make-variable-buffer-local 'erc-channel-list)
1790
1791 (defvar erc-bad-nick nil
1792   "Non-nil indicates that we got a `nick in use' error while connecting.")
1793 (make-variable-buffer-local 'erc-bad-nick)
1794
1795 (defvar erc-logged-in nil
1796   "Non-nil indicates that we are logged in.")
1797 (make-variable-buffer-local 'erc-logged-in)
1798
1799 (defvar erc-default-nicks nil
1800   "The local copy of `erc-nick' - the list of nicks to choose from.")
1801 (make-variable-buffer-local 'erc-default-nicks)
1802
1803 (defvar erc-nick-change-attempt-count 0
1804   "Used to keep track of how many times an attempt at changing nick is made.")
1805 (make-variable-buffer-local 'erc-nick-change-attempt-count)
1806
1807 (defun erc-migrate-modules (mods)
1808   "Migrate old names of ERC modules to new ones."
1809   ;; modify `transforms' to specify what needs to be changed
1810   ;; each item is in the format '(old . new)
1811   (let ((transforms '((pcomplete . completion))))
1812     (erc-delete-dups
1813      (mapcar (lambda (m) (or (cdr (assoc m transforms)) m))
1814              mods))))
1815
1816 (defcustom erc-modules '(netsplit fill button match track completion readonly
1817                          networks ring autojoin noncommands irccontrols
1818                          move-to-prompt stamp menu list)
1819   "A list of modules which ERC should enable.
1820 If you set the value of this without using `customize' remember to call
1821 \(erc-update-modules) after you change it.  When using `customize', modules
1822 removed from the list will be disabled."
1823   :get (lambda (sym)
1824          ;; replace outdated names with their newer equivalents
1825          (erc-migrate-modules (symbol-value sym)))
1826   :set (lambda (sym val)
1827          ;; disable modules which have just been removed
1828          (when (and (boundp 'erc-modules) erc-modules val)
1829            (dolist (module erc-modules)
1830              (unless (member module val)
1831                (let ((f (intern-soft (format "erc-%s-mode" module))))
1832                  (when (and (fboundp f) (boundp f) (symbol-value f))
1833                    (message "Disabling `erc-%s'" module)
1834                    (funcall f 0))))))
1835          (set sym val)
1836          ;; this test is for the case where erc hasn't been loaded yet
1837          (when (fboundp 'erc-update-modules)
1838            (erc-update-modules)))
1839   :type
1840   '(set
1841     :greedy t
1842     (const :tag "autoaway: Set away status automatically" autoaway)
1843     (const :tag "autojoin: Join channels automatically" autojoin)
1844     (const :tag "button: Buttonize URLs, nicknames, and other text" button)
1845     (const :tag "capab: Mark unidentified users on servers supporting CAPAB"
1846            capab-identify)
1847     (const :tag "completion: Complete nicknames and commands (programmable)"
1848            completion)
1849     (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete)
1850     (const :tag "dcc: Provide Direct Client-to-Client support" dcc)
1851     (const :tag "fill: Wrap long lines" fill)
1852     (const :tag "identd: Launch an identd server on port 8113" identd)
1853     (const :tag "irccontrols: Highlight or remove IRC control characters"
1854            irccontrols)
1855     (const :tag "keep-place: Leave point above un-viewed text" keep-place)
1856     (const :tag "list: List channels in a separate buffer" list)
1857     (const :tag "log: Save buffers in logs" log)
1858     (const :tag "match: Highlight pals, fools, and other keywords" match)
1859     (const :tag "menu: Display a menu in ERC buffers" menu)
1860     (const :tag "move-to-prompt: Move to the prompt when typing text"
1861            move-to-prompt)
1862     (const :tag "netsplit: Detect netsplits" netsplit)
1863     (const :tag "networks: Provide data about IRC networks" networks)
1864     (const :tag "noncommands: Don't display non-IRC commands after evaluation"
1865            noncommands)
1866     (const :tag
1867            "notify: Notify when the online status of certain users changes"
1868            notify)
1869     (const :tag "page: Process CTCP PAGE requests from IRC" page)
1870     (const :tag "readonly: Make displayed lines read-only" readonly)
1871     (const :tag "replace: Replace text in messages" replace)
1872     (const :tag "ring: Enable an input history" ring)
1873     (const :tag "scrolltobottom: Scroll to the bottom of the buffer"
1874            scrolltobottom)
1875     (const :tag "services: Identify to Nickserv (IRC Services) automatically"
1876            services)
1877     (const :tag "smiley: Convert smileys to pretty icons" smiley)
1878     (const :tag "sound: Play sounds when you receive CTCP SOUND requests"
1879            sound)
1880     (const :tag "stamp: Add timestamps to messages" stamp)
1881     (const :tag "spelling: Check spelling" spelling)
1882     (const :tag "track: Track channel activity in the mode-line" track)
1883     (const :tag "truncate: Truncate buffers to a certain size" truncate)
1884     (const :tag "unmorse: Translate morse code in messages" unmorse)
1885     (const :tag "xdcc: Act as an XDCC file-server" xdcc)
1886     (repeat :tag "Others" :inline t symbol))
1887   :group 'erc)
1888
1889 (defun erc-update-modules ()
1890   "Run this to enable erc-foo-mode for all modules in `erc-modules'."
1891   (let (req)
1892     (dolist (mod erc-modules)
1893       (setq req (concat "erc-" (symbol-name mod)))
1894       (cond
1895        ;; yuck. perhaps we should bring the filenames into sync?
1896        ((string= req "erc-capab-identify")
1897         (setq req "erc-capab"))
1898        ((string= req "erc-completion")
1899         (setq req "erc-pcomplete"))
1900        ((string= req "erc-pcomplete")
1901         (setq mod 'completion))
1902        ((string= req "erc-autojoin")
1903         (setq req "erc-join")))
1904       (condition-case nil
1905           (require (intern req))
1906         (error nil))
1907       (let ((sym (intern-soft (concat "erc-" (symbol-name mod) "-mode"))))
1908         (if (fboundp sym)
1909             (funcall sym 1)
1910           (error "`%s' is not a known ERC module" mod))))))
1911
1912 (defun erc-setup-buffer (buffer)
1913   "Consults `erc-join-buffer' to find out how to display `BUFFER'."
1914   (cond ((eq erc-join-buffer 'window)
1915          (if (active-minibuffer-window)
1916              (display-buffer buffer)
1917            (switch-to-buffer-other-window buffer)))
1918         ((eq erc-join-buffer 'window-noselect)
1919          (display-buffer buffer))
1920         ((eq erc-join-buffer 'bury)
1921          nil)
1922         ((eq erc-join-buffer 'frame)
1923          (when (or (not erc-reuse-frames)
1924                    (not (get-buffer-window buffer t)))
1925            ((lambda (frame)
1926                      (raise-frame frame)
1927                      (select-frame frame))
1928                   (make-frame (or erc-frame-alist
1929                                   default-frame-alist)))
1930          (switch-to-buffer buffer)
1931          (when erc-frame-dedicated-flag
1932            (set-window-dedicated-p (selected-window) t))))
1933         (t
1934          (if (active-minibuffer-window)
1935              (display-buffer buffer)
1936            (switch-to-buffer buffer)))))
1937
1938 (defun erc-open (&optional server port nick full-name
1939                            connect passwd tgt-list channel process)
1940   "Connect to SERVER on PORT as NICK with FULL-NAME.
1941
1942 If CONNECT is non-nil, connect to the server.  Otherwise assume
1943 already connected and just create a separate buffer for the new
1944 target CHANNEL.
1945
1946 Use PASSWD as user password on the server.  If TGT-LIST is
1947 non-nil, use it to initialize `erc-default-recipients'.
1948
1949 Returns the buffer for the given server or channel."
1950   (let ((server-announced-name (when (and (boundp 'erc-session-server)
1951                                           (string= server erc-session-server))
1952                                  erc-server-announced-name))
1953         (connected-p (unless connect erc-server-connected))
1954         (buffer (erc-get-buffer-create server port channel))
1955         (old-buffer (current-buffer))
1956         old-point
1957         continued-session)
1958     (when connect (run-hook-with-args 'erc-before-connect server port nick))
1959     (erc-update-modules)
1960     (set-buffer buffer)
1961     (setq old-point (point))
1962     (erc-mode)
1963     (setq erc-server-announced-name server-announced-name)
1964     (setq erc-server-connected connected-p)
1965     ;; connection parameters
1966     (setq erc-server-process process)
1967     (setq erc-insert-marker (make-marker))
1968     (setq erc-input-marker (make-marker))
1969     ;; go to the end of the buffer and open a new line
1970     ;; (the buffer may have existed)
1971     (goto-char (point-max))
1972     (forward-line 0)
1973     (when (get-text-property (point) 'erc-prompt)
1974       (setq continued-session t)
1975       (set-marker erc-input-marker
1976                   (or (next-single-property-change (point) 'erc-prompt)
1977                       (point-max))))
1978     (unless continued-session
1979       (goto-char (point-max))
1980       (insert "\n"))
1981     (set-marker erc-insert-marker (point))
1982     ;; stack of default recipients
1983     (setq erc-default-recipients tgt-list)
1984     (setq erc-server-current-nick nil)
1985     ;; Initialize erc-server-users and erc-channel-users
1986     (if connect
1987         (progn ;; server buffer
1988           (setq erc-server-users
1989                 (make-hash-table :test 'equal))
1990           (setq erc-channel-users nil))
1991       (progn ;; target buffer
1992         (setq erc-server-users nil)
1993         (setq erc-channel-users
1994               (make-hash-table :test 'equal))))
1995     ;; clear last incomplete line read
1996     (setq erc-server-filter-data nil)
1997     (setq erc-channel-topic "")
1998     ;; limit on the number of users on the channel (mode +l)
1999     (setq erc-channel-user-limit nil)
2000     (setq erc-channel-key nil)
2001     ;; last active buffer, defaults to this one
2002     (erc-set-active-buffer buffer)
2003     ;; last invitation channel
2004     (setq erc-invitation nil)
2005     ;; Server channel list
2006     (setq erc-channel-list ())
2007     ;; login-time 'nick in use' error
2008     (setq erc-bad-nick nil)
2009     ;; whether we have logged in
2010     (setq erc-logged-in nil)
2011     ;; The local copy of `erc-nick' - the list of nicks to choose
2012     (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
2013     ;; password stuff
2014     (setq erc-session-password (or passwd
2015                                    (let ((secret
2016                                           (plist-get
2017                                            (nth 0
2018                                                 (auth-source-search :host server
2019                                                                     :max 1
2020                                                                     :user nick
2021                                                                     :port port
2022                                                                     :require '(:secret)))
2023                                            :secret)))
2024                                      (if (functionp secret)
2025                                          (funcall secret)
2026                                        secret))))
2027     ;; debug output buffer
2028     (setq erc-dbuf
2029           (when erc-log-p
2030             (get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
2031     ;; set up prompt
2032     (unless continued-session
2033       (goto-char (point-max))
2034       (insert "\n"))
2035     (if continued-session
2036         (goto-char old-point)
2037       (set-marker erc-insert-marker (point))
2038       (erc-display-prompt)
2039       (goto-char (point-max)))
2040
2041     (erc-determine-parameters server port nick full-name)
2042
2043     ;; Saving log file on exit
2044     (run-hook-with-args 'erc-connect-pre-hook buffer)
2045
2046     (when connect
2047       (erc-server-connect erc-session-server erc-session-port buffer))
2048     (erc-update-mode-line)
2049
2050     ;; Now display the buffer in a window as per user wishes.
2051     (unless (eq buffer old-buffer)
2052       (when erc-log-p
2053         ;; we can't log to debug buffer, it may not exist yet
2054         (message "erc: old buffer %s, switching to %s"
2055                  old-buffer buffer))
2056       (erc-setup-buffer buffer))
2057
2058     buffer))
2059
2060 (defun erc-initialize-log-marker (buffer)
2061   "Initialize the `erc-last-saved-position' marker to a sensible position.
2062 BUFFER is the current buffer."
2063   (with-current-buffer buffer
2064     (setq erc-last-saved-position (make-marker))
2065     (move-marker erc-last-saved-position
2066                  (1- (marker-position erc-insert-marker)))))
2067
2068 ;; interactive startup
2069
2070 (defvar erc-server-history-list nil
2071   "IRC server interactive selection history list.")
2072
2073 (defvar erc-nick-history-list nil
2074   "Nickname interactive selection history list.")
2075
2076 (defun erc-already-logged-in (server port nick)
2077   "Return the buffers corresponding to a NICK on PORT of a session SERVER.
2078 This is determined by looking for the appropriate buffer and checking
2079 whether the connection is still alive.
2080 If no buffer matches, return nil."
2081   (erc-buffer-list
2082    (lambda ()
2083      (and (erc-server-process-alive)
2084           (string= erc-session-server server)
2085           (erc-port-equal erc-session-port port)
2086           (erc-current-nick-p nick)))))
2087
2088 (if (not (fboundp 'read-passwd))
2089     (defun read-passwd (prompt)
2090       "Substitute for `read-passwd' in early emacsen."
2091       (read-from-minibuffer prompt)))
2092
2093 (defcustom erc-before-connect nil
2094   "Hook called before connecting to a server.
2095 This hook gets executed before `erc' actually invokes `erc-mode'
2096 with your input data.  The functions in here get called with three
2097 parameters, SERVER, PORT and NICK."
2098   :group 'erc-hooks
2099   :type 'hook)
2100
2101 (defcustom erc-after-connect nil
2102   "Hook called after connecting to a server.
2103 This hook gets executed when an end of MOTD has been received.  All
2104 functions in here get called with the parameters SERVER and NICK."
2105   :group 'erc-hooks
2106   :type 'hook)
2107
2108 ;;;###autoload
2109 (defun erc-select-read-args ()
2110   "Prompt the user for values of nick, server, port, and password."
2111   (let (user-input server port nick passwd)
2112     (setq user-input (read-from-minibuffer
2113                       "IRC server: "
2114                       (erc-compute-server) nil nil 'erc-server-history-list))
2115
2116     (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input)
2117         (setq port (erc-string-to-port (match-string 2 user-input))
2118               user-input (match-string 1 user-input))
2119       (setq port
2120             (erc-string-to-port (read-from-minibuffer
2121                                  "IRC port: " (erc-port-to-string
2122                                                (erc-compute-port))))))
2123
2124     (if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input)
2125         (setq nick (match-string 1 user-input)
2126               user-input (match-string 2 user-input))
2127       (setq nick
2128             (if (erc-already-logged-in server port nick)
2129                 (read-from-minibuffer
2130                  (erc-format-message 'nick-in-use ?n nick)
2131                  nick
2132                  nil nil 'erc-nick-history-list)
2133               (read-from-minibuffer
2134                "Nickname: " (erc-compute-nick nick)
2135                nil nil 'erc-nick-history-list))))
2136
2137     (setq server user-input)
2138
2139     (setq passwd (if erc-prompt-for-password
2140                      (if (and erc-password
2141                               (y-or-n-p "Use the default password? "))
2142                          erc-password
2143                        (read-passwd "Password: "))
2144                    erc-password))
2145     (when (and passwd (string= "" passwd))
2146       (setq passwd nil))
2147
2148     (while (erc-already-logged-in server port nick)
2149       ;; hmm, this is a problem when using multiple connections to a bnc
2150       ;; with the same nick. Currently this code prevents using more than one
2151       ;; bnc with the same nick. actually it would be nice to have
2152       ;; bncs transparent, so that erc-compute-buffer-name displays
2153       ;; the server one is connected to.
2154       (setq nick (read-from-minibuffer
2155                   (erc-format-message 'nick-in-use ?n nick)
2156                   nick
2157                   nil nil 'erc-nick-history-list)))
2158     (list :server server :port port :nick nick :password passwd)))
2159
2160 ;;;###autoload
2161 (defun* erc (&key (server (erc-compute-server))
2162                   (port   (erc-compute-port))
2163                   (nick   (erc-compute-nick))
2164                   password
2165                   (full-name (erc-compute-full-name)))
2166   "ERC is a powerful, modular, and extensible IRC client.
2167 This function is the main entry point for ERC.
2168
2169 It permits you to select connection parameters, and then starts ERC.
2170
2171 Non-interactively, it takes the keyword arguments
2172    (server (erc-compute-server))
2173    (port   (erc-compute-port))
2174    (nick   (erc-compute-nick))
2175    password
2176    (full-name (erc-compute-full-name)))
2177
2178 That is, if called with
2179
2180    (erc :server \"irc.freenode.net\" :full-name \"Harry S Truman\")
2181
2182 then the server and full-name will be set to those values, whereas
2183 `erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will
2184 be invoked for the values of the other parameters."
2185   (interactive (erc-select-read-args))
2186   (erc-open server port nick full-name t password))
2187
2188 ;;;###autoload
2189 (defalias 'erc-select 'erc)
2190 (defalias 'erc-ssl 'erc-tls)
2191
2192 ;;;###autoload
2193 (defun erc-tls (&rest r)
2194   "Interactively select TLS connection parameters and run ERC.
2195 Arguments are the same as for `erc'."
2196   (interactive (erc-select-read-args))
2197   (let ((erc-server-connect-function 'erc-open-tls-stream))
2198     (apply 'erc r)))
2199
2200 (defun erc-open-tls-stream (name buffer host port)
2201   "Open an TLS stream to an IRC server.
2202 The process will be given the name NAME, its target buffer will be
2203 BUFFER.  HOST and PORT specify the connection target."
2204   (open-network-stream name buffer host port
2205                        :type 'tls))
2206
2207 ;;; Displaying error messages
2208
2209 (defun erc-error (&rest args)
2210   "Pass ARGS to `format', and display the result as an error message.
2211 If `debug-on-error' is set to non-nil, then throw a real error with this
2212 message instead, to make debugging easier."
2213   (if debug-on-error
2214       (apply #'error args)
2215     (apply #'message args)
2216     (beep)))
2217
2218 ;;; Debugging the protocol
2219
2220 (defvar erc-debug-irc-protocol nil
2221   "If non-nil, log all IRC protocol traffic to the buffer \"*erc-protocol*\".
2222
2223 The buffer is created if it doesn't exist.
2224
2225 NOTE: If this variable is non-nil, and you kill the only
2226 visible \"*erc-protocol*\" buffer, it will be recreated shortly,
2227 but you won't see it.
2228
2229 WARNING: Do not set this variable directly!  Instead, use the
2230 function `erc-toggle-debug-irc-protocol' to toggle its value.")
2231
2232 (declare-function erc-network-name "erc-networks" ())
2233
2234 (defun erc-log-irc-protocol (string &optional outbound)
2235   "Append STRING to the buffer *erc-protocol*.
2236
2237 This only has any effect if `erc-debug-irc-protocol' is non-nil.
2238
2239 The buffer is created if it doesn't exist.
2240
2241 If OUTBOUND is non-nil, STRING is being sent to the IRC server
2242 and appears in face `erc-input-face' in the buffer."
2243   (when erc-debug-irc-protocol
2244     (let ((network-name (or (ignore-errors (erc-network-name))
2245                             "???")))
2246       (with-current-buffer (get-buffer-create "*erc-protocol*")
2247         (save-excursion
2248           (goto-char (point-max))
2249           (let ((inhibit-read-only t))
2250             (insert (if (not outbound)
2251                         ;; Cope with the fact that string might
2252                         ;; contain multiple lines of text.
2253                         (let ((lines (delete "" (split-string string
2254                                                               "\n\\|\r\n")))
2255                               (result ""))
2256                           (dolist (line lines)
2257                             (setq result (concat result network-name
2258                                                  " << " line "\n")))
2259                           result)
2260                       (erc-propertize
2261                         (concat network-name " >> " string
2262                                 (if (/= ?\n
2263                                         (aref string
2264                                               (1- (length string))))
2265                                     "\n"))
2266                         'face 'erc-input-face)))))
2267         (let ((orig-win (selected-window))
2268               (debug-buffer-window (get-buffer-window (current-buffer) t)))
2269           (when debug-buffer-window
2270              (select-window debug-buffer-window)
2271              (when (= 1 (count-lines (point) (point-max)))
2272                (goto-char (point-max))
2273                (recenter -1))
2274              (select-window orig-win)))))))
2275
2276 (defun erc-toggle-debug-irc-protocol (&optional arg)
2277   "Toggle the value of `erc-debug-irc-protocol'.
2278
2279 If ARG is non-nil, show the *erc-protocol* buffer."
2280   (interactive "P")
2281   (let* ((buf (get-buffer-create "*erc-protocol*")))
2282     (with-current-buffer buf
2283       (erc-view-mode-enter)
2284       (when (null (current-local-map))
2285         (let ((inhibit-read-only t))
2286           (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n"))
2287           (insert (erc-make-notice "Kill this buffer to terminate protocol logging.\n\n")))
2288         (use-local-map (make-sparse-keymap))
2289         (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol))
2290       (add-hook 'kill-buffer-hook
2291                 #'(lambda () (setq erc-debug-irc-protocol nil))
2292                 nil 'local)
2293       (goto-char (point-max))
2294       (let ((inhibit-read-only t))
2295         (insert (erc-make-notice
2296                  (format "IRC protocol logging %s at %s -- Press `t' to toggle logging.\n"
2297                          (if erc-debug-irc-protocol "disabled" "enabled")
2298                          (current-time-string))))))
2299     (setq erc-debug-irc-protocol (not erc-debug-irc-protocol))
2300     (if (and arg
2301              (not (get-buffer-window "*erc-protocol*" t)))
2302         (display-buffer buf t))
2303     (message "IRC protocol traffic logging %s (see buffer *erc-protocol*)."
2304              (if erc-debug-irc-protocol "enabled" "disabled"))))
2305
2306 ;;; I/O interface
2307
2308 ;; send interface
2309
2310 (defun erc-send-action (tgt str &optional force)
2311   "Send CTCP ACTION information described by STR to TGT."
2312   (erc-send-ctcp-message tgt (format "ACTION %s" str) force)
2313   (erc-display-message
2314    nil 'input (current-buffer)
2315    'ACTION ?n (erc-current-nick) ?a str ?u "" ?h ""))
2316
2317 ;; Display interface
2318
2319 (defun erc-string-invisible-p (string)
2320   "Check whether STRING is invisible or not.
2321 I.e. any char in it has the `invisible' property set."
2322   (text-property-any 0 (length string) 'invisible t string))
2323
2324 (defcustom erc-remove-parsed-property t
2325   "Whether to remove the erc-parsed text property after displaying a message.
2326
2327 The default is to remove it, since it causes ERC to take up extra
2328 memory.  If you have code that relies on this property, then set
2329 this option to nil."
2330   :type 'boolean
2331   :group 'erc)
2332
2333 (defun erc-display-line-1 (string buffer)
2334   "Display STRING in `erc-mode' BUFFER.
2335 Auxiliary function used in `erc-display-line'.  The line gets filtered to
2336 interpret the control characters.  Then, `erc-insert-pre-hook' gets called.
2337 If `erc-insert-this' is still t, STRING gets inserted into the buffer.
2338 Afterwards, `erc-insert-modify' and `erc-insert-post-hook' get called.
2339 If STRING is nil, the function does nothing."
2340   (when string
2341     (with-current-buffer (or buffer (process-buffer erc-server-process))
2342       (let ((insert-position (or (marker-position erc-insert-marker)
2343                                  (point-max))))
2344         (let ((string string) ;; FIXME! Can this be removed?
2345               (buffer-undo-list t)
2346               (inhibit-read-only t))
2347           (unless (string-match "\n$" string)
2348             (setq string (concat string "\n"))
2349             (when (erc-string-invisible-p string)
2350               (erc-put-text-properties 0 (length string)
2351                                        '(invisible intangible) string)))
2352           (erc-log (concat "erc-display-line: " string
2353                            (format "(%S)" string) " in buffer "
2354                            (format "%s" buffer)))
2355           (setq erc-insert-this t)
2356           (run-hook-with-args 'erc-insert-pre-hook string)
2357           (if (null erc-insert-this)
2358               ;; Leave erc-insert-this set to t as much as possible.  Fran
2359               ;; Litterio <franl> has seen erc-insert-this set to nil while
2360               ;; erc-send-pre-hook is running, which should never happen.  This
2361               ;; may cure it.
2362               (setq erc-insert-this t)
2363             (save-excursion ;; to restore point in the new buffer
2364               (save-restriction
2365                 (widen)
2366                 (goto-char insert-position)
2367                 (insert-before-markers string)
2368                 ;; run insertion hook, with point at restored location
2369                 (save-restriction
2370                   (narrow-to-region insert-position (point))
2371                   (run-hooks 'erc-insert-modify-hook)
2372                   (run-hooks 'erc-insert-post-hook)
2373                   (when erc-remove-parsed-property
2374                     (remove-text-properties (point-min) (point-max)
2375                                             '(erc-parsed nil))))))))
2376         (erc-update-undo-list (- (or (marker-position erc-insert-marker)
2377                                      (point-max))
2378                                  insert-position))))))
2379
2380 (defun erc-update-undo-list (shift)
2381   ;; Translate buffer positions in buffer-undo-list by SHIFT.
2382   (unless (or (zerop shift) (atom buffer-undo-list))
2383     (let ((list buffer-undo-list) elt)
2384       (while list
2385         (setq elt (car list))
2386         (cond ((integerp elt)           ; POSITION
2387                (incf (car list) shift))
2388               ((or (atom elt)           ; nil, EXTENT
2389                    ;; (eq t (car elt))  ; (t . TIME)
2390                    (markerp (car elt))) ; (MARKER . DISTANCE)
2391                nil)
2392               ((integerp (car elt))     ; (BEGIN . END)
2393                (incf (car elt) shift)
2394                (incf (cdr elt) shift))
2395               ((stringp (car elt))      ; (TEXT . POSITION)
2396                (incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift)))
2397               ((null (car elt))         ; (nil PROPERTY VALUE BEG . END)
2398                (let ((cons (nthcdr 3 elt)))
2399                  (incf (car cons) shift)
2400                  (incf (cdr cons) shift)))
2401               ((and (featurep 'xemacs)
2402                     (extentp (car elt))) ; (EXTENT START END)
2403                (incf (nth 1 elt) shift)
2404                (incf (nth 2 elt) shift)))
2405         (setq list (cdr list))))))
2406
2407 (defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*"
2408   "Regexp which matches all valid characters in a IRC nickname.")
2409
2410 (defun erc-is-valid-nick-p (nick)
2411   "Check if NICK is a valid IRC nickname."
2412   (string-match (concat "^" erc-valid-nick-regexp "$") nick))
2413
2414 (defun erc-display-line (string &optional buffer)
2415   "Display STRING in the ERC BUFFER.
2416 All screen output must be done through this function.  If BUFFER is nil
2417 or omitted, the default ERC buffer for the `erc-session-server' is used.
2418 The BUFFER can be an actual buffer, a list of buffers, 'all or 'active.
2419 If BUFFER = 'all, the string is displayed in all the ERC buffers for the
2420 current session.  'active means the current active buffer
2421 \(`erc-active-buffer').  If the buffer can't be resolved, the current
2422 buffer is used.  `erc-display-line-1' is used to display STRING.
2423
2424 If STRING is nil, the function does nothing."
2425   (let ((inhibit-point-motion-hooks t)
2426         new-bufs)
2427     (dolist (buf (cond
2428                   ((bufferp buffer) (list buffer))
2429                   ((listp buffer) buffer)
2430                   ((processp buffer) (list (process-buffer buffer)))
2431                   ((eq 'all buffer)
2432                    ;; Hmm, or all of the same session server?
2433                    (erc-buffer-list nil erc-server-process))
2434                   ((and (eq 'active buffer) (erc-active-buffer))
2435                    (list (erc-active-buffer)))
2436                   ((erc-server-buffer-live-p)
2437                    (list (process-buffer erc-server-process)))
2438                   (t (list (current-buffer)))))
2439       (when (buffer-live-p buf)
2440         (erc-display-line-1 string buf)
2441         (add-to-list 'new-bufs buf)))
2442     (when (null new-bufs)
2443       (if (erc-server-buffer-live-p)
2444           (erc-display-line-1 string (process-buffer erc-server-process))
2445         (erc-display-line-1 string (current-buffer))))))
2446
2447 (defun erc-display-message-highlight (type string)
2448   "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
2449
2450 See also `erc-make-notice'."
2451   (cond ((eq type 'notice)
2452          (erc-make-notice string))
2453         (t
2454          (erc-put-text-property
2455           0 (length string)
2456           'face (or (intern-soft
2457                      (concat "erc-" (symbol-name type) "-face"))
2458                     "erc-default-face")
2459           string)
2460          string)))
2461
2462 (defvar erc-lurker-state nil
2463   "Track the time of the last PRIVMSG for each (server,nick) pair.
2464
2465 This is implemented as a hash of hashes, where the outer key is
2466 the canonicalized server name (as returned by
2467 `erc-canonicalize-server-name') and the outer value is a hash
2468 table mapping nicks (as returned by `erc-lurker-maybe-trim') to
2469 the times of their most recently received PRIVMSG on any channel
2470 on the given server.")
2471
2472 (defcustom erc-lurker-trim-nicks t
2473   "If t, trim trailing `erc-lurker-ignore-chars' from nicks.
2474
2475 This causes e.g. nick and nick` to be considered as the same
2476 individual for activity tracking and lurkiness detection
2477 purposes."
2478   :group 'erc-lurker
2479   :type 'boolean)
2480
2481 (defun erc-lurker-maybe-trim (nick)
2482   "Maybe trim trailing `erc-lurker-ignore-chars' from NICK.
2483
2484 Returns NICK unmodified unless `erc-lurker-trim-nicks' is
2485 non-nil."
2486   (if erc-lurker-trim-nicks
2487       (replace-regexp-in-string
2488        (format "[%s]"
2489                (mapconcat (lambda (char)
2490                             (regexp-quote (char-to-string char)))
2491                           erc-lurker-ignore-chars ""))
2492        "" nick)
2493     nick))
2494
2495 (defcustom erc-lurker-ignore-chars "`_"
2496   "Characters at the end of a nick to strip for activity tracking purposes.
2497
2498 See also `erc-lurker-trim-nicks'."
2499   :group 'erc-lurker
2500   :type 'string)
2501
2502 (defcustom erc-lurker-hide-list nil
2503   "List of IRC type messages to hide when sent by lurkers.
2504
2505 A typical value would be '(\"JOIN\" \"PART\" \"QUIT\").
2506 See also `erc-lurker-p' and `erc-hide-list'."
2507   :group 'erc-lurker
2508   :type 'erc-message-type)
2509
2510 (defcustom erc-lurker-threshold-time (* 60 60 24) ; 24h by default
2511   "Nicks from which no PRIVMSGs have been received within this
2512 interval (in units of seconds) are considered lurkers by
2513 `erc-lurker-p' and as a result their messages of types in
2514 `erc-lurker-hide-list' will be hidden."
2515   :group 'erc-lurker
2516   :type 'integer)
2517
2518 (defun erc-lurker-initialize ()
2519   "Initialize ERC lurker tracking functionality.
2520
2521 This function adds `erc-lurker-update-status' to
2522 `erc-insert-pre-hook' in order to record the time of each nick's
2523 most recent PRIVMSG as well as initializing the state variable
2524 storing this information."
2525   (setq erc-lurker-state (make-hash-table :test 'equal))
2526   (add-hook 'erc-insert-pre-hook 'erc-lurker-update-status))
2527
2528 (defun erc-lurker-cleanup ()
2529   "Remove all last PRIVMSG state older than `erc-lurker-threshold-time'.
2530
2531 This should be called regularly to avoid excessive resource
2532 consumption for long-lived IRC or Emacs sessions."
2533   (maphash
2534    (lambda (server hash)
2535      (maphash
2536       (lambda (nick last-PRIVMSG-time)
2537         (when
2538             (> (time-to-seconds (time-subtract
2539                                  (current-time)
2540                                  last-PRIVMSG-time))
2541                erc-lurker-threshold-time)
2542           (remhash nick hash)))
2543       hash)
2544      (if (zerop (hash-table-count hash))
2545          (remhash server erc-lurker-state)))
2546    erc-lurker-state))
2547
2548 (defvar erc-lurker-cleanup-count 0
2549   "Internal counter variable for use with `erc-lurker-cleanup-interval'.")
2550
2551 (defvar erc-lurker-cleanup-interval 100
2552   "Specifies frequency of cleaning up stale erc-lurker state.
2553
2554 `erc-lurker-update-status' calls `erc-lurker-cleanup' once for
2555 every `erc-lurker-cleanup-interval' updates to
2556 `erc-lurker-state'.  This is designed to limit the memory
2557 consumption of lurker state during long Emacs sessions and/or ERC
2558 sessions with large numbers of incoming PRIVMSGs.")
2559
2560 (defun erc-lurker-update-status (message)
2561   "Update `erc-lurker-state' if necessary.
2562
2563 This function is called from `erc-insert-pre-hook'.  If the
2564 current message is a PRIVMSG, update `erc-lurker-state' to
2565 reflect the fact that its sender has issued a PRIVMSG at the
2566 current time.  Otherwise, take no action.
2567
2568 This function depends on the fact that `erc-display-message'
2569 dynamically binds `parsed', which is used to check if the current
2570 message is a PRIVMSG and to determine its sender.  See also
2571 `erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'.
2572
2573 In order to limit memory consumption, this function also calls
2574 `erc-lurker-cleanup' once every `erc-lurker-cleanup-interval'
2575 updates of `erc-lurker-state'."
2576   (when (and (boundp 'parsed) (erc-response-p parsed))
2577     (let* ((command (erc-response.command parsed))
2578            (sender
2579             (erc-lurker-maybe-trim
2580              (car (erc-parse-user (erc-response.sender parsed)))))
2581            (server
2582             (erc-canonicalize-server-name erc-server-announced-name)))
2583       (when (equal command "PRIVMSG")
2584         (when (>= (incf erc-lurker-cleanup-count) erc-lurker-cleanup-interval)
2585           (setq erc-lurker-cleanup-count 0)
2586           (erc-lurker-cleanup))
2587         (unless (gethash server erc-lurker-state)
2588           (puthash server (make-hash-table :test 'equal) erc-lurker-state))
2589         (puthash sender (current-time)
2590                  (gethash server erc-lurker-state))))))
2591
2592 (defun erc-lurker-p (nick)
2593   "Predicate indicating NICK's lurking status on the current server.
2594
2595 Lurking is the condition where NICK has issued no PRIVMSG on this
2596 server within `erc-lurker-threshold-time'.  See also
2597 `erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'."
2598   (unless erc-lurker-state (erc-lurker-initialize))
2599     (let* ((server
2600             (erc-canonicalize-server-name erc-server-announced-name))
2601            (last-PRIVMSG-time
2602             (gethash (erc-lurker-maybe-trim nick)
2603                      (gethash server erc-lurker-state (make-hash-table)))))
2604       (or (null last-PRIVMSG-time)
2605           (> (time-to-seconds
2606               (time-subtract (current-time) last-PRIVMSG-time))
2607            erc-lurker-threshold-time))))
2608
2609 (defun erc-canonicalize-server-name (server)
2610   "Returns the canonical network name for SERVER if any,
2611 otherwise `erc-server-announced-name'.  SERVER is matched against
2612 `erc-common-server-suffixes'."
2613   (when server
2614     (or (cdar (erc-remove-if-not
2615                (lambda (net) (string-match (car net) server))
2616                erc-common-server-suffixes))
2617         erc-server-announced-name)))
2618
2619 (defun erc-hide-current-message-p (parsed)
2620   "Predicate indicating whether the parsed ERC response PARSED should be hidden.
2621
2622 Messages are always hidden if the message type of PARSED appears in
2623 `erc-hide-list'.  In addition, messages whose type is a member of
2624 `erc-lurker-hide-list' are hidden if `erc-lurker-p' returns true."
2625   (let* ((command (erc-response.command parsed))
2626          (sender (car (erc-parse-user (erc-response.sender parsed)))))
2627     (or (member command erc-hide-list)
2628         (and (member command erc-lurker-hide-list) (erc-lurker-p sender)))))
2629
2630 (defun erc-display-message (parsed type buffer msg &rest args)
2631   "Display MSG in BUFFER.
2632
2633 ARGS, PARSED, and TYPE are used to format MSG sensibly.
2634
2635 See also `erc-format-message' and `erc-display-line'."
2636   (let ((string (if (symbolp msg)
2637                     (apply 'erc-format-message msg args)
2638                   msg)))
2639     (setq string
2640           (cond
2641            ((null type)
2642             string)
2643            ((listp type)
2644             (mapc (lambda (type)
2645                     (setq string
2646                           (erc-display-message-highlight type string)))
2647                   type)
2648             string)
2649            ((symbolp type)
2650             (erc-display-message-highlight type string))))
2651
2652     (if (not (erc-response-p parsed))
2653         (erc-display-line string buffer)
2654       (unless (erc-hide-current-message-p parsed)
2655         (erc-put-text-property 0 (length string) 'erc-parsed parsed string)
2656         (erc-put-text-property 0 (length string) 'rear-sticky t string)
2657         (erc-display-line string buffer)))))
2658
2659 (defun erc-message-type-member (position list)
2660   "Return non-nil if the erc-parsed text-property at POSITION is in LIST.
2661
2662 This function relies on the erc-parsed text-property being
2663 present."
2664   (let ((prop-val (erc-get-parsed-vector position)))
2665     (and prop-val (member (erc-response.command prop-val) list))))
2666
2667 (defvar erc-send-input-line-function 'erc-send-input-line)
2668 (make-variable-buffer-local 'erc-send-input-line-function)
2669
2670 (defun erc-send-input-line (target line &optional force)
2671   "Send LINE to TARGET.
2672
2673 See also `erc-server-send'."
2674   (setq line (format "PRIVMSG %s :%s"
2675                      target
2676                      ;; If the line is empty, we still want to
2677                      ;; send it - i.e. an empty pasted line.
2678                      (if (string= line "\n")
2679                          " \n"
2680                        line)))
2681   (erc-server-send line force target))
2682
2683 (defun erc-get-arglist (fun)
2684   "Return the argument list of a function without the parens."
2685   (let ((arglist (format "%S" (erc-function-arglist fun))))
2686     (if (string-match "^(\\(.*\\))$" arglist)
2687         (match-string 1 arglist)
2688       arglist)))
2689
2690 (defun erc-command-no-process-p (str)
2691   "Return non-nil if STR is an ERC command that can be run when the process
2692 is not alive, nil otherwise."
2693   (let ((fun (erc-extract-command-from-line str)))
2694     (and fun
2695          (symbolp (car fun))
2696          (get (car fun) 'process-not-needed))))
2697
2698 (defun erc-command-name (cmd)
2699   "For CMD being the function name of a ERC command, something like
2700 erc-cmd-FOO, this returns a string /FOO."
2701   (let ((command-name (symbol-name cmd)))
2702     (if (string-match "^erc-cmd-\\(.*\\)$" command-name)
2703         (concat "/" (match-string 1 command-name))
2704       command-name)))
2705
2706 (defun erc-process-input-line (line &optional force no-command)
2707   "Translate LINE to an RFC1459 command and send it based.
2708 Returns non-nil if the command is actually sent to the server, and nil
2709 otherwise.
2710
2711 If the command in the LINE is not bound as a function `erc-cmd-<COMMAND>',
2712 it is passed to `erc-cmd-default'.  If LINE is not a command (i.e. doesn't
2713 start with /<COMMAND>) then it is sent as a message.
2714
2715 An optional FORCE argument forces sending the line when flood
2716 protection is in effect.  The optional NO-COMMAND argument prohibits
2717 this function from interpreting the line as a command."
2718   (let ((command-list (erc-extract-command-from-line line)))
2719     (if (and command-list
2720              (not no-command))
2721         (let* ((cmd  (nth 0 command-list))
2722                (args (nth 1 command-list)))
2723           (condition-case nil
2724               (if (listp args)
2725                   (apply cmd args)
2726                 (funcall cmd args))
2727             (wrong-number-of-arguments
2728              (erc-display-message nil 'error (current-buffer) 'incorrect-args
2729                                   ?c (erc-command-name cmd)
2730                                   ?u (or (erc-get-arglist cmd)
2731                                          "")
2732                                   ?d (format "%s\n"
2733                                              (or (documentation cmd) "")))
2734              nil)))
2735       (let ((r (erc-default-target)))
2736         (if r
2737             (funcall erc-send-input-line-function r line force)
2738           (erc-display-message nil 'error (current-buffer) 'no-target)
2739           nil)))))
2740
2741 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2742 ;;                    Input commands handlers
2743 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2744
2745 (defun erc-cmd-AMSG (line)
2746   "Send LINE to all channels of the current server that you are on."
2747   (interactive "sSend to all channels you're on: ")
2748   (setq line (erc-trim-string line))
2749   (erc-with-all-buffers-of-server nil
2750    (lambda ()
2751      (erc-channel-p (erc-default-target)))
2752    (erc-send-message line)))
2753 (put 'erc-cmd-AMSG 'do-not-parse-args t)
2754
2755 (defun erc-cmd-SAY (line)
2756   "Send LINE to the current query or channel as a message, not a command.
2757
2758 Use this when you want to send a message with a leading '/'.  Note
2759 that since multi-line messages are never a command, you don't
2760 need this when pasting multiple lines of text."
2761   (if (string-match "^\\s-*$" line)
2762       nil
2763     (string-match "^ ?\\(.*\\)" line)
2764     (erc-process-input-line (match-string 1 line) nil t)))
2765 (put 'erc-cmd-SAY 'do-not-parse-args t)
2766
2767 (defun erc-cmd-SET (line)
2768   "Set the variable named by the first word in LINE to some VALUE.
2769 VALUE is computed by evaluating the rest of LINE in Lisp."
2770   (cond
2771    ((string-match "^\\s-*\\(\\S-+\\)\\s-+\\(.*\\)$" line)
2772     (let ((var (read (concat "erc-" (match-string 1 line))))
2773           (val (read (match-string 2 line))))
2774       (if (boundp var)
2775           (progn
2776             (set var (eval val))
2777             (erc-display-message
2778              nil nil 'active (format "Set %S to %S" var val))
2779             t)
2780         (setq var (read (match-string 1 line)))
2781         (if (boundp var)
2782             (progn
2783               (set var (eval val))
2784               (erc-display-message
2785                nil nil 'active (format "Set %S to %S" var val))
2786               t)
2787           (erc-display-message nil 'error 'active 'variable-not-bound)
2788           nil))))
2789    ((string-match "^\\s-*$" line)
2790     (erc-display-line
2791      (concat "Available user variables:\n"
2792              (apply
2793               'concat
2794               (mapcar
2795                (lambda (var)
2796                  (let ((val (symbol-value var)))
2797                    (concat (format "%S:" var)
2798                            (if (consp val)
2799                                (concat "\n" (pp-to-string val))
2800                              (format " %S\n" val)))))
2801                (apropos-internal "^erc-" 'custom-variable-p))))
2802      (current-buffer)) t)
2803    (t nil)))
2804 (defalias 'erc-cmd-VAR 'erc-cmd-SET)
2805 (defalias 'erc-cmd-VARIABLE 'erc-cmd-SET)
2806 (put 'erc-cmd-SET 'do-not-parse-args t)
2807 (put 'erc-cmd-SET 'process-not-needed t)
2808
2809 (defun erc-cmd-default (line)
2810   "Fallback command.
2811
2812 Commands for which no erc-cmd-xxx exists, are tunneled through
2813 this function.  LINE is sent to the server verbatim, and
2814 therefore has to contain the command itself as well."
2815   (erc-log (format "cmd: DEFAULT: %s" line))
2816   (erc-server-send (substring line 1))
2817   t)
2818
2819 (defun erc-cmd-IGNORE (&optional user)
2820   "Ignore USER.  This should be a regexp matching nick!user@host.
2821 If no USER argument is specified, list the contents of `erc-ignore-list'."
2822   (if user
2823       (let ((quoted (regexp-quote user)))
2824         (when (and (not (string= user quoted))
2825                    (y-or-n-p (format "Use regexp-quoted form (%s) instead? "
2826                                      quoted)))
2827           (setq user quoted))
2828         (erc-display-line
2829          (erc-make-notice (format "Now ignoring %s" user))
2830          'active)
2831         (erc-with-server-buffer (add-to-list 'erc-ignore-list user)))
2832     (if (null (erc-with-server-buffer erc-ignore-list))
2833         (erc-display-line (erc-make-notice "Ignore list is empty") 'active)
2834       (erc-display-line (erc-make-notice "Ignore list:") 'active)
2835       (mapc #'(lambda (item)
2836                 (erc-display-line (erc-make-notice item)
2837                                   'active))
2838             (erc-with-server-buffer erc-ignore-list))))
2839   t)
2840
2841 (defun erc-cmd-UNIGNORE (user)
2842   "Remove the user specified in USER from the ignore list."
2843   (let ((ignored-nick (car (erc-with-server-buffer
2844                              (erc-member-ignore-case (regexp-quote user)
2845                                                      erc-ignore-list)))))
2846     (unless ignored-nick
2847       (if (setq ignored-nick (erc-ignored-user-p user))
2848           (unless (y-or-n-p (format "Remove this regexp (%s)? "
2849                                     ignored-nick))
2850             (setq ignored-nick nil))
2851         (erc-display-line
2852          (erc-make-notice (format "%s is not currently ignored!" user))
2853          'active)))
2854     (when ignored-nick
2855       (erc-display-line
2856        (erc-make-notice (format "No longer ignoring %s" user))
2857        'active)
2858       (erc-with-server-buffer
2859         (setq erc-ignore-list (delete ignored-nick erc-ignore-list)))))
2860   t)
2861
2862 (defun erc-cmd-CLEAR ()
2863   "Clear the window content."
2864   (recenter 0)
2865   t)
2866 (put 'erc-cmd-CLEAR 'process-not-needed t)
2867
2868 (defun erc-cmd-OPS ()
2869   "Show the ops in the current channel."
2870   (interactive)
2871   (let ((ops nil))
2872     (if erc-channel-users
2873         (maphash (lambda (nick user-data)
2874                    (let ((cuser (cdr user-data)))
2875                      (if (and cuser
2876                               (erc-channel-user-op cuser))
2877                          (setq ops (cons (erc-server-user-nickname
2878                                           (car user-data))
2879                                          ops)))))
2880                  erc-channel-users))
2881     (setq ops (sort ops 'string-lessp))
2882     (if ops
2883         (erc-display-message
2884          nil 'notice (current-buffer) 'ops
2885          ?i (length ops) ?s (if (> (length ops) 1) "s" "")
2886          ?o (mapconcat 'identity ops " "))
2887       (erc-display-message nil 'notice (current-buffer) 'ops-none)))
2888   t)
2889
2890 (defun erc-cmd-COUNTRY (tld)
2891   "Display the country associated with the top level domain TLD."
2892   (require 'mail-extr)
2893   (let ((co (ignore-errors (what-domain tld))))
2894     (if co
2895         (erc-display-message
2896          nil 'notice 'active 'country ?c co ?d tld)
2897       (erc-display-message
2898        nil 'notice 'active 'country-unknown ?d tld))
2899   t))
2900 (put 'erc-cmd-COUNTRY 'process-not-needed t)
2901
2902 (defun erc-cmd-AWAY (line)
2903   "Mark the user as being away, the reason being indicated by LINE.
2904 If no reason is given, unset away status."
2905   (when (string-match "^\\s-*\\(.*\\)$" line)
2906     (let ((reason (match-string 1 line)))
2907       (erc-log (format "cmd: AWAY: %s" reason))
2908       (erc-server-send
2909        (if (string= reason "")
2910            "AWAY"
2911          (concat "AWAY :" reason))))
2912     t))
2913 (put 'erc-cmd-AWAY 'do-not-parse-args t)
2914
2915 (defun erc-cmd-GAWAY (line)
2916   "Mark the user as being away everywhere, the reason being indicated by LINE."
2917   ;; on all server buffers.
2918   (erc-with-all-buffers-of-server nil
2919     #'erc-open-server-buffer-p
2920     (erc-cmd-AWAY line)))
2921 (put 'erc-cmd-GAWAY 'do-not-parse-args t)
2922
2923 (defun erc-cmd-CTCP (nick cmd &rest args)
2924   "Send a Client To Client Protocol message to NICK.
2925
2926 CMD is the CTCP command, possible values being ECHO, FINGER, CLIENTINFO, TIME,
2927 VERSION and so on.  It is called with ARGS."
2928   (let ((str (concat cmd
2929                      (when args
2930                        (concat " " (mapconcat #'identity args " "))))))
2931     (erc-log (format "cmd: CTCP [%s]: [%s]" nick str))
2932     (erc-send-ctcp-message nick str)
2933     t))
2934
2935 (defun erc-cmd-HELP (&optional func)
2936   "Popup help information.
2937
2938 If FUNC contains a valid function or variable, help about that
2939 will be displayed.  If FUNC is empty, display an apropos about
2940 ERC commands.  Otherwise, do `apropos' in the ERC namespace
2941 \(\"erc-.*LINE\"\).
2942
2943 Examples:
2944 To find out about erc and bbdb, do
2945   /help bbdb.*
2946
2947 For help about the WHOIS command, do:
2948   /help whois
2949
2950 For a list of user commands (/join /part, ...):
2951   /help."
2952   (if func
2953     (let* ((sym (or (let ((sym (intern-soft
2954                                 (concat "erc-cmd-" (upcase func)))))
2955                       (if (and sym (or (boundp sym) (fboundp sym)))
2956                           sym
2957                         nil))
2958                     (let ((sym (intern-soft func)))
2959                       (if (and sym (or (boundp sym) (fboundp sym)))
2960                           sym
2961                         nil))
2962                     (let ((sym (intern-soft (concat "erc-" func))))
2963                       (if (and sym (or (boundp sym) (fboundp sym)))
2964                           sym
2965                         nil)))))
2966       (if sym
2967           (cond
2968            ((boundp sym) (describe-variable sym))
2969            ((fboundp sym) (describe-function sym))
2970            (t nil))
2971         (apropos-command (concat "erc-.*" func) nil
2972                          (lambda (x)
2973                            (or (commandp x)
2974                                (get x 'custom-type))))
2975         t))
2976     (apropos "erc-cmd-")
2977     (message "Type C-h m to get additional information about keybindings.")
2978     t))
2979
2980 (defalias 'erc-cmd-H 'erc-cmd-HELP)
2981 (put 'erc-cmd-HELP 'process-not-needed t)
2982
2983 (defun erc-cmd-JOIN (channel &optional key)
2984   "Join the channel given in CHANNEL, optionally with KEY.
2985 If CHANNEL is specified as \"-invite\", join the channel to which you
2986 were most recently invited.  See also `invitation'."
2987   (let (chnl)
2988     (if (string= (upcase channel) "-INVITE")
2989         (if erc-invitation
2990             (setq chnl erc-invitation)
2991           (erc-display-message nil 'error (current-buffer) 'no-invitation))
2992       (setq chnl (erc-ensure-channel-name channel)))
2993     (when chnl
2994       ;; Prevent double joining of same channel on same server.
2995       (let ((joined-channels
2996              (mapcar #'(lambda (chanbuf)
2997                          (with-current-buffer chanbuf (erc-default-target)))
2998                      (erc-channel-list erc-server-process))))
2999         (if (erc-member-ignore-case chnl joined-channels)
3000             (switch-to-buffer (car (erc-member-ignore-case chnl
3001                                                            joined-channels)))
3002           (erc-log (format "cmd: JOIN: %s" chnl))
3003           (if (and chnl key)
3004               (erc-server-send (format "JOIN %s %s" chnl key))
3005             (erc-server-send (format "JOIN %s" chnl)))))))
3006   t)
3007
3008 (defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN)
3009 (defalias 'erc-cmd-J 'erc-cmd-JOIN)
3010
3011 (defvar erc-channel-new-member-names nil
3012   "If non-nil, a names list is currently being received.
3013
3014 If non-nil, this variable is a hash-table that associates
3015 received nicks with t.")
3016 (make-variable-buffer-local 'erc-channel-new-member-names)
3017
3018 (defun erc-cmd-NAMES (&optional channel)
3019   "Display the users in CHANNEL.
3020 If CHANNEL is not specified, display the users in the current channel.
3021 This function clears the channel name list first, then sends the
3022 command."
3023   (let ((tgt (or (and (erc-channel-p channel) channel)
3024                  (erc-default-target))))
3025     (if (and tgt (erc-channel-p tgt))
3026         (progn
3027           (erc-log (format "cmd: DEFAULT: NAMES %s" tgt))
3028           (erc-with-buffer
3029            (tgt)
3030            (erc-channel-begin-receiving-names))
3031           (erc-server-send (concat "NAMES " tgt)))
3032       (erc-display-message nil 'error (current-buffer) 'no-default-channel)))
3033   t)
3034 (defalias 'erc-cmd-N 'erc-cmd-NAMES)
3035
3036 (defun erc-cmd-KICK (target &optional reason-or-nick &rest reasonwords)
3037   "Kick the user indicated in LINE from the current channel.
3038 LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"."
3039   (let ((reasonstring (mapconcat 'identity reasonwords " ")))
3040     (if (string= "" reasonstring)
3041         (setq reasonstring (format "Kicked by %s" (erc-current-nick))))
3042     (if (erc-channel-p target)
3043         (let ((nick reason-or-nick))
3044           (erc-log (format "cmd: KICK: %s/%s: %s" nick target reasonstring))
3045           (erc-server-send (format "KICK %s %s :%s" target nick reasonstring)
3046                            nil target)
3047           t)
3048       (when target
3049         (let ((ch (erc-default-target)))
3050           (setq reasonstring (concat
3051                               (if reason-or-nick (concat reason-or-nick " "))
3052                               reasonstring))
3053           (if ch
3054               (progn
3055                 (erc-log
3056                  (format "cmd: KICK: %s/%s: %s" target ch reasonstring))
3057                 (erc-server-send
3058                  (format "KICK %s %s :%s" ch target reasonstring) nil ch))
3059             (erc-display-message nil 'error (current-buffer)
3060                                  'no-default-channel))
3061           t)))))
3062
3063 (defvar erc-script-args nil)
3064
3065 (defun erc-cmd-LOAD (line)
3066   "Load the script provided in the LINE.
3067 If LINE continues beyond the file name, the rest of
3068 it is put in a (local) variable `erc-script-args',
3069 which can be used in Emacs Lisp scripts.
3070
3071 The optional FORCE argument is ignored here - you can't force loading
3072 a script after exceeding the flood threshold."
3073   (cond
3074    ((string-match "^\\s-*\\(\\S-+\\)\\(.*\\)$" line)
3075     (let* ((file-to-find (match-string 1 line))
3076            (erc-script-args (match-string 2 line))
3077            (file (erc-find-file file-to-find erc-script-path)))
3078       (erc-log (format "cmd: LOAD: %s" file-to-find))
3079       (cond
3080        ((not file)
3081         (erc-display-message nil 'error (current-buffer)
3082                              'cannot-find-file ?f file-to-find))
3083        ((not (file-readable-p file))
3084         (erc-display-message nil 'error (current-buffer)
3085                              'cannot-read-file ?f file))
3086        (t
3087         (message "Loading \'%s\'..." file)
3088         (erc-load-script file)
3089         (message "Loading \'%s\'...done" file))))
3090     t)
3091    (t nil)))
3092
3093 (defun erc-cmd-WHOIS (user &optional server)
3094   "Display whois information for USER.
3095
3096 If SERVER is non-nil, use that, rather than the current server."
3097   ;; FIXME: is the above docstring correct?  -- Lawrence 2004-01-08
3098   (let ((send (if server
3099                   (format "WHOIS %s %s" user server)
3100                 (format "WHOIS %s" user))))
3101     (erc-log (format "cmd: %s" send))
3102     (erc-server-send send)
3103   t))
3104 (defalias 'erc-cmd-WI 'erc-cmd-WHOIS)
3105
3106 (defun erc-cmd-WHOAMI ()
3107   "Display whois information about yourself."
3108   (erc-cmd-WHOIS (erc-current-nick))
3109   t)
3110
3111 (defun erc-cmd-IDLE (nick)
3112   "Show the length of time NICK has been idle."
3113   (let ((origbuf (current-buffer))
3114         symlist)
3115     (erc-with-server-buffer
3116       (add-to-list 'symlist
3117                    (cons (erc-once-with-server-event
3118                           311 `(string= ,nick
3119                                         (second
3120                                          (erc-response.command-args parsed))))
3121                          'erc-server-311-functions))
3122       (add-to-list 'symlist
3123                    (cons (erc-once-with-server-event
3124                           312 `(string= ,nick
3125                                         (second
3126                                          (erc-response.command-args parsed))))
3127                          'erc-server-312-functions))
3128       (add-to-list 'symlist
3129                    (cons (erc-once-with-server-event
3130                           318 `(string= ,nick
3131                                         (second
3132                                          (erc-response.command-args parsed))))
3133                          'erc-server-318-functions))
3134       (add-to-list 'symlist
3135                    (cons (erc-once-with-server-event
3136                           319 `(string= ,nick
3137                                         (second
3138                                          (erc-response.command-args parsed))))
3139                          'erc-server-319-functions))
3140       (add-to-list 'symlist
3141                    (cons (erc-once-with-server-event
3142                           320 `(string= ,nick
3143                                         (second
3144                                          (erc-response.command-args parsed))))
3145                          'erc-server-320-functions))
3146       (add-to-list 'symlist
3147                    (cons (erc-once-with-server-event
3148                           330 `(string= ,nick
3149                                         (second
3150                                          (erc-response.command-args parsed))))
3151                          'erc-server-330-functions))
3152       (add-to-list 'symlist
3153                    (cons (erc-once-with-server-event
3154                           317
3155                           `(let ((idleseconds
3156                                   (string-to-number
3157                                    (third
3158                                     (erc-response.command-args parsed)))))
3159                              (erc-display-line
3160                               (erc-make-notice
3161                                (format "%s has been idle for %s."
3162                                        (erc-string-no-properties ,nick)
3163                                        (erc-seconds-to-string idleseconds)))
3164                               ,origbuf))
3165                           t)
3166                          'erc-server-317-functions))
3167
3168       ;; Send the WHOIS command.
3169       (erc-cmd-WHOIS nick)
3170
3171       ;; Remove the uninterned symbols from the server hooks that did not run.
3172       (run-at-time 20 nil `(lambda ()
3173                              (with-current-buffer ,(current-buffer)
3174                                (dolist (sym ',symlist)
3175                                  (let ((hooksym (cdr sym))
3176                                        (funcsym (car sym)))
3177                                    (remove-hook hooksym funcsym t))))))))
3178   t)
3179
3180 (defun erc-cmd-DESCRIBE (line)
3181   "Pose some action to a certain user.
3182 LINE has the format \"USER ACTION\"."
3183   (cond
3184    ((string-match
3185      "^\\s-*\\(\\S-+\\)\\s-\\(.*\\)$" line)
3186     (let ((dst (match-string 1 line))
3187           (s (match-string 2 line)))
3188       (erc-log (format "cmd: DESCRIBE: [%s] %s" dst s))
3189       (erc-send-action dst s))
3190     t)
3191    (t nil)))
3192 (put 'erc-cmd-DESCRIBE 'do-not-parse-args t)
3193
3194 (defun erc-cmd-ME (line)
3195   "Send LINE as an action."
3196   (cond
3197    ((string-match "^\\s-\\(.*\\)$" line)
3198     (let ((s (match-string 1 line)))
3199       (erc-log (format "cmd: ME: %s" s))
3200       (erc-send-action (erc-default-target) s))
3201     t)
3202    (t nil)))
3203 (put 'erc-cmd-ME 'do-not-parse-args t)
3204
3205 (defun erc-cmd-ME\'S (line)
3206   "Do a /ME command, but add the string \" 's\" to the beginning."
3207   (erc-cmd-ME (concat " 's" line)))
3208 (put 'erc-cmd-ME\'S 'do-not-parse-args t)
3209
3210 (defun erc-cmd-LASTLOG (line)
3211   "Show all lines in the current buffer matching the regexp LINE.
3212
3213 If a match spreads across multiple lines, all those lines are shown.
3214
3215 The lines are shown in a buffer named `*Occur*'.
3216 It serves as a menu to find any of the occurrences in this buffer.
3217 \\[describe-mode] in that buffer will explain how.
3218
3219 If LINE contains upper case characters (excluding those preceded by `\'),
3220 the matching is case-sensitive."
3221   (occur line)
3222   t)
3223 (put 'erc-cmd-LASTLOG 'do-not-parse-args t)
3224 (put 'erc-cmd-LASTLOG 'process-not-needed t)
3225
3226 (defun erc-send-message (line &optional force)
3227   "Send LINE to the current channel or user and display it.
3228
3229 See also `erc-message' and `erc-display-line'."
3230   (erc-message "PRIVMSG" (concat (erc-default-target) " " line) force)
3231   (erc-display-line
3232    (concat (erc-format-my-nick) line)
3233      (current-buffer))
3234   ;; FIXME - treat multiline, run hooks, or remove me?
3235   t)
3236
3237 (defun erc-cmd-MODE (line)
3238   "Change or display the mode value of a channel or user.
3239 The first word specifies the target.  The rest is the mode string
3240 to send.
3241
3242 If only one word is given, display the mode of that target.
3243
3244 A list of valid mode strings for Freenode may be found at
3245 URL `http://freenode.net/using_the_network.shtml'."
3246   (cond
3247    ((string-match "^\\s-\\(.*\\)$" line)
3248     (let ((s (match-string 1 line)))
3249       (erc-log (format "cmd: MODE: %s" s))
3250       (erc-server-send (concat "MODE " line)))
3251     t)
3252    (t nil)))
3253 (put 'erc-cmd-MODE 'do-not-parse-args t)
3254
3255 (defun erc-cmd-NOTICE (channel-or-user &rest message)
3256   "Send a notice to the channel or user given as the first word.
3257 The rest is the message to send."
3258   (erc-message "NOTICE" (concat channel-or-user " "
3259                                 (mapconcat #'identity message " "))))
3260
3261 (defun erc-cmd-MSG (line)
3262   "Send a message to the channel or user given as the first word in LINE.
3263
3264 The rest of LINE is the message to send."
3265   (erc-message "PRIVMSG" line))
3266
3267 (defalias 'erc-cmd-M 'erc-cmd-MSG)
3268 (put 'erc-cmd-MSG 'do-not-parse-args t)
3269
3270 (defun erc-cmd-SQUERY (line)
3271   "Send a Service Query to the service given as the first word in LINE.
3272
3273 The rest of LINE is the message to send."
3274   (erc-message "SQUERY" line))
3275
3276 (defun erc-cmd-NICK (nick)
3277   "Change current nickname to NICK."
3278   (erc-log (format "cmd: NICK: %s (erc-bad-nick: %S)" nick erc-bad-nick))
3279   (let ((nicklen (cdr (assoc "NICKLEN" (erc-with-server-buffer
3280                                          erc-server-parameters)))))
3281     (and nicklen (> (length nick) (string-to-number nicklen))
3282          (erc-display-message
3283           nil 'notice 'active 'nick-too-long
3284           ?i (length nick) ?l nicklen)))
3285   (erc-server-send (format "NICK %s" nick))
3286   (cond (erc-bad-nick
3287          (erc-set-current-nick nick)
3288          (erc-update-mode-line)
3289          (setq erc-bad-nick nil)))
3290   t)
3291
3292 (defun erc-cmd-PART (line)
3293   "When LINE is an empty string, leave the current channel.
3294 Otherwise leave the channel indicated by LINE."
3295   (cond
3296    ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-?\\(.*\\)$" line)
3297     (let* ((ch (match-string 1 line))
3298            (msg (match-string 2 line))
3299            (reason (funcall erc-part-reason (if (equal msg "") nil msg))))
3300       (erc-log (format "cmd: PART: %s: %s" ch reason))
3301       (erc-server-send (if (string= reason "")
3302                            (format "PART %s" ch)
3303                          (format "PART %s :%s" ch reason))
3304                        nil ch))
3305     t)
3306    ((string-match "^\\s-*\\(.*\\)$" line)
3307     (let* ((ch (erc-default-target))
3308            (msg (match-string 1 line))
3309            (reason (funcall erc-part-reason (if (equal msg "") nil msg))))
3310       (if (and ch (erc-channel-p ch))
3311           (progn
3312             (erc-log (format "cmd: PART: %s: %s" ch reason))
3313             (erc-server-send (if (string= reason "")
3314                                  (format "PART %s" ch)
3315                                (format "PART %s :%s" ch reason))
3316                              nil ch))
3317         (erc-display-message nil 'error (current-buffer) 'no-target)))
3318     t)
3319    (t nil)))
3320 (put 'erc-cmd-PART 'do-not-parse-args t)
3321
3322 (defalias 'erc-cmd-LEAVE 'erc-cmd-PART)
3323
3324 (defun erc-cmd-PING (recipient)
3325   "Ping RECIPIENT."
3326   (let ((time (format "%f" (erc-current-time))))
3327     (erc-log (format "cmd: PING: %s" time))
3328     (erc-cmd-CTCP recipient "PING" time)))
3329
3330 (defun erc-cmd-QUOTE (line)
3331   "Send LINE directly to the server.
3332 All the text given as argument is sent to the sever as unmodified,
3333 just as you provided it.  Use this command with care!"
3334   (cond
3335    ((string-match "^ ?\\(.+\\)$" line)
3336     (erc-server-send (match-string 1 line)))
3337    (t nil)))
3338 (put 'erc-cmd-QUOTE 'do-not-parse-args t)
3339
3340 (defcustom erc-query-display 'window
3341   "Indicates how to display query buffers when using the /QUERY
3342 command to talk to someone.
3343
3344 The default behavior is to display the message in a new window
3345 and bring it to the front.  See the documentation for
3346 `erc-join-buffer' for a description of the available choices.
3347
3348 See also `erc-auto-query' to decide how private messages from
3349 other people should be displayed."
3350   :group 'erc-query
3351   :type '(choice (const :tag "Split window and select" window)
3352                  (const :tag "Split window, don't select" window-noselect)
3353                  (const :tag "New frame" frame)
3354                  (const :tag "Bury in new buffer" bury)
3355                  (const :tag "Use current buffer" buffer)
3356                  (const :tag "Use current buffer" t)))
3357
3358 (defun erc-cmd-QUERY (&optional user)
3359   "Open a query with USER.
3360 The type of query window/frame/etc will depend on the value of
3361 `erc-query-display'.
3362
3363 If USER is omitted, close the current query buffer if one exists
3364 - except this is broken now ;-)"
3365   (interactive
3366    (list (read-from-minibuffer "Start a query with: " nil)))
3367   (let ((session-buffer (erc-server-buffer))
3368         (erc-join-buffer erc-query-display))
3369     (if user
3370         (erc-query user session-buffer)
3371       ;; currently broken, evil hack to display help anyway
3372       ;(erc-delete-query))))
3373       (signal 'wrong-number-of-arguments ""))))
3374 (defalias 'erc-cmd-Q 'erc-cmd-QUERY)
3375
3376 (defun erc-quit-reason-normal (&optional s)
3377   "Normal quit message.
3378
3379 If S is non-nil, it will be used as the quit reason."
3380   (or s
3381       (format "\C-bERC\C-b %s (IRC client for Emacs)"; - \C-b%s\C-b"
3382               erc-version-string) ; erc-official-location)
3383   ))
3384
3385 (defun erc-quit-reason-zippy (&optional s)
3386   "Zippy quit message.
3387
3388 If S is non-nil, it will be used as the quit reason."
3389   (or s
3390       (erc-replace-regexp-in-string "\n" "" (yow))))
3391
3392 (defun erc-quit-reason-various (s)
3393   "Choose a quit reason based on S (a string)."
3394   (when (featurep 'xemacs) (require 'poe))
3395   (let ((res (car (assoc-default (or s "")
3396                    erc-quit-reason-various-alist 'string-match))))
3397     (cond
3398      ((functionp res) (funcall res))
3399      ((stringp res) res)
3400      (s s)
3401      (t (erc-quit-reason-normal)))))
3402
3403 (defun erc-part-reason-normal (&optional s)
3404   "Normal part message.
3405
3406 If S is non-nil, it will be used as the quit reason."
3407   (or s
3408       (format "\C-bERC\C-b %s (IRC client for Emacs)"; - \C-b%s\C-b"
3409               erc-version-string) ; erc-official-location)
3410   ))
3411
3412 (defun erc-part-reason-zippy (&optional s)
3413   "Zippy part message.
3414
3415 If S is non-nil, it will be used as the quit reason."
3416   (or s
3417       (erc-replace-regexp-in-string "\n" "" (yow))))
3418
3419 (defun erc-part-reason-various (s)
3420   "Choose a part reason based on S (a string)."
3421   (when (featurep 'xemacs) (require 'poe))
3422   (let ((res (car (assoc-default (or s "")
3423                    erc-part-reason-various-alist 'string-match))))
3424     (cond
3425      ((functionp res) (funcall res))
3426      ((stringp res) res)
3427      (s s)
3428      (t (erc-part-reason-normal)))))
3429
3430 (defun erc-cmd-QUIT (reason)
3431   "Disconnect from the current server.
3432 If REASON is omitted, display a default quit message, otherwise display
3433 the message given by REASON."
3434   (unless reason
3435     (setq reason ""))
3436   (cond
3437    ((string-match "^\\s-*\\(.*\\)$" reason)
3438     (let* ((s (match-string 1 reason))
3439            (buffer (erc-server-buffer))
3440            (reason (funcall erc-quit-reason (if (equal s "") nil s)))
3441            server-proc)
3442       (with-current-buffer (if (and buffer
3443                                     (bufferp buffer))
3444                                buffer
3445                              (current-buffer))
3446         (erc-log (format "cmd: QUIT: %s" reason))
3447         (setq erc-server-quitting t)
3448         (erc-set-active-buffer (erc-server-buffer))
3449         (setq server-proc erc-server-process)
3450         (erc-server-send (format "QUIT :%s" reason)))
3451       (run-hook-with-args 'erc-quit-hook server-proc)
3452       (when erc-kill-queries-on-quit
3453         (erc-kill-query-buffers server-proc))
3454       ;; if the process has not been killed within 4 seconds, kill it
3455       (run-at-time 4 nil
3456                    (lambda (proc)
3457                      (when (and (processp proc)
3458                                 (memq (process-status proc) '(run open)))
3459                        (delete-process proc)))
3460                    server-proc))
3461     t)
3462    (t nil)))
3463
3464 (defalias 'erc-cmd-BYE 'erc-cmd-QUIT)
3465 (defalias 'erc-cmd-EXIT 'erc-cmd-QUIT)
3466 (defalias 'erc-cmd-SIGNOFF 'erc-cmd-QUIT)
3467 (put 'erc-cmd-QUIT 'do-not-parse-args t)
3468 (put 'erc-cmd-QUIT 'process-not-needed t)
3469
3470 (defun erc-cmd-GQUIT (reason)
3471   "Disconnect from all servers at once with the same quit REASON."
3472   (erc-with-all-buffers-of-server nil #'erc-open-server-buffer-p
3473                                   (erc-cmd-QUIT reason))
3474   (when erc-kill-queries-on-quit
3475     ;; if the query buffers have not been killed within 4 seconds,
3476     ;; kill them
3477     (run-at-time
3478      4 nil
3479      (lambda ()
3480        (dolist (buffer (erc-buffer-list (lambda (buf)
3481                                           (not (erc-server-buffer-p buf)))))
3482          (kill-buffer buffer)))))
3483   t)
3484
3485 (defalias 'erc-cmd-GQ 'erc-cmd-GQUIT)
3486 (put 'erc-cmd-GQUIT 'do-not-parse-args t)
3487 (put 'erc-cmd-GQUIT 'process-not-needed t)
3488
3489 (defun erc-cmd-RECONNECT ()
3490   "Try to reconnect to the current IRC server."
3491   (let ((buffer (erc-server-buffer))
3492         (process nil))
3493     (unless (buffer-live-p buffer)
3494       (setq buffer (current-buffer)))
3495     (with-current-buffer buffer
3496       (setq erc-server-quitting nil)
3497       (setq erc-server-reconnecting t)
3498       (setq erc-server-reconnect-count 0)
3499       (setq process (get-buffer-process (erc-server-buffer)))
3500       (if process
3501           (delete-process process)
3502         (erc-server-reconnect))
3503       (setq erc-server-reconnecting nil)))
3504   t)
3505 (put 'erc-cmd-RECONNECT 'process-not-needed t)
3506
3507 (defun erc-cmd-SERVER (server)
3508   "Connect to SERVER, leaving existing connection intact."
3509   (erc-log (format "cmd: SERVER: %s" server))
3510   (condition-case nil
3511       (erc :server server :nick (erc-current-nick))
3512     (error
3513      (erc-error "Cannot find host %s." server)))
3514   t)
3515 (put 'erc-cmd-SERVER 'process-not-needed t)
3516
3517 (defvar motif-version-string)
3518 (defvar gtk-version-string)
3519
3520 (defun erc-cmd-SV ()
3521   "Say the current ERC and Emacs version into channel."
3522   (erc-send-message (format "I'm using ERC %s with %s %s (%s%s) of %s."
3523                             erc-version-string
3524                             (if (featurep 'xemacs) "XEmacs" "GNU Emacs")
3525                             emacs-version
3526                             system-configuration
3527                             (concat
3528                              (cond ((featurep 'motif)
3529                                     (concat ", " (substring
3530                                                   motif-version-string 4)))
3531                                    ((featurep 'gtk)
3532                                     (concat ", GTK+ Version "
3533                                             gtk-version-string))
3534                                    ((featurep 'x-toolkit) ", X toolkit")
3535                                    (t ""))
3536                              (if (and (boundp 'x-toolkit-scroll-bars)
3537                                       (memq x-toolkit-scroll-bars
3538                                             '(xaw xaw3d)))
3539                                  (format ", %s scroll bars"
3540                                          (capitalize (symbol-name
3541                                                       x-toolkit-scroll-bars)))
3542                                "")
3543                              (if (featurep 'multi-tty) ", multi-tty" ""))
3544                             erc-emacs-build-time))
3545   t)
3546
3547 (defun erc-cmd-SM ()
3548   "Say the current ERC modes into channel."
3549   (erc-send-message (format "I'm using the following modules: %s!"
3550                             (erc-modes)))
3551   t)
3552
3553 (defun erc-cmd-DEOP (&rest people)
3554   "Remove the operator setting from user(s) given in PEOPLE."
3555   (when (> (length people) 0)
3556     (erc-server-send (concat "MODE " (erc-default-target)
3557                               " -"
3558                               (make-string (length people) ?o)
3559                               " "
3560                               (mapconcat 'identity people " ")))
3561     t))
3562
3563 (defun erc-cmd-OP (&rest people)
3564   "Add the operator setting to users(s) given in PEOPLE."
3565   (when (> (length people) 0)
3566     (erc-server-send (concat "MODE " (erc-default-target)
3567                               " +"
3568                               (make-string (length people) ?o)
3569                               " "
3570                               (mapconcat 'identity people " ")))
3571     t))
3572
3573 (defun erc-cmd-TIME (&optional line)
3574   "Request the current time and date from the current server."
3575   (cond
3576    ((and line (string-match "^\\s-*\\(.*\\)$" line))
3577     (let ((args (match-string 1 line)))
3578       (erc-log (format "cmd: TIME: %s" args))
3579       (erc-server-send (concat "TIME " args)))
3580     t)
3581    (t (erc-server-send "TIME"))))
3582 (defalias 'erc-cmd-DATE 'erc-cmd-TIME)
3583
3584 (defun erc-cmd-TOPIC (topic)
3585   "Set or request the topic for a channel.
3586 LINE has the format: \"#CHANNEL TOPIC\", \"#CHANNEL\", \"TOPIC\"
3587 or the empty string.
3588
3589 If no #CHANNEL is given, the default channel is used.  If TOPIC is
3590 given, the channel topic is modified, otherwise the current topic will
3591 be displayed."
3592   (cond
3593    ;; /topic #channel TOPIC
3594    ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-\\(.*\\)$" topic)
3595     (let ((ch (match-string 1 topic))
3596           (topic (match-string 2 topic)))
3597       (erc-log (format "cmd: TOPIC [%s]: %s" ch topic))
3598       (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))
3599     t)
3600    ;; /topic #channel
3601    ((string-match "^\\s-*\\([&#+!]\\S-+\\)" topic)
3602     (let ((ch (match-string 1 topic)))
3603       (erc-server-send (format "TOPIC %s" ch) nil ch)
3604       t))
3605    ;; /topic
3606    ((string-match "^\\s-*$" topic)
3607     (let ((ch (erc-default-target)))
3608       (erc-server-send (format "TOPIC %s" ch) nil ch)
3609       t))
3610    ;; /topic TOPIC
3611    ((string-match "^\\s-*\\(.*\\)$" topic)
3612     (let ((ch (erc-default-target))
3613           (topic (match-string 1 topic)))
3614       (if (and ch (erc-channel-p ch))
3615           (progn
3616             (erc-log (format "cmd: TOPIC [%s]: %s" ch topic))
3617             (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))
3618         (erc-display-message nil 'error (current-buffer) 'no-target)))
3619     t)
3620    (t nil)))
3621 (defalias 'erc-cmd-T 'erc-cmd-TOPIC)
3622 (put 'erc-cmd-TOPIC 'do-not-parse-args t)
3623
3624 (defun erc-cmd-APPENDTOPIC (topic)
3625   "Append TOPIC to the current channel topic, separated by a space."
3626   (let ((oldtopic erc-channel-topic))
3627     ;; display help when given no arguments
3628     (when (string-match "^\\s-*$" topic)
3629       (signal 'wrong-number-of-arguments nil))
3630     ;; strip trailing ^O
3631     (when (string-match "\\(.*\\)\C-o" oldtopic)
3632       (erc-cmd-TOPIC (concat (match-string 1 oldtopic) topic)))))
3633 (defalias 'erc-cmd-AT 'erc-cmd-APPENDTOPIC)
3634 (put 'erc-cmd-APPENDTOPIC 'do-not-parse-args t)
3635
3636 (defun erc-cmd-CLEARTOPIC (&optional channel)
3637   "Clear the topic for a CHANNEL.
3638 If CHANNEL is not specified, clear the topic for the default channel."
3639   (interactive "sClear topic of channel (RET is current channel): ")
3640   (let ((chnl (or (and (erc-channel-p channel) channel) (erc-default-target))))
3641     (when chnl
3642       (erc-server-send (format "TOPIC %s :" chnl))
3643       t)))
3644
3645 ;;; Banlists
3646
3647 (defvar erc-channel-banlist nil
3648   "A list of bans seen for the current channel.
3649
3650 Each ban is an alist of the form:
3651   (WHOSET . MASK)
3652
3653 The property `received-from-server' indicates whether
3654 or not the ban list has been requested from the server.")
3655 (make-variable-buffer-local 'erc-channel-banlist)
3656 (put 'erc-channel-banlist 'received-from-server nil)
3657
3658 (defun erc-cmd-BANLIST ()
3659   "Pretty-print the contents of `erc-channel-banlist'.
3660
3661 The ban list is fetched from the server if necessary."
3662   (let ((chnl (erc-default-target))
3663         (chnl-name (buffer-name)))
3664
3665     (cond
3666      ((not (erc-channel-p chnl))
3667       (erc-display-line (erc-make-notice "You're not on a channel\n")
3668                         'active))
3669
3670      ((not (get 'erc-channel-banlist 'received-from-server))
3671       (let ((old-367-hook erc-server-367-functions))
3672         (setq erc-server-367-functions 'erc-banlist-store
3673               erc-channel-banlist nil)
3674         ;; fetch the ban list then callback
3675         (erc-with-server-buffer
3676           (erc-once-with-server-event
3677            368
3678            `(with-current-buffer ,chnl-name
3679               (put 'erc-channel-banlist 'received-from-server t)
3680               (setq erc-server-367-functions ',old-367-hook)
3681               (erc-cmd-BANLIST)
3682               t))
3683           (erc-server-send (format "MODE %s b" chnl)))))
3684
3685      ((null erc-channel-banlist)
3686       (erc-display-line (erc-make-notice
3687                          (format "No bans for channel: %s\n" chnl))
3688                         'active)
3689       (put 'erc-channel-banlist 'received-from-server nil))
3690
3691      (t
3692       (let* ((erc-fill-column (or (and (boundp 'erc-fill-column)
3693                                        erc-fill-column)
3694                                   (and (boundp 'fill-column)
3695                                        fill-column)
3696                                   (1- (window-width))))
3697              (separator (make-string erc-fill-column ?=))
3698              (fmt (concat
3699                    "%-" (number-to-string (/ erc-fill-column 2)) "s"
3700                    "%" (number-to-string (/ erc-fill-column 2)) "s")))
3701
3702         (erc-display-line
3703          (erc-make-notice (format "Ban list for channel: %s\n"
3704                                   (erc-default-target)))
3705          'active)
3706
3707         (erc-display-line separator 'active)
3708         (erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
3709         (erc-display-line separator 'active)
3710
3711         (mapc
3712          (lambda (x)
3713            (erc-display-line
3714             (format fmt
3715                     (truncate-string-to-width (cdr x) (/ erc-fill-column 2))
3716                     (if (car x)
3717                         (truncate-string-to-width (car x) (/ erc-fill-column 2))
3718                       ""))
3719             'active))
3720          erc-channel-banlist)
3721
3722         (erc-display-line (erc-make-notice "End of Ban list")
3723                           'active)
3724         (put 'erc-channel-banlist 'received-from-server nil)))))
3725   t)
3726
3727 (defalias 'erc-cmd-BL 'erc-cmd-BANLIST)
3728
3729 (defun erc-cmd-MASSUNBAN ()
3730   "Mass Unban.
3731
3732 Unban all currently banned users in the current channel."
3733   (let ((chnl (erc-default-target)))
3734     (cond
3735
3736      ((not (erc-channel-p chnl))
3737       (erc-display-line
3738        (erc-make-notice "You're not on a channel\n")
3739        'active))
3740
3741      ((not (get 'erc-channel-banlist 'received-from-server))
3742       (let ((old-367-hook erc-server-367-functions))
3743         (setq erc-server-367-functions 'erc-banlist-store)
3744       ;; fetch the ban list then callback
3745       (erc-with-server-buffer
3746         (erc-once-with-server-event
3747          368
3748          `(with-current-buffer ,chnl
3749             (put 'erc-channel-banlist 'received-from-server t)
3750               (setq erc-server-367-functions ,old-367-hook)
3751             (erc-cmd-MASSUNBAN)
3752             t))
3753           (erc-server-send (format "MODE %s b" chnl)))))
3754
3755      (t (let ((bans (mapcar 'cdr erc-channel-banlist)))
3756     (when bans
3757       ;; Glob the bans into groups of three, and carry out the unban.
3758       ;; eg. /mode #foo -bbb a*!*@* b*!*@* c*!*@*
3759       (mapc
3760        (lambda (x)
3761          (erc-server-send
3762           (format "MODE %s -%s %s" (erc-default-target)
3763                   (make-string (length x) ?b)
3764                         (mapconcat 'identity x " "))))
3765        (erc-group-list bans 3))))
3766         t))))
3767
3768 (defalias 'erc-cmd-MUB 'erc-cmd-MASSUNBAN)
3769
3770 ;;;; End of IRC commands
3771
3772 (defun erc-ensure-channel-name (channel)
3773   "Return CHANNEL if it is a valid channel name.
3774 Eventually add a # in front of it, if that turns it into a valid channel name."
3775   (if (erc-channel-p channel)
3776       channel
3777     (concat "#" channel)))
3778
3779 (defun erc-grab-region (start end)
3780   "Copy the region between START and END in a recreatable format.
3781
3782 Converts all the IRC text properties in each line of the region
3783 into control codes and writes them to a separate buffer.  The
3784 resulting text may be used directly as a script to generate this
3785 text again."
3786   (interactive "r")
3787   (erc-set-active-buffer (current-buffer))
3788   (save-excursion
3789     (let* ((cb (current-buffer))
3790            (buf (generate-new-buffer erc-grab-buffer-name))
3791            (region (buffer-substring start end))
3792            (lines (erc-split-multiline-safe region)))
3793       (set-buffer buf)
3794       (dolist (line lines)
3795         (insert (concat line "\n")))
3796       (set-buffer cb)
3797       (switch-to-buffer-other-window buf)))
3798   (message "erc-grab-region doesn't grab colors etc. anymore. If you use this, please tell the maintainers.")
3799   (ding))
3800
3801 (defun erc-display-prompt (&optional buffer pos prompt face)
3802   "Display PROMPT in BUFFER at position POS.
3803 Display an ERC prompt in BUFFER.
3804
3805 If PROMPT is nil, one is constructed with the function `erc-prompt'.
3806 If BUFFER is nil, the `current-buffer' is used.
3807 If POS is nil, PROMPT will be displayed at `point'.
3808 If FACE is non-nil, it will be used to propertize the prompt.  If it is nil,
3809 `erc-prompt-face' will be used."
3810   (let* ((prompt (or prompt (erc-prompt)))
3811          (l (length prompt))
3812          (ob (current-buffer)))
3813     ;; We cannot use save-excursion because we move point, therefore
3814     ;; we resort to the ol' ob trick to restore this.
3815     (when (and buffer (bufferp buffer))
3816       (set-buffer buffer))
3817
3818     ;; now save excursion again to store where point and mark are
3819     ;; in the current buffer
3820     (save-excursion
3821       (setq pos (or pos (point)))
3822       (goto-char pos)
3823       (when (> l 0)
3824         ;; Do not extend the text properties when typing at the end
3825         ;; of the prompt, but stuff typed in front of the prompt
3826         ;; shall remain part of the prompt.
3827         (setq prompt (erc-propertize prompt
3828                                      'start-open t ; XEmacs
3829                                      'rear-nonsticky t ; Emacs
3830                                      'erc-prompt t
3831                                      'field t
3832                                      'front-sticky t
3833                                      'read-only t))
3834         (erc-put-text-property 0 (1- (length prompt))
3835                                'face (or face 'erc-prompt-face)
3836                                prompt)
3837         (insert prompt))
3838       ;; Set the input marker
3839       (set-marker erc-input-marker (point)))
3840
3841     ;; Now we are back at the old position.  If the prompt was
3842     ;; inserted here or before us, advance point by the length of
3843     ;; the prompt.
3844     (when (or (not pos) (<= (point) pos))
3845       (forward-char l))
3846     ;; Clear the undo buffer now, so the user can undo his stuff,
3847     ;; but not the stuff we did. Sneaky!
3848     (setq buffer-undo-list nil)
3849     (set-buffer ob)))
3850
3851 ;; interactive operations
3852
3853 (defun erc-input-message ()
3854   "Read input from the minibuffer."
3855   (interactive)
3856   (let ((minibuffer-allow-text-properties t)
3857         (read-map minibuffer-local-map))
3858     (insert (read-from-minibuffer "Message: "
3859                                   (string (if (featurep 'xemacs)
3860                                               last-command-char
3861                                             last-command-event)) read-map))
3862     (erc-send-current-line)))
3863
3864 (defvar erc-action-history-list ()
3865   "History list for interactive action input.")
3866
3867 (defun erc-input-action ()
3868   "Interactively input a user action and send it to IRC."
3869   (interactive "")
3870   (erc-set-active-buffer (current-buffer))
3871   (let ((action (read-from-minibuffer
3872                  "Action: " nil nil nil 'erc-action-history-list)))
3873     (if (not (string-match "^\\s-*$" action))
3874         (erc-send-action (erc-default-target) action))))
3875
3876 (defun erc-join-channel (channel &optional key)
3877   "Join CHANNEL.
3878
3879 If `point' is at the beginning of a channel name, use that as default."
3880   (interactive
3881    (list
3882     (let ((chnl (if (looking-at "\\([&#+!][^ \n]+\\)") (match-string 1) ""))
3883           (table (when (erc-server-buffer-live-p)
3884                    (set-buffer (process-buffer erc-server-process))
3885                    erc-channel-list)))
3886       (completing-read "Join channel: " table nil nil nil nil chnl))
3887     (when (or current-prefix-arg erc-prompt-for-channel-key)
3888       (read-from-minibuffer "Channel key (RET for none): " nil))))
3889   (erc-cmd-JOIN channel (when (>= (length key) 1) key)))
3890
3891 (defun erc-part-from-channel (reason)
3892   "Part from the current channel and prompt for a REASON."
3893   (interactive
3894    (list
3895     (if (and (boundp 'reason) (stringp reason) (not (string= reason "")))
3896         reason
3897       (read-from-minibuffer (concat "Reason for leaving " (erc-default-target)
3898                                     ": ")))))
3899   (erc-cmd-PART (concat (erc-default-target)" " reason)))
3900
3901 (defun erc-set-topic (topic)
3902   "Prompt for a TOPIC for the current channel."
3903   (interactive
3904    (list
3905     (read-from-minibuffer
3906      (concat "Set topic of " (erc-default-target) ": ")
3907      (when erc-channel-topic
3908        (let ((ss (split-string erc-channel-topic "\C-o")))
3909          (cons (apply 'concat (if (cdr ss) (butlast ss) ss))
3910                0))))))
3911   (let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter
3912     (erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list)))))
3913
3914 (defun erc-set-channel-limit (&optional limit)
3915   "Set a LIMIT for the current channel.  Remove limit if nil.
3916 Prompt for one if called interactively."
3917   (interactive (list (read-from-minibuffer
3918                       (format "Limit for %s (RET to remove limit): "
3919                               (erc-default-target)))))
3920   (let ((tgt (erc-default-target)))
3921     (if (and limit (>= (length limit) 1))
3922         (erc-server-send (format "MODE %s +l %s" tgt limit))
3923       (erc-server-send (format "MODE %s -l" tgt)))))
3924
3925 (defun erc-set-channel-key (&optional key)
3926   "Set a KEY for the current channel.  Remove key if nil.
3927 Prompt for one if called interactively."
3928   (interactive (list (read-from-minibuffer
3929                       (format "Key for %s (RET to remove key): "
3930                               (erc-default-target)))))
3931   (let ((tgt (erc-default-target)))
3932     (if (and key (>= (length key) 1))
3933         (erc-server-send (format "MODE %s +k %s" tgt key))
3934       (erc-server-send (format "MODE %s -k" tgt)))))
3935
3936 (defun erc-quit-server (reason)
3937   "Disconnect from current server after prompting for REASON.
3938 `erc-quit-reason' works with this just like with `erc-cmd-QUIT'."
3939   (interactive (list (read-from-minibuffer
3940                       (format "Reason for quitting %s: "
3941                               (or erc-server-announced-name
3942                                   erc-session-server)))))
3943   (erc-cmd-QUIT reason))
3944
3945 ;; Movement of point
3946
3947 (defun erc-bol ()
3948   "Move `point' to the beginning of the current line.
3949
3950 This places `point' just after the prompt, or at the beginning of the line."
3951   (interactive)
3952   (forward-line 0)
3953   (when (get-text-property (point) 'erc-prompt)
3954     (goto-char erc-input-marker))
3955   (point))
3956
3957 (defun erc-kill-input ()
3958   "Kill current input line using `erc-bol' followed by `kill-line'."
3959   (interactive)
3960   (when (and (erc-bol)
3961              (/= (point) (point-max))) ;; Prevent a (ding) and an error when
3962                                        ;; there's nothing to kill
3963     (if (boundp 'erc-input-ring-index)
3964         (setq erc-input-ring-index nil))
3965     (kill-line)))
3966
3967 (defun erc-complete-word-at-point ()
3968   (run-hook-with-args-until-success 'erc-complete-functions))
3969
3970 (define-obsolete-function-alias 'erc-complete-word 'completion-at-point "24.1")
3971
3972 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3973 ;;
3974 ;;                        IRC SERVER INPUT HANDLING
3975 ;;
3976 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3977
3978 ;;;; New Input parsing
3979
3980 ; Stolen from ZenIRC. I just wanna test this code, so here is
3981 ; experiment area.
3982
3983 (defcustom erc-default-server-hook '(erc-debug-missing-hooks
3984                                      erc-default-server-handler)
3985   "Default for server messages which aren't covered by `erc-server-hooks'."
3986   :group 'erc-server-hooks
3987   :type 'hook)
3988
3989 (defun erc-default-server-handler (proc parsed)
3990   "Default server handler.
3991
3992 Displays PROC and PARSED appropriately using `erc-display-message'."
3993   (erc-display-message
3994    parsed 'notice proc
3995    (mapconcat
3996     'identity
3997     (let (res)
3998       (mapc #'(lambda (x)
3999                 (if (stringp x)
4000                     (setq res (append res (list x)))))
4001             parsed)
4002       res)
4003     " ")))
4004
4005 (defvar erc-server-vectors
4006   '(["msgtype" "sender" "to" "arg1" "arg2" "arg3" "..."])
4007   "List of received server messages which ERC does not specifically handle.
4008 See `erc-debug-missing-hooks'.")
4009 ;(make-variable-buffer-local 'erc-server-vectors)
4010
4011 (defun erc-debug-missing-hooks (proc parsed)
4012   "Add PARSED server message ERC does not yet handle to `erc-server-vectors'.
4013 These vectors can be helpful when adding new server message handlers to ERC.
4014 See `erc-default-server-hook'."
4015   (nconc erc-server-vectors (list parsed))
4016   nil)
4017
4018 (defun erc-query (target server)
4019   "Open a query buffer on TARGET, using SERVER.
4020 To change how this query window is displayed, use `let' to bind
4021 `erc-join-buffer' before calling this."
4022   (unless (and server
4023                (buffer-live-p server)
4024                (set-buffer server))
4025     (error "Couldn't switch to server buffer"))
4026   (let ((buf (erc-open erc-session-server
4027                        erc-session-port
4028                        (erc-current-nick)
4029                        erc-session-user-full-name
4030                        nil
4031                        nil
4032                        (list target)
4033                        target
4034                        erc-server-process)))
4035     (unless buf
4036       (error "Couldn't open query window"))
4037     (erc-update-mode-line)
4038     buf))
4039
4040 (defcustom erc-auto-query 'window-noselect
4041   "If non-nil, create a query buffer each time you receive a private message.
4042 If the buffer doesn't already exist, it is created.
4043
4044 This can be set to a symbol, to control how the new query window
4045 should appear.  The default behavior is to display the buffer in
4046 a new window, but not to select it.  See the documentation for
4047 `erc-join-buffer' for a description of the available choices."
4048   :group 'erc-query
4049   :type '(choice (const :tag "Don't create query window" nil)
4050                  (const :tag "Split window and select" window)
4051                  (const :tag "Split window, don't select" window-noselect)
4052                  (const :tag "New frame" frame)
4053                  (const :tag "Bury in new buffer" bury)
4054                  (const :tag "Use current buffer" buffer)
4055                  (const :tag "Use current buffer" t)))
4056
4057 (defcustom erc-query-on-unjoined-chan-privmsg t
4058   "If non-nil create query buffer on receiving any PRIVMSG at all.
4059 This includes PRIVMSGs directed to channels.  If you are using an IRC
4060 bouncer, such as dircproxy, to keep a log of channels when you are
4061 disconnected, you should set this option to t."
4062   :group 'erc-query
4063   :type 'boolean)
4064
4065 (defcustom erc-format-query-as-channel-p t
4066   "If non-nil, format text from others in a query buffer like in a channel,
4067 otherwise format like a private message."
4068   :group 'erc-query
4069   :type 'boolean)
4070
4071 (defcustom erc-minibuffer-notice nil
4072   "If non-nil, print ERC notices for the user in the minibuffer.
4073 Only happens when the session buffer isn't visible."
4074   :group 'erc-display
4075   :type 'boolean)
4076
4077 (defcustom erc-minibuffer-ignored nil
4078   "If non-nil, print a message in the minibuffer if we ignored something."
4079   :group 'erc-ignore
4080   :type 'boolean)
4081
4082 (defun erc-wash-quit-reason (reason nick login host)
4083   "Remove duplicate text from quit REASON.
4084 Specifically in relation to NICK (user@host) information.  Returns REASON
4085 unmodified if nothing can be removed.
4086 E.g. \"Read error to Nick [user@some.host]: 110\" would be shortened to
4087 \"Read error: 110\". The same applies for \"Ping Timeout\"."
4088   (setq nick (regexp-quote nick)
4089         login (regexp-quote login)
4090         host (regexp-quote host))
4091   (or (when (string-match (concat "^\\(Read error\\) to "
4092                                   nick "\\[" host "\\]: "
4093                                   "\\(.+\\)$") reason)
4094         (concat (match-string 1 reason) ": " (match-string 2 reason)))
4095       (when (string-match (concat "^\\(Ping timeout\\) for "
4096                                   nick "\\[" host "\\]$") reason)
4097         (match-string 1 reason))
4098       reason))
4099
4100 (defun erc-nickname-in-use (nick reason)
4101   "If NICK is unavailable, tell the user the REASON.
4102
4103 See also `erc-display-error-notice'."
4104   (if (or (not erc-try-new-nick-p)
4105           ;; how many default-nicks are left + one more try...
4106           (eq erc-nick-change-attempt-count
4107               (if (consp erc-nick)
4108                   (+ (length erc-nick) 1)
4109                 1)))
4110       (erc-display-error-notice
4111        nil
4112        (format "Nickname %s is %s, try another." nick reason))
4113     (setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1))
4114     (let ((newnick (nth 1 erc-default-nicks))
4115           (nicklen (cdr (assoc "NICKLEN"
4116                                (erc-with-server-buffer
4117                                  erc-server-parameters)))))
4118       (setq erc-bad-nick t)
4119       ;; try to use a different nick
4120       (if erc-default-nicks
4121           (setq erc-default-nicks (cdr erc-default-nicks)))
4122       (if (not newnick)
4123           (setq newnick (concat (truncate-string-to-width
4124                                  nick
4125                                  (if (and erc-server-connected nicklen)
4126                                      (- (string-to-number nicklen)
4127                                         (length erc-nick-uniquifier))
4128                                    ;; rfc2812 max nick length = 9
4129                                    ;; we must assume this is the
4130                                    ;; server's setting if we haven't
4131                                    ;; established a connection yet
4132                                    (- 9 (length erc-nick-uniquifier))))
4133                                 erc-nick-uniquifier)))
4134       (erc-cmd-NICK newnick)
4135       (erc-display-error-notice
4136        nil
4137        (format "Nickname %s is %s, trying %s"
4138                nick reason newnick)))))
4139
4140 ;;; Server messages
4141
4142 (defgroup erc-server-hooks nil
4143   "Server event callbacks.
4144 Every server event - like numeric replies - has its own hook.
4145 Those hooks are all called using `run-hook-with-args-until-success'.
4146 They receive as first argument the process object from where the event
4147 originated from,
4148 and as second argument the event parsed as a vector."
4149   :group 'erc-hooks)
4150
4151 (defun erc-display-server-message (proc parsed)
4152   "Display the message sent by the server as a notice."
4153   (erc-display-message
4154    parsed 'notice 'active (erc-response.contents parsed)))
4155
4156 (defun erc-auto-query (proc parsed)
4157   ;; FIXME: This needs more documentation, unless it's not a user function --
4158   ;; Lawrence 2004-01-08
4159   "Put this on `erc-server-PRIVMSG-functions'."
4160   (when erc-auto-query
4161     (let* ((nick (car (erc-parse-user (erc-response.sender parsed))))
4162            (target (car (erc-response.command-args parsed)))
4163            (msg (erc-response.contents parsed))
4164            (query  (if (not erc-query-on-unjoined-chan-privmsg)
4165                        nick
4166                      (if (erc-current-nick-p target)
4167                          nick
4168                        target))))
4169       (and (not (erc-ignored-user-p (erc-response.sender parsed)))
4170            (or erc-query-on-unjoined-chan-privmsg
4171                (string= target (erc-current-nick)))
4172            (not (erc-get-buffer query proc))
4173            (not (erc-is-message-ctcp-and-not-action-p msg))
4174            (let ((erc-query-display erc-auto-query))
4175              (erc-cmd-QUERY query))
4176            nil))))
4177
4178 (defun erc-is-message-ctcp-p (message)
4179   "Check if MESSAGE is a CTCP message or not."
4180   (string-match "^\C-a\\([^\C-a]*\\)\C-a?$" message))
4181
4182 (defun erc-is-message-ctcp-and-not-action-p (message)
4183   "Check if MESSAGE is a CTCP message or not."
4184   (and (erc-is-message-ctcp-p message)
4185        (not (string-match "^\C-a\\ACTION.*\C-a$" message))))
4186
4187 (defun erc-format-privmessage (nick msg privp msgp)
4188   "Format a PRIVMSG in an insertable fashion."
4189   (let* ((mark-s (if msgp (if privp "*" "<") "-"))
4190          (mark-e (if msgp (if privp "*" ">") "-"))
4191          (str    (format "%s%s%s %s" mark-s nick mark-e msg))
4192          (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face))
4193          (msg-face (if privp 'erc-direct-msg-face 'erc-default-face)))
4194     ;; add text properties to text before the nick, the nick and after the nick
4195     (erc-put-text-property 0 (length mark-s) 'face msg-face str)
4196     (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick))
4197                            'face nick-face str)
4198     (erc-put-text-property (+ (length mark-s) (length nick)) (length str)
4199                            'face msg-face str)
4200     str))
4201
4202 (defcustom erc-format-nick-function 'erc-format-nick
4203   "Function to format a nickname for message display."
4204   :group 'erc-display
4205   :type 'function)
4206
4207 (defun erc-format-nick (&optional user channel-data)
4208   "Return the nickname of USER.
4209 See also `erc-format-nick-function'."
4210   (when user (erc-server-user-nickname user)))
4211
4212 (defun erc-format-@nick (&optional user channel-data)
4213   "Format the nickname of USER showing if USER is an operator or has voice.
4214 Operators have \"@\" and users with voice have \"+\" as a prefix.
4215 Use CHANNEL-DATA to determine op and voice status.
4216 See also `erc-format-nick-function'."
4217   (when user
4218     (let ((op (and channel-data (erc-channel-user-op channel-data) "@"))
4219           (voice (and channel-data (erc-channel-user-voice channel-data) "+")))
4220       (concat voice op (erc-server-user-nickname user)))))
4221
4222 (defun erc-format-my-nick ()
4223   "Return the beginning of this user's message, correctly propertized."
4224   (if erc-show-my-nick
4225       (let ((open "<")
4226             (close "> ")
4227             (nick (erc-current-nick)))
4228         (concat
4229          (erc-propertize open 'face 'erc-default-face)
4230          (erc-propertize nick 'face 'erc-my-nick-face)
4231          (erc-propertize close 'face 'erc-default-face)))
4232     (let ((prefix "> "))
4233       (erc-propertize prefix 'face 'erc-default-face))))
4234
4235 (defun erc-echo-notice-in-default-buffer (s parsed buffer sender)
4236   "Echos a private notice in the default buffer, namely the
4237 target buffer specified by BUFFER, or there is no target buffer,
4238 the server buffer.  This function is designed to be added to
4239 either `erc-echo-notice-hook' or `erc-echo-notice-always-hook',
4240 and always returns t."
4241   (erc-display-message parsed nil buffer s)
4242   t)
4243
4244 (defun erc-echo-notice-in-target-buffer (s parsed buffer sender)
4245   "Echos a private notice in BUFFER, if BUFFER is non-nil.  This
4246 function is designed to be added to either `erc-echo-notice-hook'
4247 or `erc-echo-notice-always-hook', and returns non-nil if BUFFER
4248 is non-nil."
4249   (if buffer
4250       (progn (erc-display-message parsed nil buffer s) t)
4251     nil))
4252
4253 (defun erc-echo-notice-in-minibuffer (s parsed buffer sender)
4254   "Echos a private notice in the minibuffer.  This function is
4255 designed to be added to either `erc-echo-notice-hook' or
4256 `erc-echo-notice-always-hook', and always returns t."
4257   (message "%s" (concat "NOTICE: " s))
4258   t)
4259
4260 (defun erc-echo-notice-in-server-buffer (s parsed buffer sender)
4261   "Echos a private notice in the server buffer.  This function is
4262 designed to be added to either `erc-echo-notice-hook' or
4263 `erc-echo-notice-always-hook', and always returns t."
4264   (erc-display-message parsed nil nil s)
4265   t)
4266
4267 (defun erc-echo-notice-in-active-non-server-buffer (s parsed buffer sender)
4268   "Echos a private notice in the active buffer if the active
4269 buffer is not the server buffer.  This function is designed to be
4270 added to either `erc-echo-notice-hook' or
4271 `erc-echo-notice-always-hook', and returns non-nil if the active
4272 buffer is not the server buffer."
4273   (if (not (eq (erc-server-buffer) (erc-active-buffer)))
4274       (progn (erc-display-message parsed nil 'active s) t)
4275     nil))
4276
4277 (defun erc-echo-notice-in-active-buffer (s parsed buffer sender)
4278   "Echos a private notice in the active buffer.  This function is
4279 designed to be added to either `erc-echo-notice-hook' or
4280 `erc-echo-notice-always-hook', and always returns t."
4281   (erc-display-message parsed nil 'active s)
4282   t)
4283
4284 (defun erc-echo-notice-in-user-buffers (s parsed buffer sender)
4285   "Echos a private notice in all of the buffers for which SENDER
4286 is a member.  This function is designed to be added to either
4287 `erc-echo-notice-hook' or `erc-echo-notice-always-hook', and
4288 returns non-nil if there is at least one buffer for which the
4289 sender is a member.
4290
4291 See also: `erc-echo-notice-in-first-user-buffer',
4292 `erc-buffer-list-with-nick'."
4293   (let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
4294     (if buffers
4295         (progn (erc-display-message parsed nil buffers s) t)
4296       nil)))
4297
4298 (defun erc-echo-notice-in-user-and-target-buffers (s parsed buffer sender)
4299   "Echos a private notice in BUFFER and in all of the buffers for
4300 which SENDER is a member.  This function is designed to be added
4301 to either `erc-echo-notice-hook' or
4302 `erc-echo-notice-always-hook', and returns non-nil if there is
4303 at least one buffer for which the sender is a member or the
4304 default target.
4305
4306 See also: `erc-echo-notice-in-user-buffers',
4307 `erc-buffer-list-with-nick'."
4308   (let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
4309     (add-to-list 'buffers buffer)
4310     (if buffers
4311         (progn (erc-display-message parsed nil buffers s) t)
4312       nil)))
4313
4314 (defun erc-echo-notice-in-first-user-buffer (s parsed buffer sender)
4315   "Echos a private notice in one of the buffers for which SENDER
4316 is a member.  This function is designed to be added to either
4317 `erc-echo-notice-hook' or `erc-echo-notice-always-hook', and
4318 returns non-nil if there is at least one buffer for which the
4319 sender is a member.
4320
4321 See also: `erc-echo-notice-in-user-buffers',
4322 `erc-buffer-list-with-nick'."
4323   (let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
4324     (if buffers
4325         (progn (erc-display-message parsed nil (car buffers) s) t)
4326       nil)))
4327
4328 ;;; Ban manipulation
4329
4330 (defun erc-banlist-store (proc parsed)
4331   "Record ban entries for a channel."
4332   (multiple-value-bind (channel mask whoset)
4333       (values-list (cdr (erc-response.command-args parsed)))
4334     ;; Determine to which buffer the message corresponds
4335     (let ((buffer (erc-get-buffer channel proc)))
4336       (with-current-buffer buffer
4337         (unless (member (cons whoset mask) erc-channel-banlist)
4338           (setq erc-channel-banlist (cons (cons whoset mask)
4339                                           erc-channel-banlist))))))
4340   nil)
4341
4342 (defun erc-banlist-finished (proc parsed)
4343   "Record that we have received the banlist."
4344   (let* ((channel (second (erc-response.command-args parsed)))
4345          (buffer (erc-get-buffer channel proc)))
4346     (with-current-buffer buffer
4347       (put 'erc-channel-banlist 'received-from-server t)))
4348   t)                                    ; suppress the 'end of banlist' message
4349
4350 (defun erc-banlist-update (proc parsed)
4351   "Check MODE commands for bans and update the banlist appropriately."
4352   ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11
4353   (let* ((tgt (first (erc-response.command-args parsed)))
4354          (mode (erc-response.contents parsed))
4355          (whoset (erc-response.sender parsed))
4356          (buffer (erc-get-buffer tgt proc)))
4357     (when buffer
4358       (with-current-buffer buffer
4359         (cond ((not (get 'erc-channel-banlist 'received-from-server)) nil)
4360               ((string-match "^\\([+-]\\)b" mode)
4361                ;; This is a ban
4362                (cond
4363                 ((string-match "^-" mode)
4364                  ;; Remove the unbanned masks from the ban list
4365                  (setq erc-channel-banlist
4366                        (erc-delete-if
4367                         #'(lambda (y)
4368                             (member (upcase (cdr y))
4369                                     (mapcar #'upcase
4370                                             (cdr (split-string mode)))))
4371                         erc-channel-banlist)))
4372                 ((string-match "^+" mode)
4373                  ;; Add the banned mask(s) to the ban list
4374                  (mapc
4375                   (lambda (mask)
4376                     (unless (member (cons whoset mask) erc-channel-banlist)
4377                       (setq erc-channel-banlist
4378                             (cons (cons whoset mask) erc-channel-banlist))))
4379                   (cdr (split-string mode))))))))))
4380   nil)
4381
4382 ;; used for the banlist cmds
4383 (defun erc-group-list (list n)
4384   "Group LIST into sublists of length N."
4385   (cond ((null list) nil)
4386         ((null (nthcdr n list)) (list list))
4387         (t (cons (erc-subseq list 0 n) (erc-group-list (nthcdr n list) n)))))
4388
4389
4390 ;;; MOTD numreplies
4391
4392 (defun erc-handle-login ()
4393   "Handle the logging in process of connection."
4394   (unless erc-logged-in
4395     (setq erc-logged-in t)
4396     (message "Logging in as \'%s\'... done" (erc-current-nick))
4397     ;; execute a startup script
4398     (let ((f (erc-select-startup-file)))
4399       (when f
4400         (erc-load-script f)))))
4401
4402 (defun erc-connection-established (proc parsed)
4403   "Run just after connection.
4404
4405 Set user modes and run `erc-after-connect' hook."
4406   (with-current-buffer (process-buffer proc)
4407     (unless erc-server-connected ; only once per session
4408       (let ((server (or erc-server-announced-name
4409                         (erc-response.sender parsed)))
4410             (nick (car (erc-response.command-args parsed)))
4411             (buffer (process-buffer proc)))
4412         (setq erc-server-connected t)
4413         (erc-update-mode-line)
4414         (erc-set-initial-user-mode nick buffer)
4415         (erc-server-setup-periodical-ping buffer)
4416         (run-hook-with-args 'erc-after-connect server nick)))))
4417
4418 (defun erc-set-initial-user-mode (nick buffer)
4419   "If `erc-user-mode' is non-nil for NICK, set the user modes.
4420 The server buffer is given by BUFFER."
4421   (with-current-buffer buffer
4422     (when erc-user-mode
4423       (let ((mode (if (functionp erc-user-mode)
4424                       (funcall erc-user-mode)
4425                     erc-user-mode)))
4426         (when (stringp mode)
4427           (erc-log (format "changing mode for %s to %s" nick mode))
4428           (erc-server-send (format "MODE %s %s" nick mode)))))))
4429
4430 (defun erc-display-error-notice (parsed string)
4431   "Display STRING as an error notice.
4432
4433 See also `erc-display-message'."
4434   (erc-display-message
4435    parsed '(notice error) 'active string))
4436
4437 (defun erc-process-ctcp-query (proc parsed nick login host)
4438   ;; FIXME: This needs a proper docstring -- Lawrence 2004-01-08
4439   "Process a CTCP query."
4440   (let ((queries (delete "" (split-string (erc-response.contents parsed)
4441                                           "\C-a"))))
4442     (if (> (length queries) 4)
4443         (erc-display-message
4444          parsed (list 'notice 'error) proc 'ctcp-too-many)
4445       (if (= 0 (length queries))
4446           (erc-display-message
4447            parsed (list 'notice 'error) proc
4448            'ctcp-empty ?n nick)
4449         (while queries
4450           (let* ((type (upcase (car (split-string (car queries)))))
4451                  (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))))
4452             (if (and hook (boundp hook))
4453                 (if (string-equal type "ACTION")
4454                     (run-hook-with-args-until-success
4455                      hook proc parsed nick login host
4456                      (car (erc-response.command-args parsed))
4457                      (car queries))
4458                   (when erc-paranoid
4459                     (if (erc-current-nick-p
4460                          (car (erc-response.command-args parsed)))
4461                         (erc-display-message
4462                          parsed 'error 'active 'ctcp-request
4463                          ?n nick ?u login ?h host ?r (car queries))
4464                       (erc-display-message
4465                        parsed 'error 'active 'ctcp-request-to
4466                        ?n nick ?u login ?h host ?r (car queries)
4467                        ?t (car (erc-response.command-args parsed)))))
4468                   (run-hook-with-args-until-success
4469                    hook proc nick login host
4470                    (car (erc-response.command-args parsed))
4471                    (car queries)))
4472               (erc-display-message
4473                parsed (list 'notice 'error) proc
4474                'undefined-ctcp)))
4475           (setq queries (cdr queries)))))))
4476
4477 (defvar erc-ctcp-query-ACTION-hook '(erc-ctcp-query-ACTION))
4478
4479 (defun erc-ctcp-query-ACTION (proc parsed nick login host to msg)
4480   "Respond to a CTCP ACTION query."
4481   (when (string-match "^ACTION\\s-\\(.*\\)\\s-*$" msg)
4482     (let ((s (match-string 1 msg))
4483           (buf (or (erc-get-buffer to proc)
4484                    (erc-get-buffer nick proc)
4485                    (process-buffer proc))))
4486       (erc-display-message
4487        parsed 'action buf
4488        'ACTION ?n nick ?u login ?h host ?a s))))
4489
4490 (defvar erc-ctcp-query-CLIENTINFO-hook '(erc-ctcp-query-CLIENTINFO))
4491
4492 (defun erc-ctcp-query-CLIENTINFO (proc nick login host to msg)
4493   "Respond to a CTCP CLIENTINFO query."
4494   (when (string-match "^CLIENTINFO\\(\\s-*\\|\\s-+.*\\)$" msg)
4495     (let ((s (erc-client-info (erc-trim-string (match-string 1 msg)))))
4496       (unless erc-disable-ctcp-replies
4497           (erc-send-ctcp-notice nick (format "CLIENTINFO %s" s)))))
4498   nil)
4499
4500 (defvar erc-ctcp-query-ECHO-hook '(erc-ctcp-query-ECHO))
4501 (defun erc-ctcp-query-ECHO (proc nick login host to msg)
4502   "Respond to a CTCP ECHO query."
4503   (when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg)
4504     (let ((s (match-string 1 msg)))
4505       (unless erc-disable-ctcp-replies
4506         (erc-send-ctcp-notice nick (format "ECHO %s" s)))))
4507   nil)
4508
4509 (defvar erc-ctcp-query-FINGER-hook '(erc-ctcp-query-FINGER))
4510 (defun erc-ctcp-query-FINGER (proc nick login host to msg)
4511   "Respond to a CTCP FINGER query."
4512   (unless erc-disable-ctcp-replies
4513     (let ((s (if erc-anonymous-login
4514                  (format "FINGER I'm %s." (erc-current-nick))
4515                (format "FINGER %s (%s@%s)."
4516                        (user-full-name)
4517                        (user-login-name)
4518                        (system-name))))
4519           (ns (erc-time-diff erc-server-last-sent-time (erc-current-time))))
4520         (when (> ns 0)
4521             (setq s (concat s " Idle for " (erc-sec-to-time ns))))
4522         (erc-send-ctcp-notice nick s)))
4523   nil)
4524
4525 (defvar erc-ctcp-query-PING-hook '(erc-ctcp-query-PING))
4526 (defun erc-ctcp-query-PING (proc nick login host to msg)
4527   "Respond to a CTCP PING query."
4528   (when (string-match "^PING\\s-+\\(.*\\)" msg)
4529     (unless erc-disable-ctcp-replies
4530       (let ((arg (match-string 1 msg)))
4531         (erc-send-ctcp-notice nick (format "PING %s" arg)))))
4532   nil)
4533
4534 (defvar erc-ctcp-query-TIME-hook '(erc-ctcp-query-TIME))
4535 (defun erc-ctcp-query-TIME (proc nick login host to msg)
4536   "Respond to a CTCP TIME query."
4537   (unless erc-disable-ctcp-replies
4538     (erc-send-ctcp-notice nick (format "TIME %s" (current-time-string))))
4539   nil)
4540
4541 (defvar erc-ctcp-query-USERINFO-hook '(erc-ctcp-query-USERINFO))
4542 (defun erc-ctcp-query-USERINFO (proc nick login host to msg)
4543   "Respond to a CTCP USERINFO query."
4544   (unless erc-disable-ctcp-replies
4545     (erc-send-ctcp-notice nick (format "USERINFO %s" erc-user-information)))
4546   nil)
4547
4548 (defvar erc-ctcp-query-VERSION-hook '(erc-ctcp-query-VERSION))
4549 (defun erc-ctcp-query-VERSION (proc nick login host to msg)
4550   "Respond to a CTCP VERSION query."
4551   (unless erc-disable-ctcp-replies
4552     (erc-send-ctcp-notice
4553      nick (format
4554            "VERSION \C-bERC\C-b %s - an IRC client for emacs (\C-b%s\C-b)"
4555            erc-version-string
4556            erc-official-location)))
4557   nil)
4558
4559 (defun erc-process-ctcp-reply (proc parsed nick login host msg)
4560   "Process MSG as a CTCP reply."
4561   (let* ((type (car (split-string msg)))
4562          (hook (intern (concat "erc-ctcp-reply-" type "-hook"))))
4563     (if (boundp hook)
4564         (run-hook-with-args-until-success
4565          hook proc nick login host
4566          (car (erc-response.command-args parsed)) msg)
4567       (erc-display-message
4568        parsed 'notice 'active
4569        'CTCP-UNKNOWN ?n nick ?u login ?h host ?m msg))))
4570
4571 (defvar erc-ctcp-reply-ECHO-hook '(erc-ctcp-reply-ECHO))
4572 (defun erc-ctcp-reply-ECHO (proc nick login host to msg)
4573   "Handle a CTCP ECHO reply."
4574   (when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg)
4575     (let ((message (match-string 1 msg)))
4576       (erc-display-message
4577        nil '(notice action) 'active
4578        'CTCP-ECHO ?n nick ?m message)))
4579   nil)
4580
4581 (defvar erc-ctcp-reply-CLIENTINFO-hook '(erc-ctcp-reply-CLIENTINFO))
4582 (defun erc-ctcp-reply-CLIENTINFO (proc nick login host to msg)
4583   "Handle a CTCP CLIENTINFO reply."
4584   (when (string-match "^CLIENTINFO\\s-+\\(.*\\)\\s-*$" msg)
4585     (let ((message (match-string 1 msg)))
4586       (erc-display-message
4587        nil 'notice 'active
4588        'CTCP-CLIENTINFO ?n nick ?m message)))
4589   nil)
4590
4591 (defvar erc-ctcp-reply-FINGER-hook '(erc-ctcp-reply-FINGER))
4592 (defun erc-ctcp-reply-FINGER (proc nick login host to msg)
4593   "Handle a CTCP FINGER reply."
4594   (when (string-match "^FINGER\\s-+\\(.*\\)\\s-*$" msg)
4595     (let ((message (match-string 1 msg)))
4596       (erc-display-message
4597        nil 'notice 'active
4598        'CTCP-FINGER ?n nick ?m message)))
4599   nil)
4600
4601 (defvar erc-ctcp-reply-PING-hook '(erc-ctcp-reply-PING))
4602 (defun erc-ctcp-reply-PING (proc nick login host to msg)
4603   "Handle a CTCP PING reply."
4604   (if (not (string-match "^PING\\s-+\\([0-9.]+\\)" msg))
4605       nil
4606     (let ((time (match-string 1 msg)))
4607       (condition-case nil
4608           (let ((delta (erc-time-diff (string-to-number time)
4609                                       (erc-current-time))))
4610             (erc-display-message
4611              nil 'notice 'active
4612              'CTCP-PING ?n nick
4613              ?t (erc-sec-to-time delta)))
4614         (range-error
4615          (erc-display-message
4616           nil 'error 'active
4617           'bad-ping-response ?n nick ?t time))))))
4618
4619 (defvar erc-ctcp-reply-TIME-hook '(erc-ctcp-reply-TIME))
4620 (defun erc-ctcp-reply-TIME (proc nick login host to msg)
4621   "Handle a CTCP TIME reply."
4622   (when (string-match "^TIME\\s-+\\(.*\\)\\s-*$" msg)
4623     (let ((message (match-string 1 msg)))
4624       (erc-display-message
4625        nil 'notice 'active
4626        'CTCP-TIME ?n nick ?m message)))
4627   nil)
4628
4629 (defvar erc-ctcp-reply-VERSION-hook '(erc-ctcp-reply-VERSION))
4630 (defun erc-ctcp-reply-VERSION (proc nick login host to msg)
4631   "Handle a CTCP VERSION reply."
4632   (when (string-match "^VERSION\\s-+\\(.*\\)\\s-*$" msg)
4633     (let ((message (match-string 1 msg)))
4634       (erc-display-message
4635        nil 'notice 'active
4636        'CTCP-VERSION ?n nick ?m message)))
4637   nil)
4638
4639 (defun erc-process-away (proc away-p)
4640   "Toggle the away status of the user depending on the value of AWAY-P.
4641
4642 If nil, set the user as away.
4643 If non-nil, return from being away."
4644   (let ((sessionbuf (process-buffer proc)))
4645     (when sessionbuf
4646       (with-current-buffer sessionbuf
4647         (when erc-away-nickname
4648           (erc-log (format "erc-process-away: away-nick: %s, away-p: %s"
4649                            erc-away-nickname away-p))
4650           (erc-cmd-NICK (if away-p
4651                             erc-away-nickname
4652                           erc-nick)))
4653         (cond
4654          (away-p
4655           (setq erc-away (current-time)))
4656          (t
4657           (let ((away-time erc-away))
4658             ;; away must be set to NIL BEFORE sending anything to prevent
4659             ;; an infinite recursion
4660             (setq erc-away nil)
4661             (with-current-buffer (erc-active-buffer)
4662               (when erc-public-away-p
4663                 (erc-send-action
4664                  (erc-default-target)
4665                  (if away-time
4666                      (format "is back (gone for %s)"
4667                              (erc-sec-to-time
4668                               (erc-time-diff
4669                                (erc-emacs-time-to-erc-time away-time)
4670                                (erc-current-time))))
4671                    "is back")))))))))
4672     (erc-update-mode-line)))
4673
4674 ;;;; List of channel members handling
4675
4676 (defun erc-channel-begin-receiving-names ()
4677   "Internal function.
4678
4679 Used when a channel names list is about to be received.  Should
4680 be called with the current buffer set to the channel buffer.
4681
4682 See also `erc-channel-end-receiving-names'."
4683   (setq erc-channel-new-member-names (make-hash-table :test 'equal)))
4684
4685 (defun erc-channel-end-receiving-names ()
4686   "Internal function.
4687
4688 Used to fix `erc-channel-users' after a channel names list has been
4689 received.  Should be called with the current buffer set to the
4690 channel buffer.
4691
4692 See also `erc-channel-begin-receiving-names'."
4693   (maphash (lambda (nick user)
4694              (if (null (gethash nick erc-channel-new-member-names))
4695                  (erc-remove-channel-user nick)))
4696            erc-channel-users)
4697   (setq erc-channel-new-member-names nil))
4698
4699 (defun erc-parse-prefix ()
4700   "Return an alist of valid prefix character types and their representations.
4701 Example: (operator) o => @, (voiced) v => +."
4702   (let ((str (or (cdr (assoc "PREFIX" (erc-with-server-buffer
4703                                         erc-server-parameters)))
4704                  ;; provide a sane default
4705                  "(ov)@+"))
4706         types chars)
4707     (when (string-match "^(\\([^)]+\\))\\(.+\\)$" str)
4708       (setq types (match-string 1 str)
4709             chars (match-string 2 str))
4710       (let ((len (min (length types) (length chars)))
4711             (i 0)
4712             (alist nil))
4713         (while (< i len)
4714           (setq alist (cons (cons (elt types i) (elt chars i))
4715                             alist))
4716           (setq i (1+ i)))
4717         alist))))
4718
4719 (defun erc-channel-receive-names (names-string)
4720   "This function is for internal use only.
4721
4722 Update `erc-channel-users' according to NAMES-STRING.
4723 NAMES-STRING is a string listing some of the names on the
4724 channel."
4725   (let (prefix op-ch voice-ch names name op voice)
4726     (setq prefix (erc-parse-prefix))
4727     (setq op-ch (cdr (assq ?o prefix))
4728           voice-ch (cdr (assq ?v prefix)))
4729     ;; We need to delete "" because in XEmacs, (split-string "a ")
4730     ;; returns ("a" "").
4731     (setq names (delete "" (split-string names-string)))
4732     (let ((erc-channel-members-changed-hook nil))
4733       (dolist (item names)
4734         (let ((updatep t)
4735               ch)
4736           (if (rassq (elt item 0) prefix)
4737               (cond ((= (length item) 1)
4738                      (setq updatep nil))
4739                     ((eq (elt item 0) op-ch)
4740                      (setq name (substring item 1)
4741                            op 'on
4742                            voice 'off))
4743                     ((eq (elt item 0) voice-ch)
4744                      (setq name (substring item 1)
4745                            op 'off
4746                            voice 'on))
4747                     (t (setq name (substring item 1)
4748                              op 'off
4749                              voice 'off)))
4750             (setq name item
4751                   op 'off
4752                   voice 'off))
4753           (when updatep
4754             (puthash (erc-downcase name) t
4755                      erc-channel-new-member-names)
4756             (erc-update-current-channel-member
4757              name name t op voice)))))
4758     (run-hooks 'erc-channel-members-changed-hook)))
4759
4760 (defcustom erc-channel-members-changed-hook nil
4761   "This hook is called every time the variable `channel-members' changes.
4762 The buffer where the change happened is current while this hook is called."
4763   :group 'erc-hooks
4764   :type 'hook)
4765
4766 (defun erc-update-user-nick (nick &optional new-nick
4767                                   host login full-name info)
4768   "Updates the stored user information for the user with nickname
4769 NICK.
4770
4771 See also: `erc-update-user'."
4772   (erc-update-user (erc-get-server-user nick) new-nick
4773                    host login full-name info))
4774
4775 (defun erc-update-user (user &optional new-nick
4776                              host login full-name info)
4777   "Update user info for USER.  USER must be an erc-server-user
4778 struct.  Any of NEW-NICK, HOST, LOGIN, FULL-NAME, INFO which are
4779 non-nil and not equal to the existing values for USER are used to
4780 replace the stored values in USER.
4781
4782 If, and only if, a change is made,
4783 `erc-channel-members-changed-hook' is run for each channel for
4784 which USER is a member, and t is returned."
4785   (let (changed)
4786     (when user
4787       (when (and new-nick
4788                  (not (equal (erc-server-user-nickname user)
4789                              new-nick)))
4790         (setq changed t)
4791         (erc-change-user-nickname user new-nick))
4792       (when (and host
4793                  (not (equal (erc-server-user-host user) host)))
4794         (setq changed t)
4795         (setf (erc-server-user-host user) host))
4796       (when (and login
4797                  (not (equal (erc-server-user-login user) login)))
4798         (setq changed t)
4799         (setf (erc-server-user-login user) login))
4800       (when (and full-name
4801                  (not (equal (erc-server-user-full-name user)
4802                              full-name)))
4803         (setq changed t)
4804         (setf (erc-server-user-full-name user) full-name))
4805       (when (and info
4806                  (not (equal (erc-server-user-info user) info)))
4807         (setq changed t)
4808         (setf (erc-server-user-info user) info))
4809       (if changed
4810           (dolist (buf (erc-server-user-buffers user))
4811             (if (buffer-live-p buf)
4812                 (with-current-buffer buf
4813                   (run-hooks 'erc-channel-members-changed-hook))))))
4814     changed))
4815
4816 (defun erc-update-current-channel-member
4817   (nick new-nick &optional add op voice host login full-name info
4818         update-message-time)
4819   "Updates the stored user information for the user with nickname
4820 NICK.  `erc-update-user' is called to handle changes to nickname,
4821 HOST, LOGIN, FULL-NAME, and INFO.  If OP or VOICE are non-nil,
4822 they must be equal to either `on' or `off', in which case the
4823 operator or voice status of the user in the current channel is
4824 changed accordingly.  If UPDATE-MESSAGE-TIME is non-nil, the
4825 last-message-time of the user in the current channel is set
4826 to (current-time).
4827
4828 If ADD is non-nil, the user will be added with the specified
4829 information if it is not already present in the user or channel
4830 lists.
4831
4832 If, and only if, changes are made, or the user is added,
4833 `erc-channel-members-updated-hook' is run, and t is returned.
4834
4835 See also: `erc-update-user' and `erc-update-channel-member'."
4836   (let* (changed user-changed
4837          (channel-data (erc-get-channel-user nick))
4838          (cuser (if channel-data (cdr channel-data)))
4839          (user (if channel-data (car channel-data)
4840                  (erc-get-server-user nick))))
4841     (if cuser
4842         (progn
4843           (erc-log (format "update-member: user = %S, cuser = %S" user cuser))
4844           (when (and op
4845                      (not (eq (erc-channel-user-op cuser) op)))
4846               (setq changed t)
4847             (setf (erc-channel-user-op cuser)
4848                   (cond ((eq op 'on) t)
4849                         ((eq op 'off) nil)
4850                         (t op))))
4851           (when (and voice
4852                      (not (eq (erc-channel-user-voice cuser) voice)))
4853               (setq changed t)
4854             (setf (erc-channel-user-voice cuser)
4855                   (cond ((eq voice 'on) t)
4856                         ((eq voice 'off) nil)
4857                         (t voice))))
4858           (when update-message-time
4859             (setf (erc-channel-user-last-message-time cuser) (current-time)))
4860           (setq user-changed
4861                 (erc-update-user user new-nick
4862                                  host login full-name info)))
4863       (when add
4864         (if (null user)
4865             (progn
4866               (setq user (make-erc-server-user
4867                           :nickname nick
4868                           :host host
4869                           :full-name full-name
4870                           :login login
4871                           :info info
4872                           :buffers (list (current-buffer))))
4873               (erc-add-server-user nick user))
4874           (setf (erc-server-user-buffers user)
4875                 (cons (current-buffer)
4876                       (erc-server-user-buffers user))))
4877         (setq cuser (make-erc-channel-user
4878                      :op (cond ((eq op 'on) t)
4879                                ((eq op 'off) nil)
4880                                (t op))
4881                      :voice (cond ((eq voice 'on) t)
4882                                   ((eq voice 'off) nil)
4883                                   (t voice))
4884                      :last-message-time
4885                      (if update-message-time (current-time))))
4886         (puthash (erc-downcase nick) (cons user cuser)
4887                  erc-channel-users)
4888         (setq changed t)))
4889     (when (and changed (null user-changed))
4890       (run-hooks 'erc-channel-members-changed-hook))
4891     (or changed user-changed add)))
4892
4893 (defun erc-update-channel-member (channel nick new-nick
4894                                   &optional add op voice host login
4895                                   full-name info update-message-time)
4896   "Updates user and channel information for the user with
4897 nickname NICK in channel CHANNEL.
4898
4899 See also: `erc-update-current-channel-member'."
4900   (erc-with-buffer
4901    (channel)
4902    (erc-update-current-channel-member nick new-nick add op voice host
4903                                       login full-name info
4904                                       update-message-time)))
4905
4906 (defun erc-remove-current-channel-member (nick)
4907   "Remove NICK from current channel membership list.
4908 Runs `erc-channel-members-changed-hook'."
4909   (let ((channel-data (erc-get-channel-user nick)))
4910     (when channel-data
4911       (erc-remove-channel-user nick)
4912       (run-hooks 'erc-channel-members-changed-hook))))
4913
4914 (defun erc-remove-channel-member (channel nick)
4915   "Remove NICK from CHANNEL's membership list.
4916
4917 See also `erc-remove-current-channel-member'."
4918   (erc-with-buffer
4919    (channel)
4920    (erc-remove-current-channel-member nick)))
4921
4922 (defun erc-update-channel-topic (channel topic &optional modify)
4923   "Find a buffer for CHANNEL and set the TOPIC for it.
4924
4925 If optional MODIFY is 'append or 'prepend, then append or prepend the
4926 TOPIC string to the current topic."
4927   (erc-with-buffer (channel)
4928     (cond ((eq modify 'append)
4929            (setq erc-channel-topic (concat erc-channel-topic topic)))
4930           ((eq modify 'prepend)
4931            (setq erc-channel-topic (concat topic erc-channel-topic)))
4932           (t (setq erc-channel-topic topic)))
4933     (erc-update-mode-line-buffer (current-buffer))))
4934
4935 (defun erc-set-modes (tgt mode-string)
4936   "Set the modes for the TGT provided as MODE-STRING."
4937   (let* ((modes (erc-parse-modes mode-string))
4938          (add-modes (nth 0 modes))
4939          (remove-modes (nth 1 modes))
4940          ;; list of triples: (mode-char 'on/'off argument)
4941          (arg-modes (nth 2 modes)))
4942     (cond ((erc-channel-p tgt); channel modes
4943            (let ((buf (and erc-server-process
4944                            (erc-get-buffer tgt erc-server-process))))
4945              (when buf
4946                (with-current-buffer buf
4947                  (setq erc-channel-modes add-modes)
4948                  (setq erc-channel-user-limit nil)
4949                  (setq erc-channel-key nil)
4950                  (while arg-modes
4951                    (let ((mode (nth 0 (car arg-modes)))
4952                          (onoff (nth 1 (car arg-modes)))
4953                          (arg (nth 2 (car arg-modes))))
4954                      (cond ((string-match "^[Ll]" mode)
4955                             (erc-update-channel-limit tgt onoff arg))
4956                            ((string-match "^[Kk]" mode)
4957                             (erc-update-channel-key tgt onoff arg))
4958                            (t nil)))
4959                    (setq arg-modes (cdr arg-modes)))
4960                  (erc-update-mode-line-buffer buf)))))
4961           ;; we do not keep our nick's modes yet
4962           ;;(t (setq erc-user-modes add-modes))
4963           )
4964     ))
4965
4966 (defun erc-sort-strings (list-of-strings)
4967   "Sort LIST-OF-STRINGS in lexicographic order.
4968
4969 Side-effect free."
4970   (sort (copy-sequence list-of-strings) 'string<))
4971
4972 (defun erc-parse-modes (mode-string)
4973   "Parse MODE-STRING into a list.
4974
4975 Returns a list of three elements:
4976
4977   (ADD-MODES REMOVE-MODES ARG-MODES).
4978
4979 The add-modes and remove-modes are lists of single-character strings
4980 for modes without parameters to add and remove respectively.  The
4981 arg-modes is a list of triples of the form:
4982
4983   (MODE-CHAR ON/OFF ARGUMENT)."
4984   (if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string)
4985       (let ((chars (mapcar 'char-to-string (match-string 1 mode-string)))
4986             ;; arguments in channel modes
4987             (args-str (match-string 2 mode-string))
4988             (args nil)
4989             (add-modes nil)
4990             (remove-modes nil)
4991             (arg-modes nil); list of triples: (mode-char 'on/'off argument)
4992             (add-p t))
4993         ;; make the argument list
4994         (while (string-match "^\\s-*\\(\\S-+\\)\\(\\s-+.*$\\|$\\)" args-str)
4995           (setq args (cons (match-string 1 args-str) args))
4996           (setq args-str (match-string 2 args-str)))
4997         (setq args (nreverse args))
4998         ;; collect what modes changed, and match them with arguments
4999         (while chars
5000           (cond ((string= (car chars) "+") (setq add-p t))
5001                 ((string= (car chars) "-") (setq add-p nil))
5002                 ((string-match "^[ovbOVB]" (car chars))
5003                  (setq arg-modes (cons (list (car chars)
5004                                              (if add-p 'on 'off)
5005                                              (if args (car args) nil))
5006                                        arg-modes))
5007                  (if args (setq args (cdr args))))
5008                 ((string-match "^[LlKk]" (car chars))
5009                  (setq arg-modes (cons (list (car chars)
5010                                              (if add-p 'on 'off)
5011                                              (if (and add-p args)
5012                                                  (car args) nil))
5013                                        arg-modes))
5014                  (if (and add-p args) (setq args (cdr args))))
5015                 (add-p (setq add-modes (cons (car chars) add-modes)))
5016                 (t (setq remove-modes (cons (car chars) remove-modes))))
5017           (setq chars (cdr chars)))
5018         (setq add-modes (nreverse add-modes))
5019         (setq remove-modes (nreverse remove-modes))
5020         (setq arg-modes (nreverse arg-modes))
5021         (list add-modes remove-modes arg-modes))
5022     nil))
5023
5024 (defun erc-update-modes (tgt mode-string &optional nick host login)
5025   "Update the mode information for TGT, provided as MODE-STRING.
5026 Optional arguments: NICK, HOST and LOGIN - the attributes of the
5027 person who changed the modes."
5028   (let* ((modes (erc-parse-modes mode-string))
5029          (add-modes (nth 0 modes))
5030          (remove-modes (nth 1 modes))
5031          ;; list of triples: (mode-char 'on/'off argument)
5032          (arg-modes (nth 2 modes)))
5033     ;; now parse the modes changes and do the updates
5034     (cond ((erc-channel-p tgt); channel modes
5035            (let ((buf (and erc-server-process
5036                            (erc-get-buffer tgt erc-server-process))))
5037              (when buf
5038                ;; FIXME! This used to have an original buffer
5039                ;; variable, but it never switched back to the original
5040                ;; buffer. Is this wanted behavior?
5041                (set-buffer buf)
5042                (if (not (boundp 'erc-channel-modes))
5043                    (setq erc-channel-modes nil))
5044                (while remove-modes
5045                  (setq erc-channel-modes (delete (car remove-modes)
5046                                                  erc-channel-modes)
5047                        remove-modes (cdr remove-modes)))
5048                (while add-modes
5049                  (setq erc-channel-modes (cons (car add-modes)
5050                                                erc-channel-modes)
5051                        add-modes (cdr add-modes)))
5052                (setq erc-channel-modes (erc-sort-strings erc-channel-modes))
5053                (while arg-modes
5054                  (let ((mode (nth 0 (car arg-modes)))
5055                        (onoff (nth 1 (car arg-modes)))
5056                        (arg (nth 2 (car arg-modes))))
5057                    (cond ((string-match "^[oO]" mode)
5058                           (erc-update-channel-member tgt arg arg nil onoff))
5059                          ((string-match "^[Vv]" mode)
5060                           (erc-update-channel-member tgt arg arg nil nil
5061                                                      onoff))
5062                          ((string-match "^[Ll]" mode)
5063                           (erc-update-channel-limit tgt onoff arg))
5064                          ((string-match "^[Kk]" mode)
5065                           (erc-update-channel-key tgt onoff arg))
5066                          (t nil)); only ops are tracked now
5067                    (setq arg-modes (cdr arg-modes))))
5068                (erc-update-mode-line buf))))
5069           ;; nick modes - ignored at this point
5070           (t nil))))
5071
5072 (defun erc-update-channel-limit (channel onoff n)
5073   ;; FIXME: what does ONOFF actually do?  -- Lawrence 2004-01-08
5074   "Update CHANNEL's user limit to N."
5075   (if (or (not (eq onoff 'on))
5076           (and (stringp n) (string-match "^[0-9]+$" n)))
5077       (erc-with-buffer
5078        (channel)
5079       (cond ((eq onoff 'on) (setq erc-channel-user-limit (string-to-number n)))
5080             (t (setq erc-channel-user-limit nil))))))
5081
5082 (defun erc-update-channel-key (channel onoff key)
5083   "Update CHANNEL's key to KEY if ONOFF is 'on or to nil if it's 'off."
5084   (erc-with-buffer
5085    (channel)
5086    (cond ((eq onoff 'on) (setq erc-channel-key key))
5087          (t (setq erc-channel-key nil)))))
5088
5089 (defun erc-handle-user-status-change (type nlh &optional l)
5090   "Handle changes in any user's status.
5091
5092 So far, only nick change is handled.
5093
5094 Generally, the TYPE argument is a symbol describing the change type, NLH is
5095 a list containing the original nickname, login name and hostname for the user,
5096 and L is a list containing additional TYPE-specific arguments.
5097
5098 So far the following TYPE/L pairs are supported:
5099
5100        Event                    TYPE                   L
5101
5102     nickname change            'nick                (NEW-NICK)"
5103   (erc-log (format "user-change: type: %S  nlh: %S  l: %S" type nlh l))
5104   (cond
5105    ;; nickname change
5106    ((equal type 'nick)
5107     t)
5108    (t
5109     nil)))
5110
5111 (defun erc-highlight-notice (s)
5112   "Highlight notice message S and return it.
5113 See also variable `erc-notice-highlight-type'."
5114   (cond
5115    ((eq erc-notice-highlight-type 'prefix)
5116     (erc-put-text-property 0 (length erc-notice-prefix)
5117                            'face 'erc-notice-face s)
5118     s)
5119    ((eq erc-notice-highlight-type 'all)
5120     (erc-put-text-property 0 (length s) 'face 'erc-notice-face s)
5121     s)
5122    (t s)))
5123
5124 (defun erc-make-notice (message)
5125   "Notify the user of MESSAGE."
5126   (when erc-minibuffer-notice
5127     (message "%s" message))
5128   (erc-highlight-notice (concat erc-notice-prefix message)))
5129
5130 (defun erc-highlight-error (s)
5131   "Highlight error message S and return it."
5132   (erc-put-text-property 0 (length s) 'face 'erc-error-face s)
5133   s)
5134
5135 (defun erc-put-text-property (start end property value &optional object)
5136   "Set text-property for an object (usually a string).
5137 START and END define the characters covered.
5138 PROPERTY is the text-property set, usually the symbol `face'.
5139 VALUE is the value for the text-property, usually a face symbol such as
5140 the face `bold' or `erc-pal-face'.
5141 OBJECT is a string which will be modified and returned.
5142 OBJECT is modified without being copied first.
5143
5144 You can redefine or `defadvice' this function in order to add
5145 EmacsSpeak support."
5146   (put-text-property start end property value object))
5147
5148 (defun erc-list (thing)
5149   "Return THING if THING is a list, or a list with THING as its element."
5150   (if (listp thing)
5151       thing
5152     (list thing)))
5153
5154 (defun erc-parse-user (string)
5155   "Parse STRING as a user specification (nick!login@host).
5156
5157 Return a list of the three separate tokens."
5158   (cond
5159    ((string-match "^\\([^!\n]*\\)!\\([^@\n]*\\)@\\(.*\\)$" string)
5160     (list (match-string 1 string)
5161           (match-string 2 string)
5162           (match-string 3 string)))
5163    ;; Some bogus bouncers send Nick!(null), try to live with that.
5164    ((string-match "^\\([^!\n]*\\)!\\(.*\\)$" string)
5165     (list (match-string 1 string)
5166           ""
5167           (match-string 2 string)))
5168    (t
5169     (list string "" ""))))
5170
5171 (defun erc-extract-nick (string)
5172   "Return the nick corresponding to a user specification STRING.
5173
5174 See also `erc-parse-user'."
5175   (car (erc-parse-user string)))
5176
5177 (defun erc-put-text-properties (start end properties
5178                                 &optional object value-list)
5179   "Set text-properties for OBJECT.
5180
5181 START and END describe positions in OBJECT.
5182 If VALUE-LIST is nil, set each property in PROPERTIES to t, else set
5183 each property to the corresponding value in VALUE-LIST."
5184   (unless value-list
5185     (setq value-list (mapcar (lambda (x)
5186                                t)
5187                              properties)))
5188   (while (and properties value-list)
5189     (erc-put-text-property
5190      start end (pop properties) (pop value-list) object)))
5191
5192 ;;; Input area handling:
5193
5194 (defun erc-beg-of-input-line ()
5195   "Return the value of `point' at the beginning of the input line.
5196
5197 Specifically, return the position of `erc-insert-marker'."
5198   (or (and (boundp 'erc-insert-marker)
5199            (markerp erc-insert-marker))
5200       (error "erc-insert-marker has no value, please report a bug"))
5201   (marker-position erc-insert-marker))
5202
5203 (defun erc-end-of-input-line ()
5204   "Return the value of `point' at the end of the input line."
5205   (point-max))
5206
5207 (defun erc-send-current-line ()
5208   "Parse current line and send it to IRC."
5209   (interactive)
5210   (save-restriction
5211     (widen)
5212     (if (< (point) (erc-beg-of-input-line))
5213         (erc-error "Point is not in the input area")
5214       (let ((inhibit-read-only t)
5215             (str (erc-user-input))
5216             (old-buf (current-buffer)))
5217         (if (and (not (erc-server-buffer-live-p))
5218                  (not (erc-command-no-process-p str)))
5219             (erc-error "ERC: No process running")
5220           (erc-set-active-buffer (current-buffer))
5221
5222           ;; Kill the input and the prompt
5223           (delete-region (erc-beg-of-input-line)
5224                          (erc-end-of-input-line))
5225
5226           (unwind-protect
5227               (erc-send-input str)
5228             ;; Fix the buffer if the command didn't kill it
5229             (when (buffer-live-p old-buf)
5230               (with-current-buffer old-buf
5231                 (save-restriction
5232                   (widen)
5233                   (goto-char (point-max))
5234                   (when (processp erc-server-process)
5235                     (set-marker (process-mark erc-server-process) (point)))
5236                   (set-marker erc-insert-marker (point))
5237                   (let ((buffer-modified (buffer-modified-p)))
5238                     (erc-display-prompt)
5239                     (set-buffer-modified-p buffer-modified))))))
5240
5241           ;; Only when last hook has been run...
5242           (run-hook-with-args 'erc-send-completed-hook str))))))
5243
5244 (defun erc-user-input ()
5245   "Return the input of the user in the current buffer."
5246   (buffer-substring-no-properties
5247    erc-input-marker
5248    (erc-end-of-input-line)))
5249
5250 (defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$"
5251   "Regular expression used for matching commands in ERC.")
5252
5253 (defun erc-send-input (input)
5254   "Treat INPUT as typed in by the user. It is assumed that the input
5255 and the prompt is already deleted.
5256 This returns non-nil only if we actually send anything."
5257   ;; Handle different kinds of inputs
5258   (cond
5259    ;; Ignore empty input
5260    ((if erc-send-whitespace-lines
5261         (string= input "")
5262       (string-match "\\`[ \t\r\f\n]*\\'" input))
5263     (when erc-warn-about-blank-lines
5264       (message "Blank line - ignoring...")
5265       (beep))
5266     nil)
5267    (t
5268     (let ((str input)
5269           (erc-insert-this t))
5270       (setq erc-send-this t)
5271       (run-hook-with-args 'erc-send-pre-hook input)
5272       (when erc-send-this
5273         (if (or (string-match "\n" str)
5274                 (not (string-match erc-command-regexp str)))
5275             (mapc
5276              (lambda (line)
5277                (mapc
5278                 (lambda (line)
5279                   ;; Insert what has to be inserted for this.
5280                   (erc-display-msg line)
5281                   (erc-process-input-line (concat line "\n")
5282                                           (null erc-flood-protect) t))
5283                 (or (and erc-flood-protect (erc-split-line line))
5284                     (list line))))
5285              (split-string str "\n"))
5286           ;; Insert the prompt along with the command.
5287           (erc-display-command str)
5288           (erc-process-input-line (concat str "\n") t nil))
5289         t)))))
5290
5291 (defun erc-display-command (line)
5292   (when erc-insert-this
5293     (let ((insert-position (point)))
5294       (unless erc-hide-prompt
5295         (erc-display-prompt nil nil (erc-command-indicator)
5296                             (and (erc-command-indicator)
5297                                  'erc-command-indicator-face)))
5298       (let ((beg (point)))
5299         (insert line)
5300         (erc-put-text-property beg (point)
5301                                'face 'erc-command-indicator-face)
5302         (insert "\n"))
5303       (when (processp erc-server-process)
5304         (set-marker (process-mark erc-server-process) (point)))
5305       (set-marker erc-insert-marker (point))
5306       (save-excursion
5307         (save-restriction
5308           (narrow-to-region insert-position (point))
5309           (run-hooks 'erc-send-modify-hook)
5310           (run-hooks 'erc-send-post-hook))))))
5311
5312 (defun erc-display-msg (line)
5313   "Display LINE as a message of the user to the current target at the
5314 current position."
5315   (when erc-insert-this
5316     (let ((insert-position (point)))
5317       (insert (erc-format-my-nick))
5318       (let ((beg (point)))
5319         (insert line)
5320         (erc-put-text-property beg (point)
5321                                'face 'erc-input-face))
5322       (insert "\n")
5323       (when (processp erc-server-process)
5324         (set-marker (process-mark erc-server-process) (point)))
5325       (set-marker erc-insert-marker (point))
5326       (save-excursion
5327         (save-restriction
5328           (narrow-to-region insert-position (point))
5329           (run-hooks 'erc-send-modify-hook)
5330           (run-hooks 'erc-send-post-hook))))))
5331
5332 (defun erc-command-symbol (command)
5333   "Return the ERC command symbol for COMMAND if it exists and is bound."
5334   (let ((cmd (intern-soft (format "erc-cmd-%s" (upcase command)))))
5335     (when (fboundp cmd) cmd)))
5336
5337 (defun erc-extract-command-from-line (line)
5338   "Extract command and args from the input LINE.
5339 If no command was given, return nil.  If command matches, return a
5340 list of the form: (command args) where both elements are strings."
5341   (when (string-match erc-command-regexp line)
5342     (let* ((cmd (erc-command-symbol (match-string 1 line)))
5343            ;; note: return is nil, we apply this simply for side effects
5344            (canon-defun (while (and cmd (symbolp (symbol-function cmd)))
5345                           (setq cmd (symbol-function cmd))))
5346            (cmd-fun (or cmd #'erc-cmd-default))
5347            (arg (if cmd
5348                     (if (get cmd-fun 'do-not-parse-args)
5349                         (format "%s" (match-string 2 line))
5350                       (delete "" (split-string (erc-trim-string
5351                                                 (match-string 2 line)) " ")))
5352                   line)))
5353       (list cmd-fun arg))))
5354
5355 (defun erc-split-multiline-safe (string)
5356   "Split STRING, containing multiple lines and return them in a list.
5357 Do it only for STRING as the complete input, do not carry unfinished
5358 strings over to the next call."
5359   (let ((l ())
5360         (i0 0)
5361         (doit t))
5362     (while doit
5363       (let ((i (string-match "\r?\n" string i0))
5364             (s (substring string i0)))
5365         (cond (i (setq l (cons (substring string i0 i) l))
5366                  (setq i0 (match-end 0)))
5367               ((> (length s) 0)
5368                  (setq l (cons s l))(setq doit nil))
5369               (t (setq doit nil)))))
5370     (nreverse l)))
5371
5372 ;; nick handling
5373
5374 (defun erc-set-current-nick (nick)
5375   "Set the current nickname to NICK."
5376   (with-current-buffer (if (buffer-live-p (erc-server-buffer))
5377                            (erc-server-buffer)
5378                          (current-buffer))
5379     (setq erc-server-current-nick nick)))
5380
5381 (defun erc-current-nick ()
5382   "Return the current nickname."
5383   (with-current-buffer (if (buffer-live-p (erc-server-buffer))
5384                            (erc-server-buffer)
5385                          (current-buffer))
5386     erc-server-current-nick))
5387
5388 (defun erc-current-nick-p (nick)
5389   "Return non-nil if NICK is the current nickname."
5390   (erc-nick-equal-p nick (erc-current-nick)))
5391
5392 (defun erc-nick-equal-p (nick1 nick2)
5393   "Return non-nil if NICK1 and NICK2 are the same.
5394
5395 This matches strings according to the IRC protocol's case convention.
5396
5397 See also `erc-downcase'."
5398   (string= (erc-downcase nick1)
5399            (erc-downcase nick2)))
5400
5401 ;; default target handling
5402
5403 (defun erc-default-target ()
5404   "Return the current default target (as a character string) or nil if none."
5405   (let ((tgt (car erc-default-recipients)))
5406     (cond
5407      ((not tgt) nil)
5408      ((listp tgt) (cdr tgt))
5409      (t tgt))))
5410
5411 (defun erc-add-default-channel (channel)
5412   "Add CHANNEL to the default channel list."
5413
5414   (let ((d1 (car erc-default-recipients))
5415         (d2 (cdr erc-default-recipients))
5416         (chl (downcase channel)))
5417       (setq erc-default-recipients
5418             (cons chl erc-default-recipients))))
5419
5420 (defun erc-delete-default-channel (channel &optional buffer)
5421   "Delete CHANNEL from the default channel list."
5422   (let ((ob (current-buffer)))
5423     (with-current-buffer (if (and buffer
5424                                   (bufferp buffer))
5425                              buffer
5426                            (current-buffer))
5427       (setq erc-default-recipients (delete (downcase channel)
5428                                            erc-default-recipients)))))
5429
5430 (defun erc-add-query (nickname)
5431   "Add QUERY'd NICKNAME to the default channel list.
5432
5433 The previous default target of QUERY type gets removed."
5434   (let ((d1 (car erc-default-recipients))
5435         (d2 (cdr erc-default-recipients))
5436         (qt (cons 'QUERY (downcase nickname))))
5437     (if (and (listp d1)
5438              (eq (car d1) 'QUERY))
5439         (setq erc-default-recipients (cons qt d2))
5440       (setq erc-default-recipients (cons qt erc-default-recipients)))))
5441
5442 (defun erc-delete-query ()
5443   "Delete the topmost target if it is a QUERY."
5444
5445   (let ((d1 (car erc-default-recipients))
5446         (d2 (cdr erc-default-recipients)))
5447     (if (and (listp d1)
5448              (eq (car d1) 'QUERY))
5449         (setq erc-default-recipients d2)
5450       (error "Current target is not a QUERY"))))
5451
5452 (defun erc-ignored-user-p (spec)
5453   "Return non-nil if SPEC matches something in `erc-ignore-list'.
5454
5455 Takes a full SPEC of a user in the form \"nick!login@host\", and
5456 matches against all the regexp's in `erc-ignore-list'.  If any
5457 match, returns that regexp."
5458   (catch 'found
5459     (dolist (ignored (erc-with-server-buffer erc-ignore-list))
5460       (if (string-match ignored spec)
5461           (throw 'found ignored)))))
5462
5463 (defun erc-ignored-reply-p (msg tgt proc)
5464   ;; FIXME: this docstring needs fixing -- Lawrence 2004-01-08
5465   "Return non-nil if MSG matches something in `erc-ignore-reply-list'.
5466
5467 Takes a message MSG to a channel and returns non-nil if the addressed
5468 user matches any regexp in `erc-ignore-reply-list'."
5469   (let ((target-nick (erc-message-target msg)))
5470     (if (not target-nick)
5471         nil
5472       (erc-with-buffer (tgt proc)
5473         (let ((user (erc-get-server-user target-nick)))
5474           (when user
5475             (erc-list-match erc-ignore-reply-list
5476                             (erc-user-spec user))))))))
5477
5478 (defun erc-message-target (msg)
5479   "Return the addressed target in MSG.
5480
5481 The addressed target is the string before the first colon in MSG."
5482   (if (string-match "^\\([^: \n]*\\):" msg)
5483       (match-string 1 msg)
5484     nil))
5485
5486 (defun erc-user-spec (user)
5487   "Create a nick!user@host spec from a user struct."
5488   (let ((nick (erc-server-user-nickname user))
5489         (host (erc-server-user-host user))
5490         (login (erc-server-user-login user)))
5491   (concat (if nick
5492               nick
5493             "")
5494           "!"
5495           (if login
5496               login
5497             "")
5498           "@"
5499           (if host
5500               host
5501             ""))))
5502
5503 (defun erc-list-match (lst str)
5504   "Return non-nil if any regexp in LST matches STR."
5505   (memq nil (mapcar (lambda (regexp)
5506                       (not (string-match regexp str)))
5507                     lst)))
5508
5509 ;; other "toggles"
5510
5511 (defun erc-toggle-ctcp-autoresponse (&optional arg)
5512   "Toggle automatic CTCP replies (like VERSION and PING).
5513
5514 If ARG is positive, turns CTCP replies on.
5515
5516 If ARG is non-nil and not positive, turns CTCP replies off."
5517   (interactive "P")
5518   (cond ((and (numberp arg) (> arg 0))
5519          (setq erc-disable-ctcp-replies t))
5520         (arg (setq erc-disable-ctcp-replies nil))
5521         (t (setq erc-disable-ctcp-replies (not erc-disable-ctcp-replies))))
5522   (message "ERC CTCP replies are %s" (if erc-disable-ctcp-replies "OFF" "ON")))
5523
5524 (defun erc-toggle-flood-control (&optional arg)
5525   "Toggle use of flood control on sent messages.
5526
5527 If ARG is positive, use flood control.
5528 If ARG is non-nil and not positive, do not use flood control.
5529
5530 See `erc-server-flood-margin' for an explanation of the available
5531 flood control parameters."
5532   (interactive "P")
5533   (cond ((and (numberp arg) (> arg 0))
5534          (setq erc-flood-protect t))
5535         (arg (setq erc-flood-protect nil))
5536         (t (setq erc-flood-protect (not erc-flood-protect))))
5537   (message "ERC flood control is %s"
5538            (cond (erc-flood-protect "ON")
5539                  (t "OFF"))))
5540
5541 ;; Some useful channel and nick commands for fast key bindings
5542
5543 (defun erc-invite-only-mode (&optional arg)
5544   "Turn on the invite only mode (+i) for the current channel.
5545
5546 If ARG is non-nil, turn this mode off (-i).
5547
5548 This command is sent even if excess flood is detected."
5549   (interactive "P")
5550   (erc-set-active-buffer (current-buffer))
5551   (let ((tgt (erc-default-target))
5552         (erc-force-send t))
5553     (cond ((or (not tgt) (not (erc-channel-p tgt)))
5554            (erc-display-message nil 'error (current-buffer) 'no-target))
5555           (arg (erc-load-irc-script-lines (list (concat "/mode " tgt " -i"))
5556                                           t))
5557           (t (erc-load-irc-script-lines (list (concat "/mode " tgt " +i"))
5558                                         t)))))
5559
5560 (defun erc-get-channel-mode-from-keypress (key)
5561   "Read a key sequence and call the corresponding channel mode function.
5562 After doing C-c C-o, type in a channel mode letter.
5563
5564 C-g means quit.
5565 RET lets you type more than one mode at a time.
5566 If \"l\" is pressed, `erc-set-channel-limit' gets called.
5567 If \"k\" is pressed, `erc-set-channel-key' gets called.
5568 Anything else will be sent to `erc-toggle-channel-mode'."
5569   (interactive "kChannel mode (RET to set more than one): ")
5570   (when (featurep 'xemacs)
5571     (setq key (char-to-string (event-to-character (aref key 0)))))
5572   (cond ((equal key "\C-g")
5573          (keyboard-quit))
5574         ((equal key "\C-m")
5575          (erc-insert-mode-command))
5576         ((equal key "l")
5577          (call-interactively 'erc-set-channel-limit))
5578         ((equal key "k")
5579          (call-interactively 'erc-set-channel-key))
5580         (t (erc-toggle-channel-mode key))))
5581
5582 (defun erc-toggle-channel-mode (mode &optional channel)
5583   "Toggle channel MODE.
5584
5585 If CHANNEL is non-nil, toggle MODE for that channel, otherwise use
5586 `erc-default-target'."
5587   (interactive "P")
5588   (erc-set-active-buffer (current-buffer))
5589   (let ((tgt (or channel (erc-default-target)))
5590         (erc-force-send t))
5591     (cond ((or (null tgt) (null (erc-channel-p tgt)))
5592            (erc-display-message nil 'error 'active 'no-target))
5593           ((member mode erc-channel-modes)
5594            (erc-log (format "%s: Toggle mode %s OFF" tgt mode))
5595            (message "Toggle channel mode %s OFF" mode)
5596            (erc-server-send (format "MODE %s -%s" tgt mode)))
5597           (t (erc-log (format "%s: Toggle channel mode %s ON" tgt mode))
5598              (message "Toggle channel mode %s ON" mode)
5599              (erc-server-send (format "MODE %s +%s" tgt mode))))))
5600
5601 (defun erc-insert-mode-command ()
5602   "Insert the line \"/mode <current target> \" at `point'."
5603   (interactive)
5604   (let ((tgt (erc-default-target)))
5605     (if tgt (insert (concat "/mode " tgt " "))
5606       (erc-display-message nil 'error (current-buffer) 'no-target))))
5607
5608 (defun erc-channel-names ()
5609   "Run \"/names #channel\" in the current channel."
5610   (interactive)
5611   (erc-set-active-buffer (current-buffer))
5612   (let ((tgt (erc-default-target)))
5613     (if tgt (erc-load-irc-script-lines (list (concat "/names " tgt)))
5614       (erc-display-message nil 'error (current-buffer) 'no-target))))
5615
5616 (defun erc-remove-text-properties-region (start end &optional object)
5617   "Clears the region (START,END) in OBJECT from all colors, etc."
5618   (interactive "r")
5619   (save-excursion
5620     (let ((inhibit-read-only t))
5621       (set-text-properties start end nil object))))
5622 (put 'erc-remove-text-properties-region 'disabled t)
5623
5624 ;; script execution and startup
5625
5626 (defun erc-find-file (file &optional path)
5627   "Search for a FILE in the filesystem.
5628 First the `default-directory' is searched for FILE, then any directories
5629 specified in the list PATH.
5630
5631 If FILE is found, return the path to it."
5632   (let ((filepath file))
5633     (if (file-readable-p filepath) filepath
5634       (progn
5635         (while (and path
5636                     (progn (setq filepath (expand-file-name file (car path)))
5637                            (not (file-readable-p filepath))))
5638           (setq path (cdr path)))
5639         (if path filepath nil)))))
5640
5641 (defun erc-select-startup-file ()
5642   "Select an ERC startup file.
5643 See also `erc-startup-file-list'."
5644   (catch 'found
5645     (dolist (f erc-startup-file-list)
5646       (setq f (convert-standard-filename f))
5647       (when (file-readable-p f)
5648         (throw 'found f)))))
5649
5650 (defun erc-find-script-file (file)
5651   "Search for FILE in `default-directory', and any in `erc-script-path'."
5652   (erc-find-file file erc-script-path))
5653
5654 (defun erc-load-script (file)
5655   "Load a script from FILE.
5656
5657 FILE must be the full name, it is not searched in the
5658 `erc-script-path'.  If the filename ends with `.el', then load it
5659 as an Emacs Lisp program.  Otherwise, treat it as a regular IRC
5660 script."
5661   (erc-log (concat "erc-load-script: " file))
5662   (cond
5663    ((string-match "\\.el$" file)
5664     (load file))
5665    (t
5666     (erc-load-irc-script file))))
5667
5668 (defun erc-process-script-line (line &optional args)
5669   "Process an IRC script LINE.
5670
5671 Does script-specific substitutions (script arguments, current nick,
5672 server, etc.) in LINE and returns it.
5673
5674 Substitutions are: %C and %c = current target (channel or nick),
5675 %S %s = current server, %N %n = my current nick, and %x is x verbatim,
5676 where x is any other character;
5677 $* = the entire argument string, $1 = the first argument, $2 = the second,
5678 and so on."
5679   (if (not args) (setq args ""))
5680   (let* ((arg-esc-regexp "\\(\\$\\(\\*\\|[1-9][0-9]*\\)\\)\\([^0-9]\\|$\\)")
5681          (percent-regexp "\\(%.\\)")
5682          (esc-regexp (concat arg-esc-regexp "\\|" percent-regexp))
5683          (tgt (erc-default-target))
5684          (server (and (boundp 'erc-session-server) erc-session-server))
5685          (nick (erc-current-nick))
5686          (res "")
5687          (tmp nil)
5688          (arg-list nil)
5689          (arg-num 0))
5690     (if (not tgt) (setq tgt ""))
5691     (if (not server) (setq server ""))
5692     (if (not nick) (setq nick ""))
5693     ;; First, compute the argument list
5694     (setq tmp args)
5695     (while (string-match "^\\s-*\\(\\S-+\\)\\(\\s-+.*$\\|$\\)" tmp)
5696       (setq arg-list (cons (match-string 1 tmp) arg-list))
5697       (setq tmp (match-string 2 tmp)))
5698     (setq arg-list (nreverse arg-list))
5699     (setq arg-num (length arg-list))
5700     ;; now do the substitution
5701     (setq tmp (string-match esc-regexp line))
5702     (while tmp
5703       ;;(message "beginning of while: tmp=%S" tmp)
5704       (let* ((hd (substring line 0 tmp))
5705              (esc "")
5706              (subst "")
5707              (tail (substring line tmp)))
5708         (cond ((string-match (concat "^" arg-esc-regexp) tail)
5709                (setq esc (match-string 1 tail))
5710                (setq tail (substring tail (match-end 1))))
5711               ((string-match (concat "^" percent-regexp) tail)
5712                (setq esc (match-string 1 tail))
5713                (setq tail (substring tail (match-end 1)))))
5714         ;;(message "hd=%S, esc=%S, tail=%S, arg-num=%S" hd esc tail arg-num)
5715         (setq res (concat res hd))
5716         (setq subst
5717               (cond ((string= esc "") "")
5718                     ((string-match "^\\$\\*$" esc) args)
5719                     ((string-match "^\\$\\([0-9]+\\)$" esc)
5720                      (let ((n (string-to-number (match-string 1 esc))))
5721                        (message "n = %S, integerp(n)=%S" n (integerp n))
5722                        (if (<= n arg-num) (nth (1- n) arg-list) "")))
5723                     ((string-match "^%[Cc]$" esc) tgt)
5724                     ((string-match "^%[Ss]$" esc) server)
5725                     ((string-match "^%[Nn]$" esc) nick)
5726                     ((string-match "^%\\(.\\)$" esc) (match-string 1 esc))
5727                     (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc))
5728                        (message "BUG IN ERC: esc=%S" esc)
5729                        "")))
5730         (setq line tail)
5731         (setq tmp (string-match esc-regexp line))
5732         (setq res (concat res subst))
5733         ;;(message "end of while: line=%S, res=%S, tmp=%S" line res tmp)
5734         ))
5735     (setq res (concat res line))
5736     res))
5737
5738 (defun erc-load-irc-script (file &optional force)
5739   "Load an IRC script from FILE."
5740   (erc-log (concat "erc-load-script: " file))
5741   (let ((str (with-temp-buffer
5742                (insert-file-contents file)
5743                (buffer-string))))
5744     (erc-load-irc-script-lines (erc-split-multiline-safe str) force)))
5745
5746 (defun erc-load-irc-script-lines (lines &optional force noexpand)
5747   "Load IRC script LINES (a list of strings).
5748
5749 If optional NOEXPAND is non-nil, do not expand script-specific
5750 sequences, process the lines verbatim.  Use this for multiline
5751 user input."
5752   (let* ((cb (current-buffer))
5753          (pnt (point))
5754          (s "")
5755          (sp (or (erc-command-indicator) (erc-prompt)))
5756          (args (and (boundp 'erc-script-args) erc-script-args)))
5757     (if (and args (string-match "^ " args))
5758         (setq args (substring args 1)))
5759     ;; prepare the prompt string for echo
5760     (erc-put-text-property 0 (length sp)
5761                            'face 'erc-command-indicator-face sp)
5762     (while lines
5763       (setq s (car lines))
5764       (erc-log (concat "erc-load-script: CMD: " s))
5765       (unless (string-match "^\\s-*$" s)
5766         (let ((line (if noexpand s (erc-process-script-line s args))))
5767           (if (and (erc-process-input-line line force)
5768                    erc-script-echo)
5769               (progn
5770                 (erc-put-text-property 0 (length line)
5771                                        'face 'erc-input-face line)
5772                 (erc-display-line (concat sp line) cb)))))
5773       (setq lines (cdr lines)))))
5774
5775 ;; authentication
5776
5777 (defun erc-login ()
5778   "Perform user authentication at the IRC server."
5779   (erc-log (format "login: nick: %s, user: %s %s %s :%s"
5780                    (erc-current-nick)
5781                    (user-login-name)
5782                    (or erc-system-name (system-name))
5783                    erc-session-server
5784                    erc-session-user-full-name))
5785   (if erc-session-password
5786       (erc-server-send (format "PASS %s" erc-session-password))
5787     (message "Logging in without password"))
5788   (erc-server-send (format "NICK %s" (erc-current-nick)))
5789   (erc-server-send
5790    (format "USER %s %s %s :%s"
5791            ;; hacked - S.B.
5792            (if erc-anonymous-login erc-email-userid (user-login-name))
5793            "0" "*"
5794            erc-session-user-full-name))
5795   (erc-update-mode-line))
5796
5797 ;; connection properties' heuristics
5798
5799 (defun erc-determine-parameters (&optional server port nick name)
5800   "Determine the connection and authentication parameters.
5801 Sets the buffer local variables:
5802
5803 - `erc-session-connector'
5804 - `erc-session-server'
5805 - `erc-session-port'
5806 - `erc-session-full-name'
5807 - `erc-server-current-nick'"
5808   (setq erc-session-connector erc-server-connect-function
5809         erc-session-server (erc-compute-server server)
5810         erc-session-port (or port erc-default-port)
5811         erc-session-user-full-name (erc-compute-full-name name))
5812   (erc-set-current-nick (erc-compute-nick nick)))
5813
5814 (defun erc-compute-server (&optional server)
5815   "Return an IRC server name.
5816
5817 This tries a number of increasingly more default methods until a
5818 non-nil value is found.
5819
5820 - SERVER (the argument passed to this function)
5821 - The `erc-server' option
5822 - The value of the IRCSERVER environment variable
5823 - The `erc-default-server' variable"
5824   (or server
5825       erc-server
5826       (getenv "IRCSERVER")
5827       erc-default-server))
5828
5829 (defun erc-compute-nick (&optional nick)
5830   "Return user's IRC nick.
5831
5832 This tries a number of increasingly more default methods until a
5833 non-nil value is found.
5834
5835 - NICK (the argument passed to this function)
5836 - The `erc-nick' option
5837 - The value of the IRCNICK environment variable
5838 - The result from the `user-login-name' function"
5839   (or nick
5840       (if (consp erc-nick) (car erc-nick) erc-nick)
5841       (getenv "IRCNICK")
5842       (user-login-name)))
5843
5844
5845 (defun erc-compute-full-name (&optional full-name)
5846   "Return user's full name.
5847
5848 This tries a number of increasingly more default methods until a
5849 non-nil value is found.
5850
5851 - FULL-NAME (the argument passed to this function)
5852 - The `erc-user-full-name' option
5853 - The value of the IRCNAME environment variable
5854 - The result from the `user-full-name' function"
5855   (or full-name
5856       erc-user-full-name
5857       (getenv "IRCNAME")
5858       (if erc-anonymous-login "unknown" nil)
5859       (user-full-name)))
5860
5861 (defun erc-compute-port (&optional port)
5862   "Return a port for an IRC server.
5863
5864 This tries a number of increasingly more default methods until a
5865 non-nil value is found.
5866
5867 - PORT (the argument passed to this function)
5868 - The `erc-port' option
5869 - The `erc-default-port' variable"
5870   (or port erc-port erc-default-port))
5871
5872 ;; time routines
5873
5874 (defun erc-string-to-emacs-time (string)
5875   "Convert the long number represented by STRING into an Emacs format.
5876 Returns a list of the form (HIGH LOW), compatible with Emacs time format."
5877   (let* ((n (string-to-number (concat string ".0"))))
5878     (list (truncate (/ n 65536))
5879           (truncate (mod n 65536)))))
5880
5881 (defun erc-emacs-time-to-erc-time (time)
5882   "Convert Emacs TIME to a number of seconds since the epoch."
5883   (when time
5884     (+ (* (nth 0 time) 65536.0) (nth 1 time))))
5885 ;  (round (+ (* (nth 0 tm) 65536.0) (nth 1 tm))))
5886
5887 (defun erc-current-time ()
5888   "Return the `current-time' as a number of seconds since the epoch.
5889
5890 See also `erc-emacs-time-to-erc-time'."
5891   (erc-emacs-time-to-erc-time (current-time)))
5892
5893 (defun erc-time-diff (t1 t2)
5894   "Return the time difference in seconds between T1 and T2."
5895   (abs (- t2 t1)))
5896
5897 (defun erc-time-gt (t1 t2)
5898   "Check whether T1 > T2."
5899   (> t1 t2))
5900
5901 (defun erc-sec-to-time (ns)
5902   "Convert NS to a time string HH:MM.SS."
5903   (setq ns (truncate ns))
5904   (format "%02d:%02d.%02d"
5905           (/ ns 3600)
5906           (/ (% ns 3600) 60)
5907           (% ns 60)))
5908
5909 (defun erc-seconds-to-string (seconds)
5910   "Convert a number of SECONDS into an English phrase."
5911   (let (days hours minutes format-args output)
5912     (setq days          (/ seconds 86400)
5913           seconds       (% seconds 86400)
5914           hours         (/ seconds 3600)
5915           seconds       (% seconds 3600)
5916           minutes       (/ seconds 60)
5917           seconds       (% seconds 60)
5918           format-args   (if (> days 0)
5919                             `("%d days, %d hours, %d minutes, %d seconds"
5920                               ,days ,hours ,minutes ,seconds)
5921                           (if (> hours 0)
5922                               `("%d hours, %d minutes, %d seconds"
5923                                 ,hours ,minutes ,seconds)
5924                             (if (> minutes 0)
5925                                 `("%d minutes, %d seconds" ,minutes ,seconds)
5926                               `("%d seconds" ,seconds))))
5927           output        (apply 'format format-args))
5928     ;; Change all "1 units" to "1 unit".
5929     (while (string-match "\\([^0-9]\\|^\\)1 \\S-+\\(s\\)" output)
5930       (setq output (erc-replace-match-subexpression-in-string
5931                     "" output (match-string 2 output) 2 (match-beginning 2))))
5932     output))
5933
5934
5935 ;; info
5936
5937 (defconst erc-clientinfo-alist
5938   '(("ACTION" . "is used to inform about one's current activity")
5939     ("CLIENTINFO" . "gives help on CTCP commands supported by client")
5940     ("ECHO" . "echoes its arguments back")
5941     ("FINGER" . "shows user's name, location, and idle time")
5942     ("PING" . "measures delay between peers")
5943     ("TIME" . "shows client-side time")
5944     ("USERINFO" . "shows information provided by a user")
5945     ("VERSION" . "shows client type and version"))
5946   "Alist of CTCP CLIENTINFO for ERC commands.")
5947
5948 (defun erc-client-info (s)
5949   "Return CTCP CLIENTINFO on command S.
5950 If S is nil or an empty string then return general CLIENTINFO."
5951   (if (or (not s) (string= s ""))
5952       (concat
5953        (apply #'concat
5954               (mapcar (lambda (e)
5955                         (concat (car e) " "))
5956                       erc-clientinfo-alist))
5957        ": use CLIENTINFO <COMMAND> to get more specific information")
5958     (let ((h (assoc (upcase s) erc-clientinfo-alist)))
5959       (if h
5960           (concat s " " (cdr h))
5961         (concat s ": unknown command")))))
5962
5963 ;; Hook functions
5964
5965 (defun erc-directory-writable-p (dir)
5966   "Determine whether DIR is a writable directory.
5967 If it doesn't exist, create it."
5968   (unless (file-attributes dir) (make-directory dir))
5969   (or (file-accessible-directory-p dir) (error "Cannot access %s" dir)))
5970
5971 (defun erc-kill-query-buffers (process)
5972   "Kill all buffers of PROCESS."
5973   ;; here, we only want to match the channel buffers, to avoid
5974   ;; "selecting killed buffers" b0rkage.
5975   (erc-with-all-buffers-of-server process
5976                                   (lambda ()
5977                                     (not (erc-server-buffer-p)))
5978                                   (kill-buffer (current-buffer))))
5979
5980 (defun erc-nick-at-point ()
5981   "Give information about the nickname at `point'.
5982
5983 If called interactively, give a human readable message in the
5984 minibuffer.  If called programmatically, return the corresponding
5985 entry of `channel-members'."
5986   (interactive)
5987   (require 'thingatpt)
5988   (let* ((word (word-at-point))
5989          (channel-data (erc-get-channel-user word))
5990          (cuser (cdr channel-data))
5991          (user (if channel-data
5992                    (car channel-data)
5993                  (erc-get-server-user word)))
5994          host login full-name info nick op voice)
5995     (when user
5996       (setq nick (erc-server-user-nickname user)
5997             host (erc-server-user-host user)
5998             login (erc-server-user-login user)
5999             full-name (erc-server-user-full-name user)
6000             info (erc-server-user-info user))
6001       (if cuser
6002           (setq op (erc-channel-user-op cuser)
6003                 voice (erc-channel-user-voice cuser)))
6004       (if (interactive-p)
6005           (message "%s is %s@%s%s%s"
6006                    nick login host
6007                    (if full-name (format " (%s)" full-name) "")
6008                    (if (or op voice)
6009                                (format " and is +%s%s on %s"
6010                                (if op "o" "")
6011                                (if voice "v" "")
6012                                        (erc-default-target))
6013                              ""))
6014         user))))
6015
6016 (defun erc-away-time ()
6017   "Return non-nil if the current ERC process is set away.
6018
6019 In particular, the time that we were set away is returned.
6020 See `current-time' for details on the time format."
6021   (erc-with-server-buffer erc-away))
6022
6023 ;; Mode line handling
6024
6025 (defcustom erc-mode-line-format "%S %a"
6026   "A string to be formatted and shown in the mode-line in `erc-mode'.
6027
6028 The string is formatted using `format-spec' and the result is set as the value
6029 of `mode-line-buffer-identification'.
6030
6031 The following characters are replaced:
6032 %a: String indicating away status or \"\" if you are not away
6033 %l: The estimated lag time to the server
6034 %m: The modes of the channel
6035 %n: The current nick name
6036 %N: The name of the network
6037 %o: The topic of the channel
6038 %p: The session port
6039 %t: The name of the target (channel, nickname, or servername:port)
6040 %s: In the server-buffer, this gets filled with the value of
6041     `erc-server-announced-name', in a channel, the value of
6042     (erc-default-target) also get concatenated.
6043 %S: In the server-buffer, this gets filled with the value of
6044     `erc-network', in a channel, the value of (erc-default-target)
6045     also get concatenated."
6046   :group 'erc-mode-line-and-header
6047   :type 'string)
6048
6049 (defcustom erc-header-line-format "%n on %t (%m,%l) %o"
6050   "A string to be formatted and shown in the header-line in `erc-mode'.
6051 Only used starting in Emacs 21.
6052
6053 Set this to nil if you do not want the header line to be
6054 displayed.
6055
6056 See `erc-mode-line-format' for which characters are can be used."
6057   :group 'erc-mode-line-and-header
6058   :set (lambda (sym val)
6059          (set sym val)
6060          (when (fboundp 'erc-update-mode-line)
6061            (erc-update-mode-line nil)))
6062   :type '(choice (const :tag "Disabled" nil)
6063                  string))
6064
6065 (defcustom erc-header-line-uses-tabbar-p nil
6066   "Use tabbar mode instead of the header line to display the header."
6067   :group 'erc-mode-line-and-header
6068   :type 'boolean)
6069
6070 (defcustom erc-header-line-uses-help-echo-p t
6071   "Show the contents of the header line in the echo area or as a tooltip
6072 when you move point into the header line."
6073   :group 'erc-mode-line-and-header
6074   :type 'boolean)
6075
6076 (defcustom erc-header-line-face-method nil
6077   "Determine what method to use when colorizing the header line text.
6078
6079 If nil, don't colorize the header text.
6080 If given a function, call it and use the resulting face name.
6081 Otherwise, use the `erc-header-line' face."
6082   :group 'erc-mode-line-and-header
6083   :type '(choice (const :tag "Don't colorize" nil)
6084                  (const :tag "Use the erc-header-line face" t)
6085                  (function :tag "Call a function")))
6086
6087 (defcustom erc-show-channel-key-p t
6088   "Show the channel key in the header line."
6089   :group 'erc-paranoia
6090   :type 'boolean)
6091
6092 (defcustom erc-common-server-suffixes
6093   '(("openprojects.net$" . "OPN")
6094     ("freenode.net$" . "freenode")
6095     ("oftc.net$" . "OFTC"))
6096   "Alist of common server name suffixes.
6097 This variable is used in mode-line display to save screen
6098 real estate.  Set it to nil if you want to avoid changing
6099 displayed hostnames."
6100   :group 'erc-mode-line-and-header
6101   :type 'alist)
6102
6103 (defcustom erc-mode-line-away-status-format
6104   "(AWAY since %a %b %d %H:%M) "
6105   "When you're away on a server, this is shown in the mode line.
6106 This should be a string with substitution variables recognized by
6107 `format-time-string'."
6108   :group 'erc-mode-line-and-header
6109   :type 'string)
6110
6111 (defun erc-shorten-server-name (server-name)
6112   "Shorten SERVER-NAME according to `erc-common-server-suffixes'."
6113   (if (stringp server-name)
6114       (with-temp-buffer
6115         (insert server-name)
6116         (let ((alist erc-common-server-suffixes))
6117           (while alist
6118             (goto-char (point-min))
6119         (if (re-search-forward (caar alist) nil t)
6120             (replace-match (cdar alist)))
6121         (setq alist (cdr alist))))
6122         (buffer-string))))
6123
6124 (defun erc-format-target ()
6125   "Return the name of the target (channel or nickname or servername:port)."
6126   (let ((target (erc-default-target)))
6127     (or target
6128         (concat (erc-shorten-server-name
6129                  (or erc-server-announced-name
6130                      erc-session-server))
6131                 ":" (erc-port-to-string erc-session-port)))))
6132
6133 (defun erc-format-target-and/or-server ()
6134   "Return the server name or the current target and server name combined."
6135   (let ((server-name (erc-shorten-server-name
6136                       (or erc-server-announced-name
6137                           erc-session-server))))
6138     (cond ((erc-default-target)
6139            (concat (erc-string-no-properties (erc-default-target))
6140                    "@" server-name))
6141           (server-name server-name)
6142           (t (buffer-name (current-buffer))))))
6143
6144 (defun erc-format-network ()
6145   "Return the name of the network we are currently on."
6146   (let ((network (and (fboundp 'erc-network-name) (erc-network-name))))
6147     (if (and network (symbolp network))
6148         (symbol-name network)
6149       "")))
6150
6151 (defun erc-format-target-and/or-network ()
6152   "Return the network or the current target and network combined.
6153 If the name of the network is not available, then use the
6154 shortened server name instead."
6155   (let ((network-name (or (and (fboundp 'erc-network-name) (erc-network-name))
6156                           (erc-shorten-server-name
6157                            (or erc-server-announced-name
6158                                erc-session-server)))))
6159     (when (and network-name (symbolp network-name))
6160       (setq network-name (symbol-name network-name)))
6161     (cond ((erc-default-target)
6162            (concat (erc-string-no-properties (erc-default-target))
6163                    "@" network-name))
6164           (network-name network-name)
6165           (t (buffer-name (current-buffer))))))
6166
6167 (defun erc-format-away-status ()
6168   "Return a formatted `erc-mode-line-away-status-format'
6169 if `erc-away' is non-nil."
6170   (let ((a (erc-away-time)))
6171     (if a
6172         (format-time-string erc-mode-line-away-status-format a)
6173       "")))
6174
6175 (defun erc-format-channel-modes ()
6176   "Return the current channel's modes."
6177   (concat (apply 'concat
6178                  "+" erc-channel-modes)
6179           (cond ((and erc-channel-user-limit erc-channel-key)
6180                  (if erc-show-channel-key-p
6181                      (format "lk %.0f %s" erc-channel-user-limit
6182                              erc-channel-key)
6183                    (format "kl %.0f" erc-channel-user-limit)))
6184                 (erc-channel-user-limit
6185                  ;; Emacs has no bignums
6186                  (format "l %.0f" erc-channel-user-limit))
6187                 (erc-channel-key
6188                  (if erc-show-channel-key-p
6189                      (format "k %s" erc-channel-key)
6190                    "k"))
6191                 (t nil))))
6192
6193 (defun erc-format-lag-time ()
6194   "Return the estimated lag time to server, `erc-server-lag'."
6195   (let ((lag (erc-with-server-buffer erc-server-lag)))
6196     (cond (lag (format "lag:%.0f" lag))
6197           (t ""))))
6198
6199 ;; erc-goodies is required at end of this file.
6200 (declare-function erc-controls-strip "erc-goodies" (str))
6201
6202 (defvar tabbar--local-hlf)
6203
6204 (defun erc-update-mode-line-buffer (buffer)
6205   "Update the mode line in a single ERC buffer BUFFER."
6206   (with-current-buffer buffer
6207     (let ((spec (format-spec-make
6208                  ?a (erc-format-away-status)
6209                  ?l (erc-format-lag-time)
6210                  ?m (erc-format-channel-modes)
6211                  ?n (or (erc-current-nick) "")
6212                  ?N (erc-format-network)
6213                  ?o (erc-controls-strip erc-channel-topic)
6214                  ?p (erc-port-to-string erc-session-port)
6215                  ?s (erc-format-target-and/or-server)
6216                  ?S (erc-format-target-and/or-network)
6217                  ?t (erc-format-target)))
6218           (process-status (cond ((and (erc-server-process-alive)
6219                                       (not erc-server-connected))
6220                                  ":connecting")
6221                                 ((erc-server-process-alive)
6222                                  "")
6223                                 (t
6224                                  ": CLOSED")))
6225           (face (cond ((eq erc-header-line-face-method nil)
6226                        nil)
6227                       ((functionp erc-header-line-face-method)
6228                        (funcall erc-header-line-face-method))
6229                       (t
6230                        'erc-header-line))))
6231       (cond ((featurep 'xemacs)
6232              (setq modeline-buffer-identification
6233                    (list (format-spec erc-mode-line-format spec)))
6234              (setq modeline-process (list process-status)))
6235             (t
6236              (setq mode-line-buffer-identification
6237                    (list (format-spec erc-mode-line-format spec)))
6238              (setq mode-line-process (list process-status))))
6239       (when (boundp 'header-line-format)
6240         (let ((header (if erc-header-line-format
6241                           (format-spec erc-header-line-format spec)
6242                         nil)))
6243           (cond (erc-header-line-uses-tabbar-p
6244                  (set (make-local-variable 'tabbar--local-hlf)
6245                       header-line-format)
6246                  (kill-local-variable 'header-line-format))
6247                 ((null header)
6248                  (setq header-line-format nil))
6249                 (erc-header-line-uses-help-echo-p
6250                  (let ((help-echo (with-temp-buffer
6251                                     (insert header)
6252                                     (fill-region (point-min) (point-max))
6253                                     (buffer-string))))
6254                    (setq header-line-format
6255                          (erc-replace-regexp-in-string
6256                           "%"
6257                           "%%"
6258                           (if face
6259                               (erc-propertize header 'help-echo help-echo
6260                                               'face face)
6261                             (erc-propertize header 'help-echo help-echo))))))
6262                 (t (setq header-line-format
6263                          (if face
6264                              (erc-propertize header 'face face)
6265                            header)))))))
6266     (if (featurep 'xemacs)
6267         (redraw-modeline)
6268       (force-mode-line-update))))
6269
6270 (defun erc-update-mode-line (&optional buffer)
6271   "Update the mode line in BUFFER.
6272
6273 If BUFFER is nil, update the mode line in all ERC buffers."
6274   (if (and buffer (bufferp buffer))
6275       (erc-update-mode-line-buffer buffer)
6276     (dolist (buf (erc-buffer-list))
6277       (when (buffer-live-p buf)
6278         (erc-update-mode-line-buffer buf)))))
6279
6280 ;; Miscellaneous
6281
6282 (defun erc-port-to-string (p)
6283   "Convert port P to a string.
6284 P may be an integer or a service name."
6285   (if (integerp p)
6286       (int-to-string p)
6287     p))
6288
6289 (defun erc-string-to-port (s)
6290   "Convert string S to either an integer port number or a service name."
6291   (if (numberp s)
6292       s
6293     (let ((n (string-to-number s)))
6294       (if (= n 0)
6295           s
6296         n))))
6297
6298 (defun erc-version (&optional here)
6299   "Show the version number of ERC in the minibuffer.
6300 If optional argument HERE is non-nil, insert version number at point."
6301   (interactive "P")
6302   (let ((version-string
6303          (format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version)))
6304     (if here
6305         (insert version-string)
6306       (if (interactive-p)
6307           (message "%s" version-string)
6308         version-string))))
6309
6310 (defun erc-modes (&optional here)
6311   "Show the active ERC modes in the minibuffer.
6312 If optional argument HERE is non-nil, insert version number at point."
6313   (interactive "P")
6314   (let ((string
6315          (mapconcat 'identity
6316                     (let (modes (case-fold-search nil))
6317                       (dolist (var (apropos-internal "^erc-.*mode$"))
6318                         (when (and (boundp var)
6319                                    (symbol-value var))
6320                           (setq modes (cons (symbol-name var)
6321                                             modes))))
6322                       modes)
6323                     ", ")))
6324     (if here
6325         (insert string)
6326       (if (interactive-p)
6327           (message "%s" string)
6328         string))))
6329
6330 (defun erc-trim-string (s)
6331   "Trim leading and trailing spaces off S."
6332   (cond
6333    ((not (stringp s)) nil)
6334    ((string-match "^\\s-*$" s)
6335     "")
6336    ((string-match "^\\s-*\\(.*\\S-\\)\\s-*$" s)
6337     (match-string 1 s))
6338    (t
6339     s)))
6340
6341 (defun erc-arrange-session-in-multiple-windows ()
6342   "Open a window for every non-server buffer related to `erc-session-server'.
6343
6344 All windows are opened in the current frame."
6345   (interactive)
6346   (unless erc-server-process
6347     (error "No erc-server-process found in current buffer"))
6348   (let ((bufs (erc-buffer-list nil erc-server-process)))
6349     (when bufs
6350       (delete-other-windows)
6351       (switch-to-buffer (car bufs))
6352       (setq bufs (cdr bufs))
6353       (while bufs
6354         (split-window)
6355         (other-window 1)
6356         (switch-to-buffer (car bufs))
6357         (setq bufs (cdr bufs))
6358         (balance-windows)))))
6359
6360 (defun erc-popup-input-buffer ()
6361   "Provide an input buffer."
6362    (interactive)
6363    (let ((buffer-name (generate-new-buffer-name "*ERC input*"))
6364          (mode (intern
6365                 (completing-read
6366                  "Mode: "
6367                  (mapcar (lambda (e)
6368                            (list (symbol-name e)))
6369                          (apropos-internal "-mode$" 'commandp))
6370                  nil t))))
6371      (pop-to-buffer (make-indirect-buffer (current-buffer) buffer-name))
6372      (funcall mode)
6373      (narrow-to-region (point) (point))
6374      (shrink-window-if-larger-than-buffer)))
6375
6376 ;;; Message catalog
6377
6378 (defun erc-make-message-variable-name (catalog entry)
6379   "Create a variable name corresponding to CATALOG's ENTRY."
6380   (intern (concat "erc-message-"
6381                   (symbol-name catalog) "-" (symbol-name entry))))
6382
6383 (defun erc-define-catalog-entry (catalog entry format-spec)
6384   "Set CATALOG's ENTRY to FORMAT-SPEC."
6385   (set (erc-make-message-variable-name catalog entry)
6386        format-spec))
6387
6388 (defun erc-define-catalog (catalog entries)
6389   "Define a CATALOG according to ENTRIES."
6390   (dolist (entry entries)
6391     (erc-define-catalog-entry catalog (car entry) (cdr entry))))
6392
6393 (erc-define-catalog
6394  'english
6395  '((bad-ping-response . "Unexpected PING response from %n (time %t)")
6396    (bad-syntax . "Error occurred - incorrect usage?\n%c %u\n%d")
6397    (incorrect-args . "Incorrect arguments. Usage:\n%c %u\n%d")
6398    (cannot-find-file . "Cannot find file %f")
6399    (cannot-read-file . "Cannot read file %f")
6400    (connect . "Connecting to %S:%p... ")
6401    (country . "%c")
6402    (country-unknown . "%d: No such domain")
6403    (ctcp-empty . "Illegal empty CTCP query received from %n. Ignoring.")
6404    (ctcp-request . "==> CTCP request from %n (%u@%h): %r")
6405    (ctcp-request-to . "==> CTCP request from %n (%u@%h) to %t: %r")
6406    (ctcp-too-many . "Too many CTCP queries in single message. Ignoring")
6407    (flood-ctcp-off . "FLOOD PROTECTION: Automatic CTCP responses turned off.")
6408    (flood-strict-mode
6409     . "FLOOD PROTECTION: Switched to Strict Flood Control mode.")
6410    (disconnected . "\n\nConnection failed!  Re-establishing connection...\n")
6411    (disconnected-noreconnect
6412     . "\n\nConnection failed!  Not re-establishing connection.\n")
6413    (finished . "\n\n*** ERC finished ***\n")
6414    (terminated . "\n\n*** ERC terminated: %e\n")
6415    (login . "Logging in as \'%n\'...")
6416    (nick-in-use . "%n is in use. Choose new nickname: ")
6417    (nick-too-long
6418     . "WARNING: Nick length (%i) exceeds max NICKLEN(%l) defined by server")
6419    (no-default-channel . "No default channel")
6420    (no-invitation . "You've got no invitation")
6421    (no-target . "No target")
6422    (ops . "%i operator%s: %o")
6423    (ops-none . "No operators in this channel.")
6424    (undefined-ctcp . "Undefined CTCP query received. Silently ignored")
6425    (variable-not-bound . "Variable not bound!")
6426    (ACTION . "* %n %a")
6427    (CTCP-CLIENTINFO . "Client info for %n: %m")
6428    (CTCP-ECHO . "Echo %n: %m")
6429    (CTCP-FINGER . "Finger info for %n: %m")
6430    (CTCP-PING . "Ping time to %n is %t")
6431    (CTCP-TIME . "Time by %n is %m")
6432    (CTCP-UNKNOWN . "Unknown CTCP message from %n (%u@%h): %m")
6433    (CTCP-VERSION . "Version for %n is %m")
6434    (ERROR  . "==> ERROR from %s: %c\n")
6435    (INVITE . "%n (%u@%h) invites you to channel %c")
6436    (JOIN   . "%n (%u@%h) has joined channel %c")
6437    (JOIN-you . "You have joined channel %c")
6438    (KICK . "%n (%u@%h) has kicked %k off channel %c: %r")
6439    (KICK-you . "You have been kicked off channel %c by %n (%u@%h): %r")
6440    (KICK-by-you . "You have kicked %k off channel %c: %r")
6441    (MODE   . "%n (%u@%h) has changed mode for %t to %m")
6442    (MODE-nick . "%n has changed mode for %t to %m")
6443    (NICK   . "%n (%u@%h) is now known as %N")
6444    (NICK-you . "Your new nickname is %N")
6445    (PART   . erc-message-english-PART)
6446    (PING   . "PING from server (last: %s sec. ago)")
6447    (PONG   . "PONG from %h (%i second%s)")
6448    (QUIT   . "%n (%u@%h) has quit: %r")
6449    (TOPIC  . "%n (%u@%h) has set the topic for %c: \"%T\"")
6450    (WALLOPS . "Wallops from %n: %m")
6451    (s004   . "%s %v %U %C")
6452    (s221   . "User modes for %n: %m")
6453    (s252   . "%i operator(s) online")
6454    (s253   . "%i unknown connection(s)")
6455    (s254   . "%i channels formed")
6456    (s275   . "%n %m")
6457    (s301   . "%n is AWAY: %r")
6458    (s303   . "Is online: %n")
6459    (s305   . "%m")
6460    (s306   . "%m")
6461    (s307   . "%n %m")
6462    (s311   . "%n is %f (%u@%h)")
6463    (s312   . "%n is/was on server %s (%c)")
6464    (s313   . "%n is an IRC operator")
6465    (s314   . "%n was %f (%u@%h)")
6466    (s317   . "%n has been idle for %i")
6467    (s317-on-since . "%n has been idle for %i, on since %t")
6468    (s319   . "%n is on channel(s): %c")
6469    (s320   . "%n is an identified user")
6470    (s321   . "Channel  Users  Topic")
6471    (s322   . "%c [%u] %t")
6472    (s324   . "%c modes: %m")
6473    (s328   . "%c URL: %u")
6474    (s329   . "%c was created on %t")
6475    (s330   . "%n %a %i")
6476    (s331   . "No topic is set for %c")
6477    (s332   . "Topic for %c: %T")
6478    (s333   . "%c: topic set by %n, %t")
6479    (s341   . "Inviting %n to channel %c")
6480    (s352   . "%-11c %-10n %-4a %u@%h (%f)")
6481    (s353   . "Users on %c: %u")
6482    (s367   . "Ban for %b on %c")
6483    (s367-set-by . "Ban for %b on %c set by %s on %t")
6484    (s368   . "Banlist of %c ends.")
6485    (s379   . "%c: Forwarded to %f")
6486    (s391   . "The time at %s is %t")
6487    (s401   . "%n: No such nick/channel")
6488    (s403   . "%c: No such channel")
6489    (s404   . "%c: Cannot send to channel")
6490    (s405   . "%c: You have joined too many channels")
6491    (s406   . "%n: There was no such nickname")
6492    (s412   . "No text to send")
6493    (s421   . "%c: Unknown command")
6494    (s431   . "No nickname given")
6495    (s432   . "%n is an erroneous nickname")
6496    (s442   . "%c: You're not on that channel")
6497    (s445   . "SUMMON has been disabled")
6498    (s446   . "USERS has been disabled")
6499    (s451   . "You have not registered")
6500    (s461   . "%c: not enough parameters")
6501    (s462   . "Unauthorized command (already registered)")
6502    (s463   . "Your host isn't among the privileged")
6503    (s464   . "Password incorrect")
6504    (s465   . "You are banned from this server")
6505    (s474   . "You can't join %c because you're banned (+b)")
6506    (s475   . "You must specify the correct channel key (+k) to join %c")
6507    (s481   . "Permission Denied - You're not an IRC operator")
6508    (s482   . "You need to be a channel operator of %c to do that")
6509    (s483   . "You can't kill a server!")
6510    (s484   . "Your connection is restricted!")
6511    (s485   . "You're not the original channel operator")
6512    (s491   . "No O-lines for your host")
6513    (s501   . "Unknown MODE flag")
6514    (s502   . "You can't change modes for other users")
6515    (s671   . "%n %a")))
6516
6517 (defun erc-message-english-PART (&rest args)
6518   "Format a proper PART message.
6519
6520 This function is an example on what could be done with formatting
6521 functions."
6522   (let ((nick (cadr (memq ?n args)))
6523         (user (cadr (memq ?u args)))
6524         (host (cadr (memq ?h args)))
6525         (channel (cadr (memq ?c args)))
6526         (reason (cadr (memq ?r args))))
6527     (if (string= nick (erc-current-nick))
6528         (format "You have left channel %s" channel)
6529       (format "%s (%s@%s) has left channel %s%s"
6530               nick user host channel
6531               (if (not (string= reason ""))
6532                   (format ": %s"
6533                           (erc-replace-regexp-in-string "%" "%%" reason))
6534                 "")))))
6535
6536
6537 (defvar erc-current-message-catalog 'english)
6538 (make-variable-buffer-local 'erc-current-message-catalog)
6539
6540 (defun erc-retrieve-catalog-entry (entry &optional catalog)
6541   "Retrieve ENTRY from CATALOG.
6542
6543 If CATALOG is nil, `erc-current-message-catalog' is used.
6544
6545 If ENTRY is nil in CATALOG, it is retrieved from the fallback,
6546 english, catalog."
6547   (unless catalog (setq catalog erc-current-message-catalog))
6548   (let ((var (erc-make-message-variable-name catalog entry)))
6549     (if (boundp var)
6550         (symbol-value var)
6551       (when (boundp (erc-make-message-variable-name 'english entry))
6552         (symbol-value (erc-make-message-variable-name 'english entry))))))
6553
6554 (defun erc-format-message (msg &rest args)
6555   "Format MSG according to ARGS.
6556
6557 See also `format-spec'."
6558   (when (eq (logand (length args) 1) 1) ; oddp
6559     (error "Obscure usage of this function appeared"))
6560   (let ((entry (erc-retrieve-catalog-entry msg)))
6561     (when (not entry)
6562       (error "No format spec for message %s" msg))
6563     (when (functionp entry)
6564       (setq entry (apply entry args)))
6565     (format-spec entry (apply 'format-spec-make args))))
6566
6567 ;;; Various hook functions
6568
6569 (add-hook 'kill-buffer-hook 'erc-kill-buffer-function)
6570
6571 (defcustom erc-kill-server-hook '(erc-kill-server)
6572   "Invoked whenever a server-buffer is killed via `kill-buffer'."
6573   :group 'erc-hooks
6574   :type 'hook)
6575
6576 (defcustom erc-kill-channel-hook '(erc-kill-channel)
6577   "Invoked whenever a channel-buffer is killed via `kill-buffer'."
6578   :group 'erc-hooks
6579   :type 'hook)
6580
6581 (defcustom erc-kill-buffer-hook nil
6582   "Hook run whenever a non-server or channel buffer is killed.
6583
6584 See also `kill-buffer'."
6585   :group 'erc-hooks
6586   :type 'hook)
6587
6588 (defun erc-kill-buffer-function ()
6589   "Function to call when an ERC buffer is killed.
6590 This function should be on `kill-buffer-hook'.
6591 When the current buffer is in `erc-mode', this function will run
6592 one of the following hooks:
6593 `erc-kill-server-hook' if the server buffer was killed,
6594 `erc-kill-channel-hook' if a channel buffer was killed,
6595 or `erc-kill-buffer-hook' if any other buffer."
6596   (when (eq major-mode 'erc-mode)
6597     (erc-remove-channel-users)
6598     (cond
6599      ((eq (erc-server-buffer) (current-buffer))
6600       (run-hooks 'erc-kill-server-hook))
6601      ((erc-channel-p (erc-default-target))
6602       (run-hooks 'erc-kill-channel-hook))
6603      (t
6604       (run-hooks 'erc-kill-buffer-hook)))))
6605
6606 (defun erc-kill-server ()
6607   "Sends a QUIT command to the server when the server buffer is killed.
6608 This function should be on `erc-kill-server-hook'."
6609   (when (erc-server-process-alive)
6610     (setq erc-server-quitting t)
6611     (erc-server-send (format "QUIT :%s" (funcall erc-quit-reason nil)))))
6612
6613 (defun erc-kill-channel ()
6614   "Sends a PART command to the server when the channel buffer is killed.
6615 This function should be on `erc-kill-channel-hook'."
6616   (when (erc-server-process-alive)
6617     (let ((tgt (erc-default-target)))
6618       (erc-server-send (format "PART %s :%s" tgt
6619                                (funcall erc-part-reason nil))
6620                        nil tgt))))
6621
6622 ;;; Dealing with `erc-parsed'
6623
6624 (defun erc-find-parsed-property ()
6625   "Find the next occurrence of the `erc-parsed' text property."
6626   (text-property-not-all (point-min) (point-max) 'erc-parsed nil))
6627
6628 (defun erc-restore-text-properties ()
6629   "Restore the property 'erc-parsed for the region."
6630   (let ((parsed-posn (erc-find-parsed-property)))
6631     (put-text-property
6632      (point-min) (point-max)
6633      'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
6634
6635 (defun erc-get-parsed-vector (point)
6636   "Return the whole parsed vector on POINT."
6637   (get-text-property point 'erc-parsed))
6638
6639 (defun erc-get-parsed-vector-nick (vect)
6640   "Return nickname in the parsed vector VECT."
6641   (let* ((untreated-nick (and vect (erc-response.sender vect)))
6642          (maybe-nick (when untreated-nick
6643                        (car (split-string untreated-nick "!")))))
6644     (when (and (not (null maybe-nick))
6645                (erc-is-valid-nick-p maybe-nick))
6646       untreated-nick)))
6647
6648 (defun erc-get-parsed-vector-type (vect)
6649   "Return message type in the parsed vector VECT."
6650   (and vect
6651        (erc-response.command vect)))
6652
6653 ;; Teach url.el how to open irc:// URLs with ERC.
6654 ;; To activate, customize `url-irc-function' to `url-irc-erc'.
6655
6656 ;;;###autoload
6657 (defun erc-handle-irc-url (host port channel user password)
6658   "Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
6659 If ERC is already connected to HOST:PORT, simply /join CHANNEL.
6660 Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
6661   (let ((server-buffer
6662          (car (erc-buffer-filter
6663                (lambda ()
6664                  (and (string-equal erc-session-server host)
6665                       (= erc-session-port port)
6666                       (erc-open-server-buffer-p)))))))
6667     (with-current-buffer (or server-buffer (current-buffer))
6668       (if (and server-buffer channel)
6669           (erc-cmd-JOIN channel)
6670         (erc-open host port (or user (erc-compute-nick)) (erc-compute-full-name)
6671                   (not server-buffer) password nil channel
6672                   (when server-buffer
6673                     (get-buffer-process server-buffer)))))))
6674
6675 (provide 'erc)
6676
6677 ;;; Deprecated. We might eventually stop requiring the goodies automatically.
6678 ;;; IMPORTANT: This require must appear _after_ the above (provide 'erc) to
6679 ;;; avoid a recursive require error when byte-compiling the entire package.
6680 (require 'erc-goodies)
6681
6682 ;;; erc.el ends here
6683 ;;
6684 ;; Local Variables:
6685 ;; outline-regexp: ";;+"
6686 ;; indent-tabs-mode: t
6687 ;; tab-width: 8
6688 ;; End: