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