aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorl3thal2014-11-08 20:51:43 -0500
committerl3thal2014-11-08 20:51:43 -0500
commitd1036d288de1e047f7f6043188a1063f0d6b044d (patch)
tree539b06df3227d25928e2a78f8144bf4242be67f9 /lisp
parent7d8205619a95e44ec5c4d589c538c6616e64483b (diff)
downloademacs-d1036d288de1e047f7f6043188a1063f0d6b044d.tar.gz
emacs-d1036d288de1e047f7f6043188a1063f0d6b044d.zip
backport: erc bugfixes
Diffstat (limited to 'lisp')
-rw-r--r--lisp/erc/ChangeLog107
-rw-r--r--lisp/erc/erc-backend.el15
-rw-r--r--lisp/erc/erc-ring.el3
-rw-r--r--lisp/erc/erc-stamp.el3
-rw-r--r--lisp/erc/erc-track.el2
-rw-r--r--lisp/erc/erc.el4018
6 files changed, 2166 insertions, 1982 deletions
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index 869befc1191..0875994e775 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,17 +1,111 @@
12014-11-04 Stefan Monnier <monnier@iro.umontreal.ca> 12014-11-05 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * erc.el (erc-send-input): Bind `str' dynamically (bug#18936). 3 * erc.el (erc-send-input): Bind `str' dynamically (bug#18936).
4 4
52014-10-29 Paul Eggert <eggert@cs.ucla.edu>
6
7 Simplify use of current-time and friends.
8 * erc-backend.el (TOPIC): Omit unnecessary call to current-time.
9 * erc.el (erc-emacs-time-to-erc-time): Simplify by using float-time.
10 (erc-current-time): Simplify by using erc-emacs-time-to-erc-time.
11
52014-10-20 Glenn Morris <rgm@gnu.org> 122014-10-20 Glenn Morris <rgm@gnu.org>
6 13
7 * Version 24.4 released. 14 * Merge in all changes up to 24.4 release.
15
162014-10-15 Ivan Shmakov <ivan@siamics.net>
17
18 * erc-track.el (erc-modified-channels-display): Update mode line
19 more frequently (bug#18510).
20
212014-10-10 Kelvin White <kwhite@gnu.org>
22
23 * erc.el (erc-initialize-log-marker): Only initialize
24 erc-last-saved-position if not already a marker.
25
262014-10-04 Stefan Monnier <monnier@iro.umontreal.ca>
27
28 * erc.el (erc-channel-receive-names): Silence compiler warning.
29 (erc-format-@nick, erc-update-modes): Idem.
8 30
92014-09-24 Stefan Monnier <monnier@iro.umontreal.ca> 312014-10-03 Kelvin White <kwhite@gnu.org>
32
33 * erc.el (erc-rename-buffers): Use defcustom instead of defvar for
34 buffer renaming configuration option.
35
362014-10-02 Paul Eggert <eggert@cs.ucla.edu>
37
38 * erc.el (erc-nick-at-point): Fix format-string typo (Bug#17755).
39
402014-10-02 Kelvin White <kwhite@gnu.org>
41
42 * erc.el (erc-rename-buffer-p): When set to t buffers will be
43 renamed to the current irc network.
44 (erc-format-target-and/or-network): Use `erc-rename-buffer-p' when
45 renaming buffers.
46
47 * erc-ring.el (erc-input-ring-setup): Fixes Bug #18599
48
492014-09-30 Stefan Monnier <monnier@iro.umontreal.ca>
10 50
11 * erc-track.el (erc-modified-channels-display): Update all mode lines 51 * erc-track.el (erc-modified-channels-display): Update all mode lines
12 if needed (bug#18510). Remove call to erc-modified-channels-object 52 if needed (bug#18510). Remove call to erc-modified-channels-object
13 where we ignored the return value. 53 where we ignored the return value.
14 (erc-modified-channels-update): Don't force-mode-line-update here any more. 54 (erc-modified-channels-update): Don't force-mode-line-update here
55 any more.
56
572014-09-26 Kelvin White <kwhite@gnu.org>
58
59 * erc.el (erc-format-nick): Fix code regression - Bug #18551
60
612014-09-25 Kelvin White <kwhite@gnu.org>
62
63 * erc.el: Follow Emacs version instead of tracking it seperately.
64 (erc-quit/part-reason-default) : Clean up quit/part message
65 functions by abstracting repetitive code, change version string.
66 (erc-quit-reason-various, erc-quit-reason-normal, erc-quit-reason-zippy)
67 (erc-part-reason-normal, erc-part-reason-zippy, erc-part-reason-various)
68 (erc-cmd-SV, erc-ctcp-query-VERSION, erc-version, erc-version-string):
69 Change version string.
70
712014-08-13 Kelvin White <kwhite@gnu.org>
72
73 * erc.el (erc-send-input): Disable display commands in current buffer
74 (erc-format-target-and/or-network): Fix cases when buffer name is set
75
762014-08-12 Stefan Monnier <monnier@iro.umontreal.ca>
77
78 * erc-stamp.el (erc-timestamp-intangible): Disable by default because
79 `intangible' is evil.
80
812014-08-07 Kelvin White <kwhite@gnu.org>
82
83 * erc.el (erc-channel-receive-names): Fix variable names
84 (erc-format-target-and/or-network): Rename server-buffers to
85 network name if possible
86
872014-07-08 Stefan Monnier <monnier@iro.umontreal.ca>
88
89 * erc.el (erc-channel-receive-names): Reduce redundancy.
90
912014-06-19 Kelvin White <kwhite@gnu.org>
92
93 * erc-backend.el: Handle user modes in relevant server responses
94 * erc.el: Better user mode support.
95 (erc-channel-user): Add members for new modes.
96 (erc-channel-member-halfop-p, erc-channel-user-admin-p)
97 (erc-channel-user-owner-p): Use new struct members.
98 (erc-format-nick, erc-format-@nick): Display user modes as nick prefix.
99 (erc-nick-prefix-face, erc-my-nick-prefix-face): Add new faces
100 (erc-get-user-mode-prefix): Return symbol for mode prefix.
101 (erc-update-channel-member, erc-update-current-channel-member)
102 (erc-channel-receive-names): Update channel users.
103 (erc-nick-at-point): Return correct user info.
104
1052014-04-04 Stefan Monnier <monnier@iro.umontreal.ca>
106
107 * erc.el (erc-invite-only-mode, erc-toggle-channel-mode): Simplify.
108 (erc-load-script): Tighten a regexp.
15 109
162014-02-25 Julien Danjou <julien@danjou.info> 1102014-02-25 Julien Danjou <julien@danjou.info>
17 111
@@ -360,9 +454,9 @@
360 454
3612011-11-28 Mike Kazantsev <mk.fraggod@gmail.com> (tiny change) 4552011-11-28 Mike Kazantsev <mk.fraggod@gmail.com> (tiny change)
362 456
363 * erc-dcc.el (erc-dcc-ctcp-query-send-regexp): Updated regexp to 457 * erc-dcc.el (erc-dcc-ctcp-query-send-regexp): Update regexp to
364 match quoted filenames with spaces inside. 458 match quoted filenames with spaces inside.
365 (erc-dcc-handle-ctcp-send): Updated regexp match group numbers, 459 (erc-dcc-handle-ctcp-send): Update regexp match group numbers,
366 added processing of escaped quotes and backslashes if filename 460 added processing of escaped quotes and backslashes if filename
367 itself was in quotes. 461 itself was in quotes.
368 462
@@ -625,4 +719,3 @@ See ChangeLog.08 for earlier changes.
625;; coding: utf-8 719;; coding: utf-8
626;; add-log-time-zone-rule: t 720;; add-log-time-zone-rule: t
627;; End: 721;; End:
628
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 01fdfc54d1d..fb22f58822d 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -679,7 +679,7 @@ Conditionally try to reconnect and take appropriate action."
679 (when (buffer-live-p buf) 679 (when (buffer-live-p buf)
680 (with-current-buffer buf 680 (with-current-buffer buf
681 (erc-log (format 681 (erc-log (format
682 "SENTINEL: proc: %S status: %S event: %S (quitting: %S)" 682 "SENTINEL: proc: %S status: %S event: %S (quitting: %S)"
683 cproc (process-status cproc) event erc-server-quitting)) 683 cproc (process-status cproc) event erc-server-quitting))
684 (if (string-match "^open" event) 684 (if (string-match "^open" event)
685 ;; newly opened connection (no wait) 685 ;; newly opened connection (no wait)
@@ -1208,7 +1208,6 @@ add things to `%s' instead."
1208 parsed 'notice 'active 1208 parsed 'notice 'active
1209 'INVITE ?n nick ?u login ?h host ?c chnl))))) 1209 'INVITE ?n nick ?u login ?h host ?c chnl)))))
1210 1210
1211
1212(define-erc-response-handler (JOIN) 1211(define-erc-response-handler (JOIN)
1213 "Handle join messages." 1212 "Handle join messages."
1214 nil 1213 nil
@@ -1244,7 +1243,7 @@ add things to `%s' instead."
1244 (erc-format-message 1243 (erc-format-message
1245 'JOIN ?n nick ?u login ?h host ?c chnl)))))) 1244 'JOIN ?n nick ?u login ?h host ?c chnl))))))
1246 (when buffer (set-buffer buffer)) 1245 (when buffer (set-buffer buffer))
1247 (erc-update-channel-member chnl nick nick t nil nil host login) 1246 (erc-update-channel-member chnl nick nick t nil nil nil nil nil host login)
1248 ;; on join, we want to stay in the new channel buffer 1247 ;; on join, we want to stay in the new channel buffer
1249 ;;(set-buffer ob) 1248 ;;(set-buffer ob)
1250 (erc-display-message parsed nil buffer str)))))) 1249 (erc-display-message parsed nil buffer str))))))
@@ -1413,7 +1412,7 @@ add things to `%s' instead."
1413 ;; message. We will accumulate private identities indefinitely 1412 ;; message. We will accumulate private identities indefinitely
1414 ;; at this point. 1413 ;; at this point.
1415 (erc-update-channel-member (if privp nick tgt) nick nick 1414 (erc-update-channel-member (if privp nick tgt) nick nick
1416 privp nil nil host login nil nil t) 1415 privp nil nil nil nil nil host login nil nil t)
1417 (let ((cdata (erc-get-channel-user nick))) 1416 (let ((cdata (erc-get-channel-user nick)))
1418 (setq fnick (funcall erc-format-nick-function 1417 (setq fnick (funcall erc-format-nick-function
1419 (car cdata) (cdr cdata)))))) 1418 (car cdata) (cdr cdata))))))
@@ -1466,11 +1465,10 @@ add things to `%s' instead."
1466 "The channel topic has changed." nil 1465 "The channel topic has changed." nil
1467 (let* ((ch (car (erc-response.command-args parsed))) 1466 (let* ((ch (car (erc-response.command-args parsed)))
1468 (topic (erc-trim-string (erc-response.contents parsed))) 1467 (topic (erc-trim-string (erc-response.contents parsed)))
1469 (time (format-time-string erc-server-timestamp-format 1468 (time (format-time-string erc-server-timestamp-format)))
1470 (current-time))))
1471 (pcase-let ((`(,nick ,login ,host) 1469 (pcase-let ((`(,nick ,login ,host)
1472 (erc-parse-user (erc-response.sender parsed)))) 1470 (erc-parse-user (erc-response.sender parsed))))
1473 (erc-update-channel-member ch nick nick nil nil nil host login) 1471 (erc-update-channel-member ch nick nick nil nil nil nil nil nil host login)
1474 (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time)) 1472 (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time))
1475 (erc-display-message parsed 'notice (erc-get-buffer ch proc) 1473 (erc-display-message parsed 'notice (erc-get-buffer ch proc)
1476 'TOPIC ?n nick ?u login ?h host 1474 'TOPIC ?n nick ?u login ?h host
@@ -1800,8 +1798,7 @@ See `erc-display-server-message'." nil
1800 (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name) 1798 (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name)
1801 (setq hopcount (match-string 1 full-name)) 1799 (setq hopcount (match-string 1 full-name))
1802 (setq full-name (match-string 2 full-name))) 1800 (setq full-name (match-string 2 full-name)))
1803 (erc-update-channel-member channel nick nick nil nil nil host 1801 (erc-update-channel-member channel nick nick nil nil nil nil nil nil host user full-name)
1804 user full-name)
1805 (erc-display-message parsed 'notice 'active 's352 1802 (erc-display-message parsed 'notice 'active 's352
1806 ?c channel ?n nick ?a away-flag 1803 ?c channel ?n nick ?a away-flag
1807 ?u user ?h host ?f full-name)))) 1804 ?u user ?h host ?f full-name))))
diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el
index 1762700ff36..682585c53bb 100644
--- a/lisp/erc/erc-ring.el
+++ b/lisp/erc/erc-ring.el
@@ -67,7 +67,8 @@ variable.")
67(defun erc-input-ring-setup () 67(defun erc-input-ring-setup ()
68 "Do the setup required so that we can use comint style input rings. 68 "Do the setup required so that we can use comint style input rings.
69Call this function when setting up the mode." 69Call this function when setting up the mode."
70 (setq erc-input-ring (make-ring comint-input-ring-size)) 70 (unless (ring-p erc-input-ring)
71 (setq erc-input-ring (make-ring comint-input-ring-size)))
71 (setq erc-input-ring-index nil)) 72 (setq erc-input-ring-index nil))
72 73
73(defun erc-add-to-input-ring (s) 74(defun erc-add-to-input-ring (s)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index ab951652bcc..39ffbb4bf38 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -147,10 +147,11 @@ the minibuffer."
147 :group 'erc-stamp 147 :group 'erc-stamp
148 :type 'string) 148 :type 'string)
149 149
150(defcustom erc-timestamp-intangible t 150(defcustom erc-timestamp-intangible nil
151 "Whether the timestamps should be intangible, i.e. prevent the point 151 "Whether the timestamps should be intangible, i.e. prevent the point
152from entering them and instead jump over them." 152from entering them and instead jump over them."
153 :group 'erc-stamp 153 :group 'erc-stamp
154 :version "25.1"
154 :type 'boolean) 155 :type 'boolean)
155 156
156(defface erc-timestamp-face '((t :weight bold :foreground "green")) 157(defface erc-timestamp-face '((t :weight bold :foreground "green"))
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 67d41c74e81..fae6be433fd 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -858,7 +858,7 @@ Use `erc-make-mode-line-buffer-name' to create buttons."
858 faces (cdr faces))) 858 faces (cdr faces)))
859 strings))) 859 strings)))
860 (newobject (erc-modified-channels-object strings))) 860 (newobject (erc-modified-channels-object strings)))
861 (unless (equal oldobject newobject) 861 (unless (equal-including-properties oldobject newobject)
862 (setq erc-modified-channels-object newobject) 862 (setq erc-modified-channels-object newobject)
863 (force-mode-line-update t))))) 863 (force-mode-line-update t)))))
864 864
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 3a107c69f9a..37b24eaaa60 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -9,9 +9,10 @@
9;; Andreas Fuchs (afs@void.at) 9;; Andreas Fuchs (afs@void.at)
10;; Gergely Nagy (algernon@midgard.debian.net) 10;; Gergely Nagy (algernon@midgard.debian.net)
11;; David Edmondson (dme@dme.org) 11;; David Edmondson (dme@dme.org)
12;; Kelvin White (kwhite@gnu.org)
12;; Maintainer: emacs-devel@gnu.org 13;; Maintainer: emacs-devel@gnu.org
13;; Keywords: IRC, chat, client, Internet 14;; Keywords: IRC, chat, client, Internet
14;; Version: 5.3 15
15 16
16;; This file is part of GNU Emacs. 17;; This file is part of GNU Emacs.
17 18
@@ -62,11 +63,11 @@
62;;; History: 63;;; History:
63;; 64;;
64 65
65;;; Code: 66(defconst erc-version-string (format "\C-bERC\C-b (IRC client for Emacs %s)" emacs-version)
66
67(defconst erc-version-string "Version 5.3"
68 "ERC version. This is used by function `erc-version'.") 67 "ERC version. This is used by function `erc-version'.")
69 68
69;;; Code:
70
70(eval-when-compile (require 'cl-lib)) 71(eval-when-compile (require 'cl-lib))
71(require 'font-lock) 72(require 'font-lock)
72(require 'pp) 73(require 'pp)
@@ -143,7 +144,7 @@ See function `erc-compute-server' for more details on connection
143parameters and authentication." 144parameters and authentication."
144 :group 'erc 145 :group 'erc
145 :type '(choice (const :tag "None" nil) 146 :type '(choice (const :tag "None" nil)
146 (string :tag "Server"))) 147 (string :tag "Server")))
147 148
148(defcustom erc-port nil 149(defcustom erc-port nil
149 "IRC port to use if not specified. 150 "IRC port to use if not specified.
@@ -151,8 +152,8 @@ parameters and authentication."
151This can be either a string or a number." 152This can be either a string or a number."
152 :group 'erc 153 :group 'erc
153 :type '(choice (const :tag "None" nil) 154 :type '(choice (const :tag "None" nil)
154 (integer :tag "Port number") 155 (integer :tag "Port number")
155 (string :tag "Port string"))) 156 (string :tag "Port string")))
156 157
157(defcustom erc-nick nil 158(defcustom erc-nick nil
158 "Nickname to use if one is not provided. 159 "Nickname to use if one is not provided.
@@ -165,8 +166,8 @@ See function `erc-compute-nick' for more details on connection
165parameters and authentication." 166parameters and authentication."
166 :group 'erc 167 :group 'erc
167 :type '(choice (const :tag "None" nil) 168 :type '(choice (const :tag "None" nil)
168 (string :tag "Nickname") 169 (string :tag "Nickname")
169 (repeat (string :tag "Nickname")))) 170 (repeat (string :tag "Nickname"))))
170 171
171(defcustom erc-nick-uniquifier "`" 172(defcustom erc-nick-uniquifier "`"
172 "The string to append to the nick if it is already in use." 173 "The string to append to the nick if it is already in use."
@@ -190,10 +191,15 @@ See function `erc-compute-full-name' for more details on connection
190parameters and authentication." 191parameters and authentication."
191 :group 'erc 192 :group 'erc
192 :type '(choice (const :tag "No name" nil) 193 :type '(choice (const :tag "No name" nil)
193 (string :tag "Name") 194 (string :tag "Name")
194 (function :tag "Get from function")) 195 (function :tag "Get from function"))
195 :set (lambda (sym val) 196 :set (lambda (sym val)
196 (set sym (if (functionp val) (funcall val) val)))) 197 (set sym (if (functionp val) (funcall val) val))))
198
199(defcustom erc-rename-buffers nil
200 "When this is set to t, buffers will be renamed to network name if available"
201 :group 'erc
202 :type 'boolean)
197 203
198(defvar erc-password nil 204(defvar erc-password nil
199 "Password to use when authenticating to an IRC server. 205 "Password to use when authenticating to an IRC server.
@@ -243,12 +249,12 @@ If nil, only \"> \" will be shown."
243(define-widget 'erc-message-type 'set 249(define-widget 'erc-message-type 'set
244 "A set of standard IRC Message types." 250 "A set of standard IRC Message types."
245 :args '((const "JOIN") 251 :args '((const "JOIN")
246 (const "KICK") 252 (const "KICK")
247 (const "NICK") 253 (const "NICK")
248 (const "PART") 254 (const "PART")
249 (const "QUIT") 255 (const "QUIT")
250 (const "MODE") 256 (const "MODE")
251 (repeat :inline t :tag "Others" (string :tag "IRC Message Type")))) 257 (repeat :inline t :tag "Others" (string :tag "IRC Message Type"))))
252 258
253(defcustom erc-hide-list nil 259(defcustom erc-hide-list nil
254 "List of IRC type messages to hide. 260 "List of IRC type messages to hide.
@@ -339,14 +345,14 @@ nicknames with erc-server-user struct instances.")
339(defun erc-downcase (string) 345(defun erc-downcase (string)
340 "Convert STRING to IRC standard conforming downcase." 346 "Convert STRING to IRC standard conforming downcase."
341 (let ((s (downcase string)) 347 (let ((s (downcase string))
342 (c '((?\[ . ?\{) 348 (c '((?\[ . ?\{)
343 (?\] . ?\}) 349 (?\] . ?\})
344 (?\\ . ?\|) 350 (?\\ . ?\|)
345 (?~ . ?^)))) 351 (?~ . ?^))))
346 (save-match-data 352 (save-match-data
347 (while (string-match "[]\\[~]" s) 353 (while (string-match "[]\\[~]" s)
348 (aset s (match-beginning 0) 354 (aset s (match-beginning 0)
349 (cdr (assq (aref s (match-beginning 0)) c))))) 355 (cdr (assq (aref s (match-beginning 0)) c)))))
350 s)) 356 s))
351 357
352(defmacro erc-with-server-buffer (&rest body) 358(defmacro erc-with-server-buffer (&rest body)
@@ -356,8 +362,8 @@ If no server buffer exists, return nil."
356 (let ((buffer (make-symbol "buffer"))) 362 (let ((buffer (make-symbol "buffer")))
357 `(let ((,buffer (erc-server-buffer))) 363 `(let ((,buffer (erc-server-buffer)))
358 (when (buffer-live-p ,buffer) 364 (when (buffer-live-p ,buffer)
359 (with-current-buffer ,buffer 365 (with-current-buffer ,buffer
360 ,@body))))) 366 ,@body)))))
361 367
362(cl-defstruct (erc-server-user (:type vector) :named) 368(cl-defstruct (erc-server-user (:type vector) :named)
363 ;; User data 369 ;; User data
@@ -370,7 +376,7 @@ If no server buffer exists, return nil."
370 ) 376 )
371 377
372(cl-defstruct (erc-channel-user (:type vector) :named) 378(cl-defstruct (erc-channel-user (:type vector) :named)
373 op voice 379 voice halfop op admin owner
374 ;; Last message time (in the form of the return value of 380 ;; Last message time (in the form of the return value of
375 ;; (current-time) 381 ;; (current-time)
376 ;; 382 ;;
@@ -419,11 +425,11 @@ other buffers are also changed."
419 (puthash (erc-downcase new-nick) user erc-server-users)) 425 (puthash (erc-downcase new-nick) user erc-server-users))
420 (dolist (buf (erc-server-user-buffers user)) 426 (dolist (buf (erc-server-user-buffers user))
421 (if (buffer-live-p buf) 427 (if (buffer-live-p buf)
422 (with-current-buffer buf 428 (with-current-buffer buf
423 (let ((cdata (erc-get-channel-user nick))) 429 (let ((cdata (erc-get-channel-user nick)))
424 (remhash (erc-downcase nick) erc-channel-users) 430 (remhash (erc-downcase nick) erc-channel-users)
425 (puthash (erc-downcase new-nick) cdata 431 (puthash (erc-downcase new-nick) cdata
426 erc-channel-users))))))) 432 erc-channel-users)))))))
427 433
428(defun erc-remove-channel-user (nick) 434(defun erc-remove-channel-user (nick)
429 "This function is for internal use only. 435 "This function is for internal use only.
@@ -437,12 +443,12 @@ See also: `erc-remove-server-user' and `erc-remove-user'."
437 (let ((channel-data (erc-get-channel-user nick))) 443 (let ((channel-data (erc-get-channel-user nick)))
438 (when channel-data 444 (when channel-data
439 (let ((user (car channel-data))) 445 (let ((user (car channel-data)))
440 (setf (erc-server-user-buffers user) 446 (setf (erc-server-user-buffers user)
441 (delq (current-buffer) 447 (delq (current-buffer)
442 (erc-server-user-buffers user))) 448 (erc-server-user-buffers user)))
443 (remhash (erc-downcase nick) erc-channel-users) 449 (remhash (erc-downcase nick) erc-channel-users)
444 (if (null (erc-server-user-buffers user)) 450 (if (null (erc-server-user-buffers user))
445 (erc-remove-server-user nick)))))) 451 (erc-remove-server-user nick))))))
446 452
447(defun erc-remove-user (nick) 453(defun erc-remove-user (nick)
448 "This function is for internal use only. 454 "This function is for internal use only.
@@ -455,11 +461,11 @@ See also: `erc-remove-server-user' and
455 (let ((user (erc-get-server-user nick))) 461 (let ((user (erc-get-server-user nick)))
456 (when user 462 (when user
457 (let ((buffers (erc-server-user-buffers user))) 463 (let ((buffers (erc-server-user-buffers user)))
458 (dolist (buf buffers) 464 (dolist (buf buffers)
459 (if (buffer-live-p buf) 465 (if (buffer-live-p buf)
460 (with-current-buffer buf 466 (with-current-buffer buf
461 (remhash (erc-downcase nick) erc-channel-users) 467 (remhash (erc-downcase nick) erc-channel-users)
462 (run-hooks 'erc-channel-members-changed-hook))))) 468 (run-hooks 'erc-channel-members-changed-hook)))))
463 (erc-remove-server-user nick)))) 469 (erc-remove-server-user nick))))
464 470
465(defun erc-remove-channel-users () 471(defun erc-remove-channel-users ()
@@ -468,28 +474,52 @@ See also: `erc-remove-server-user' and
468Removes all users in the current channel. This is called by 474Removes all users in the current channel. This is called by
469`erc-server-PART' and `erc-server-QUIT'." 475`erc-server-PART' and `erc-server-QUIT'."
470 (when (and erc-server-connected 476 (when (and erc-server-connected
471 (erc-server-process-alive) 477 (erc-server-process-alive)
472 (hash-table-p erc-channel-users)) 478 (hash-table-p erc-channel-users))
473 (maphash (lambda (nick _cdata) 479 (maphash (lambda (nick _cdata)
474 (erc-remove-channel-user nick)) 480 (erc-remove-channel-user nick))
475 erc-channel-users) 481 erc-channel-users)
476 (clrhash erc-channel-users))) 482 (clrhash erc-channel-users)))
477 483
484(defsubst erc-channel-user-owner-p (nick)
485 "Return non-nil if NICK is an owner of 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-owner (cdr cdata))))))
491
492(defsubst erc-channel-user-admin-p (nick)
493 "Return non-nil if NICK is an admin in the current channel."
494 (and nick
495 (hash-table-p erc-channel-users)
496 (let ((cdata (erc-get-channel-user nick)))
497 (and cdata (cdr cdata)
498 (erc-channel-user-admin (cdr cdata))))))
499
478(defsubst erc-channel-user-op-p (nick) 500(defsubst erc-channel-user-op-p (nick)
479 "Return t if NICK is an operator in the current channel." 501 "Return non-nil if NICK is an operator in the current channel."
480 (and nick 502 (and nick
481 (hash-table-p erc-channel-users) 503 (hash-table-p erc-channel-users)
482 (let ((cdata (erc-get-channel-user nick))) 504 (let ((cdata (erc-get-channel-user nick)))
483 (and cdata (cdr cdata) 505 (and cdata (cdr cdata)
484 (erc-channel-user-op (cdr cdata)))))) 506 (erc-channel-user-op (cdr cdata))))))
507
508(defsubst erc-channel-user-halfop-p (nick)
509 "Return non-nil if NICK is a half-operator in the current channel."
510 (and nick
511 (hash-table-p erc-channel-users)
512 (let ((cdata (erc-get-channel-user nick)))
513 (and cdata (cdr cdata)
514 (erc-channel-user-halfop (cdr cdata))))))
485 515
486(defsubst erc-channel-user-voice-p (nick) 516(defsubst erc-channel-user-voice-p (nick)
487 "Return t if NICK has voice in the current channel." 517 "Return non-nil if NICK has voice in the current channel."
488 (and nick 518 (and nick
489 (hash-table-p erc-channel-users) 519 (hash-table-p erc-channel-users)
490 (let ((cdata (erc-get-channel-user nick))) 520 (let ((cdata (erc-get-channel-user nick)))
491 (and cdata (cdr cdata) 521 (and cdata (cdr cdata)
492 (erc-channel-user-voice (cdr cdata)))))) 522 (erc-channel-user-voice (cdr cdata))))))
493 523
494(defun erc-get-channel-user-list () 524(defun erc-get-channel-user-list ()
495 "Return a list of users in the current channel. Each element 525 "Return a list of users in the current channel. Each element
@@ -500,9 +530,9 @@ erc-channel-user struct.
500See also: `erc-sort-channel-users-by-activity'" 530See also: `erc-sort-channel-users-by-activity'"
501 (let (users) 531 (let (users)
502 (if (hash-table-p erc-channel-users) 532 (if (hash-table-p erc-channel-users)
503 (maphash (lambda (_nick cdata) 533 (maphash (lambda (_nick cdata)
504 (setq users (cons cdata users))) 534 (setq users (cons cdata users)))
505 erc-channel-users)) 535 erc-channel-users))
506 users)) 536 users))
507 537
508(defun erc-get-server-nickname-list () 538(defun erc-get-server-nickname-list ()
@@ -510,22 +540,22 @@ See also: `erc-sort-channel-users-by-activity'"
510 (erc-with-server-buffer 540 (erc-with-server-buffer
511 (let (nicks) 541 (let (nicks)
512 (when (hash-table-p erc-server-users) 542 (when (hash-table-p erc-server-users)
513 (maphash (lambda (_n user) 543 (maphash (lambda (_n user)
514 (setq nicks 544 (setq nicks
515 (cons (erc-server-user-nickname user) 545 (cons (erc-server-user-nickname user)
516 nicks))) 546 nicks)))
517 erc-server-users) 547 erc-server-users)
518 nicks)))) 548 nicks))))
519 549
520(defun erc-get-channel-nickname-list () 550(defun erc-get-channel-nickname-list ()
521 "Return a list of known nicknames on the current channel." 551 "Return a list of known nicknames on the current channel."
522 (let (nicks) 552 (let (nicks)
523 (when (hash-table-p erc-channel-users) 553 (when (hash-table-p erc-channel-users)
524 (maphash (lambda (_n cdata) 554 (maphash (lambda (_n cdata)
525 (setq nicks 555 (setq nicks
526 (cons (erc-server-user-nickname (car cdata)) 556 (cons (erc-server-user-nickname (car cdata))
527 nicks))) 557 nicks)))
528 erc-channel-users) 558 erc-channel-users)
529 nicks))) 559 nicks)))
530 560
531(defun erc-get-server-nickname-alist () 561(defun erc-get-server-nickname-alist ()
@@ -533,22 +563,22 @@ See also: `erc-sort-channel-users-by-activity'"
533 (erc-with-server-buffer 563 (erc-with-server-buffer
534 (let (nicks) 564 (let (nicks)
535 (when (hash-table-p erc-server-users) 565 (when (hash-table-p erc-server-users)
536 (maphash (lambda (_n user) 566 (maphash (lambda (_n user)
537 (setq nicks 567 (setq nicks
538 (cons (cons (erc-server-user-nickname user) nil) 568 (cons (cons (erc-server-user-nickname user) nil)
539 nicks))) 569 nicks)))
540 erc-server-users) 570 erc-server-users)
541 nicks)))) 571 nicks))))
542 572
543(defun erc-get-channel-nickname-alist () 573(defun erc-get-channel-nickname-alist ()
544 "Return an alist of known nicknames on the current channel." 574 "Return an alist of known nicknames on the current channel."
545 (let (nicks) 575 (let (nicks)
546 (when (hash-table-p erc-channel-users) 576 (when (hash-table-p erc-channel-users)
547 (maphash (lambda (_n cdata) 577 (maphash (lambda (_n cdata)
548 (setq nicks 578 (setq nicks
549 (cons (cons (erc-server-user-nickname (car cdata)) nil) 579 (cons (cons (erc-server-user-nickname (car cdata)) nil)
550 nicks))) 580 nicks)))
551 erc-channel-users) 581 erc-channel-users)
552 nicks))) 582 nicks)))
553 583
554(defun erc-sort-channel-users-by-activity (list) 584(defun erc-sort-channel-users-by-activity (list)
@@ -557,13 +587,13 @@ LIST must be of the form (USER . CHANNEL-DATA).
557 587
558See also: `erc-get-channel-user-list'." 588See also: `erc-get-channel-user-list'."
559 (sort list 589 (sort list
560 (lambda (x y) 590 (lambda (x y)
561 (when (and (cdr x) (cdr y)) 591 (when (and (cdr x) (cdr y))
562 (let ((tx (erc-channel-user-last-message-time (cdr x))) 592 (let ((tx (erc-channel-user-last-message-time (cdr x)))
563 (ty (erc-channel-user-last-message-time (cdr y)))) 593 (ty (erc-channel-user-last-message-time (cdr y))))
564 (and tx 594 (and tx
565 (or (not ty) 595 (or (not ty)
566 (time-less-p ty tx)))))))) 596 (time-less-p ty tx))))))))
567 597
568(defun erc-sort-channel-users-alphabetically (list) 598(defun erc-sort-channel-users-alphabetically (list)
569 "Sort LIST so that users' nicknames are in alphabetical order. 599 "Sort LIST so that users' nicknames are in alphabetical order.
@@ -571,13 +601,13 @@ LIST must be of the form (USER . CHANNEL-DATA).
571 601
572See also: `erc-get-channel-user-list'." 602See also: `erc-get-channel-user-list'."
573 (sort list 603 (sort list
574 (lambda (x y) 604 (lambda (x y)
575 (when (and (cdr x) (cdr y)) 605 (when (and (cdr x) (cdr y))
576 (let ((nickx (downcase (erc-server-user-nickname (car x)))) 606 (let ((nickx (downcase (erc-server-user-nickname (car x))))
577 (nicky (downcase (erc-server-user-nickname (car y))))) 607 (nicky (downcase (erc-server-user-nickname (car y)))))
578 (and nickx 608 (and nickx
579 (or (not nicky) 609 (or (not nicky)
580 (string-lessp nickx nicky)))))))) 610 (string-lessp nickx nicky))))))))
581 611
582(defvar erc-channel-topic nil 612(defvar erc-channel-topic nil
583 "A topic string for the channel. Should only be used in channel-buffers.") 613 "A topic string for the channel. Should only be used in channel-buffers.")
@@ -613,10 +643,10 @@ E.g. '(\"i\" \"m\" \"s\" \"b Quake!*@*\")
613 643
614See also the variable `erc-prompt'." 644See also the variable `erc-prompt'."
615 (let ((prompt (if (functionp erc-prompt) 645 (let ((prompt (if (functionp erc-prompt)
616 (funcall erc-prompt) 646 (funcall erc-prompt)
617 erc-prompt))) 647 erc-prompt)))
618 (if (> (length prompt) 0) 648 (if (> (length prompt) 0)
619 (concat prompt " ") 649 (concat prompt " ")
620 prompt))) 650 prompt)))
621 651
622(defcustom erc-command-indicator nil 652(defcustom erc-command-indicator nil
@@ -635,11 +665,11 @@ If nil, the prompt will be constructed from the variable `erc-prompt'."
635This only has any meaning if the variable `erc-command-indicator' is non-nil." 665This only has any meaning if the variable `erc-command-indicator' is non-nil."
636 (and erc-command-indicator 666 (and erc-command-indicator
637 (let ((prompt (if (functionp erc-command-indicator) 667 (let ((prompt (if (functionp erc-command-indicator)
638 (funcall erc-command-indicator) 668 (funcall erc-command-indicator)
639 erc-command-indicator))) 669 erc-command-indicator)))
640 (if (> (length prompt) 0) 670 (if (> (length prompt) 0)
641 (concat prompt " ") 671 (concat prompt " ")
642 prompt)))) 672 prompt))))
643 673
644(defcustom erc-notice-prefix "*** " 674(defcustom erc-notice-prefix "*** "
645 "Prefix for all notices." 675 "Prefix for all notices."
@@ -658,8 +688,8 @@ The following values are allowed:
658Any other value disables notice's highlighting altogether." 688Any other value disables notice's highlighting altogether."
659 :group 'erc-display 689 :group 'erc-display
660 :type '(choice (const :tag "highlight notice prefix only" prefix) 690 :type '(choice (const :tag "highlight notice prefix only" prefix)
661 (const :tag "highlight the entire notice" all) 691 (const :tag "highlight the entire notice" all)
662 (const :tag "don't highlight notices at all" nil))) 692 (const :tag "don't highlight notices at all" nil)))
663 693
664(defcustom erc-echo-notice-hook nil 694(defcustom erc-echo-notice-hook nil
665 "List of functions to call to echo a private notice. 695 "List of functions to call to echo a private notice.
@@ -682,14 +712,14 @@ See also: `erc-echo-notice-always-hook',
682 :group 'erc-hooks 712 :group 'erc-hooks
683 :type 'hook 713 :type 'hook
684 :options '(erc-echo-notice-in-default-buffer 714 :options '(erc-echo-notice-in-default-buffer
685 erc-echo-notice-in-target-buffer 715 erc-echo-notice-in-target-buffer
686 erc-echo-notice-in-minibuffer 716 erc-echo-notice-in-minibuffer
687 erc-echo-notice-in-server-buffer 717 erc-echo-notice-in-server-buffer
688 erc-echo-notice-in-active-non-server-buffer 718 erc-echo-notice-in-active-non-server-buffer
689 erc-echo-notice-in-active-buffer 719 erc-echo-notice-in-active-buffer
690 erc-echo-notice-in-user-buffers 720 erc-echo-notice-in-user-buffers
691 erc-echo-notice-in-user-and-target-buffers 721 erc-echo-notice-in-user-and-target-buffers
692 erc-echo-notice-in-first-user-buffer)) 722 erc-echo-notice-in-first-user-buffer))
693 723
694(defcustom erc-echo-notice-always-hook 724(defcustom erc-echo-notice-always-hook
695 '(erc-echo-notice-in-default-buffer) 725 '(erc-echo-notice-in-default-buffer)
@@ -713,14 +743,14 @@ See also: `erc-echo-notice-hook',
713 :group 'erc-hooks 743 :group 'erc-hooks
714 :type 'hook 744 :type 'hook
715 :options '(erc-echo-notice-in-default-buffer 745 :options '(erc-echo-notice-in-default-buffer
716 erc-echo-notice-in-target-buffer 746 erc-echo-notice-in-target-buffer
717 erc-echo-notice-in-minibuffer 747 erc-echo-notice-in-minibuffer
718 erc-echo-notice-in-server-buffer 748 erc-echo-notice-in-server-buffer
719 erc-echo-notice-in-active-non-server-buffer 749 erc-echo-notice-in-active-non-server-buffer
720 erc-echo-notice-in-active-buffer 750 erc-echo-notice-in-active-buffer
721 erc-echo-notice-in-user-buffers 751 erc-echo-notice-in-user-buffers
722 erc-echo-notice-in-user-and-target-buffers 752 erc-echo-notice-in-user-and-target-buffers
723 erc-echo-notice-in-first-user-buffer)) 753 erc-echo-notice-in-first-user-buffer))
724 754
725;; other tunable parameters 755;; other tunable parameters
726 756
@@ -747,7 +777,7 @@ Many consider it impolite to do so automatically."
747 "The nickname to take when you are marked as being away." 777 "The nickname to take when you are marked as being away."
748 :group 'erc 778 :group 'erc
749 :type '(choice (const nil) 779 :type '(choice (const nil)
750 string)) 780 string))
751 781
752(defcustom erc-paranoid nil 782(defcustom erc-paranoid nil
753 "If non-nil, then all incoming CTCP requests will be shown." 783 "If non-nil, then all incoming CTCP requests will be shown."
@@ -782,7 +812,7 @@ set if some hacker is trying to flood you away."
782If nil, ERC will call `system-name' to get this information." 812If nil, ERC will call `system-name' to get this information."
783 :group 'erc 813 :group 'erc
784 :type '(choice (const :tag "Default system name" nil) 814 :type '(choice (const :tag "Default system name" nil)
785 string)) 815 string))
786 816
787(defcustom erc-ignore-list nil 817(defcustom erc-ignore-list nil
788 "List of regexps matching user identifiers to ignore. 818 "List of regexps matching user identifiers to ignore.
@@ -824,8 +854,8 @@ See `erc-server-flood-margin' for other flood-related parameters.")
824 854
825(defcustom erc-startup-file-list 855(defcustom erc-startup-file-list
826 (list (concat erc-user-emacs-directory ".ercrc.el") 856 (list (concat erc-user-emacs-directory ".ercrc.el")
827 (concat erc-user-emacs-directory ".ercrc") 857 (concat erc-user-emacs-directory ".ercrc")
828 "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc") 858 "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc")
829 "List of files to try for a startup script. 859 "List of files to try for a startup script.
830The first existent and readable one will get executed. 860The first existent and readable one will get executed.
831 861
@@ -884,9 +914,9 @@ If no elements match, then the empty string is used.
884As an example: 914As an example:
885 (setq erc-quit-reason-various-alist 915 (setq erc-quit-reason-various-alist
886 '((\"xmms\" dme:now-playing) 916 '((\"xmms\" dme:now-playing)
887 (\"version\" erc-quit-reason-normal) 917 (\"version\" erc-quit-reason-normal)
888 (\"home\" \"Gone home !\") 918 (\"home\" \"Gone home !\")
889 (\"^$\" \"Default Reason\"))) 919 (\"^$\" \"Default Reason\")))
890If the user types \"/quit home\", then \"Gone home !\" will be used 920If the user types \"/quit home\", then \"Gone home !\" will be used
891as the quit message." 921as the quit message."
892 :group 'erc-quit-and-part 922 :group 'erc-quit-and-part
@@ -907,9 +937,9 @@ If no elements match, then the empty string is used.
907As an example: 937As an example:
908 (setq erc-part-reason-various-alist 938 (setq erc-part-reason-various-alist
909 '((\"xmms\" dme:now-playing) 939 '((\"xmms\" dme:now-playing)
910 (\"version\" erc-part-reason-normal) 940 (\"version\" erc-part-reason-normal)
911 (\"home\" \"Gone home !\") 941 (\"home\" \"Gone home !\")
912 (\"^$\" \"Default Reason\"))) 942 (\"^$\" \"Default Reason\")))
913If the user types \"/part home\", then \"Gone home !\" will be used 943If the user types \"/part home\", then \"Gone home !\" will be used
914as the part message." 944as the part message."
915 :group 'erc-quit-and-part 945 :group 'erc-quit-and-part
@@ -922,8 +952,8 @@ The function is passed a single argument, the string typed by the
922user after \"/quit\"." 952user after \"/quit\"."
923 :group 'erc-quit-and-part 953 :group 'erc-quit-and-part
924 :type '(choice (const erc-quit-reason-normal) 954 :type '(choice (const erc-quit-reason-normal)
925 (const erc-quit-reason-various) 955 (const erc-quit-reason-various)
926 (symbol))) 956 (symbol)))
927 957
928(defcustom erc-part-reason 'erc-part-reason-normal 958(defcustom erc-part-reason 'erc-part-reason-normal
929 "A function which returns the reason for parting a channel. 959 "A function which returns the reason for parting a channel.
@@ -932,8 +962,8 @@ The function is passed a single argument, the string typed by the
932user after \"/PART\"." 962user after \"/PART\"."
933 :group 'erc-quit-and-part 963 :group 'erc-quit-and-part
934 :type '(choice (const erc-part-reason-normal) 964 :type '(choice (const erc-part-reason-normal)
935 (const erc-part-reason-various) 965 (const erc-part-reason-various)
936 (symbol))) 966 (symbol)))
937 967
938(defvar erc-grab-buffer-name "*erc-grab*" 968(defvar erc-grab-buffer-name "*erc-grab*"
939 "The name of the buffer created by `erc-grab-region'.") 969 "The name of the buffer created by `erc-grab-region'.")
@@ -1017,8 +1047,8 @@ At this point, all modifications from prior hook functions are done."
1017 :group 'erc-hooks 1047 :group 'erc-hooks
1018 :type 'hook 1048 :type 'hook
1019 :options '(erc-truncate-buffer 1049 :options '(erc-truncate-buffer
1020 erc-make-read-only 1050 erc-make-read-only
1021 erc-save-buffer-in-logs)) 1051 erc-save-buffer-in-logs))
1022 1052
1023(defcustom erc-send-modify-hook nil 1053(defcustom erc-send-modify-hook nil
1024 "Sending hook for functions that will change the text's appearance. 1054 "Sending hook for functions that will change the text's appearance.
@@ -1048,8 +1078,8 @@ This function is called with narrowing, ala `erc-send-modify-hook'."
1048(defcustom erc-send-completed-hook 1078(defcustom erc-send-completed-hook
1049 (when (fboundp 'emacspeak-auditory-icon) 1079 (when (fboundp 'emacspeak-auditory-icon)
1050 (list (byte-compile 1080 (list (byte-compile
1051 (lambda (_str) 1081 (lambda (_str)
1052 (emacspeak-auditory-icon 'select-object))))) 1082 (emacspeak-auditory-icon 'select-object)))))
1053 "Hook called after a message has been parsed by ERC. 1083 "Hook called after a message has been parsed by ERC.
1054 1084
1055The single argument to the functions is the unmodified string 1085The single argument to the functions is the unmodified string
@@ -1122,6 +1152,14 @@ which the local user typed."
1122 "ERC default face." 1152 "ERC default face."
1123 :group 'erc-faces) 1153 :group 'erc-faces)
1124 1154
1155(defface erc-nick-prefix-face '((t :inherit erc-nick-default-face :weight bold))
1156 "ERC face used for user mode prefix."
1157 :group 'erc-faces)
1158
1159(defface erc-my-nick-prefix-face '((t :inherit erc-nick-default-face :weight bold))
1160 "ERC face used for my user mode prefix."
1161 :group 'erc-faces)
1162
1125(defface erc-direct-msg-face '((t :foreground "IndianRed")) 1163(defface erc-direct-msg-face '((t :foreground "IndianRed"))
1126 "ERC face used for messages you receive in the main erc buffer." 1164 "ERC face used for messages you receive in the main erc buffer."
1127 :group 'erc-faces) 1165 :group 'erc-faces)
@@ -1189,7 +1227,7 @@ See also `erc-show-my-nick'."
1189(make-variable-buffer-local 'erc-dbuf) 1227(make-variable-buffer-local 'erc-dbuf)
1190 1228
1191(defmacro define-erc-module (name alias doc enable-body disable-body 1229(defmacro define-erc-module (name alias doc enable-body disable-body
1192 &optional local-p) 1230 &optional local-p)
1193 "Define a new minor mode using ERC conventions. 1231 "Define a new minor mode using ERC conventions.
1194Symbol NAME is the name of the module. 1232Symbol NAME is the name of the module.
1195Symbol ALIAS is the alias to use, or nil. 1233Symbol ALIAS is the alias to use, or nil.
@@ -1209,50 +1247,50 @@ Example:
1209 (define-erc-module replace nil 1247 (define-erc-module replace nil
1210 \"This mode replaces incoming text according to `erc-replace-alist'.\" 1248 \"This mode replaces incoming text according to `erc-replace-alist'.\"
1211 ((add-hook 'erc-insert-modify-hook 1249 ((add-hook 'erc-insert-modify-hook
1212 'erc-replace-insert)) 1250 'erc-replace-insert))
1213 ((remove-hook 'erc-insert-modify-hook 1251 ((remove-hook 'erc-insert-modify-hook
1214 'erc-replace-insert)))" 1252 'erc-replace-insert)))"
1215 (declare (doc-string 3)) 1253 (declare (doc-string 3))
1216 (let* ((sn (symbol-name name)) 1254 (let* ((sn (symbol-name name))
1217 (mode (intern (format "erc-%s-mode" (downcase sn)))) 1255 (mode (intern (format "erc-%s-mode" (downcase sn))))
1218 (group (intern (format "erc-%s" (downcase sn)))) 1256 (group (intern (format "erc-%s" (downcase sn))))
1219 (enable (intern (format "erc-%s-enable" (downcase sn)))) 1257 (enable (intern (format "erc-%s-enable" (downcase sn))))
1220 (disable (intern (format "erc-%s-disable" (downcase sn))))) 1258 (disable (intern (format "erc-%s-disable" (downcase sn)))))
1221 `(progn 1259 `(progn
1222 (erc-define-minor-mode 1260 (erc-define-minor-mode
1223 ,mode 1261 ,mode
1224 ,(format "Toggle ERC %S mode. 1262 ,(format "Toggle ERC %S mode.
1225With a prefix argument ARG, enable %s if ARG is positive, 1263With a prefix argument ARG, enable %s if ARG is positive,
1226and disable it otherwise. If called from Lisp, enable the mode 1264and disable it otherwise. If called from Lisp, enable the mode
1227if ARG is omitted or nil. 1265if ARG is omitted or nil.
1228%s" name name doc) 1266%s" name name doc)
1229 nil nil nil 1267 nil nil nil
1230 :global ,(not local-p) :group (quote ,group) 1268 :global ,(not local-p) :group (quote ,group)
1231 (if ,mode 1269 (if ,mode
1232 (,enable) 1270 (,enable)
1233 (,disable))) 1271 (,disable)))
1234 (defun ,enable () 1272 (defun ,enable ()
1235 ,(format "Enable ERC %S mode." 1273 ,(format "Enable ERC %S mode."
1236 name) 1274 name)
1237 (interactive) 1275 (interactive)
1238 (add-to-list 'erc-modules (quote ,name)) 1276 (add-to-list 'erc-modules (quote ,name))
1239 (setq ,mode t) 1277 (setq ,mode t)
1240 ,@enable-body) 1278 ,@enable-body)
1241 (defun ,disable () 1279 (defun ,disable ()
1242 ,(format "Disable ERC %S mode." 1280 ,(format "Disable ERC %S mode."
1243 name) 1281 name)
1244 (interactive) 1282 (interactive)
1245 (setq erc-modules (delq (quote ,name) erc-modules)) 1283 (setq erc-modules (delq (quote ,name) erc-modules))
1246 (setq ,mode nil) 1284 (setq ,mode nil)
1247 ,@disable-body) 1285 ,@disable-body)
1248 ,(when (and alias (not (eq name alias))) 1286 ,(when (and alias (not (eq name alias)))
1249 `(defalias 1287 `(defalias
1250 (quote 1288 (quote
1251 ,(intern 1289 ,(intern
1252 (format "erc-%s-mode" 1290 (format "erc-%s-mode"
1253 (downcase (symbol-name alias))))) 1291 (downcase (symbol-name alias)))))
1254 (quote 1292 (quote
1255 ,mode))) 1293 ,mode)))
1256 ;; For find-function and find-variable. 1294 ;; For find-function and find-variable.
1257 (put ',mode 'definition-name ',name) 1295 (put ',mode 'definition-name ',name)
1258 (put ',enable 'definition-name ',name) 1296 (put ',enable 'definition-name ',name)
@@ -1278,13 +1316,13 @@ capabilities."
1278 (error 1316 (error
1279 "You should only run `erc-once-with-server-event' in a server buffer")) 1317 "You should only run `erc-once-with-server-event' in a server buffer"))
1280 (let ((fun (make-symbol "fun")) 1318 (let ((fun (make-symbol "fun"))
1281 (hook (erc-get-hook event))) 1319 (hook (erc-get-hook event)))
1282 (put fun 'erc-original-buffer (current-buffer)) 1320 (put fun 'erc-original-buffer (current-buffer))
1283 (fset fun (lambda (proc parsed) 1321 (fset fun (lambda (proc parsed)
1284 (with-current-buffer (get fun 'erc-original-buffer) 1322 (with-current-buffer (get fun 'erc-original-buffer)
1285 (remove-hook hook fun t)) 1323 (remove-hook hook fun t))
1286 (fmakunbound fun) 1324 (fmakunbound fun)
1287 (funcall f proc parsed))) 1325 (funcall f proc parsed)))
1288 (add-hook hook fun nil t) 1326 (add-hook hook fun nil t)
1289 fun)) 1327 fun))
1290 1328
@@ -1311,7 +1349,7 @@ the process buffer."
1311If BUFFER is nil, the current buffer is used." 1349If BUFFER is nil, the current buffer is used."
1312 (with-current-buffer (or buffer (current-buffer)) 1350 (with-current-buffer (or buffer (current-buffer))
1313 (and (eq major-mode 'erc-mode) 1351 (and (eq major-mode 'erc-mode)
1314 (null (erc-default-target))))) 1352 (null (erc-default-target)))))
1315 1353
1316(defun erc-open-server-buffer-p (&optional buffer) 1354(defun erc-open-server-buffer-p (&optional buffer)
1317 "Return non-nil if argument BUFFER is an ERC server buffer that 1355 "Return non-nil if argument BUFFER is an ERC server buffer that
@@ -1327,8 +1365,8 @@ If BUFFER is nil, the current buffer is used."
1327 (with-current-buffer (or buffer (current-buffer)) 1365 (with-current-buffer (or buffer (current-buffer))
1328 (let ((target (erc-default-target))) 1366 (let ((target (erc-default-target)))
1329 (and (eq major-mode 'erc-mode) 1367 (and (eq major-mode 'erc-mode)
1330 target 1368 target
1331 (not (memq (aref target 0) '(?# ?& ?+ ?!))))))) 1369 (not (memq (aref target 0) '(?# ?& ?+ ?!)))))))
1332 1370
1333(defun erc-ison-p (nick) 1371(defun erc-ison-p (nick)
1334 "Return non-nil if NICK is online." 1372 "Return non-nil if NICK is online."
@@ -1338,39 +1376,39 @@ If BUFFER is nil, the current buffer is used."
1338 (erc-once-with-server-event 1376 (erc-once-with-server-event
1339 303 1377 303
1340 (lambda (_proc parsed) 1378 (lambda (_proc parsed)
1341 (let ((ison (split-string (aref parsed 3)))) 1379 (let ((ison (split-string (aref parsed 3))))
1342 (setq erc-online-p (car (erc-member-ignore-case nick ison))) 1380 (setq erc-online-p (car (erc-member-ignore-case nick ison)))
1343 t))) 1381 t)))
1344 (erc-server-send (format "ISON %s" nick)) 1382 (erc-server-send (format "ISON %s" nick))
1345 (while (eq erc-online-p 'unknown) (accept-process-output)) 1383 (while (eq erc-online-p 'unknown) (accept-process-output))
1346 (if (called-interactively-p 'interactive) 1384 (if (called-interactively-p 'interactive)
1347 (message "%s is %sonline" 1385 (message "%s is %sonline"
1348 (or erc-online-p nick) 1386 (or erc-online-p nick)
1349 (if erc-online-p "" "not ")) 1387 (if erc-online-p "" "not "))
1350 erc-online-p)))) 1388 erc-online-p))))
1351 1389
1352(defun erc-log-aux (string) 1390(defun erc-log-aux (string)
1353 "Do the debug logging of STRING." 1391 "Do the debug logging of STRING."
1354 (let ((cb (current-buffer)) 1392 (let ((cb (current-buffer))
1355 (point 1) 1393 (point 1)
1356 (was-eob nil) 1394 (was-eob nil)
1357 (session-buffer (erc-server-buffer))) 1395 (session-buffer (erc-server-buffer)))
1358 (if session-buffer 1396 (if session-buffer
1359 (progn 1397 (progn
1360 (set-buffer session-buffer) 1398 (set-buffer session-buffer)
1361 (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf))) 1399 (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf)))
1362 (progn 1400 (progn
1363 (setq erc-dbuf (get-buffer-create 1401 (setq erc-dbuf (get-buffer-create
1364 (concat "*ERC-DEBUG: " 1402 (concat "*ERC-DEBUG: "
1365 erc-session-server "*"))))) 1403 erc-session-server "*")))))
1366 (set-buffer erc-dbuf) 1404 (set-buffer erc-dbuf)
1367 (setq point (point)) 1405 (setq point (point))
1368 (setq was-eob (eobp)) 1406 (setq was-eob (eobp))
1369 (goto-char (point-max)) 1407 (goto-char (point-max))
1370 (insert (concat "** " string "\n")) 1408 (insert (concat "** " string "\n"))
1371 (if was-eob (goto-char (point-max)) 1409 (if was-eob (goto-char (point-max))
1372 (goto-char point)) 1410 (goto-char point))
1373 (set-buffer cb)) 1411 (set-buffer cb))
1374 (message "ERC: ** %s" string)))) 1412 (message "ERC: ** %s" string))))
1375 1413
1376;; Last active buffer, to print server messages in the right place 1414;; Last active buffer, to print server messages in the right place
@@ -1386,15 +1424,15 @@ server buffer.")
1386Defaults to the server buffer." 1424Defaults to the server buffer."
1387 (erc-with-server-buffer 1425 (erc-with-server-buffer
1388 (if (buffer-live-p erc-active-buffer) 1426 (if (buffer-live-p erc-active-buffer)
1389 erc-active-buffer 1427 erc-active-buffer
1390 (setq erc-active-buffer (current-buffer))))) 1428 (setq erc-active-buffer (current-buffer)))))
1391 1429
1392(defun erc-set-active-buffer (buffer) 1430(defun erc-set-active-buffer (buffer)
1393 "Set the value of `erc-active-buffer' to BUFFER." 1431 "Set the value of `erc-active-buffer' to BUFFER."
1394 (cond ((erc-server-buffer) 1432 (cond ((erc-server-buffer)
1395 (with-current-buffer (erc-server-buffer) 1433 (with-current-buffer (erc-server-buffer)
1396 (setq erc-active-buffer buffer))) 1434 (setq erc-active-buffer buffer)))
1397 (t (setq erc-active-buffer buffer)))) 1435 (t (setq erc-active-buffer buffer))))
1398 1436
1399;; Mode activation routines 1437;; Mode activation routines
1400 1438
@@ -1431,19 +1469,19 @@ The available choices are:
1431 any other value - in place of the current buffer." 1469 any other value - in place of the current buffer."
1432 :group 'erc-buffers 1470 :group 'erc-buffers
1433 :type '(choice (const :tag "Split window and select" window) 1471 :type '(choice (const :tag "Split window and select" window)
1434 (const :tag "Split window, don't select" window-noselect) 1472 (const :tag "Split window, don't select" window-noselect)
1435 (const :tag "New frame" frame) 1473 (const :tag "New frame" frame)
1436 (const :tag "Bury in new buffer" bury) 1474 (const :tag "Bury in new buffer" bury)
1437 (const :tag "Use current buffer" buffer) 1475 (const :tag "Use current buffer" buffer)
1438 (const :tag "Use current buffer" t))) 1476 (const :tag "Use current buffer" t)))
1439 1477
1440(defcustom erc-frame-alist nil 1478(defcustom erc-frame-alist nil
1441 "Alist of frame parameters for creating erc frames. 1479 "Alist of frame parameters for creating erc frames.
1442A value of nil means to use `default-frame-alist'." 1480A value of nil means to use `default-frame-alist'."
1443 :group 'erc-buffers 1481 :group 'erc-buffers
1444 :type '(repeat (cons :format "%v" 1482 :type '(repeat (cons :format "%v"
1445 (symbol :tag "Parameter") 1483 (symbol :tag "Parameter")
1446 (sexp :tag "Value")))) 1484 (sexp :tag "Value"))))
1447 1485
1448(defcustom erc-frame-dedicated-flag nil 1486(defcustom erc-frame-dedicated-flag nil
1449 "Non-nil means the erc frames are dedicated to that buffer. 1487 "Non-nil means the erc frames are dedicated to that buffer.
@@ -1462,11 +1500,11 @@ effect when `erc-join-buffer' is set to `frame'."
1462(defun erc-channel-p (channel) 1500(defun erc-channel-p (channel)
1463 "Return non-nil if CHANNEL seems to be an IRC channel name." 1501 "Return non-nil if CHANNEL seems to be an IRC channel name."
1464 (cond ((stringp channel) 1502 (cond ((stringp channel)
1465 (memq (aref channel 0) '(?# ?& ?+ ?!))) 1503 (memq (aref channel 0) '(?# ?& ?+ ?!)))
1466 ((and (bufferp channel) (buffer-live-p channel)) 1504 ((and (bufferp channel) (buffer-live-p channel))
1467 (with-current-buffer channel 1505 (with-current-buffer channel
1468 (erc-channel-p (erc-default-target)))) 1506 (erc-channel-p (erc-default-target))))
1469 (t nil))) 1507 (t nil)))
1470 1508
1471(defcustom erc-reuse-buffers t 1509(defcustom erc-reuse-buffers t
1472 "If nil, create new buffers on joining a channel/query. 1510 "If nil, create new buffers on joining a channel/query.
@@ -1492,17 +1530,17 @@ symbol, it may have these values:
1492 (let ((port-nr (string-to-number port))) 1530 (let ((port-nr (string-to-number port)))
1493 (cond 1531 (cond
1494 ((> port-nr 0) 1532 ((> port-nr 0)
1495 port-nr) 1533 port-nr)
1496 ((string-equal port "irc") 1534 ((string-equal port "irc")
1497 194) 1535 194)
1498 ((string-equal port "ircs") 1536 ((string-equal port "ircs")
1499 994) 1537 994)
1500 ((string-equal port "ircd") 1538 ((string-equal port "ircd")
1501 6667) 1539 6667)
1502 ((string-equal port "ircd-dalnet") 1540 ((string-equal port "ircd-dalnet")
1503 7000) 1541 7000)
1504 (t 1542 (t
1505 nil)))) 1543 nil))))
1506 ((numberp port) 1544 ((numberp port)
1507 port) 1545 port)
1508 (t 1546 (t
@@ -1557,8 +1595,8 @@ All strings are compared according to IRC protocol case rules, see
1557 (catch 'result 1595 (catch 'result
1558 (while list 1596 (while list
1559 (if (string= string (erc-downcase (car list))) 1597 (if (string= string (erc-downcase (car list)))
1560 (throw 'result list) 1598 (throw 'result list)
1561 (setq list (cdr list)))))) 1599 (setq list (cdr list))))))
1562 1600
1563(defmacro erc-with-buffer (spec &rest body) 1601(defmacro erc-with-buffer (spec &rest body)
1564 "Execute BODY in the buffer associated with SPEC. 1602 "Execute BODY in the buffer associated with SPEC.
@@ -1578,21 +1616,21 @@ See also `with-current-buffer'.
1578\(fn (TARGET [PROCESS]) BODY...)" 1616\(fn (TARGET [PROCESS]) BODY...)"
1579 (declare (indent 1) (debug ((form &optional form) body))) 1617 (declare (indent 1) (debug ((form &optional form) body)))
1580 (let ((buf (make-symbol "buf")) 1618 (let ((buf (make-symbol "buf"))
1581 (proc (make-symbol "proc")) 1619 (proc (make-symbol "proc"))
1582 (target (make-symbol "target")) 1620 (target (make-symbol "target"))
1583 (process (make-symbol "process"))) 1621 (process (make-symbol "process")))
1584 `(let* ((,target ,(car spec)) 1622 `(let* ((,target ,(car spec))
1585 (,process ,(cadr spec)) 1623 (,process ,(cadr spec))
1586 (,buf (if (bufferp ,target) 1624 (,buf (if (bufferp ,target)
1587 ,target 1625 ,target
1588 (let ((,proc (or ,process 1626 (let ((,proc (or ,process
1589 (and (processp erc-server-process) 1627 (and (processp erc-server-process)
1590 erc-server-process)))) 1628 erc-server-process))))
1591 (if (and ,target ,proc) 1629 (if (and ,target ,proc)
1592 (erc-get-buffer ,target ,proc)))))) 1630 (erc-get-buffer ,target ,proc))))))
1593 (when (buffer-live-p ,buf) 1631 (when (buffer-live-p ,buf)
1594 (with-current-buffer ,buf 1632 (with-current-buffer ,buf
1595 ,@body))))) 1633 ,@body)))))
1596 1634
1597(defun erc-get-buffer (target &optional proc) 1635(defun erc-get-buffer (target &optional proc)
1598 "Return the buffer matching TARGET in the process PROC. 1636 "Return the buffer matching TARGET in the process PROC.
@@ -1601,10 +1639,10 @@ If PROC is not supplied, all processes are searched."
1601 (catch 'buffer 1639 (catch 'buffer
1602 (erc-buffer-filter 1640 (erc-buffer-filter
1603 (lambda () 1641 (lambda ()
1604 (let ((current (erc-default-target))) 1642 (let ((current (erc-default-target)))
1605 (and (stringp current) 1643 (and (stringp current)
1606 (string-equal downcased-target (erc-downcase current)) 1644 (string-equal downcased-target (erc-downcase current))
1607 (throw 'buffer (current-buffer))))) 1645 (throw 'buffer (current-buffer)))))
1608 proc)))) 1646 proc))))
1609 1647
1610(defun erc-buffer-filter (predicate &optional proc) 1648(defun erc-buffer-filter (predicate &optional proc)
@@ -1618,14 +1656,14 @@ server connection, or nil which means all open connections."
1618 (delq 1656 (delq
1619 nil 1657 nil
1620 (mapcar (lambda (buf) 1658 (mapcar (lambda (buf)
1621 (when (buffer-live-p buf) 1659 (when (buffer-live-p buf)
1622 (with-current-buffer buf 1660 (with-current-buffer buf
1623 (and (eq major-mode 'erc-mode) 1661 (and (eq major-mode 'erc-mode)
1624 (or (not proc) 1662 (or (not proc)
1625 (eq proc erc-server-process)) 1663 (eq proc erc-server-process))
1626 (funcall predicate) 1664 (funcall predicate)
1627 buf)))) 1665 buf))))
1628 (buffer-list))))) 1666 (buffer-list)))))
1629 1667
1630(defun erc-buffer-list (&optional predicate proc) 1668(defun erc-buffer-list (&optional predicate proc)
1631 "Return a list of ERC buffers. 1669 "Return a list of ERC buffers.
@@ -1645,14 +1683,14 @@ nil."
1645 (declare (indent 1) (debug (form form body))) 1683 (declare (indent 1) (debug (form form body)))
1646 ;; Make the evaluation have the correct order 1684 ;; Make the evaluation have the correct order
1647 (let ((pre (make-symbol "pre")) 1685 (let ((pre (make-symbol "pre"))
1648 (pro (make-symbol "pro"))) 1686 (pro (make-symbol "pro")))
1649 `(let* ((,pro ,process) 1687 `(let* ((,pro ,process)
1650 (,pre ,pred) 1688 (,pre ,pred)
1651 (res (mapcar (lambda (buffer) 1689 (res (mapcar (lambda (buffer)
1652 (with-current-buffer buffer 1690 (with-current-buffer buffer
1653 ,@forms)) 1691 ,@forms))
1654 (erc-buffer-list ,pre 1692 (erc-buffer-list ,pre
1655 ,pro)))) 1693 ,pro))))
1656 ;; Silence the byte-compiler by binding the result of mapcar to 1694 ;; Silence the byte-compiler by binding the result of mapcar to
1657 ;; a variable. 1695 ;; a variable.
1658 res))) 1696 res)))
@@ -1660,7 +1698,7 @@ nil."
1660;; (iswitchb-mode) will autoload iswitchb.el 1698;; (iswitchb-mode) will autoload iswitchb.el
1661(defvar iswitchb-temp-buflist) 1699(defvar iswitchb-temp-buflist)
1662(declare-function iswitchb-read-buffer "iswitchb" 1700(declare-function iswitchb-read-buffer "iswitchb"
1663 (prompt &optional default require-match start matches-set)) 1701 (prompt &optional default require-match start matches-set))
1664(defvar iswitchb-make-buflist-hook) 1702(defvar iswitchb-make-buflist-hook)
1665 1703
1666(defun erc-iswitchb (&optional arg) 1704(defun erc-iswitchb (&optional arg)
@@ -1676,20 +1714,20 @@ needs to be active for this function to work."
1676 (let ((enabled (bound-and-true-p iswitchb-mode))) 1714 (let ((enabled (bound-and-true-p iswitchb-mode)))
1677 (or enabled (iswitchb-mode 1)) 1715 (or enabled (iswitchb-mode 1))
1678 (unwind-protect 1716 (unwind-protect
1679 (let ((iswitchb-make-buflist-hook 1717 (let ((iswitchb-make-buflist-hook
1680 (lambda () 1718 (lambda ()
1681 (setq iswitchb-temp-buflist 1719 (setq iswitchb-temp-buflist
1682 (mapcar 'buffer-name 1720 (mapcar 'buffer-name
1683 (erc-buffer-list 1721 (erc-buffer-list
1684 nil 1722 nil
1685 (when arg erc-server-process))))))) 1723 (when arg erc-server-process)))))))
1686 (switch-to-buffer 1724 (switch-to-buffer
1687 (iswitchb-read-buffer 1725 (iswitchb-read-buffer
1688 "Switch-to: " 1726 "Switch-to: "
1689 (if (boundp 'erc-modified-channels-alist) 1727 (if (boundp 'erc-modified-channels-alist)
1690 (buffer-name (caar (last erc-modified-channels-alist))) 1728 (buffer-name (caar (last erc-modified-channels-alist)))
1691 nil) 1729 nil)
1692 t))) 1730 t)))
1693 (or enabled (iswitchb-mode -1))))) 1731 (or enabled (iswitchb-mode -1)))))
1694 1732
1695(defun erc-channel-list (proc) 1733(defun erc-channel-list (proc)
@@ -1699,7 +1737,7 @@ all channel buffers on all servers."
1699 (erc-buffer-filter 1737 (erc-buffer-filter
1700 (lambda () 1738 (lambda ()
1701 (and (erc-default-target) 1739 (and (erc-default-target)
1702 (erc-channel-p (erc-default-target)))) 1740 (erc-channel-p (erc-default-target))))
1703 proc)) 1741 proc))
1704 1742
1705(defun erc-buffer-list-with-nick (nick proc) 1743(defun erc-buffer-list-with-nick (nick proc)
@@ -1707,8 +1745,8 @@ all channel buffers on all servers."
1707 (with-current-buffer (process-buffer proc) 1745 (with-current-buffer (process-buffer proc)
1708 (let ((user (gethash (erc-downcase nick) erc-server-users))) 1746 (let ((user (gethash (erc-downcase nick) erc-server-users)))
1709 (if user 1747 (if user
1710 (erc-server-user-buffers user) 1748 (erc-server-user-buffers user)
1711 nil)))) 1749 nil))))
1712 1750
1713;; Some local variables 1751;; Some local variables
1714 1752
@@ -1766,31 +1804,31 @@ buffer rather than a server buffer.")
1766 (let ((transforms '((pcomplete . completion)))) 1804 (let ((transforms '((pcomplete . completion))))
1767 (erc-delete-dups 1805 (erc-delete-dups
1768 (mapcar (lambda (m) (or (cdr (assoc m transforms)) m)) 1806 (mapcar (lambda (m) (or (cdr (assoc m transforms)) m))
1769 mods)))) 1807 mods))))
1770 1808
1771(defcustom erc-modules '(netsplit fill button match track completion readonly 1809(defcustom erc-modules '(netsplit fill button match track completion readonly
1772 networks ring autojoin noncommands irccontrols 1810 networks ring autojoin noncommands irccontrols
1773 move-to-prompt stamp menu list) 1811 move-to-prompt stamp menu list)
1774 "A list of modules which ERC should enable. 1812 "A list of modules which ERC should enable.
1775If you set the value of this without using `customize' remember to call 1813If you set the value of this without using `customize' remember to call
1776\(erc-update-modules) after you change it. When using `customize', modules 1814\(erc-update-modules) after you change it. When using `customize', modules
1777removed from the list will be disabled." 1815removed from the list will be disabled."
1778 :get (lambda (sym) 1816 :get (lambda (sym)
1779 ;; replace outdated names with their newer equivalents 1817 ;; replace outdated names with their newer equivalents
1780 (erc-migrate-modules (symbol-value sym))) 1818 (erc-migrate-modules (symbol-value sym)))
1781 :set (lambda (sym val) 1819 :set (lambda (sym val)
1782 ;; disable modules which have just been removed 1820 ;; disable modules which have just been removed
1783 (when (and (boundp 'erc-modules) erc-modules val) 1821 (when (and (boundp 'erc-modules) erc-modules val)
1784 (dolist (module erc-modules) 1822 (dolist (module erc-modules)
1785 (unless (member module val) 1823 (unless (member module val)
1786 (let ((f (intern-soft (format "erc-%s-mode" module)))) 1824 (let ((f (intern-soft (format "erc-%s-mode" module))))
1787 (when (and (fboundp f) (boundp f) (symbol-value f)) 1825 (when (and (fboundp f) (boundp f) (symbol-value f))
1788 (message "Disabling `erc-%s'" module) 1826 (message "Disabling `erc-%s'" module)
1789 (funcall f 0)))))) 1827 (funcall f 0))))))
1790 (set sym val) 1828 (set sym val)
1791 ;; this test is for the case where erc hasn't been loaded yet 1829 ;; this test is for the case where erc hasn't been loaded yet
1792 (when (fboundp 'erc-update-modules) 1830 (when (fboundp 'erc-update-modules)
1793 (erc-update-modules))) 1831 (erc-update-modules)))
1794 :type 1832 :type
1795 '(set 1833 '(set
1796 :greedy t 1834 :greedy t
@@ -1798,42 +1836,42 @@ removed from the list will be disabled."
1798 (const :tag "autojoin: Join channels automatically" autojoin) 1836 (const :tag "autojoin: Join channels automatically" autojoin)
1799 (const :tag "button: Buttonize URLs, nicknames, and other text" button) 1837 (const :tag "button: Buttonize URLs, nicknames, and other text" button)
1800 (const :tag "capab: Mark unidentified users on servers supporting CAPAB" 1838 (const :tag "capab: Mark unidentified users on servers supporting CAPAB"
1801 capab-identify) 1839 capab-identify)
1802 (const :tag "completion: Complete nicknames and commands (programmable)" 1840 (const :tag "completion: Complete nicknames and commands (programmable)"
1803 completion) 1841 completion)
1804 (const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete) 1842 (const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete)
1805 (const :tag "dcc: Provide Direct Client-to-Client support" dcc) 1843 (const :tag "dcc: Provide Direct Client-to-Client support" dcc)
1806 (const :tag "fill: Wrap long lines" fill) 1844 (const :tag "fill: Wrap long lines" fill)
1807 (const :tag "identd: Launch an identd server on port 8113" identd) 1845 (const :tag "identd: Launch an identd server on port 8113" identd)
1808 (const :tag "irccontrols: Highlight or remove IRC control characters" 1846 (const :tag "irccontrols: Highlight or remove IRC control characters"
1809 irccontrols) 1847 irccontrols)
1810 (const :tag "keep-place: Leave point above un-viewed text" keep-place) 1848 (const :tag "keep-place: Leave point above un-viewed text" keep-place)
1811 (const :tag "list: List channels in a separate buffer" list) 1849 (const :tag "list: List channels in a separate buffer" list)
1812 (const :tag "log: Save buffers in logs" log) 1850 (const :tag "log: Save buffers in logs" log)
1813 (const :tag "match: Highlight pals, fools, and other keywords" match) 1851 (const :tag "match: Highlight pals, fools, and other keywords" match)
1814 (const :tag "menu: Display a menu in ERC buffers" menu) 1852 (const :tag "menu: Display a menu in ERC buffers" menu)
1815 (const :tag "move-to-prompt: Move to the prompt when typing text" 1853 (const :tag "move-to-prompt: Move to the prompt when typing text"
1816 move-to-prompt) 1854 move-to-prompt)
1817 (const :tag "netsplit: Detect netsplits" netsplit) 1855 (const :tag "netsplit: Detect netsplits" netsplit)
1818 (const :tag "networks: Provide data about IRC networks" networks) 1856 (const :tag "networks: Provide data about IRC networks" networks)
1819 (const :tag "noncommands: Don't display non-IRC commands after evaluation" 1857 (const :tag "noncommands: Don't display non-IRC commands after evaluation"
1820 noncommands) 1858 noncommands)
1821 (const :tag 1859 (const :tag
1822 "notify: Notify when the online status of certain users changes" 1860 "notify: Notify when the online status of certain users changes"
1823 notify) 1861 notify)
1824 (const :tag "notifications: Send notifications on PRIVMSG or nickname mentions" 1862 (const :tag "notifications: Send notifications on PRIVMSG or nickname mentions"
1825 notifications) 1863 notifications)
1826 (const :tag "page: Process CTCP PAGE requests from IRC" page) 1864 (const :tag "page: Process CTCP PAGE requests from IRC" page)
1827 (const :tag "readonly: Make displayed lines read-only" readonly) 1865 (const :tag "readonly: Make displayed lines read-only" readonly)
1828 (const :tag "replace: Replace text in messages" replace) 1866 (const :tag "replace: Replace text in messages" replace)
1829 (const :tag "ring: Enable an input history" ring) 1867 (const :tag "ring: Enable an input history" ring)
1830 (const :tag "scrolltobottom: Scroll to the bottom of the buffer" 1868 (const :tag "scrolltobottom: Scroll to the bottom of the buffer"
1831 scrolltobottom) 1869 scrolltobottom)
1832 (const :tag "services: Identify to Nickserv (IRC Services) automatically" 1870 (const :tag "services: Identify to Nickserv (IRC Services) automatically"
1833 services) 1871 services)
1834 (const :tag "smiley: Convert smileys to pretty icons" smiley) 1872 (const :tag "smiley: Convert smileys to pretty icons" smiley)
1835 (const :tag "sound: Play sounds when you receive CTCP SOUND requests" 1873 (const :tag "sound: Play sounds when you receive CTCP SOUND requests"
1836 sound) 1874 sound)
1837 (const :tag "stamp: Add timestamps to messages" stamp) 1875 (const :tag "stamp: Add timestamps to messages" stamp)
1838 (const :tag "spelling: Check spelling" spelling) 1876 (const :tag "spelling: Check spelling" spelling)
1839 (const :tag "track: Track channel activity in the mode-line" track) 1877 (const :tag "track: Track channel activity in the mode-line" track)
@@ -1851,27 +1889,27 @@ removed from the list will be disabled."
1851 (cond 1889 (cond
1852 ;; yuck. perhaps we should bring the filenames into sync? 1890 ;; yuck. perhaps we should bring the filenames into sync?
1853 ((string= req "erc-capab-identify") 1891 ((string= req "erc-capab-identify")
1854 (setq req "erc-capab")) 1892 (setq req "erc-capab"))
1855 ((string= req "erc-completion") 1893 ((string= req "erc-completion")
1856 (setq req "erc-pcomplete")) 1894 (setq req "erc-pcomplete"))
1857 ((string= req "erc-pcomplete") 1895 ((string= req "erc-pcomplete")
1858 (setq mod 'completion)) 1896 (setq mod 'completion))
1859 ((string= req "erc-autojoin") 1897 ((string= req "erc-autojoin")
1860 (setq req "erc-join"))) 1898 (setq req "erc-join")))
1861 (condition-case nil 1899 (condition-case nil
1862 (require (intern req)) 1900 (require (intern req))
1863 (error nil)) 1901 (error nil))
1864 (let ((sym (intern-soft (concat "erc-" (symbol-name mod) "-mode")))) 1902 (let ((sym (intern-soft (concat "erc-" (symbol-name mod) "-mode"))))
1865 (if (fboundp sym) 1903 (if (fboundp sym)
1866 (funcall sym 1) 1904 (funcall sym 1)
1867 (error "`%s' is not a known ERC module" mod)))))) 1905 (error "`%s' is not a known ERC module" mod))))))
1868 1906
1869(defun erc-setup-buffer (buffer) 1907(defun erc-setup-buffer (buffer)
1870 "Consults `erc-join-buffer' to find out how to display `BUFFER'." 1908 "Consults `erc-join-buffer' to find out how to display `BUFFER'."
1871 (pcase erc-join-buffer 1909 (pcase erc-join-buffer
1872 (`window 1910 (`window
1873 (if (active-minibuffer-window) 1911 (if (active-minibuffer-window)
1874 (display-buffer buffer) 1912 (display-buffer buffer)
1875 (switch-to-buffer-other-window buffer))) 1913 (switch-to-buffer-other-window buffer)))
1876 (`window-noselect 1914 (`window-noselect
1877 (display-buffer buffer)) 1915 (display-buffer buffer))
@@ -1879,21 +1917,21 @@ removed from the list will be disabled."
1879 nil) 1917 nil)
1880 (`frame 1918 (`frame
1881 (when (or (not erc-reuse-frames) 1919 (when (or (not erc-reuse-frames)
1882 (not (get-buffer-window buffer t))) 1920 (not (get-buffer-window buffer t)))
1883 (let ((frame (make-frame (or erc-frame-alist 1921 (let ((frame (make-frame (or erc-frame-alist
1884 default-frame-alist)))) 1922 default-frame-alist))))
1885 (raise-frame frame) 1923 (raise-frame frame)
1886 (select-frame frame)) 1924 (select-frame frame))
1887 (switch-to-buffer buffer) 1925 (switch-to-buffer buffer)
1888 (when erc-frame-dedicated-flag 1926 (when erc-frame-dedicated-flag
1889 (set-window-dedicated-p (selected-window) t)))) 1927 (set-window-dedicated-p (selected-window) t))))
1890 (_ 1928 (_
1891 (if (active-minibuffer-window) 1929 (if (active-minibuffer-window)
1892 (display-buffer buffer) 1930 (display-buffer buffer)
1893 (switch-to-buffer buffer))))) 1931 (switch-to-buffer buffer)))))
1894 1932
1895(defun erc-open (&optional server port nick full-name 1933(defun erc-open (&optional server port nick full-name
1896 connect passwd tgt-list channel process) 1934 connect passwd tgt-list channel process)
1897 "Connect to SERVER on PORT as NICK with FULL-NAME. 1935 "Connect to SERVER on PORT as NICK with FULL-NAME.
1898 1936
1899If CONNECT is non-nil, connect to the server. Otherwise assume 1937If CONNECT is non-nil, connect to the server. Otherwise assume
@@ -1905,13 +1943,13 @@ non-nil, use it to initialize `erc-default-recipients'.
1905 1943
1906Returns the buffer for the given server or channel." 1944Returns the buffer for the given server or channel."
1907 (let ((server-announced-name (when (and (boundp 'erc-session-server) 1945 (let ((server-announced-name (when (and (boundp 'erc-session-server)
1908 (string= server erc-session-server)) 1946 (string= server erc-session-server))
1909 erc-server-announced-name)) 1947 erc-server-announced-name))
1910 (connected-p (unless connect erc-server-connected)) 1948 (connected-p (unless connect erc-server-connected))
1911 (buffer (erc-get-buffer-create server port channel)) 1949 (buffer (erc-get-buffer-create server port channel))
1912 (old-buffer (current-buffer)) 1950 (old-buffer (current-buffer))
1913 old-point 1951 old-point
1914 continued-session) 1952 continued-session)
1915 (when connect (run-hook-with-args 'erc-before-connect server port nick)) 1953 (when connect (run-hook-with-args 'erc-before-connect server port nick))
1916 (erc-update-modules) 1954 (erc-update-modules)
1917 (set-buffer buffer) 1955 (set-buffer buffer)
@@ -1930,8 +1968,8 @@ Returns the buffer for the given server or channel."
1930 (when (get-text-property (point) 'erc-prompt) 1968 (when (get-text-property (point) 'erc-prompt)
1931 (setq continued-session t) 1969 (setq continued-session t)
1932 (set-marker erc-input-marker 1970 (set-marker erc-input-marker
1933 (or (next-single-property-change (point) 'erc-prompt) 1971 (or (next-single-property-change (point) 'erc-prompt)
1934 (point-max)))) 1972 (point-max))))
1935 (unless continued-session 1973 (unless continued-session
1936 (goto-char (point-max)) 1974 (goto-char (point-max))
1937 (insert "\n")) 1975 (insert "\n"))
@@ -1941,14 +1979,14 @@ Returns the buffer for the given server or channel."
1941 (setq erc-server-current-nick nil) 1979 (setq erc-server-current-nick nil)
1942 ;; Initialize erc-server-users and erc-channel-users 1980 ;; Initialize erc-server-users and erc-channel-users
1943 (if connect 1981 (if connect
1944 (progn ;; server buffer 1982 (progn ;; server buffer
1945 (setq erc-server-users 1983 (setq erc-server-users
1946 (make-hash-table :test 'equal)) 1984 (make-hash-table :test 'equal))
1947 (setq erc-channel-users nil)) 1985 (setq erc-channel-users nil))
1948 (progn ;; target buffer 1986 (progn ;; target buffer
1949 (setq erc-server-users nil) 1987 (setq erc-server-users nil)
1950 (setq erc-channel-users 1988 (setq erc-channel-users
1951 (make-hash-table :test 'equal)))) 1989 (make-hash-table :test 'equal))))
1952 ;; clear last incomplete line read 1990 ;; clear last incomplete line read
1953 (setq erc-server-filter-data nil) 1991 (setq erc-server-filter-data nil)
1954 (setq erc-channel-topic "") 1992 (setq erc-channel-topic "")
@@ -1969,29 +2007,29 @@ Returns the buffer for the given server or channel."
1969 (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) 2007 (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
1970 ;; password stuff 2008 ;; password stuff
1971 (setq erc-session-password 2009 (setq erc-session-password
1972 (or passwd 2010 (or passwd
1973 (let ((secret 2011 (let ((secret
1974 (plist-get 2012 (plist-get
1975 (nth 0 2013 (nth 0
1976 (auth-source-search :host server 2014 (auth-source-search :host server
1977 :max 1 2015 :max 1
1978 :user nick 2016 :user nick
1979 :port port 2017 :port port
1980 :require '(:secret))) 2018 :require '(:secret)))
1981 :secret))) 2019 :secret)))
1982 (if (functionp secret) 2020 (if (functionp secret)
1983 (funcall secret) 2021 (funcall secret)
1984 secret)))) 2022 secret))))
1985 ;; debug output buffer 2023 ;; debug output buffer
1986 (setq erc-dbuf 2024 (setq erc-dbuf
1987 (when erc-log-p 2025 (when erc-log-p
1988 (get-buffer-create (concat "*ERC-DEBUG: " server "*")))) 2026 (get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
1989 ;; set up prompt 2027 ;; set up prompt
1990 (unless continued-session 2028 (unless continued-session
1991 (goto-char (point-max)) 2029 (goto-char (point-max))
1992 (insert "\n")) 2030 (insert "\n"))
1993 (if continued-session 2031 (if continued-session
1994 (goto-char old-point) 2032 (goto-char old-point)
1995 (set-marker erc-insert-marker (point)) 2033 (set-marker erc-insert-marker (point))
1996 (erc-display-prompt) 2034 (erc-display-prompt)
1997 (goto-char (point-max))) 2035 (goto-char (point-max)))
@@ -2008,9 +2046,9 @@ Returns the buffer for the given server or channel."
2008 ;; Now display the buffer in a window as per user wishes. 2046 ;; Now display the buffer in a window as per user wishes.
2009 (unless (eq buffer old-buffer) 2047 (unless (eq buffer old-buffer)
2010 (when erc-log-p 2048 (when erc-log-p
2011 ;; we can't log to debug buffer, it may not exist yet 2049 ;; we can't log to debug buffer, it may not exist yet
2012 (message "erc: old buffer %s, switching to %s" 2050 (message "erc: old buffer %s, switching to %s"
2013 old-buffer buffer)) 2051 old-buffer buffer))
2014 (erc-setup-buffer buffer)) 2052 (erc-setup-buffer buffer))
2015 2053
2016 buffer)) 2054 buffer))
@@ -2019,9 +2057,10 @@ Returns the buffer for the given server or channel."
2019 "Initialize the `erc-last-saved-position' marker to a sensible position. 2057 "Initialize the `erc-last-saved-position' marker to a sensible position.
2020BUFFER is the current buffer." 2058BUFFER is the current buffer."
2021 (with-current-buffer buffer 2059 (with-current-buffer buffer
2022 (setq erc-last-saved-position (make-marker)) 2060 (unless (markerp erc-last-saved-position)
2023 (move-marker erc-last-saved-position 2061 (setq erc-last-saved-position (make-marker))
2024 (1- (marker-position erc-insert-marker))))) 2062 (move-marker erc-last-saved-position
2063 (1- (marker-position erc-insert-marker))))))
2025 2064
2026;; interactive startup 2065;; interactive startup
2027 2066
@@ -2039,9 +2078,9 @@ If no buffer matches, return nil."
2039 (erc-buffer-list 2078 (erc-buffer-list
2040 (lambda () 2079 (lambda ()
2041 (and (erc-server-process-alive) 2080 (and (erc-server-process-alive)
2042 (string= erc-session-server server) 2081 (string= erc-session-server server)
2043 (erc-port-equal erc-session-port port) 2082 (erc-port-equal erc-session-port port)
2044 (erc-current-nick-p nick))))) 2083 (erc-current-nick-p nick)))))
2045 2084
2046(defcustom erc-before-connect nil 2085(defcustom erc-before-connect nil
2047 "Hook called before connecting to a server. 2086 "Hook called before connecting to a server.
@@ -2063,38 +2102,38 @@ functions in here get called with the parameters SERVER and NICK."
2063 "Prompt the user for values of nick, server, port, and password." 2102 "Prompt the user for values of nick, server, port, and password."
2064 (let (user-input server port nick passwd) 2103 (let (user-input server port nick passwd)
2065 (setq user-input (read-from-minibuffer 2104 (setq user-input (read-from-minibuffer
2066 "IRC server: " 2105 "IRC server: "
2067 (erc-compute-server) nil nil 'erc-server-history-list)) 2106 (erc-compute-server) nil nil 'erc-server-history-list))
2068 2107
2069 (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input) 2108 (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input)
2070 (setq port (erc-string-to-port (match-string 2 user-input)) 2109 (setq port (erc-string-to-port (match-string 2 user-input))
2071 user-input (match-string 1 user-input)) 2110 user-input (match-string 1 user-input))
2072 (setq port 2111 (setq port
2073 (erc-string-to-port (read-from-minibuffer 2112 (erc-string-to-port (read-from-minibuffer
2074 "IRC port: " (erc-port-to-string 2113 "IRC port: " (erc-port-to-string
2075 (erc-compute-port)))))) 2114 (erc-compute-port))))))
2076 2115
2077 (if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input) 2116 (if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input)
2078 (setq nick (match-string 1 user-input) 2117 (setq nick (match-string 1 user-input)
2079 user-input (match-string 2 user-input)) 2118 user-input (match-string 2 user-input))
2080 (setq nick 2119 (setq nick
2081 (if (erc-already-logged-in server port nick) 2120 (if (erc-already-logged-in server port nick)
2082 (read-from-minibuffer 2121 (read-from-minibuffer
2083 (erc-format-message 'nick-in-use ?n nick) 2122 (erc-format-message 'nick-in-use ?n nick)
2084 nick 2123 nick
2085 nil nil 'erc-nick-history-list) 2124 nil nil 'erc-nick-history-list)
2086 (read-from-minibuffer 2125 (read-from-minibuffer
2087 "Nickname: " (erc-compute-nick nick) 2126 "Nickname: " (erc-compute-nick nick)
2088 nil nil 'erc-nick-history-list)))) 2127 nil nil 'erc-nick-history-list))))
2089 2128
2090 (setq server user-input) 2129 (setq server user-input)
2091 2130
2092 (setq passwd (if erc-prompt-for-password 2131 (setq passwd (if erc-prompt-for-password
2093 (if (and erc-password 2132 (if (and erc-password
2094 (y-or-n-p "Use the default password? ")) 2133 (y-or-n-p "Use the default password? "))
2095 erc-password 2134 erc-password
2096 (read-passwd "Password: ")) 2135 (read-passwd "Password: "))
2097 erc-password)) 2136 erc-password))
2098 (when (and passwd (string= "" passwd)) 2137 (when (and passwd (string= "" passwd))
2099 (setq passwd nil)) 2138 (setq passwd nil))
2100 2139
@@ -2105,17 +2144,17 @@ functions in here get called with the parameters SERVER and NICK."
2105 ;; bncs transparent, so that erc-compute-buffer-name displays 2144 ;; bncs transparent, so that erc-compute-buffer-name displays
2106 ;; the server one is connected to. 2145 ;; the server one is connected to.
2107 (setq nick (read-from-minibuffer 2146 (setq nick (read-from-minibuffer
2108 (erc-format-message 'nick-in-use ?n nick) 2147 (erc-format-message 'nick-in-use ?n nick)
2109 nick 2148 nick
2110 nil nil 'erc-nick-history-list))) 2149 nil nil 'erc-nick-history-list)))
2111 (list :server server :port port :nick nick :password passwd))) 2150 (list :server server :port port :nick nick :password passwd)))
2112 2151
2113;;;###autoload 2152;;;###autoload
2114(cl-defun erc (&key (server (erc-compute-server)) 2153(cl-defun erc (&key (server (erc-compute-server))
2115 (port (erc-compute-port)) 2154 (port (erc-compute-port))
2116 (nick (erc-compute-nick)) 2155 (nick (erc-compute-nick))
2117 password 2156 password
2118 (full-name (erc-compute-full-name))) 2157 (full-name (erc-compute-full-name)))
2119 "ERC is a powerful, modular, and extensible IRC client. 2158 "ERC is a powerful, modular, and extensible IRC client.
2120This function is the main entry point for ERC. 2159This function is the main entry point for ERC.
2121 2160
@@ -2155,7 +2194,7 @@ Arguments are the same as for `erc'."
2155The process will be given the name NAME, its target buffer will be 2194The process will be given the name NAME, its target buffer will be
2156BUFFER. HOST and PORT specify the connection target." 2195BUFFER. HOST and PORT specify the connection target."
2157 (open-network-stream name buffer host port 2196 (open-network-stream name buffer host port
2158 :type 'tls)) 2197 :type 'tls))
2159 2198
2160;;; Displaying error messages 2199;;; Displaying error messages
2161 2200
@@ -2195,36 +2234,36 @@ If OUTBOUND is non-nil, STRING is being sent to the IRC server
2195and appears in face `erc-input-face' in the buffer." 2234and appears in face `erc-input-face' in the buffer."
2196 (when erc-debug-irc-protocol 2235 (when erc-debug-irc-protocol
2197 (let ((network-name (or (ignore-errors (erc-network-name)) 2236 (let ((network-name (or (ignore-errors (erc-network-name))
2198 "???"))) 2237 "???")))
2199 (with-current-buffer (get-buffer-create "*erc-protocol*") 2238 (with-current-buffer (get-buffer-create "*erc-protocol*")
2200 (save-excursion 2239 (save-excursion
2201 (goto-char (point-max)) 2240 (goto-char (point-max))
2202 (let ((inhibit-read-only t)) 2241 (let ((inhibit-read-only t))
2203 (insert (if (not outbound) 2242 (insert (if (not outbound)
2204 ;; Cope with the fact that string might 2243 ;; Cope with the fact that string might
2205 ;; contain multiple lines of text. 2244 ;; contain multiple lines of text.
2206 (let ((lines (delete "" (split-string string 2245 (let ((lines (delete "" (split-string string
2207 "\n\\|\r\n"))) 2246 "\n\\|\r\n")))
2208 (result "")) 2247 (result ""))
2209 (dolist (line lines) 2248 (dolist (line lines)
2210 (setq result (concat result network-name 2249 (setq result (concat result network-name
2211 " << " line "\n"))) 2250 " << " line "\n")))
2212 result) 2251 result)
2213 (erc-propertize 2252 (erc-propertize
2214 (concat network-name " >> " string 2253 (concat network-name " >> " string
2215 (if (/= ?\n 2254 (if (/= ?\n
2216 (aref string 2255 (aref string
2217 (1- (length string)))) 2256 (1- (length string))))
2218 "\n")) 2257 "\n"))
2219 'face 'erc-input-face))))) 2258 'face 'erc-input-face)))))
2220 (let ((orig-win (selected-window)) 2259 (let ((orig-win (selected-window))
2221 (debug-buffer-window (get-buffer-window (current-buffer) t))) 2260 (debug-buffer-window (get-buffer-window (current-buffer) t)))
2222 (when debug-buffer-window 2261 (when debug-buffer-window
2223 (select-window debug-buffer-window) 2262 (select-window debug-buffer-window)
2224 (when (= 1 (count-lines (point) (point-max))) 2263 (when (= 1 (count-lines (point) (point-max)))
2225 (goto-char (point-max)) 2264 (goto-char (point-max))
2226 (recenter -1)) 2265 (recenter -1))
2227 (select-window orig-win))))))) 2266 (select-window orig-win)))))))
2228 2267
2229(defun erc-toggle-debug-irc-protocol (&optional arg) 2268(defun erc-toggle-debug-irc-protocol (&optional arg)
2230 "Toggle the value of `erc-debug-irc-protocol'. 2269 "Toggle the value of `erc-debug-irc-protocol'.
@@ -2235,26 +2274,26 @@ If ARG is non-nil, show the *erc-protocol* buffer."
2235 (with-current-buffer buf 2274 (with-current-buffer buf
2236 (erc-view-mode-enter) 2275 (erc-view-mode-enter)
2237 (when (null (current-local-map)) 2276 (when (null (current-local-map))
2238 (let ((inhibit-read-only t)) 2277 (let ((inhibit-read-only t))
2239 (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n")) 2278 (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n"))
2240 (insert (erc-make-notice "Kill this buffer to terminate protocol logging.\n\n"))) 2279 (insert (erc-make-notice "Kill this buffer to terminate protocol logging.\n\n")))
2241 (use-local-map (make-sparse-keymap)) 2280 (use-local-map (make-sparse-keymap))
2242 (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol)) 2281 (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol))
2243 (add-hook 'kill-buffer-hook 2282 (add-hook 'kill-buffer-hook
2244 #'(lambda () (setq erc-debug-irc-protocol nil)) 2283 #'(lambda () (setq erc-debug-irc-protocol nil))
2245 nil 'local) 2284 nil 'local)
2246 (goto-char (point-max)) 2285 (goto-char (point-max))
2247 (let ((inhibit-read-only t)) 2286 (let ((inhibit-read-only t))
2248 (insert (erc-make-notice 2287 (insert (erc-make-notice
2249 (format "IRC protocol logging %s at %s -- Press `t' to toggle logging.\n" 2288 (format "IRC protocol logging %s at %s -- Press `t' to toggle logging.\n"
2250 (if erc-debug-irc-protocol "disabled" "enabled") 2289 (if erc-debug-irc-protocol "disabled" "enabled")
2251 (current-time-string)))))) 2290 (current-time-string))))))
2252 (setq erc-debug-irc-protocol (not erc-debug-irc-protocol)) 2291 (setq erc-debug-irc-protocol (not erc-debug-irc-protocol))
2253 (if (and arg 2292 (if (and arg
2254 (not (get-buffer-window "*erc-protocol*" t))) 2293 (not (get-buffer-window "*erc-protocol*" t)))
2255 (display-buffer buf t)) 2294 (display-buffer buf t))
2256 (message "IRC protocol traffic logging %s (see buffer *erc-protocol*)." 2295 (message "IRC protocol traffic logging %s (see buffer *erc-protocol*)."
2257 (if erc-debug-irc-protocol "enabled" "disabled")))) 2296 (if erc-debug-irc-protocol "enabled" "disabled"))))
2258 2297
2259;;; I/O interface 2298;;; I/O interface
2260 2299
@@ -2293,69 +2332,69 @@ If STRING is nil, the function does nothing."
2293 (when string 2332 (when string
2294 (with-current-buffer (or buffer (process-buffer erc-server-process)) 2333 (with-current-buffer (or buffer (process-buffer erc-server-process))
2295 (let ((insert-position (or (marker-position erc-insert-marker) 2334 (let ((insert-position (or (marker-position erc-insert-marker)
2296 (point-max)))) 2335 (point-max))))
2297 (let ((string string) ;; FIXME! Can this be removed? 2336 (let ((string string) ;; FIXME! Can this be removed?
2298 (buffer-undo-list t) 2337 (buffer-undo-list t)
2299 (inhibit-read-only t)) 2338 (inhibit-read-only t))
2300 (unless (string-match "\n$" string) 2339 (unless (string-match "\n$" string)
2301 (setq string (concat string "\n")) 2340 (setq string (concat string "\n"))
2302 (when (erc-string-invisible-p string) 2341 (when (erc-string-invisible-p string)
2303 (erc-put-text-properties 0 (length string) 2342 (erc-put-text-properties 0 (length string)
2304 '(invisible intangible) string))) 2343 '(invisible intangible) string)))
2305 (erc-log (concat "erc-display-line: " string 2344 (erc-log (concat "erc-display-line: " string
2306 (format "(%S)" string) " in buffer " 2345 (format "(%S)" string) " in buffer "
2307 (format "%s" buffer))) 2346 (format "%s" buffer)))
2308 (setq erc-insert-this t) 2347 (setq erc-insert-this t)
2309 (run-hook-with-args 'erc-insert-pre-hook string) 2348 (run-hook-with-args 'erc-insert-pre-hook string)
2310 (if (null erc-insert-this) 2349 (if (null erc-insert-this)
2311 ;; Leave erc-insert-this set to t as much as possible. Fran 2350 ;; Leave erc-insert-this set to t as much as possible. Fran
2312 ;; Litterio <franl> has seen erc-insert-this set to nil while 2351 ;; Litterio <franl> has seen erc-insert-this set to nil while
2313 ;; erc-send-pre-hook is running, which should never happen. This 2352 ;; erc-send-pre-hook is running, which should never happen. This
2314 ;; may cure it. 2353 ;; may cure it.
2315 (setq erc-insert-this t) 2354 (setq erc-insert-this t)
2316 (save-excursion ;; to restore point in the new buffer 2355 (save-excursion ;; to restore point in the new buffer
2317 (save-restriction 2356 (save-restriction
2318 (widen) 2357 (widen)
2319 (goto-char insert-position) 2358 (goto-char insert-position)
2320 (insert-before-markers string) 2359 (insert-before-markers string)
2321 ;; run insertion hook, with point at restored location 2360 ;; run insertion hook, with point at restored location
2322 (save-restriction 2361 (save-restriction
2323 (narrow-to-region insert-position (point)) 2362 (narrow-to-region insert-position (point))
2324 (run-hooks 'erc-insert-modify-hook) 2363 (run-hooks 'erc-insert-modify-hook)
2325 (run-hooks 'erc-insert-post-hook) 2364 (run-hooks 'erc-insert-post-hook)
2326 (when erc-remove-parsed-property 2365 (when erc-remove-parsed-property
2327 (remove-text-properties (point-min) (point-max) 2366 (remove-text-properties (point-min) (point-max)
2328 '(erc-parsed nil)))))))) 2367 '(erc-parsed nil))))))))
2329 (erc-update-undo-list (- (or (marker-position erc-insert-marker) 2368 (erc-update-undo-list (- (or (marker-position erc-insert-marker)
2330 (point-max)) 2369 (point-max))
2331 insert-position)))))) 2370 insert-position))))))
2332 2371
2333(defun erc-update-undo-list (shift) 2372(defun erc-update-undo-list (shift)
2334 ;; Translate buffer positions in buffer-undo-list by SHIFT. 2373 ;; Translate buffer positions in buffer-undo-list by SHIFT.
2335 (unless (or (zerop shift) (atom buffer-undo-list)) 2374 (unless (or (zerop shift) (atom buffer-undo-list))
2336 (let ((list buffer-undo-list) elt) 2375 (let ((list buffer-undo-list) elt)
2337 (while list 2376 (while list
2338 (setq elt (car list)) 2377 (setq elt (car list))
2339 (cond ((integerp elt) ; POSITION 2378 (cond ((integerp elt) ; POSITION
2340 (cl-incf (car list) shift)) 2379 (cl-incf (car list) shift))
2341 ((or (atom elt) ; nil, EXTENT 2380 ((or (atom elt) ; nil, EXTENT
2342 ;; (eq t (car elt)) ; (t . TIME) 2381 ;; (eq t (car elt)) ; (t . TIME)
2343 (markerp (car elt))) ; (MARKER . DISTANCE) 2382 (markerp (car elt))) ; (MARKER . DISTANCE)
2344 nil) 2383 nil)
2345 ((integerp (car elt)) ; (BEGIN . END) 2384 ((integerp (car elt)) ; (BEGIN . END)
2346 (cl-incf (car elt) shift) 2385 (cl-incf (car elt) shift)
2347 (cl-incf (cdr elt) shift)) 2386 (cl-incf (cdr elt) shift))
2348 ((stringp (car elt)) ; (TEXT . POSITION) 2387 ((stringp (car elt)) ; (TEXT . POSITION)
2349 (cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift))) 2388 (cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift)))
2350 ((null (car elt)) ; (nil PROPERTY VALUE BEG . END) 2389 ((null (car elt)) ; (nil PROPERTY VALUE BEG . END)
2351 (let ((cons (nthcdr 3 elt))) 2390 (let ((cons (nthcdr 3 elt)))
2352 (cl-incf (car cons) shift) 2391 (cl-incf (car cons) shift)
2353 (cl-incf (cdr cons) shift))) 2392 (cl-incf (cdr cons) shift)))
2354 ((and (featurep 'xemacs) 2393 ((and (featurep 'xemacs)
2355 (extentp (car elt))) ; (EXTENT START END) 2394 (extentp (car elt))) ; (EXTENT START END)
2356 (cl-incf (nth 1 elt) shift) 2395 (cl-incf (nth 1 elt) shift)
2357 (cl-incf (nth 2 elt) shift))) 2396 (cl-incf (nth 2 elt) shift)))
2358 (setq list (cdr list)))))) 2397 (setq list (cdr list))))))
2359 2398
2360(defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*" 2399(defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*"
2361 "Regexp which matches all valid characters in a IRC nickname.") 2400 "Regexp which matches all valid characters in a IRC nickname.")
@@ -2376,41 +2415,41 @@ buffer is used. `erc-display-line-1' is used to display STRING.
2376 2415
2377If STRING is nil, the function does nothing." 2416If STRING is nil, the function does nothing."
2378 (let ((inhibit-point-motion-hooks t) 2417 (let ((inhibit-point-motion-hooks t)
2379 new-bufs) 2418 new-bufs)
2380 (dolist (buf (cond 2419 (dolist (buf (cond
2381 ((bufferp buffer) (list buffer)) 2420 ((bufferp buffer) (list buffer))
2382 ((listp buffer) buffer) 2421 ((listp buffer) buffer)
2383 ((processp buffer) (list (process-buffer buffer))) 2422 ((processp buffer) (list (process-buffer buffer)))
2384 ((eq 'all buffer) 2423 ((eq 'all buffer)
2385 ;; Hmm, or all of the same session server? 2424 ;; Hmm, or all of the same session server?
2386 (erc-buffer-list nil erc-server-process)) 2425 (erc-buffer-list nil erc-server-process))
2387 ((and (eq 'active buffer) (erc-active-buffer)) 2426 ((and (eq 'active buffer) (erc-active-buffer))
2388 (list (erc-active-buffer))) 2427 (list (erc-active-buffer)))
2389 ((erc-server-buffer-live-p) 2428 ((erc-server-buffer-live-p)
2390 (list (process-buffer erc-server-process))) 2429 (list (process-buffer erc-server-process)))
2391 (t (list (current-buffer))))) 2430 (t (list (current-buffer)))))
2392 (when (buffer-live-p buf) 2431 (when (buffer-live-p buf)
2393 (erc-display-line-1 string buf) 2432 (erc-display-line-1 string buf)
2394 (push buf new-bufs))) 2433 (push buf new-bufs)))
2395 (when (null new-bufs) 2434 (when (null new-bufs)
2396 (erc-display-line-1 string (if (erc-server-buffer-live-p) 2435 (erc-display-line-1 string (if (erc-server-buffer-live-p)
2397 (process-buffer erc-server-process) 2436 (process-buffer erc-server-process)
2398 (current-buffer)))))) 2437 (current-buffer))))))
2399 2438
2400(defun erc-display-message-highlight (type string) 2439(defun erc-display-message-highlight (type string)
2401 "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face. 2440 "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
2402 2441
2403See also `erc-make-notice'." 2442See also `erc-make-notice'."
2404 (cond ((eq type 'notice) 2443 (cond ((eq type 'notice)
2405 (erc-make-notice string)) 2444 (erc-make-notice string))
2406 (t 2445 (t
2407 (erc-put-text-property 2446 (erc-put-text-property
2408 0 (length string) 2447 0 (length string)
2409 'face (or (intern-soft 2448 'face (or (intern-soft
2410 (concat "erc-" (symbol-name type) "-face")) 2449 (concat "erc-" (symbol-name type) "-face"))
2411 "erc-default-face") 2450 "erc-default-face")
2412 string) 2451 string)
2413 string))) 2452 string)))
2414 2453
2415(defvar erc-lurker-state nil 2454(defvar erc-lurker-state nil
2416 "Track the time of the last PRIVMSG for each (server,nick) pair. 2455 "Track the time of the last PRIVMSG for each (server,nick) pair.
@@ -2487,15 +2526,15 @@ consumption for long-lived IRC or Emacs sessions."
2487 (lambda (server hash) 2526 (lambda (server hash)
2488 (maphash 2527 (maphash
2489 (lambda (nick last-PRIVMSG-time) 2528 (lambda (nick last-PRIVMSG-time)
2490 (when 2529 (when
2491 (> (float-time (time-subtract 2530 (> (float-time (time-subtract
2492 (current-time) 2531 (current-time)
2493 last-PRIVMSG-time)) 2532 last-PRIVMSG-time))
2494 erc-lurker-threshold-time) 2533 erc-lurker-threshold-time)
2495 (remhash nick hash))) 2534 (remhash nick hash)))
2496 hash) 2535 hash)
2497 (if (zerop (hash-table-count hash)) 2536 (if (zerop (hash-table-count hash))
2498 (remhash server erc-lurker-state))) 2537 (remhash server erc-lurker-state)))
2499 erc-lurker-state)) 2538 erc-lurker-state))
2500 2539
2501(defvar erc-lurker-cleanup-count 0 2540(defvar erc-lurker-cleanup-count 0
@@ -2535,7 +2574,7 @@ updates of `erc-lurker-state'."
2535 (erc-canonicalize-server-name erc-server-announced-name))) 2574 (erc-canonicalize-server-name erc-server-announced-name)))
2536 (when (equal command "PRIVMSG") 2575 (when (equal command "PRIVMSG")
2537 (when (>= (cl-incf erc-lurker-cleanup-count) 2576 (when (>= (cl-incf erc-lurker-cleanup-count)
2538 erc-lurker-cleanup-interval) 2577 erc-lurker-cleanup-interval)
2539 (setq erc-lurker-cleanup-count 0) 2578 (setq erc-lurker-cleanup-count 0)
2540 (erc-lurker-cleanup)) 2579 (erc-lurker-cleanup))
2541 (unless (gethash server erc-lurker-state) 2580 (unless (gethash server erc-lurker-state)
@@ -2550,14 +2589,14 @@ Lurking is the condition where NICK has issued no PRIVMSG on this
2550server within `erc-lurker-threshold-time'. See also 2589server within `erc-lurker-threshold-time'. See also
2551`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'." 2590`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'."
2552 (unless erc-lurker-state (erc-lurker-initialize)) 2591 (unless erc-lurker-state (erc-lurker-initialize))
2553 (let* ((server 2592 (let* ((server
2554 (erc-canonicalize-server-name erc-server-announced-name)) 2593 (erc-canonicalize-server-name erc-server-announced-name))
2555 (last-PRIVMSG-time 2594 (last-PRIVMSG-time
2556 (gethash (erc-lurker-maybe-trim nick) 2595 (gethash (erc-lurker-maybe-trim nick)
2557 (gethash server erc-lurker-state (make-hash-table))))) 2596 (gethash server erc-lurker-state (make-hash-table)))))
2558 (or (null last-PRIVMSG-time) 2597 (or (null last-PRIVMSG-time)
2559 (> (float-time 2598 (> (float-time
2560 (time-subtract (current-time) last-PRIVMSG-time)) 2599 (time-subtract (current-time) last-PRIVMSG-time))
2561 erc-lurker-threshold-time)))) 2600 erc-lurker-threshold-time))))
2562 2601
2563(defcustom erc-common-server-suffixes 2602(defcustom erc-common-server-suffixes
@@ -2577,8 +2616,8 @@ otherwise `erc-server-announced-name'. SERVER is matched against
2577`erc-common-server-suffixes'." 2616`erc-common-server-suffixes'."
2578 (when server 2617 (when server
2579 (or (cdar (erc-remove-if-not 2618 (or (cdar (erc-remove-if-not
2580 (lambda (net) (string-match (car net) server)) 2619 (lambda (net) (string-match (car net) server))
2581 erc-common-server-suffixes)) 2620 erc-common-server-suffixes))
2582 erc-server-announced-name))) 2621 erc-server-announced-name)))
2583 2622
2584(defun erc-hide-current-message-p (parsed) 2623(defun erc-hide-current-message-p (parsed)
@@ -2599,27 +2638,27 @@ ARGS, PARSED, and TYPE are used to format MSG sensibly.
2599 2638
2600See also `erc-format-message' and `erc-display-line'." 2639See also `erc-format-message' and `erc-display-line'."
2601 (let ((string (if (symbolp msg) 2640 (let ((string (if (symbolp msg)
2602 (apply 'erc-format-message msg args) 2641 (apply 'erc-format-message msg args)
2603 msg))) 2642 msg)))
2604 (setq string 2643 (setq string
2605 (cond 2644 (cond
2606 ((null type) 2645 ((null type)
2607 string) 2646 string)
2608 ((listp type) 2647 ((listp type)
2609 (mapc (lambda (type) 2648 (mapc (lambda (type)
2610 (setq string 2649 (setq string
2611 (erc-display-message-highlight type string))) 2650 (erc-display-message-highlight type string)))
2612 type) 2651 type)
2613 string) 2652 string)
2614 ((symbolp type) 2653 ((symbolp type)
2615 (erc-display-message-highlight type string)))) 2654 (erc-display-message-highlight type string))))
2616 2655
2617 (if (not (erc-response-p parsed)) 2656 (if (not (erc-response-p parsed))
2618 (erc-display-line string buffer) 2657 (erc-display-line string buffer)
2619 (unless (erc-hide-current-message-p parsed) 2658 (unless (erc-hide-current-message-p parsed)
2620 (erc-put-text-property 0 (length string) 'erc-parsed parsed string) 2659 (erc-put-text-property 0 (length string) 'erc-parsed parsed string)
2621 (erc-put-text-property 0 (length string) 'rear-sticky t string) 2660 (erc-put-text-property 0 (length string) 'rear-sticky t string)
2622 (erc-display-line string buffer))))) 2661 (erc-display-line string buffer)))))
2623 2662
2624(defun erc-message-type-member (position list) 2663(defun erc-message-type-member (position list)
2625 "Return non-nil if the erc-parsed text-property at POSITION is in LIST. 2664 "Return non-nil if the erc-parsed text-property at POSITION is in LIST.
@@ -2637,19 +2676,19 @@ present."
2637 2676
2638See also `erc-server-send'." 2677See also `erc-server-send'."
2639 (setq line (format "PRIVMSG %s :%s" 2678 (setq line (format "PRIVMSG %s :%s"
2640 target 2679 target
2641 ;; If the line is empty, we still want to 2680 ;; If the line is empty, we still want to
2642 ;; send it - i.e. an empty pasted line. 2681 ;; send it - i.e. an empty pasted line.
2643 (if (string= line "\n") 2682 (if (string= line "\n")
2644 " \n" 2683 " \n"
2645 line))) 2684 line)))
2646 (erc-server-send line force target)) 2685 (erc-server-send line force target))
2647 2686
2648(defun erc-get-arglist (fun) 2687(defun erc-get-arglist (fun)
2649 "Return the argument list of a function without the parens." 2688 "Return the argument list of a function without the parens."
2650 (let ((arglist (format "%S" (erc-function-arglist fun)))) 2689 (let ((arglist (format "%S" (erc-function-arglist fun))))
2651 (if (string-match "^(\\(.*\\))$" arglist) 2690 (if (string-match "^(\\(.*\\))$" arglist)
2652 (match-string 1 arglist) 2691 (match-string 1 arglist)
2653 arglist))) 2692 arglist)))
2654 2693
2655(defun erc-command-no-process-p (str) 2694(defun erc-command-no-process-p (str)
@@ -2657,15 +2696,15 @@ See also `erc-server-send'."
2657is not alive, nil otherwise." 2696is not alive, nil otherwise."
2658 (let ((fun (erc-extract-command-from-line str))) 2697 (let ((fun (erc-extract-command-from-line str)))
2659 (and fun 2698 (and fun
2660 (symbolp (car fun)) 2699 (symbolp (car fun))
2661 (get (car fun) 'process-not-needed)))) 2700 (get (car fun) 'process-not-needed))))
2662 2701
2663(defun erc-command-name (cmd) 2702(defun erc-command-name (cmd)
2664 "For CMD being the function name of a ERC command, something like 2703 "For CMD being the function name of a ERC command, something like
2665erc-cmd-FOO, this returns a string /FOO." 2704erc-cmd-FOO, this returns a string /FOO."
2666 (let ((command-name (symbol-name cmd))) 2705 (let ((command-name (symbol-name cmd)))
2667 (if (string-match "^erc-cmd-\\(.*\\)$" command-name) 2706 (if (string-match "^erc-cmd-\\(.*\\)$" command-name)
2668 (concat "/" (match-string 1 command-name)) 2707 (concat "/" (match-string 1 command-name))
2669 command-name))) 2708 command-name)))
2670 2709
2671(defun erc-process-input-line (line &optional force no-command) 2710(defun erc-process-input-line (line &optional force no-command)
@@ -2681,30 +2720,30 @@ An optional FORCE argument forces sending the line when flood
2681protection is in effect. The optional NO-COMMAND argument prohibits 2720protection is in effect. The optional NO-COMMAND argument prohibits
2682this function from interpreting the line as a command." 2721this function from interpreting the line as a command."
2683 (let ((command-list (erc-extract-command-from-line line))) 2722 (let ((command-list (erc-extract-command-from-line line)))
2684 (if (and command-list 2723 (if (and command-list
2685 (not no-command)) 2724 (not no-command))
2686 (let* ((cmd (nth 0 command-list)) 2725 (let* ((cmd (nth 0 command-list))
2687 (args (nth 1 command-list))) 2726 (args (nth 1 command-list)))
2688 (condition-case nil 2727 (condition-case nil
2689 (if (listp args) 2728 (if (listp args)
2690 (apply cmd args) 2729 (apply cmd args)
2691 (funcall cmd args)) 2730 (funcall cmd args))
2692 (wrong-number-of-arguments 2731 (wrong-number-of-arguments
2693 (erc-display-message nil 'error (current-buffer) 'incorrect-args 2732 (erc-display-message nil 'error (current-buffer) 'incorrect-args
2694 ?c (erc-command-name cmd) 2733 ?c (erc-command-name cmd)
2695 ?u (or (erc-get-arglist cmd) 2734 ?u (or (erc-get-arglist cmd)
2696 "") 2735 "")
2697 ?d (format "%s\n" 2736 ?d (format "%s\n"
2698 (or (documentation cmd) ""))) 2737 (or (documentation cmd) "")))
2699 nil))) 2738 nil)))
2700 (let ((r (erc-default-target))) 2739 (let ((r (erc-default-target)))
2701 (if r 2740 (if r
2702 (funcall erc-send-input-line-function r line force) 2741 (funcall erc-send-input-line-function r line force)
2703 (erc-display-message nil 'error (current-buffer) 'no-target) 2742 (erc-display-message nil 'error (current-buffer) 'no-target)
2704 nil))))) 2743 nil)))))
2705 2744
2706;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2745;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2707;; Input commands handlers 2746;; Input commands handlers
2708;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2747;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2709 2748
2710(defun erc-cmd-AMSG (line) 2749(defun erc-cmd-AMSG (line)
@@ -2712,9 +2751,9 @@ this function from interpreting the line as a command."
2712 (interactive "sSend to all channels you're on: ") 2751 (interactive "sSend to all channels you're on: ")
2713 (setq line (erc-trim-string line)) 2752 (setq line (erc-trim-string line))
2714 (erc-with-all-buffers-of-server nil 2753 (erc-with-all-buffers-of-server nil
2715 (lambda () 2754 (lambda ()
2716 (erc-channel-p (erc-default-target))) 2755 (erc-channel-p (erc-default-target)))
2717 (erc-send-message line))) 2756 (erc-send-message line)))
2718(put 'erc-cmd-AMSG 'do-not-parse-args t) 2757(put 'erc-cmd-AMSG 'do-not-parse-args t)
2719 2758
2720(defun erc-cmd-SAY (line) 2759(defun erc-cmd-SAY (line)
@@ -2735,36 +2774,37 @@ VALUE is computed by evaluating the rest of LINE in Lisp."
2735 (cond 2774 (cond
2736 ((string-match "^\\s-*\\(\\S-+\\)\\s-+\\(.*\\)$" line) 2775 ((string-match "^\\s-*\\(\\S-+\\)\\s-+\\(.*\\)$" line)
2737 (let ((var (read (concat "erc-" (match-string 1 line)))) 2776 (let ((var (read (concat "erc-" (match-string 1 line))))
2738 (val (read (match-string 2 line)))) 2777 (val (read (match-string 2 line))))
2739 (if (boundp var) 2778 (if (boundp var)
2740 (progn 2779 (progn
2741 (set var (eval val)) 2780 (set var (eval val))
2742 (erc-display-message 2781 (erc-display-message
2743 nil nil 'active (format "Set %S to %S" var val)) 2782 nil nil 'active (format "Set %S to %S" var val))
2744 t) 2783 t)
2745 (setq var (read (match-string 1 line))) 2784 (setq var (read (match-string 1 line)))
2746 (if (boundp var) 2785 (if (boundp var)
2747 (progn 2786 (progn
2748 (set var (eval val)) 2787 (set var (eval val))
2749 (erc-display-message 2788 (erc-display-message
2750 nil nil 'active (format "Set %S to %S" var val)) 2789 nil nil 'active (format "Set %S to %S" var val))
2751 t) 2790 t)
2752 (erc-display-message nil 'error 'active 'variable-not-bound) 2791 (erc-display-message nil 'error 'active 'variable-not-bound)
2753 nil)))) 2792 nil))))
2754 ((string-match "^\\s-*$" line) 2793 ((string-match "^\\s-*$" line)
2755 (erc-display-line 2794 (erc-display-line
2756 (concat "Available user variables:\n" 2795 (concat "Available user variables:\n"
2757 (apply 2796 (apply
2758 'concat 2797 'concat
2759 (mapcar 2798 (mapcar
2760 (lambda (var) 2799 (lambda (var)
2761 (let ((val (symbol-value var))) 2800 (let ((val (symbol-value var)))
2762 (concat (format "%S:" var) 2801 (concat (format "%S:" var)
2763 (if (consp val) 2802 (if (consp val)
2764 (concat "\n" (pp-to-string val)) 2803 (concat "\n" (pp-to-string val))
2765 (format " %S\n" val))))) 2804 (format " %S\n" val)))))
2766 (apropos-internal "^erc-" 'custom-variable-p)))) 2805 (apropos-internal "^erc-" 'custom-variable-p))))
2767 (current-buffer)) t) 2806 (current-buffer))
2807 t)
2768 (t nil))) 2808 (t nil)))
2769(defalias 'erc-cmd-VAR 'erc-cmd-SET) 2809(defalias 'erc-cmd-VAR 'erc-cmd-SET)
2770(defalias 'erc-cmd-VARIABLE 'erc-cmd-SET) 2810(defalias 'erc-cmd-VARIABLE 'erc-cmd-SET)
@@ -2786,42 +2826,42 @@ therefore has to contain the command itself as well."
2786If no USER argument is specified, list the contents of `erc-ignore-list'." 2826If no USER argument is specified, list the contents of `erc-ignore-list'."
2787 (if user 2827 (if user
2788 (let ((quoted (regexp-quote user))) 2828 (let ((quoted (regexp-quote user)))
2789 (when (and (not (string= user quoted)) 2829 (when (and (not (string= user quoted))
2790 (y-or-n-p (format "Use regexp-quoted form (%s) instead? " 2830 (y-or-n-p (format "Use regexp-quoted form (%s) instead? "
2791 quoted))) 2831 quoted)))
2792 (setq user quoted)) 2832 (setq user quoted))
2793 (erc-display-line 2833 (erc-display-line
2794 (erc-make-notice (format "Now ignoring %s" user)) 2834 (erc-make-notice (format "Now ignoring %s" user))
2795 'active) 2835 'active)
2796 (erc-with-server-buffer (add-to-list 'erc-ignore-list user))) 2836 (erc-with-server-buffer (add-to-list 'erc-ignore-list user)))
2797 (if (null (erc-with-server-buffer erc-ignore-list)) 2837 (if (null (erc-with-server-buffer erc-ignore-list))
2798 (erc-display-line (erc-make-notice "Ignore list is empty") 'active) 2838 (erc-display-line (erc-make-notice "Ignore list is empty") 'active)
2799 (erc-display-line (erc-make-notice "Ignore list:") 'active) 2839 (erc-display-line (erc-make-notice "Ignore list:") 'active)
2800 (mapc #'(lambda (item) 2840 (mapc #'(lambda (item)
2801 (erc-display-line (erc-make-notice item) 2841 (erc-display-line (erc-make-notice item)
2802 'active)) 2842 'active))
2803 (erc-with-server-buffer erc-ignore-list)))) 2843 (erc-with-server-buffer erc-ignore-list))))
2804 t) 2844 t)
2805 2845
2806(defun erc-cmd-UNIGNORE (user) 2846(defun erc-cmd-UNIGNORE (user)
2807 "Remove the user specified in USER from the ignore list." 2847 "Remove the user specified in USER from the ignore list."
2808 (let ((ignored-nick (car (erc-with-server-buffer 2848 (let ((ignored-nick (car (erc-with-server-buffer
2809 (erc-member-ignore-case (regexp-quote user) 2849 (erc-member-ignore-case (regexp-quote user)
2810 erc-ignore-list))))) 2850 erc-ignore-list)))))
2811 (unless ignored-nick 2851 (unless ignored-nick
2812 (if (setq ignored-nick (erc-ignored-user-p user)) 2852 (if (setq ignored-nick (erc-ignored-user-p user))
2813 (unless (y-or-n-p (format "Remove this regexp (%s)? " 2853 (unless (y-or-n-p (format "Remove this regexp (%s)? "
2814 ignored-nick)) 2854 ignored-nick))
2815 (setq ignored-nick nil)) 2855 (setq ignored-nick nil))
2816 (erc-display-line 2856 (erc-display-line
2817 (erc-make-notice (format "%s is not currently ignored!" user)) 2857 (erc-make-notice (format "%s is not currently ignored!" user))
2818 'active))) 2858 'active)))
2819 (when ignored-nick 2859 (when ignored-nick
2820 (erc-display-line 2860 (erc-display-line
2821 (erc-make-notice (format "No longer ignoring %s" user)) 2861 (erc-make-notice (format "No longer ignoring %s" user))
2822 'active) 2862 'active)
2823 (erc-with-server-buffer 2863 (erc-with-server-buffer
2824 (setq erc-ignore-list (delete ignored-nick erc-ignore-list))))) 2864 (setq erc-ignore-list (delete ignored-nick erc-ignore-list)))))
2825 t) 2865 t)
2826 2866
2827(defun erc-cmd-CLEAR () 2867(defun erc-cmd-CLEAR ()
@@ -2835,20 +2875,20 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
2835 (interactive) 2875 (interactive)
2836 (let ((ops nil)) 2876 (let ((ops nil))
2837 (if erc-channel-users 2877 (if erc-channel-users
2838 (maphash (lambda (_nick user-data) 2878 (maphash (lambda (_nick user-data)
2839 (let ((cuser (cdr user-data))) 2879 (let ((cuser (cdr user-data)))
2840 (if (and cuser 2880 (if (and cuser
2841 (erc-channel-user-op cuser)) 2881 (erc-channel-user-op cuser))
2842 (setq ops (cons (erc-server-user-nickname 2882 (setq ops (cons (erc-server-user-nickname
2843 (car user-data)) 2883 (car user-data))
2844 ops))))) 2884 ops)))))
2845 erc-channel-users)) 2885 erc-channel-users))
2846 (setq ops (sort ops 'string-lessp)) 2886 (setq ops (sort ops 'string-lessp))
2847 (if ops 2887 (if ops
2848 (erc-display-message 2888 (erc-display-message
2849 nil 'notice (current-buffer) 'ops 2889 nil 'notice (current-buffer) 'ops
2850 ?i (length ops) ?s (if (> (length ops) 1) "s" "") 2890 ?i (length ops) ?s (if (> (length ops) 1) "s" "")
2851 ?o (mapconcat 'identity ops " ")) 2891 ?o (mapconcat 'identity ops " "))
2852 (erc-display-message nil 'notice (current-buffer) 'ops-none))) 2892 (erc-display-message nil 'notice (current-buffer) 'ops-none)))
2853 t) 2893 t)
2854 2894
@@ -2857,11 +2897,11 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
2857 (require 'mail-extr) 2897 (require 'mail-extr)
2858 (let ((co (ignore-errors (what-domain tld)))) 2898 (let ((co (ignore-errors (what-domain tld))))
2859 (if co 2899 (if co
2860 (erc-display-message 2900 (erc-display-message
2861 nil 'notice 'active 'country ?c co ?d tld) 2901 nil 'notice 'active 'country ?c co ?d tld)
2862 (erc-display-message 2902 (erc-display-message
2863 nil 'notice 'active 'country-unknown ?d tld)) 2903 nil 'notice 'active 'country-unknown ?d tld))
2864 t)) 2904 t))
2865(put 'erc-cmd-COUNTRY 'process-not-needed t) 2905(put 'erc-cmd-COUNTRY 'process-not-needed t)
2866 2906
2867(defun erc-cmd-AWAY (line) 2907(defun erc-cmd-AWAY (line)
@@ -2872,8 +2912,8 @@ If no reason is given, unset away status."
2872 (erc-log (format "cmd: AWAY: %s" reason)) 2912 (erc-log (format "cmd: AWAY: %s" reason))
2873 (erc-server-send 2913 (erc-server-send
2874 (if (string= reason "") 2914 (if (string= reason "")
2875 "AWAY" 2915 "AWAY"
2876 (concat "AWAY :" reason)))) 2916 (concat "AWAY :" reason))))
2877 t)) 2917 t))
2878(put 'erc-cmd-AWAY 'do-not-parse-args t) 2918(put 'erc-cmd-AWAY 'do-not-parse-args t)
2879 2919
@@ -2891,8 +2931,8 @@ If no reason is given, unset away status."
2891CMD is the CTCP command, possible values being ECHO, FINGER, CLIENTINFO, TIME, 2931CMD is the CTCP command, possible values being ECHO, FINGER, CLIENTINFO, TIME,
2892VERSION and so on. It is called with ARGS." 2932VERSION and so on. It is called with ARGS."
2893 (let ((str (concat cmd 2933 (let ((str (concat cmd
2894 (when args 2934 (when args
2895 (concat " " (mapconcat #'identity args " ")))))) 2935 (concat " " (mapconcat #'identity args " "))))))
2896 (erc-log (format "cmd: CTCP [%s]: [%s]" nick str)) 2936 (erc-log (format "cmd: CTCP [%s]: [%s]" nick str))
2897 (erc-send-ctcp-message nick str) 2937 (erc-send-ctcp-message nick str)
2898 t)) 2938 t))
@@ -2915,29 +2955,29 @@ For help about the WHOIS command, do:
2915For a list of user commands (/join /part, ...): 2955For a list of user commands (/join /part, ...):
2916 /help." 2956 /help."
2917 (if func 2957 (if func
2918 (let* ((sym (or (let ((sym (intern-soft 2958 (let* ((sym (or (let ((sym (intern-soft
2919 (concat "erc-cmd-" (upcase func))))) 2959 (concat "erc-cmd-" (upcase func)))))
2920 (if (and sym (or (boundp sym) (fboundp sym))) 2960 (if (and sym (or (boundp sym) (fboundp sym)))
2921 sym 2961 sym
2922 nil)) 2962 nil))
2923 (let ((sym (intern-soft func))) 2963 (let ((sym (intern-soft func)))
2924 (if (and sym (or (boundp sym) (fboundp sym))) 2964 (if (and sym (or (boundp sym) (fboundp sym)))
2925 sym 2965 sym
2926 nil)) 2966 nil))
2927 (let ((sym (intern-soft (concat "erc-" func)))) 2967 (let ((sym (intern-soft (concat "erc-" func))))
2928 (if (and sym (or (boundp sym) (fboundp sym))) 2968 (if (and sym (or (boundp sym) (fboundp sym)))
2929 sym 2969 sym
2930 nil))))) 2970 nil)))))
2931 (if sym 2971 (if sym
2932 (cond 2972 (cond
2933 ((boundp sym) (describe-variable sym)) 2973 ((boundp sym) (describe-variable sym))
2934 ((fboundp sym) (describe-function sym)) 2974 ((fboundp sym) (describe-function sym))
2935 (t nil)) 2975 (t nil))
2936 (apropos-command (concat "erc-.*" func) nil 2976 (apropos-command (concat "erc-.*" func) nil
2937 (lambda (x) 2977 (lambda (x)
2938 (or (commandp x) 2978 (or (commandp x)
2939 (get x 'custom-type)))) 2979 (get x 'custom-type))))
2940 t)) 2980 t))
2941 (apropos "erc-cmd-") 2981 (apropos "erc-cmd-")
2942 (message "Type C-h m to get additional information about keybindings.") 2982 (message "Type C-h m to get additional information about keybindings.")
2943 t)) 2983 t))
@@ -2951,23 +2991,23 @@ If CHANNEL is specified as \"-invite\", join the channel to which you
2951were most recently invited. See also `invitation'." 2991were most recently invited. See also `invitation'."
2952 (let (chnl) 2992 (let (chnl)
2953 (if (string= (upcase channel) "-INVITE") 2993 (if (string= (upcase channel) "-INVITE")
2954 (if erc-invitation 2994 (if erc-invitation
2955 (setq chnl erc-invitation) 2995 (setq chnl erc-invitation)
2956 (erc-display-message nil 'error (current-buffer) 'no-invitation)) 2996 (erc-display-message nil 'error (current-buffer) 'no-invitation))
2957 (setq chnl (erc-ensure-channel-name channel))) 2997 (setq chnl (erc-ensure-channel-name channel)))
2958 (when chnl 2998 (when chnl
2959 ;; Prevent double joining of same channel on same server. 2999 ;; Prevent double joining of same channel on same server.
2960 (let ((joined-channels 3000 (let ((joined-channels
2961 (mapcar #'(lambda (chanbuf) 3001 (mapcar #'(lambda (chanbuf)
2962 (with-current-buffer chanbuf (erc-default-target))) 3002 (with-current-buffer chanbuf (erc-default-target)))
2963 (erc-channel-list erc-server-process)))) 3003 (erc-channel-list erc-server-process))))
2964 (if (erc-member-ignore-case chnl joined-channels) 3004 (if (erc-member-ignore-case chnl joined-channels)
2965 (switch-to-buffer (car (erc-member-ignore-case chnl 3005 (switch-to-buffer (car (erc-member-ignore-case chnl
2966 joined-channels))) 3006 joined-channels)))
2967 (erc-log (format "cmd: JOIN: %s" chnl)) 3007 (erc-log (format "cmd: JOIN: %s" chnl))
2968 (erc-server-send (if (and chnl key) 3008 (erc-server-send (if (and chnl key)
2969 (format "JOIN %s %s" chnl key) 3009 (format "JOIN %s %s" chnl key)
2970 (format "JOIN %s" chnl))))))) 3010 (format "JOIN %s" chnl)))))))
2971 t) 3011 t)
2972 3012
2973(defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN) 3013(defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN)
@@ -2986,14 +3026,14 @@ If CHANNEL is not specified, display the users in the current channel.
2986This function clears the channel name list first, then sends the 3026This function clears the channel name list first, then sends the
2987command." 3027command."
2988 (let ((tgt (or (and (erc-channel-p channel) channel) 3028 (let ((tgt (or (and (erc-channel-p channel) channel)
2989 (erc-default-target)))) 3029 (erc-default-target))))
2990 (if (and tgt (erc-channel-p tgt)) 3030 (if (and tgt (erc-channel-p tgt))
2991 (progn 3031 (progn
2992 (erc-log (format "cmd: DEFAULT: NAMES %s" tgt)) 3032 (erc-log (format "cmd: DEFAULT: NAMES %s" tgt))
2993 (erc-with-buffer 3033 (erc-with-buffer
2994 (tgt) 3034 (tgt)
2995 (erc-channel-begin-receiving-names)) 3035 (erc-channel-begin-receiving-names))
2996 (erc-server-send (concat "NAMES " tgt))) 3036 (erc-server-send (concat "NAMES " tgt)))
2997 (erc-display-message nil 'error (current-buffer) 'no-default-channel))) 3037 (erc-display-message nil 'error (current-buffer) 'no-default-channel)))
2998 t) 3038 t)
2999(defalias 'erc-cmd-N 'erc-cmd-NAMES) 3039(defalias 'erc-cmd-N 'erc-cmd-NAMES)
@@ -3003,27 +3043,27 @@ command."
3003LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"." 3043LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"."
3004 (let ((reasonstring (mapconcat 'identity reasonwords " "))) 3044 (let ((reasonstring (mapconcat 'identity reasonwords " ")))
3005 (if (string= "" reasonstring) 3045 (if (string= "" reasonstring)
3006 (setq reasonstring (format "Kicked by %s" (erc-current-nick)))) 3046 (setq reasonstring (format "Kicked by %s" (erc-current-nick))))
3007 (if (erc-channel-p target) 3047 (if (erc-channel-p target)
3008 (let ((nick reason-or-nick)) 3048 (let ((nick reason-or-nick))
3009 (erc-log (format "cmd: KICK: %s/%s: %s" nick target reasonstring)) 3049 (erc-log (format "cmd: KICK: %s/%s: %s" nick target reasonstring))
3010 (erc-server-send (format "KICK %s %s :%s" target nick reasonstring) 3050 (erc-server-send (format "KICK %s %s :%s" target nick reasonstring)
3011 nil target) 3051 nil target)
3012 t) 3052 t)
3013 (when target 3053 (when target
3014 (let ((ch (erc-default-target))) 3054 (let ((ch (erc-default-target)))
3015 (setq reasonstring (concat 3055 (setq reasonstring (concat
3016 (if reason-or-nick (concat reason-or-nick " ")) 3056 (if reason-or-nick (concat reason-or-nick " "))
3017 reasonstring)) 3057 reasonstring))
3018 (if ch 3058 (if ch
3019 (progn 3059 (progn
3020 (erc-log 3060 (erc-log
3021 (format "cmd: KICK: %s/%s: %s" target ch reasonstring)) 3061 (format "cmd: KICK: %s/%s: %s" target ch reasonstring))
3022 (erc-server-send 3062 (erc-server-send
3023 (format "KICK %s %s :%s" ch target reasonstring) nil ch)) 3063 (format "KICK %s %s :%s" ch target reasonstring) nil ch))
3024 (erc-display-message nil 'error (current-buffer) 3064 (erc-display-message nil 'error (current-buffer)
3025 'no-default-channel)) 3065 'no-default-channel))
3026 t))))) 3066 t)))))
3027 3067
3028(defvar erc-script-args nil) 3068(defvar erc-script-args nil)
3029 3069
@@ -3038,20 +3078,20 @@ a script after exceeding the flood threshold."
3038 (cond 3078 (cond
3039 ((string-match "^\\s-*\\(\\S-+\\)\\(.*\\)$" line) 3079 ((string-match "^\\s-*\\(\\S-+\\)\\(.*\\)$" line)
3040 (let* ((file-to-find (match-string 1 line)) 3080 (let* ((file-to-find (match-string 1 line))
3041 (erc-script-args (match-string 2 line)) 3081 (erc-script-args (match-string 2 line))
3042 (file (erc-find-file file-to-find erc-script-path))) 3082 (file (erc-find-file file-to-find erc-script-path)))
3043 (erc-log (format "cmd: LOAD: %s" file-to-find)) 3083 (erc-log (format "cmd: LOAD: %s" file-to-find))
3044 (cond 3084 (cond
3045 ((not file) 3085 ((not file)
3046 (erc-display-message nil 'error (current-buffer) 3086 (erc-display-message nil 'error (current-buffer)
3047 'cannot-find-file ?f file-to-find)) 3087 'cannot-find-file ?f file-to-find))
3048 ((not (file-readable-p file)) 3088 ((not (file-readable-p file))
3049 (erc-display-message nil 'error (current-buffer) 3089 (erc-display-message nil 'error (current-buffer)
3050 'cannot-read-file ?f file)) 3090 'cannot-read-file ?f file))
3051 (t 3091 (t
3052 (message "Loading \'%s\'..." file) 3092 (message "Loading \'%s\'..." file)
3053 (erc-load-script file) 3093 (erc-load-script file)
3054 (message "Loading \'%s\'...done" file)))) 3094 (message "Loading \'%s\'...done" file))))
3055 t) 3095 t)
3056 (t nil))) 3096 (t nil)))
3057 3097
@@ -3061,11 +3101,11 @@ a script after exceeding the flood threshold."
3061If SERVER is non-nil, use that, rather than the current server." 3101If SERVER is non-nil, use that, rather than the current server."
3062 ;; FIXME: is the above docstring correct? -- Lawrence 2004-01-08 3102 ;; FIXME: is the above docstring correct? -- Lawrence 2004-01-08
3063 (let ((send (if server 3103 (let ((send (if server
3064 (format "WHOIS %s %s" user server) 3104 (format "WHOIS %s %s" user server)
3065 (format "WHOIS %s" user)))) 3105 (format "WHOIS %s" user))))
3066 (erc-log (format "cmd: %s" send)) 3106 (erc-log (format "cmd: %s" send))
3067 (erc-server-send send) 3107 (erc-server-send send)
3068 t)) 3108 t))
3069(defalias 'erc-cmd-WI 'erc-cmd-WHOIS) 3109(defalias 'erc-cmd-WI 'erc-cmd-WHOIS)
3070 3110
3071(defun erc-cmd-WHOAMI () 3111(defun erc-cmd-WHOAMI ()
@@ -3076,78 +3116,78 @@ If SERVER is non-nil, use that, rather than the current server."
3076(defun erc-cmd-IDLE (nick) 3116(defun erc-cmd-IDLE (nick)
3077 "Show the length of time NICK has been idle." 3117 "Show the length of time NICK has been idle."
3078 (let ((origbuf (current-buffer)) 3118 (let ((origbuf (current-buffer))
3079 symlist) 3119 symlist)
3080 (erc-with-server-buffer 3120 (erc-with-server-buffer
3081 (push (cons (erc-once-with-server-event 3121 (push (cons (erc-once-with-server-event
3082 311 (lambda (_proc parsed) 3122 311 (lambda (_proc parsed)
3083 (string= nick 3123 (string= nick
3084 (nth 1 (erc-response.command-args 3124 (nth 1 (erc-response.command-args
3085 parsed))))) 3125 parsed)))))
3086 'erc-server-311-functions) 3126 'erc-server-311-functions)
3087 symlist) 3127 symlist)
3088 (push (cons (erc-once-with-server-event 3128 (push (cons (erc-once-with-server-event
3089 312 (lambda (_proc parsed) 3129 312 (lambda (_proc parsed)
3090 (string= nick 3130 (string= nick
3091 (nth 1 (erc-response.command-args 3131 (nth 1 (erc-response.command-args
3092 parsed))))) 3132 parsed)))))
3093 'erc-server-312-functions) 3133 'erc-server-312-functions)
3094 symlist) 3134 symlist)
3095 (push (cons (erc-once-with-server-event 3135 (push (cons (erc-once-with-server-event
3096 318 (lambda (_proc parsed) 3136 318 (lambda (_proc parsed)
3097 (string= nick 3137 (string= nick
3098 (nth 1 (erc-response.command-args 3138 (nth 1 (erc-response.command-args
3099 parsed))))) 3139 parsed)))))
3100 'erc-server-318-functions) 3140 'erc-server-318-functions)
3101 symlist) 3141 symlist)
3102 (push (cons (erc-once-with-server-event 3142 (push (cons (erc-once-with-server-event
3103 319 (lambda (_proc parsed) 3143 319 (lambda (_proc parsed)
3104 (string= nick 3144 (string= nick
3105 (nth 1 (erc-response.command-args 3145 (nth 1 (erc-response.command-args
3106 parsed))))) 3146 parsed)))))
3107 'erc-server-319-functions) 3147 'erc-server-319-functions)
3108 symlist) 3148 symlist)
3109 (push (cons (erc-once-with-server-event 3149 (push (cons (erc-once-with-server-event
3110 320 (lambda (_proc parsed) 3150 320 (lambda (_proc parsed)
3111 (string= nick 3151 (string= nick
3112 (nth 1 (erc-response.command-args 3152 (nth 1 (erc-response.command-args
3113 parsed))))) 3153 parsed)))))
3114 'erc-server-320-functions) 3154 'erc-server-320-functions)
3115 symlist) 3155 symlist)
3116 (push (cons (erc-once-with-server-event 3156 (push (cons (erc-once-with-server-event
3117 330 (lambda (_proc parsed) 3157 330 (lambda (_proc parsed)
3118 (string= nick 3158 (string= nick
3119 (nth 1 (erc-response.command-args 3159 (nth 1 (erc-response.command-args
3120 parsed))))) 3160 parsed)))))
3121 'erc-server-330-functions) 3161 'erc-server-330-functions)
3122 symlist) 3162 symlist)
3123 (push (cons (erc-once-with-server-event 3163 (push (cons (erc-once-with-server-event
3124 317 3164 317
3125 (lambda (_proc parsed) 3165 (lambda (_proc parsed)
3126 (let ((idleseconds 3166 (let ((idleseconds
3127 (string-to-number 3167 (string-to-number
3128 (cl-third 3168 (cl-third
3129 (erc-response.command-args parsed))))) 3169 (erc-response.command-args parsed)))))
3130 (erc-display-line 3170 (erc-display-line
3131 (erc-make-notice 3171 (erc-make-notice
3132 (format "%s has been idle for %s." 3172 (format "%s has been idle for %s."
3133 (erc-string-no-properties nick) 3173 (erc-string-no-properties nick)
3134 (erc-seconds-to-string idleseconds))) 3174 (erc-seconds-to-string idleseconds)))
3135 origbuf) 3175 origbuf)
3136 t))) 3176 t)))
3137 'erc-server-317-functions) 3177 'erc-server-317-functions)
3138 symlist) 3178 symlist)
3139 3179
3140 ;; Send the WHOIS command. 3180 ;; Send the WHOIS command.
3141 (erc-cmd-WHOIS nick) 3181 (erc-cmd-WHOIS nick)
3142 3182
3143 ;; Remove the uninterned symbols from the server hooks that did not run. 3183 ;; Remove the uninterned symbols from the server hooks that did not run.
3144 (run-at-time 20 nil (lambda (buf symlist) 3184 (run-at-time 20 nil (lambda (buf symlist)
3145 (with-current-buffer buf 3185 (with-current-buffer buf
3146 (dolist (sym symlist) 3186 (dolist (sym symlist)
3147 (let ((hooksym (cdr sym)) 3187 (let ((hooksym (cdr sym))
3148 (funcsym (car sym))) 3188 (funcsym (car sym)))
3149 (remove-hook hooksym funcsym t))))) 3189 (remove-hook hooksym funcsym t)))))
3150 (current-buffer) symlist))) 3190 (current-buffer) symlist)))
3151 t) 3191 t)
3152 3192
3153(defun erc-cmd-DESCRIBE (line) 3193(defun erc-cmd-DESCRIBE (line)
@@ -3157,7 +3197,7 @@ LINE has the format \"USER ACTION\"."
3157 ((string-match 3197 ((string-match
3158 "^\\s-*\\(\\S-+\\)\\s-\\(.*\\)$" line) 3198 "^\\s-*\\(\\S-+\\)\\s-\\(.*\\)$" line)
3159 (let ((dst (match-string 1 line)) 3199 (let ((dst (match-string 1 line))
3160 (s (match-string 2 line))) 3200 (s (match-string 2 line)))
3161 (erc-log (format "cmd: DESCRIBE: [%s] %s" dst s)) 3201 (erc-log (format "cmd: DESCRIBE: [%s] %s" dst s))
3162 (erc-send-action dst s)) 3202 (erc-send-action dst s))
3163 t) 3203 t)
@@ -3203,7 +3243,7 @@ See also `erc-message' and `erc-display-line'."
3203 (erc-message "PRIVMSG" (concat (erc-default-target) " " line) force) 3243 (erc-message "PRIVMSG" (concat (erc-default-target) " " line) force)
3204 (erc-display-line 3244 (erc-display-line
3205 (concat (erc-format-my-nick) line) 3245 (concat (erc-format-my-nick) line)
3206 (current-buffer)) 3246 (current-buffer))
3207 ;; FIXME - treat multiline, run hooks, or remove me? 3247 ;; FIXME - treat multiline, run hooks, or remove me?
3208 t) 3248 t)
3209 3249
@@ -3229,7 +3269,7 @@ URL `http://freenode.net/using_the_network.shtml'."
3229 "Send a notice to the channel or user given as the first word. 3269 "Send a notice to the channel or user given as the first word.
3230The rest is the message to send." 3270The rest is the message to send."
3231 (erc-message "NOTICE" (concat channel-or-user " " 3271 (erc-message "NOTICE" (concat channel-or-user " "
3232 (mapconcat #'identity message " ")))) 3272 (mapconcat #'identity message " "))))
3233 3273
3234(defun erc-cmd-MSG (line) 3274(defun erc-cmd-MSG (line)
3235 "Send a message to the channel or user given as the first word in LINE. 3275 "Send a message to the channel or user given as the first word in LINE.
@@ -3250,16 +3290,16 @@ The rest of LINE is the message to send."
3250 "Change current nickname to NICK." 3290 "Change current nickname to NICK."
3251 (erc-log (format "cmd: NICK: %s (erc-bad-nick: %S)" nick erc-bad-nick)) 3291 (erc-log (format "cmd: NICK: %s (erc-bad-nick: %S)" nick erc-bad-nick))
3252 (let ((nicklen (cdr (assoc "NICKLEN" (erc-with-server-buffer 3292 (let ((nicklen (cdr (assoc "NICKLEN" (erc-with-server-buffer
3253 erc-server-parameters))))) 3293 erc-server-parameters)))))
3254 (and nicklen (> (length nick) (string-to-number nicklen)) 3294 (and nicklen (> (length nick) (string-to-number nicklen))
3255 (erc-display-message 3295 (erc-display-message
3256 nil 'notice 'active 'nick-too-long 3296 nil 'notice 'active 'nick-too-long
3257 ?i (length nick) ?l nicklen))) 3297 ?i (length nick) ?l nicklen)))
3258 (erc-server-send (format "NICK %s" nick)) 3298 (erc-server-send (format "NICK %s" nick))
3259 (cond (erc-bad-nick 3299 (cond (erc-bad-nick
3260 (erc-set-current-nick nick) 3300 (erc-set-current-nick nick)
3261 (erc-update-mode-line) 3301 (erc-update-mode-line)
3262 (setq erc-bad-nick nil))) 3302 (setq erc-bad-nick nil)))
3263 t) 3303 t)
3264 3304
3265(defun erc-cmd-PART (line) 3305(defun erc-cmd-PART (line)
@@ -3268,26 +3308,26 @@ Otherwise leave the channel indicated by LINE."
3268 (cond 3308 (cond
3269 ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-?\\(.*\\)$" line) 3309 ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-?\\(.*\\)$" line)
3270 (let* ((ch (match-string 1 line)) 3310 (let* ((ch (match-string 1 line))
3271 (msg (match-string 2 line)) 3311 (msg (match-string 2 line))
3272 (reason (funcall erc-part-reason (if (equal msg "") nil msg)))) 3312 (reason (funcall erc-part-reason (if (equal msg "") nil msg))))
3273 (erc-log (format "cmd: PART: %s: %s" ch reason)) 3313 (erc-log (format "cmd: PART: %s: %s" ch reason))
3274 (erc-server-send (if (string= reason "") 3314 (erc-server-send (if (string= reason "")
3275 (format "PART %s" ch) 3315 (format "PART %s" ch)
3276 (format "PART %s :%s" ch reason)) 3316 (format "PART %s :%s" ch reason))
3277 nil ch)) 3317 nil ch))
3278 t) 3318 t)
3279 ((string-match "^\\s-*\\(.*\\)$" line) 3319 ((string-match "^\\s-*\\(.*\\)$" line)
3280 (let* ((ch (erc-default-target)) 3320 (let* ((ch (erc-default-target))
3281 (msg (match-string 1 line)) 3321 (msg (match-string 1 line))
3282 (reason (funcall erc-part-reason (if (equal msg "") nil msg)))) 3322 (reason (funcall erc-part-reason (if (equal msg "") nil msg))))
3283 (if (and ch (erc-channel-p ch)) 3323 (if (and ch (erc-channel-p ch))
3284 (progn 3324 (progn
3285 (erc-log (format "cmd: PART: %s: %s" ch reason)) 3325 (erc-log (format "cmd: PART: %s: %s" ch reason))
3286 (erc-server-send (if (string= reason "") 3326 (erc-server-send (if (string= reason "")
3287 (format "PART %s" ch) 3327 (format "PART %s" ch)
3288 (format "PART %s :%s" ch reason)) 3328 (format "PART %s :%s" ch reason))
3289 nil ch)) 3329 nil ch))
3290 (erc-display-message nil 'error (current-buffer) 'no-target))) 3330 (erc-display-message nil 'error (current-buffer) 'no-target)))
3291 t) 3331 t)
3292 (t nil))) 3332 (t nil)))
3293(put 'erc-cmd-PART 'do-not-parse-args t) 3333(put 'erc-cmd-PART 'do-not-parse-args t)
@@ -3322,11 +3362,11 @@ See also `erc-auto-query' to decide how private messages from
3322other people should be displayed." 3362other people should be displayed."
3323 :group 'erc-query 3363 :group 'erc-query
3324 :type '(choice (const :tag "Split window and select" window) 3364 :type '(choice (const :tag "Split window and select" window)
3325 (const :tag "Split window, don't select" window-noselect) 3365 (const :tag "Split window, don't select" window-noselect)
3326 (const :tag "New frame" frame) 3366 (const :tag "New frame" frame)
3327 (const :tag "Bury in new buffer" bury) 3367 (const :tag "Bury in new buffer" bury)
3328 (const :tag "Use current buffer" buffer) 3368 (const :tag "Use current buffer" buffer)
3329 (const :tag "Use current buffer" t))) 3369 (const :tag "Use current buffer" t)))
3330 3370
3331(defun erc-cmd-QUERY (&optional user) 3371(defun erc-cmd-QUERY (&optional user)
3332 "Open a query with USER. 3372 "Open a query with USER.
@@ -3338,22 +3378,24 @@ If USER is omitted, close the current query buffer if one exists
3338 (interactive 3378 (interactive
3339 (list (read-from-minibuffer "Start a query with: " nil))) 3379 (list (read-from-minibuffer "Start a query with: " nil)))
3340 (let ((session-buffer (erc-server-buffer)) 3380 (let ((session-buffer (erc-server-buffer))
3341 (erc-join-buffer erc-query-display)) 3381 (erc-join-buffer erc-query-display))
3342 (if user 3382 (if user
3343 (erc-query user session-buffer) 3383 (erc-query user session-buffer)
3344 ;; currently broken, evil hack to display help anyway 3384 ;; currently broken, evil hack to display help anyway
3345 ;(erc-delete-query)))) 3385 ;(erc-delete-query))))
3346 (signal 'wrong-number-of-arguments "")))) 3386 (signal 'wrong-number-of-arguments ""))))
3347(defalias 'erc-cmd-Q 'erc-cmd-QUERY) 3387(defalias 'erc-cmd-Q 'erc-cmd-QUERY)
3348 3388
3389(defun erc-quit/part-reason-default ()
3390 "Default quit/part message."
3391 (format "\C-bERC\C-b (IRC client for Emacs %s)" emacs-version))
3392
3393
3349(defun erc-quit-reason-normal (&optional s) 3394(defun erc-quit-reason-normal (&optional s)
3350 "Normal quit message. 3395 "Normal quit message.
3351 3396
3352If S is non-nil, it will be used as the quit reason." 3397If S is non-nil, it will be used as the quit reason."
3353 (or s 3398 (or s (erc-quit/part-reason-default)))
3354 (format "\C-bERC\C-b %s (IRC client for Emacs)"; - \C-b%s\C-b"
3355 erc-version-string) ; erc-official-location)
3356 ))
3357 3399
3358(defun erc-quit-reason-zippy (&optional s) 3400(defun erc-quit-reason-zippy (&optional s)
3359 "Zippy quit message. 3401 "Zippy quit message.
@@ -3361,8 +3403,8 @@ If S is non-nil, it will be used as the quit reason."
3361If S is non-nil, it will be used as the quit reason." 3403If S is non-nil, it will be used as the quit reason."
3362 (or s 3404 (or s
3363 (if (fboundp 'yow) 3405 (if (fboundp 'yow)
3364 (erc-replace-regexp-in-string "\n" "" (yow)) 3406 (erc-replace-regexp-in-string "\n" "" (yow))
3365 (erc-quit-reason-normal)))) 3407 (erc-quit/part-reason-default))))
3366 3408
3367(make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4") 3409(make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4")
3368 3410
@@ -3370,21 +3412,18 @@ If S is non-nil, it will be used as the quit reason."
3370 "Choose a quit reason based on S (a string)." 3412 "Choose a quit reason based on S (a string)."
3371 (when (featurep 'xemacs) (require 'poe)) 3413 (when (featurep 'xemacs) (require 'poe))
3372 (let ((res (car (assoc-default (or s "") 3414 (let ((res (car (assoc-default (or s "")
3373 erc-quit-reason-various-alist 'string-match)))) 3415 erc-quit-reason-various-alist 'string-match))))
3374 (cond 3416 (cond
3375 ((functionp res) (funcall res)) 3417 ((functionp res) (funcall res))
3376 ((stringp res) res) 3418 ((stringp res) res)
3377 (s s) 3419 (s s)
3378 (t (erc-quit-reason-normal))))) 3420 (t (erc-quit/part-reason-default)))))
3379 3421
3380(defun erc-part-reason-normal (&optional s) 3422(defun erc-part-reason-normal (&optional s)
3381 "Normal part message. 3423 "Normal part message.
3382 3424
3383If S is non-nil, it will be used as the quit reason." 3425If S is non-nil, it will be used as the part reason."
3384 (or s 3426 (or s (erc-quit/part-reason-default)))
3385 (format "\C-bERC\C-b %s (IRC client for Emacs)"; - \C-b%s\C-b"
3386 erc-version-string) ; erc-official-location)
3387 ))
3388 3427
3389(defun erc-part-reason-zippy (&optional s) 3428(defun erc-part-reason-zippy (&optional s)
3390 "Zippy part message. 3429 "Zippy part message.
@@ -3392,8 +3431,8 @@ If S is non-nil, it will be used as the quit reason."
3392If S is non-nil, it will be used as the quit reason." 3431If S is non-nil, it will be used as the quit reason."
3393 (or s 3432 (or s
3394 (if (fboundp 'yow) 3433 (if (fboundp 'yow)
3395 (erc-replace-regexp-in-string "\n" "" (yow)) 3434 (erc-replace-regexp-in-string "\n" "" (yow))
3396 (erc-part-reason-normal)))) 3435 (erc-quit/part-reason-default))))
3397 3436
3398(make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4") 3437(make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4")
3399 3438
@@ -3401,12 +3440,12 @@ If S is non-nil, it will be used as the quit reason."
3401 "Choose a part reason based on S (a string)." 3440 "Choose a part reason based on S (a string)."
3402 (when (featurep 'xemacs) (require 'poe)) 3441 (when (featurep 'xemacs) (require 'poe))
3403 (let ((res (car (assoc-default (or s "") 3442 (let ((res (car (assoc-default (or s "")
3404 erc-part-reason-various-alist 'string-match)))) 3443 erc-part-reason-various-alist 'string-match))))
3405 (cond 3444 (cond
3406 ((functionp res) (funcall res)) 3445 ((functionp res) (funcall res))
3407 ((stringp res) res) 3446 ((stringp res) res)
3408 (s s) 3447 (s s)
3409 (t (erc-part-reason-normal))))) 3448 (t (erc-quit/part-reason-default)))))
3410 3449
3411(defun erc-cmd-QUIT (reason) 3450(defun erc-cmd-QUIT (reason)
3412 "Disconnect from the current server. 3451 "Disconnect from the current server.
@@ -3417,28 +3456,28 @@ the message given by REASON."
3417 (cond 3456 (cond
3418 ((string-match "^\\s-*\\(.*\\)$" reason) 3457 ((string-match "^\\s-*\\(.*\\)$" reason)
3419 (let* ((s (match-string 1 reason)) 3458 (let* ((s (match-string 1 reason))
3420 (buffer (erc-server-buffer)) 3459 (buffer (erc-server-buffer))
3421 (reason (funcall erc-quit-reason (if (equal s "") nil s))) 3460 (reason (funcall erc-quit-reason (if (equal s "") nil s)))
3422 server-proc) 3461 server-proc)
3423 (with-current-buffer (if (and buffer 3462 (with-current-buffer (if (and buffer
3424 (bufferp buffer)) 3463 (bufferp buffer))
3425 buffer 3464 buffer
3426 (current-buffer)) 3465 (current-buffer))
3427 (erc-log (format "cmd: QUIT: %s" reason)) 3466 (erc-log (format "cmd: QUIT: %s" reason))
3428 (setq erc-server-quitting t) 3467 (setq erc-server-quitting t)
3429 (erc-set-active-buffer (erc-server-buffer)) 3468 (erc-set-active-buffer (erc-server-buffer))
3430 (setq server-proc erc-server-process) 3469 (setq server-proc erc-server-process)
3431 (erc-server-send (format "QUIT :%s" reason))) 3470 (erc-server-send (format "QUIT :%s" reason)))
3432 (run-hook-with-args 'erc-quit-hook server-proc) 3471 (run-hook-with-args 'erc-quit-hook server-proc)
3433 (when erc-kill-queries-on-quit 3472 (when erc-kill-queries-on-quit
3434 (erc-kill-query-buffers server-proc)) 3473 (erc-kill-query-buffers server-proc))
3435 ;; if the process has not been killed within 4 seconds, kill it 3474 ;; if the process has not been killed within 4 seconds, kill it
3436 (run-at-time 4 nil 3475 (run-at-time 4 nil
3437 (lambda (proc) 3476 (lambda (proc)
3438 (when (and (processp proc) 3477 (when (and (processp proc)
3439 (memq (process-status proc) '(run open))) 3478 (memq (process-status proc) '(run open)))
3440 (delete-process proc))) 3479 (delete-process proc)))
3441 server-proc)) 3480 server-proc))
3442 t) 3481 t)
3443 (t nil))) 3482 (t nil)))
3444 3483
@@ -3451,7 +3490,7 @@ the message given by REASON."
3451(defun erc-cmd-GQUIT (reason) 3490(defun erc-cmd-GQUIT (reason)
3452 "Disconnect from all servers at once with the same quit REASON." 3491 "Disconnect from all servers at once with the same quit REASON."
3453 (erc-with-all-buffers-of-server nil #'erc-open-server-buffer-p 3492 (erc-with-all-buffers-of-server nil #'erc-open-server-buffer-p
3454 (erc-cmd-QUIT reason)) 3493 (erc-cmd-QUIT reason))
3455 (when erc-kill-queries-on-quit 3494 (when erc-kill-queries-on-quit
3456 ;; if the query buffers have not been killed within 4 seconds, 3495 ;; if the query buffers have not been killed within 4 seconds,
3457 ;; kill them 3496 ;; kill them
@@ -3459,8 +3498,8 @@ the message given by REASON."
3459 4 nil 3498 4 nil
3460 (lambda () 3499 (lambda ()
3461 (dolist (buffer (erc-buffer-list (lambda (buf) 3500 (dolist (buffer (erc-buffer-list (lambda (buf)
3462 (not (erc-server-buffer-p buf))))) 3501 (not (erc-server-buffer-p buf)))))
3463 (kill-buffer buffer))))) 3502 (kill-buffer buffer)))))
3464 t) 3503 t)
3465 3504
3466(defalias 'erc-cmd-GQ 'erc-cmd-GQUIT) 3505(defalias 'erc-cmd-GQ 'erc-cmd-GQUIT)
@@ -3470,7 +3509,7 @@ the message given by REASON."
3470(defun erc-cmd-RECONNECT () 3509(defun erc-cmd-RECONNECT ()
3471 "Try to reconnect to the current IRC server." 3510 "Try to reconnect to the current IRC server."
3472 (let ((buffer (erc-server-buffer)) 3511 (let ((buffer (erc-server-buffer))
3473 (process nil)) 3512 (process nil))
3474 (unless (buffer-live-p buffer) 3513 (unless (buffer-live-p buffer)
3475 (setq buffer (current-buffer))) 3514 (setq buffer (current-buffer)))
3476 (with-current-buffer buffer 3515 (with-current-buffer buffer
@@ -3479,8 +3518,8 @@ the message given by REASON."
3479 (setq erc-server-reconnect-count 0) 3518 (setq erc-server-reconnect-count 0)
3480 (setq process (get-buffer-process (erc-server-buffer))) 3519 (setq process (get-buffer-process (erc-server-buffer)))
3481 (if process 3520 (if process
3482 (delete-process process) 3521 (delete-process process)
3483 (erc-server-reconnect)) 3522 (erc-server-reconnect))
3484 (setq erc-server-reconnecting nil))) 3523 (setq erc-server-reconnecting nil)))
3485 t) 3524 t)
3486(put 'erc-cmd-RECONNECT 'process-not-needed t) 3525(put 'erc-cmd-RECONNECT 'process-not-needed t)
@@ -3500,55 +3539,54 @@ the message given by REASON."
3500 3539
3501(defun erc-cmd-SV () 3540(defun erc-cmd-SV ()
3502 "Say the current ERC and Emacs version into channel." 3541 "Say the current ERC and Emacs version into channel."
3503 (erc-send-message (format "I'm using ERC %s with %s %s (%s%s) of %s." 3542 (erc-send-message (format "I'm using ERC with %s %s (%s%s) of %s."
3504 erc-version-string 3543 (if (featurep 'xemacs) "XEmacs" "GNU Emacs")
3505 (if (featurep 'xemacs) "XEmacs" "GNU Emacs") 3544 emacs-version
3506 emacs-version 3545 system-configuration
3507 system-configuration 3546 (concat
3508 (concat 3547 (cond ((featurep 'motif)
3509 (cond ((featurep 'motif) 3548 (concat ", " (substring
3510 (concat ", " (substring 3549 motif-version-string 4)))
3511 motif-version-string 4))) 3550 ((featurep 'gtk)
3512 ((featurep 'gtk) 3551 (concat ", GTK+ Version "
3513 (concat ", GTK+ Version " 3552 gtk-version-string))
3514 gtk-version-string)) 3553 ((featurep 'x-toolkit) ", X toolkit")
3515 ((featurep 'x-toolkit) ", X toolkit") 3554 (t ""))
3516 (t "")) 3555 (if (and (boundp 'x-toolkit-scroll-bars)
3517 (if (and (boundp 'x-toolkit-scroll-bars) 3556 (memq x-toolkit-scroll-bars
3518 (memq x-toolkit-scroll-bars 3557 '(xaw xaw3d)))
3519 '(xaw xaw3d))) 3558 (format ", %s scroll bars"
3520 (format ", %s scroll bars" 3559 (capitalize (symbol-name
3521 (capitalize (symbol-name 3560 x-toolkit-scroll-bars)))
3522 x-toolkit-scroll-bars))) 3561 "")
3523 "") 3562 (if (featurep 'multi-tty) ", multi-tty" ""))
3524 (if (featurep 'multi-tty) ", multi-tty" "")) 3563 erc-emacs-build-time))
3525 erc-emacs-build-time))
3526 t) 3564 t)
3527 3565
3528(defun erc-cmd-SM () 3566(defun erc-cmd-SM ()
3529 "Say the current ERC modes into channel." 3567 "Say the current ERC modes into channel."
3530 (erc-send-message (format "I'm using the following modules: %s!" 3568 (erc-send-message (format "I'm using the following modules: %s!"
3531 (erc-modes))) 3569 (erc-modes)))
3532 t) 3570 t)
3533 3571
3534(defun erc-cmd-DEOP (&rest people) 3572(defun erc-cmd-DEOP (&rest people)
3535 "Remove the operator setting from user(s) given in PEOPLE." 3573 "Remove the operator setting from user(s) given in PEOPLE."
3536 (when (> (length people) 0) 3574 (when (> (length people) 0)
3537 (erc-server-send (concat "MODE " (erc-default-target) 3575 (erc-server-send (concat "MODE " (erc-default-target)
3538 " -" 3576 " -"
3539 (make-string (length people) ?o) 3577 (make-string (length people) ?o)
3540 " " 3578 " "
3541 (mapconcat 'identity people " "))) 3579 (mapconcat 'identity people " ")))
3542 t)) 3580 t))
3543 3581
3544(defun erc-cmd-OP (&rest people) 3582(defun erc-cmd-OP (&rest people)
3545 "Add the operator setting to users(s) given in PEOPLE." 3583 "Add the operator setting to users(s) given in PEOPLE."
3546 (when (> (length people) 0) 3584 (when (> (length people) 0)
3547 (erc-server-send (concat "MODE " (erc-default-target) 3585 (erc-server-send (concat "MODE " (erc-default-target)
3548 " +" 3586 " +"
3549 (make-string (length people) ?o) 3587 (make-string (length people) ?o)
3550 " " 3588 " "
3551 (mapconcat 'identity people " "))) 3589 (mapconcat 'identity people " ")))
3552 t)) 3590 t))
3553 3591
3554(defun erc-cmd-TIME (&optional line) 3592(defun erc-cmd-TIME (&optional line)
@@ -3574,7 +3612,7 @@ be displayed."
3574 ;; /topic #channel TOPIC 3612 ;; /topic #channel TOPIC
3575 ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-\\(.*\\)$" topic) 3613 ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-\\(.*\\)$" topic)
3576 (let ((ch (match-string 1 topic)) 3614 (let ((ch (match-string 1 topic))
3577 (topic (match-string 2 topic))) 3615 (topic (match-string 2 topic)))
3578 (erc-log (format "cmd: TOPIC [%s]: %s" ch topic)) 3616 (erc-log (format "cmd: TOPIC [%s]: %s" ch topic))
3579 (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch)) 3617 (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))
3580 t) 3618 t)
@@ -3591,12 +3629,12 @@ be displayed."
3591 ;; /topic TOPIC 3629 ;; /topic TOPIC
3592 ((string-match "^\\s-*\\(.*\\)$" topic) 3630 ((string-match "^\\s-*\\(.*\\)$" topic)
3593 (let ((ch (erc-default-target)) 3631 (let ((ch (erc-default-target))
3594 (topic (match-string 1 topic))) 3632 (topic (match-string 1 topic)))
3595 (if (and ch (erc-channel-p ch)) 3633 (if (and ch (erc-channel-p ch))
3596 (progn 3634 (progn
3597 (erc-log (format "cmd: TOPIC [%s]: %s" ch topic)) 3635 (erc-log (format "cmd: TOPIC [%s]: %s" ch topic))
3598 (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch)) 3636 (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))
3599 (erc-display-message nil 'error (current-buffer) 'no-target))) 3637 (erc-display-message nil 'error (current-buffer) 'no-target)))
3600 t) 3638 t)
3601 (t nil))) 3639 (t nil)))
3602(defalias 'erc-cmd-T 'erc-cmd-TOPIC) 3640(defalias 'erc-cmd-T 'erc-cmd-TOPIC)
@@ -3641,69 +3679,69 @@ or not the ban list has been requested from the server.")
3641 3679
3642The ban list is fetched from the server if necessary." 3680The ban list is fetched from the server if necessary."
3643 (let ((chnl (erc-default-target)) 3681 (let ((chnl (erc-default-target))
3644 (chnl-name (buffer-name))) 3682 (chnl-name (buffer-name)))
3645 3683
3646 (cond 3684 (cond
3647 ((not (erc-channel-p chnl)) 3685 ((not (erc-channel-p chnl))
3648 (erc-display-line (erc-make-notice "You're not on a channel\n") 3686 (erc-display-line (erc-make-notice "You're not on a channel\n")
3649 'active)) 3687 'active))
3650 3688
3651 ((not (get 'erc-channel-banlist 'received-from-server)) 3689 ((not (get 'erc-channel-banlist 'received-from-server))
3652 (let ((old-367-hook erc-server-367-functions)) 3690 (let ((old-367-hook erc-server-367-functions))
3653 (setq erc-server-367-functions 'erc-banlist-store 3691 (setq erc-server-367-functions 'erc-banlist-store
3654 erc-channel-banlist nil) 3692 erc-channel-banlist nil)
3655 ;; fetch the ban list then callback 3693 ;; fetch the ban list then callback
3656 (erc-with-server-buffer 3694 (erc-with-server-buffer
3657 (erc-once-with-server-event 3695 (erc-once-with-server-event
3658 368 3696 368
3659 (lambda (_proc _parsed) 3697 (lambda (_proc _parsed)
3660 (with-current-buffer chnl-name 3698 (with-current-buffer chnl-name
3661 (put 'erc-channel-banlist 'received-from-server t) 3699 (put 'erc-channel-banlist 'received-from-server t)
3662 (setq erc-server-367-functions old-367-hook) 3700 (setq erc-server-367-functions old-367-hook)
3663 (erc-cmd-BANLIST) 3701 (erc-cmd-BANLIST)
3664 t))) 3702 t)))
3665 (erc-server-send (format "MODE %s b" chnl))))) 3703 (erc-server-send (format "MODE %s b" chnl)))))
3666 3704
3667 ((null erc-channel-banlist) 3705 ((null erc-channel-banlist)
3668 (erc-display-line (erc-make-notice 3706 (erc-display-line (erc-make-notice
3669 (format "No bans for channel: %s\n" chnl)) 3707 (format "No bans for channel: %s\n" chnl))
3670 'active) 3708 'active)
3671 (put 'erc-channel-banlist 'received-from-server nil)) 3709 (put 'erc-channel-banlist 'received-from-server nil))
3672 3710
3673 (t 3711 (t
3674 (let* ((erc-fill-column (or (and (boundp 'erc-fill-column) 3712 (let* ((erc-fill-column (or (and (boundp 'erc-fill-column)
3675 erc-fill-column) 3713 erc-fill-column)
3676 (and (boundp 'fill-column) 3714 (and (boundp 'fill-column)
3677 fill-column) 3715 fill-column)
3678 (1- (window-width)))) 3716 (1- (window-width))))
3679 (separator (make-string erc-fill-column ?=)) 3717 (separator (make-string erc-fill-column ?=))
3680 (fmt (concat 3718 (fmt (concat
3681 "%-" (number-to-string (/ erc-fill-column 2)) "s" 3719 "%-" (number-to-string (/ erc-fill-column 2)) "s"
3682 "%" (number-to-string (/ erc-fill-column 2)) "s"))) 3720 "%" (number-to-string (/ erc-fill-column 2)) "s")))
3683 3721
3684 (erc-display-line 3722 (erc-display-line
3685 (erc-make-notice (format "Ban list for channel: %s\n" 3723 (erc-make-notice (format "Ban list for channel: %s\n"
3686 (erc-default-target))) 3724 (erc-default-target)))
3687 'active) 3725 'active)
3688 3726
3689 (erc-display-line separator 'active) 3727 (erc-display-line separator 'active)
3690 (erc-display-line (format fmt "Ban Mask" "Banned By") 'active) 3728 (erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
3691 (erc-display-line separator 'active) 3729 (erc-display-line separator 'active)
3692 3730
3693 (mapc 3731 (mapc
3694 (lambda (x) 3732 (lambda (x)
3695 (erc-display-line 3733 (erc-display-line
3696 (format fmt 3734 (format fmt
3697 (truncate-string-to-width (cdr x) (/ erc-fill-column 2)) 3735 (truncate-string-to-width (cdr x) (/ erc-fill-column 2))
3698 (if (car x) 3736 (if (car x)
3699 (truncate-string-to-width (car x) (/ erc-fill-column 2)) 3737 (truncate-string-to-width (car x) (/ erc-fill-column 2))
3700 "")) 3738 ""))
3701 'active)) 3739 'active))
3702 erc-channel-banlist) 3740 erc-channel-banlist)
3703 3741
3704 (erc-display-line (erc-make-notice "End of Ban list") 3742 (erc-display-line (erc-make-notice "End of Ban list")
3705 'active) 3743 'active)
3706 (put 'erc-channel-banlist 'received-from-server nil))))) 3744 (put 'erc-channel-banlist 'received-from-server nil)))))
3707 t) 3745 t)
3708 3746
3709(defalias 'erc-cmd-BL 'erc-cmd-BANLIST) 3747(defalias 'erc-cmd-BL 'erc-cmd-BANLIST)
@@ -3722,31 +3760,31 @@ Unban all currently banned users in the current channel."
3722 3760
3723 ((not (get 'erc-channel-banlist 'received-from-server)) 3761 ((not (get 'erc-channel-banlist 'received-from-server))
3724 (let ((old-367-hook erc-server-367-functions)) 3762 (let ((old-367-hook erc-server-367-functions))
3725 (setq erc-server-367-functions 'erc-banlist-store) 3763 (setq erc-server-367-functions 'erc-banlist-store)
3726 ;; fetch the ban list then callback 3764 ;; fetch the ban list then callback
3727 (erc-with-server-buffer 3765 (erc-with-server-buffer
3728 (erc-once-with-server-event 3766 (erc-once-with-server-event
3729 368 3767 368
3730 (lambda (_proc _parsed) 3768 (lambda (_proc _parsed)
3731 (with-current-buffer chnl 3769 (with-current-buffer chnl
3732 (put 'erc-channel-banlist 'received-from-server t) 3770 (put 'erc-channel-banlist 'received-from-server t)
3733 (setq erc-server-367-functions old-367-hook) 3771 (setq erc-server-367-functions old-367-hook)
3734 (erc-cmd-MASSUNBAN) 3772 (erc-cmd-MASSUNBAN)
3735 t))) 3773 t)))
3736 (erc-server-send (format "MODE %s b" chnl))))) 3774 (erc-server-send (format "MODE %s b" chnl)))))
3737 3775
3738 (t (let ((bans (mapcar 'cdr erc-channel-banlist))) 3776 (t (let ((bans (mapcar 'cdr erc-channel-banlist)))
3739 (when bans 3777 (when bans
3740 ;; Glob the bans into groups of three, and carry out the unban. 3778 ;; Glob the bans into groups of three, and carry out the unban.
3741 ;; eg. /mode #foo -bbb a*!*@* b*!*@* c*!*@* 3779 ;; eg. /mode #foo -bbb a*!*@* b*!*@* c*!*@*
3742 (mapc 3780 (mapc
3743 (lambda (x) 3781 (lambda (x)
3744 (erc-server-send 3782 (erc-server-send
3745 (format "MODE %s -%s %s" (erc-default-target) 3783 (format "MODE %s -%s %s" (erc-default-target)
3746 (make-string (length x) ?b) 3784 (make-string (length x) ?b)
3747 (mapconcat 'identity x " ")))) 3785 (mapconcat 'identity x " "))))
3748 (erc-group-list bans 3)))) 3786 (erc-group-list bans 3))))
3749 t)))) 3787 t))))
3750 3788
3751(defalias 'erc-cmd-MUB 'erc-cmd-MASSUNBAN) 3789(defalias 'erc-cmd-MUB 'erc-cmd-MASSUNBAN)
3752 3790
@@ -3770,12 +3808,12 @@ text again."
3770 (erc-set-active-buffer (current-buffer)) 3808 (erc-set-active-buffer (current-buffer))
3771 (save-excursion 3809 (save-excursion
3772 (let* ((cb (current-buffer)) 3810 (let* ((cb (current-buffer))
3773 (buf (generate-new-buffer erc-grab-buffer-name)) 3811 (buf (generate-new-buffer erc-grab-buffer-name))
3774 (region (buffer-substring start end)) 3812 (region (buffer-substring start end))
3775 (lines (erc-split-multiline-safe region))) 3813 (lines (erc-split-multiline-safe region)))
3776 (set-buffer buf) 3814 (set-buffer buf)
3777 (dolist (line lines) 3815 (dolist (line lines)
3778 (insert (concat line "\n"))) 3816 (insert (concat line "\n")))
3779 (set-buffer cb) 3817 (set-buffer cb)
3780 (switch-to-buffer-other-window buf))) 3818 (switch-to-buffer-other-window buf)))
3781 (message "erc-grab-region doesn't grab colors etc. anymore. If you use this, please tell the maintainers.") 3819 (message "erc-grab-region doesn't grab colors etc. anymore. If you use this, please tell the maintainers.")
@@ -3791,8 +3829,8 @@ If POS is nil, PROMPT will be displayed at `point'.
3791If FACE is non-nil, it will be used to propertize the prompt. If it is nil, 3829If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
3792`erc-prompt-face' will be used." 3830`erc-prompt-face' will be used."
3793 (let* ((prompt (or prompt (erc-prompt))) 3831 (let* ((prompt (or prompt (erc-prompt)))
3794 (l (length prompt)) 3832 (l (length prompt))
3795 (ob (current-buffer))) 3833 (ob (current-buffer)))
3796 ;; We cannot use save-excursion because we move point, therefore 3834 ;; We cannot use save-excursion because we move point, therefore
3797 ;; we resort to the ol' ob trick to restore this. 3835 ;; we resort to the ol' ob trick to restore this.
3798 (when (and buffer (bufferp buffer)) 3836 (when (and buffer (bufferp buffer))
@@ -3804,20 +3842,20 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
3804 (setq pos (or pos (point))) 3842 (setq pos (or pos (point)))
3805 (goto-char pos) 3843 (goto-char pos)
3806 (when (> l 0) 3844 (when (> l 0)
3807 ;; Do not extend the text properties when typing at the end 3845 ;; Do not extend the text properties when typing at the end
3808 ;; of the prompt, but stuff typed in front of the prompt 3846 ;; of the prompt, but stuff typed in front of the prompt
3809 ;; shall remain part of the prompt. 3847 ;; shall remain part of the prompt.
3810 (setq prompt (erc-propertize prompt 3848 (setq prompt (erc-propertize prompt
3811 'start-open t ; XEmacs 3849 'start-open t ; XEmacs
3812 'rear-nonsticky t ; Emacs 3850 'rear-nonsticky t ; Emacs
3813 'erc-prompt t 3851 'erc-prompt t
3814 'field t 3852 'field t
3815 'front-sticky t 3853 'front-sticky t
3816 'read-only t)) 3854 'read-only t))
3817 (erc-put-text-property 0 (1- (length prompt)) 3855 (erc-put-text-property 0 (1- (length prompt))
3818 'face (or face 'erc-prompt-face) 3856 'face (or face 'erc-prompt-face)
3819 prompt) 3857 prompt)
3820 (insert prompt)) 3858 (insert prompt))
3821 ;; Set the input marker 3859 ;; Set the input marker
3822 (set-marker erc-input-marker (point))) 3860 (set-marker erc-input-marker (point)))
3823 3861
@@ -3837,11 +3875,12 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
3837 "Read input from the minibuffer." 3875 "Read input from the minibuffer."
3838 (interactive) 3876 (interactive)
3839 (let ((minibuffer-allow-text-properties t) 3877 (let ((minibuffer-allow-text-properties t)
3840 (read-map minibuffer-local-map)) 3878 (read-map minibuffer-local-map))
3841 (insert (read-from-minibuffer "Message: " 3879 (insert (read-from-minibuffer "Message: "
3842 (string (if (featurep 'xemacs) 3880 (string (if (featurep 'xemacs)
3843 last-command-char 3881 last-command-char
3844 last-command-event)) read-map)) 3882 last-command-event))
3883 read-map))
3845 (erc-send-current-line))) 3884 (erc-send-current-line)))
3846 3885
3847(defvar erc-action-history-list () 3886(defvar erc-action-history-list ()
@@ -3852,9 +3891,9 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
3852 (interactive "") 3891 (interactive "")
3853 (erc-set-active-buffer (current-buffer)) 3892 (erc-set-active-buffer (current-buffer))
3854 (let ((action (read-from-minibuffer 3893 (let ((action (read-from-minibuffer
3855 "Action: " nil nil nil 'erc-action-history-list))) 3894 "Action: " nil nil nil 'erc-action-history-list)))
3856 (if (not (string-match "^\\s-*$" action)) 3895 (if (not (string-match "^\\s-*$" action))
3857 (erc-send-action (erc-default-target) action)))) 3896 (erc-send-action (erc-default-target) action))))
3858 3897
3859(defun erc-join-channel (channel &optional key) 3898(defun erc-join-channel (channel &optional key)
3860 "Join CHANNEL. 3899 "Join CHANNEL.
@@ -3863,9 +3902,9 @@ If `point' is at the beginning of a channel name, use that as default."
3863 (interactive 3902 (interactive
3864 (list 3903 (list
3865 (let ((chnl (if (looking-at "\\([&#+!][^ \n]+\\)") (match-string 1) "")) 3904 (let ((chnl (if (looking-at "\\([&#+!][^ \n]+\\)") (match-string 1) ""))
3866 (table (when (erc-server-buffer-live-p) 3905 (table (when (erc-server-buffer-live-p)
3867 (set-buffer (process-buffer erc-server-process)) 3906 (set-buffer (process-buffer erc-server-process))
3868 erc-channel-list))) 3907 erc-channel-list)))
3869 (completing-read "Join channel: " table nil nil nil nil chnl)) 3908 (completing-read "Join channel: " table nil nil nil nil chnl))
3870 (when (or current-prefix-arg erc-prompt-for-channel-key) 3909 (when (or current-prefix-arg erc-prompt-for-channel-key)
3871 (read-from-minibuffer "Channel key (RET for none): " nil)))) 3910 (read-from-minibuffer "Channel key (RET for none): " nil))))
@@ -3876,9 +3915,9 @@ If `point' is at the beginning of a channel name, use that as default."
3876 (interactive 3915 (interactive
3877 (list 3916 (list
3878 (if (and (boundp 'reason) (stringp reason) (not (string= reason ""))) 3917 (if (and (boundp 'reason) (stringp reason) (not (string= reason "")))
3879 reason 3918 reason
3880 (read-from-minibuffer (concat "Reason for leaving " (erc-default-target) 3919 (read-from-minibuffer (concat "Reason for leaving " (erc-default-target)
3881 ": "))))) 3920 ": ")))))
3882 (erc-cmd-PART (concat (erc-default-target)" " reason))) 3921 (erc-cmd-PART (concat (erc-default-target)" " reason)))
3883 3922
3884(defun erc-set-topic (topic) 3923(defun erc-set-topic (topic)
@@ -3889,8 +3928,8 @@ If `point' is at the beginning of a channel name, use that as default."
3889 (concat "Set topic of " (erc-default-target) ": ") 3928 (concat "Set topic of " (erc-default-target) ": ")
3890 (when erc-channel-topic 3929 (when erc-channel-topic
3891 (let ((ss (split-string erc-channel-topic "\C-o"))) 3930 (let ((ss (split-string erc-channel-topic "\C-o")))
3892 (cons (apply 'concat (if (cdr ss) (butlast ss) ss)) 3931 (cons (apply 'concat (if (cdr ss) (butlast ss) ss))
3893 0)))))) 3932 0))))))
3894 (let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter 3933 (let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter
3895 (erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list))))) 3934 (erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list)))))
3896 3935
@@ -3898,31 +3937,31 @@ If `point' is at the beginning of a channel name, use that as default."
3898 "Set a LIMIT for the current channel. Remove limit if nil. 3937 "Set a LIMIT for the current channel. Remove limit if nil.
3899Prompt for one if called interactively." 3938Prompt for one if called interactively."
3900 (interactive (list (read-from-minibuffer 3939 (interactive (list (read-from-minibuffer
3901 (format "Limit for %s (RET to remove limit): " 3940 (format "Limit for %s (RET to remove limit): "
3902 (erc-default-target))))) 3941 (erc-default-target)))))
3903 (let ((tgt (erc-default-target))) 3942 (let ((tgt (erc-default-target)))
3904 (erc-server-send (if (and limit (>= (length limit) 1)) 3943 (erc-server-send (if (and limit (>= (length limit) 1))
3905 (format "MODE %s +l %s" tgt limit) 3944 (format "MODE %s +l %s" tgt limit)
3906 (format "MODE %s -l" tgt))))) 3945 (format "MODE %s -l" tgt)))))
3907 3946
3908(defun erc-set-channel-key (&optional key) 3947(defun erc-set-channel-key (&optional key)
3909 "Set a KEY for the current channel. Remove key if nil. 3948 "Set a KEY for the current channel. Remove key if nil.
3910Prompt for one if called interactively." 3949Prompt for one if called interactively."
3911 (interactive (list (read-from-minibuffer 3950 (interactive (list (read-from-minibuffer
3912 (format "Key for %s (RET to remove key): " 3951 (format "Key for %s (RET to remove key): "
3913 (erc-default-target))))) 3952 (erc-default-target)))))
3914 (let ((tgt (erc-default-target))) 3953 (let ((tgt (erc-default-target)))
3915 (erc-server-send (if (and key (>= (length key) 1)) 3954 (erc-server-send (if (and key (>= (length key) 1))
3916 (format "MODE %s +k %s" tgt key) 3955 (format "MODE %s +k %s" tgt key)
3917 (format "MODE %s -k" tgt))))) 3956 (format "MODE %s -k" tgt)))))
3918 3957
3919(defun erc-quit-server (reason) 3958(defun erc-quit-server (reason)
3920 "Disconnect from current server after prompting for REASON. 3959 "Disconnect from current server after prompting for REASON.
3921`erc-quit-reason' works with this just like with `erc-cmd-QUIT'." 3960`erc-quit-reason' works with this just like with `erc-cmd-QUIT'."
3922 (interactive (list (read-from-minibuffer 3961 (interactive (list (read-from-minibuffer
3923 (format "Reason for quitting %s: " 3962 (format "Reason for quitting %s: "
3924 (or erc-server-announced-name 3963 (or erc-server-announced-name
3925 erc-session-server))))) 3964 erc-session-server)))))
3926 (erc-cmd-QUIT reason)) 3965 (erc-cmd-QUIT reason))
3927 3966
3928;; Movement of point 3967;; Movement of point
@@ -3941,10 +3980,10 @@ This places `point' just after the prompt, or at the beginning of the line."
3941 "Kill current input line using `erc-bol' followed by `kill-line'." 3980 "Kill current input line using `erc-bol' followed by `kill-line'."
3942 (interactive) 3981 (interactive)
3943 (when (and (erc-bol) 3982 (when (and (erc-bol)
3944 (/= (point) (point-max))) ;; Prevent a (ding) and an error when 3983 (/= (point) (point-max))) ;; Prevent a (ding) and an error when
3945 ;; there's nothing to kill 3984 ;; there's nothing to kill
3946 (if (boundp 'erc-input-ring-index) 3985 (if (boundp 'erc-input-ring-index)
3947 (setq erc-input-ring-index nil)) 3986 (setq erc-input-ring-index nil))
3948 (kill-line))) 3987 (kill-line)))
3949 3988
3950(defun erc-complete-word-at-point () 3989(defun erc-complete-word-at-point ()
@@ -3954,7 +3993,7 @@ This places `point' just after the prompt, or at the beginning of the line."
3954 3993
3955;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3994;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3956;; 3995;;
3957;; IRC SERVER INPUT HANDLING 3996;; IRC SERVER INPUT HANDLING
3958;; 3997;;
3959;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3998;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3960 3999
@@ -3964,7 +4003,7 @@ This places `point' just after the prompt, or at the beginning of the line."
3964; experiment area. 4003; experiment area.
3965 4004
3966(defcustom erc-default-server-hook '(erc-debug-missing-hooks 4005(defcustom erc-default-server-hook '(erc-debug-missing-hooks
3967 erc-default-server-handler) 4006 erc-default-server-handler)
3968 "Default for server messages which aren't covered by `erc-server-hooks'." 4007 "Default for server messages which aren't covered by `erc-server-hooks'."
3969 :group 'erc-server-hooks 4008 :group 'erc-server-hooks
3970 :type 'hook) 4009 :type 'hook)
@@ -3979,9 +4018,9 @@ Displays PROC and PARSED appropriately using `erc-display-message'."
3979 'identity 4018 'identity
3980 (let (res) 4019 (let (res)
3981 (mapc #'(lambda (x) 4020 (mapc #'(lambda (x)
3982 (if (stringp x) 4021 (if (stringp x)
3983 (setq res (append res (list x))))) 4022 (setq res (append res (list x)))))
3984 parsed) 4023 parsed)
3985 res) 4024 res)
3986 " "))) 4025 " ")))
3987 4026
@@ -4003,18 +4042,18 @@ See `erc-default-server-hook'."
4003To change how this query window is displayed, use `let' to bind 4042To change how this query window is displayed, use `let' to bind
4004`erc-join-buffer' before calling this." 4043`erc-join-buffer' before calling this."
4005 (unless (and server 4044 (unless (and server
4006 (buffer-live-p server) 4045 (buffer-live-p server)
4007 (set-buffer server)) 4046 (set-buffer server))
4008 (error "Couldn't switch to server buffer")) 4047 (error "Couldn't switch to server buffer"))
4009 (let ((buf (erc-open erc-session-server 4048 (let ((buf (erc-open erc-session-server
4010 erc-session-port 4049 erc-session-port
4011 (erc-current-nick) 4050 (erc-current-nick)
4012 erc-session-user-full-name 4051 erc-session-user-full-name
4013 nil 4052 nil
4014 nil 4053 nil
4015 (list target) 4054 (list target)
4016 target 4055 target
4017 erc-server-process))) 4056 erc-server-process)))
4018 (unless buf 4057 (unless buf
4019 (error "Couldn't open query window")) 4058 (error "Couldn't open query window"))
4020 (erc-update-mode-line) 4059 (erc-update-mode-line)
@@ -4030,12 +4069,12 @@ a new window, but not to select it. See the documentation for
4030`erc-join-buffer' for a description of the available choices." 4069`erc-join-buffer' for a description of the available choices."
4031 :group 'erc-query 4070 :group 'erc-query
4032 :type '(choice (const :tag "Don't create query window" nil) 4071 :type '(choice (const :tag "Don't create query window" nil)
4033 (const :tag "Split window and select" window) 4072 (const :tag "Split window and select" window)
4034 (const :tag "Split window, don't select" window-noselect) 4073 (const :tag "Split window, don't select" window-noselect)
4035 (const :tag "New frame" frame) 4074 (const :tag "New frame" frame)
4036 (const :tag "Bury in new buffer" bury) 4075 (const :tag "Bury in new buffer" bury)
4037 (const :tag "Use current buffer" buffer) 4076 (const :tag "Use current buffer" buffer)
4038 (const :tag "Use current buffer" t))) 4077 (const :tag "Use current buffer" t)))
4039 4078
4040(defcustom erc-query-on-unjoined-chan-privmsg t 4079(defcustom erc-query-on-unjoined-chan-privmsg t
4041 "If non-nil create query buffer on receiving any PRIVMSG at all. 4080 "If non-nil create query buffer on receiving any PRIVMSG at all.
@@ -4069,15 +4108,17 @@ unmodified if nothing can be removed.
4069E.g. \"Read error to Nick [user@some.host]: 110\" would be shortened to 4108E.g. \"Read error to Nick [user@some.host]: 110\" would be shortened to
4070\"Read error: 110\". The same applies for \"Ping Timeout\"." 4109\"Read error: 110\". The same applies for \"Ping Timeout\"."
4071 (setq nick (regexp-quote nick) 4110 (setq nick (regexp-quote nick)
4072 login (regexp-quote login) 4111 login (regexp-quote login)
4073 host (regexp-quote host)) 4112 host (regexp-quote host))
4074 (or (when (string-match (concat "^\\(Read error\\) to " 4113 (or (when (string-match (concat "^\\(Read error\\) to "
4075 nick "\\[" host "\\]: " 4114 nick "\\[" host "\\]: "
4076 "\\(.+\\)$") reason) 4115 "\\(.+\\)$")
4077 (concat (match-string 1 reason) ": " (match-string 2 reason))) 4116 reason)
4117 (concat (match-string 1 reason) ": " (match-string 2 reason)))
4078 (when (string-match (concat "^\\(Ping timeout\\) for " 4118 (when (string-match (concat "^\\(Ping timeout\\) for "
4079 nick "\\[" host "\\]$") reason) 4119 nick "\\[" host "\\]$")
4080 (match-string 1 reason)) 4120 reason)
4121 (match-string 1 reason))
4081 reason)) 4122 reason))
4082 4123
4083(defun erc-nickname-in-use (nick reason) 4124(defun erc-nickname-in-use (nick reason)
@@ -4085,40 +4126,40 @@ E.g. \"Read error to Nick [user@some.host]: 110\" would be shortened to
4085 4126
4086See also `erc-display-error-notice'." 4127See also `erc-display-error-notice'."
4087 (if (or (not erc-try-new-nick-p) 4128 (if (or (not erc-try-new-nick-p)
4088 ;; how many default-nicks are left + one more try... 4129 ;; how many default-nicks are left + one more try...
4089 (eq erc-nick-change-attempt-count 4130 (eq erc-nick-change-attempt-count
4090 (if (consp erc-nick) 4131 (if (consp erc-nick)
4091 (+ (length erc-nick) 1) 4132 (+ (length erc-nick) 1)
4092 1))) 4133 1)))
4093 (erc-display-error-notice 4134 (erc-display-error-notice
4094 nil 4135 nil
4095 (format "Nickname %s is %s, try another." nick reason)) 4136 (format "Nickname %s is %s, try another." nick reason))
4096 (setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1)) 4137 (setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1))
4097 (let ((newnick (nth 1 erc-default-nicks)) 4138 (let ((newnick (nth 1 erc-default-nicks))
4098 (nicklen (cdr (assoc "NICKLEN" 4139 (nicklen (cdr (assoc "NICKLEN"
4099 (erc-with-server-buffer 4140 (erc-with-server-buffer
4100 erc-server-parameters))))) 4141 erc-server-parameters)))))
4101 (setq erc-bad-nick t) 4142 (setq erc-bad-nick t)
4102 ;; try to use a different nick 4143 ;; try to use a different nick
4103 (if erc-default-nicks 4144 (if erc-default-nicks
4104 (setq erc-default-nicks (cdr erc-default-nicks))) 4145 (setq erc-default-nicks (cdr erc-default-nicks)))
4105 (if (not newnick) 4146 (if (not newnick)
4106 (setq newnick (concat (truncate-string-to-width 4147 (setq newnick (concat (truncate-string-to-width
4107 nick 4148 nick
4108 (if (and erc-server-connected nicklen) 4149 (if (and erc-server-connected nicklen)
4109 (- (string-to-number nicklen) 4150 (- (string-to-number nicklen)
4110 (length erc-nick-uniquifier)) 4151 (length erc-nick-uniquifier))
4111 ;; rfc2812 max nick length = 9 4152 ;; rfc2812 max nick length = 9
4112 ;; we must assume this is the 4153 ;; we must assume this is the
4113 ;; server's setting if we haven't 4154 ;; server's setting if we haven't
4114 ;; established a connection yet 4155 ;; established a connection yet
4115 (- 9 (length erc-nick-uniquifier)))) 4156 (- 9 (length erc-nick-uniquifier))))
4116 erc-nick-uniquifier))) 4157 erc-nick-uniquifier)))
4117 (erc-cmd-NICK newnick) 4158 (erc-cmd-NICK newnick)
4118 (erc-display-error-notice 4159 (erc-display-error-notice
4119 nil 4160 nil
4120 (format "Nickname %s is %s, trying %s" 4161 (format "Nickname %s is %s, trying %s"
4121 nick reason newnick))))) 4162 nick reason newnick)))))
4122 4163
4123;;; Server messages 4164;;; Server messages
4124 4165
@@ -4142,21 +4183,21 @@ and as second argument the event parsed as a vector."
4142 "Put this on `erc-server-PRIVMSG-functions'." 4183 "Put this on `erc-server-PRIVMSG-functions'."
4143 (when erc-auto-query 4184 (when erc-auto-query
4144 (let* ((nick (car (erc-parse-user (erc-response.sender parsed)))) 4185 (let* ((nick (car (erc-parse-user (erc-response.sender parsed))))
4145 (target (car (erc-response.command-args parsed))) 4186 (target (car (erc-response.command-args parsed)))
4146 (msg (erc-response.contents parsed)) 4187 (msg (erc-response.contents parsed))
4147 (query (if (not erc-query-on-unjoined-chan-privmsg) 4188 (query (if (not erc-query-on-unjoined-chan-privmsg)
4148 nick 4189 nick
4149 (if (erc-current-nick-p target) 4190 (if (erc-current-nick-p target)
4150 nick 4191 nick
4151 target)))) 4192 target))))
4152 (and (not (erc-ignored-user-p (erc-response.sender parsed))) 4193 (and (not (erc-ignored-user-p (erc-response.sender parsed)))
4153 (or erc-query-on-unjoined-chan-privmsg 4194 (or erc-query-on-unjoined-chan-privmsg
4154 (string= target (erc-current-nick))) 4195 (string= target (erc-current-nick)))
4155 (not (erc-get-buffer query proc)) 4196 (not (erc-get-buffer query proc))
4156 (not (erc-is-message-ctcp-and-not-action-p msg)) 4197 (not (erc-is-message-ctcp-and-not-action-p msg))
4157 (let ((erc-query-display erc-auto-query)) 4198 (let ((erc-query-display erc-auto-query))
4158 (erc-cmd-QUERY query)) 4199 (erc-cmd-QUERY query))
4159 nil)))) 4200 nil))))
4160 4201
4161(defun erc-is-message-ctcp-p (message) 4202(defun erc-is-message-ctcp-p (message)
4162 "Check if MESSAGE is a CTCP message or not." 4203 "Check if MESSAGE is a CTCP message or not."
@@ -4170,16 +4211,16 @@ and as second argument the event parsed as a vector."
4170(defun erc-format-privmessage (nick msg privp msgp) 4211(defun erc-format-privmessage (nick msg privp msgp)
4171 "Format a PRIVMSG in an insertable fashion." 4212 "Format a PRIVMSG in an insertable fashion."
4172 (let* ((mark-s (if msgp (if privp "*" "<") "-")) 4213 (let* ((mark-s (if msgp (if privp "*" "<") "-"))
4173 (mark-e (if msgp (if privp "*" ">") "-")) 4214 (mark-e (if msgp (if privp "*" ">") "-"))
4174 (str (format "%s%s%s %s" mark-s nick mark-e msg)) 4215 (str (format "%s%s%s %s" mark-s nick mark-e msg))
4175 (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) 4216 (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face))
4176 (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) 4217 (msg-face (if privp 'erc-direct-msg-face 'erc-default-face)))
4177 ;; add text properties to text before the nick, the nick and after the nick 4218 ;; add text properties to text before the nick, the nick and after the nick
4178 (erc-put-text-property 0 (length mark-s) 'face msg-face str) 4219 (erc-put-text-property 0 (length mark-s) 'face msg-face str)
4179 (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick)) 4220 (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick))
4180 'face nick-face str) 4221 'face nick-face str)
4181 (erc-put-text-property (+ (length mark-s) (length nick)) (length str) 4222 (erc-put-text-property (+ (length mark-s) (length nick)) (length str)
4182 'face msg-face str) 4223 'face msg-face str)
4183 str)) 4224 str))
4184 4225
4185(defcustom erc-format-nick-function 'erc-format-nick 4226(defcustom erc-format-nick-function 'erc-format-nick
@@ -4192,26 +4233,45 @@ and as second argument the event parsed as a vector."
4192See also `erc-format-nick-function'." 4233See also `erc-format-nick-function'."
4193 (when user (erc-server-user-nickname user))) 4234 (when user (erc-server-user-nickname user)))
4194 4235
4195(defun erc-format-@nick (&optional user channel-data) 4236(defun erc-get-user-mode-prefix (user)
4196 "Format the nickname of USER showing if USER is an operator or has voice.
4197Operators have \"@\" and users with voice have \"+\" as a prefix.
4198Use CHANNEL-DATA to determine op and voice status.
4199See also `erc-format-nick-function'."
4200 (when user 4237 (when user
4201 (let ((op (and channel-data (erc-channel-user-op channel-data) "@")) 4238 (cond ((erc-channel-user-owner-p user)
4202 (voice (and channel-data (erc-channel-user-voice channel-data) "+"))) 4239 (erc-propertize "~" 'help-echo "owner"))
4203 (concat voice op (erc-server-user-nickname user))))) 4240 ((erc-channel-user-admin-p user)
4241 (erc-propertize "&" 'help-echo "admin"))
4242 ((erc-channel-user-op-p user)
4243 (erc-propertize "@" 'help-echo "operator"))
4244 ((erc-channel-user-halfop-p user)
4245 (erc-propertize "%" 'help-echo "half-op"))
4246 ((erc-channel-user-voice-p user)
4247 (erc-propertize "+" 'help-echo "voice"))
4248 (t ""))))
4249
4250(defun erc-format-@nick (&optional user _channel-data)
4251 "Format the nickname of USER showing if USER has a voice, is an
4252operator, half-op, admin or owner. Owners have \"~\", admins have
4253\"&\", operators have \"@\" and users with voice have \"+\" as a
4254prefix. Use CHANNEL-DATA to determine op and voice status. See
4255also `erc-format-nick-function'."
4256 (when user
4257 (let ((nick (erc-server-user-nickname user)))
4258 (concat (erc-propertize
4259 (erc-get-user-mode-prefix nick)
4260 'face 'erc-nick-prefix-face)
4261 nick))))
4204 4262
4205(defun erc-format-my-nick () 4263(defun erc-format-my-nick ()
4206 "Return the beginning of this user's message, correctly propertized." 4264 "Return the beginning of this user's message, correctly propertized."
4207 (if erc-show-my-nick 4265 (if erc-show-my-nick
4208 (let ((open "<") 4266 (let* ((open "<")
4209 (close "> ") 4267 (close "> ")
4210 (nick (erc-current-nick))) 4268 (nick (erc-current-nick))
4211 (concat 4269 (mode (erc-get-user-mode-prefix nick)))
4212 (erc-propertize open 'face 'erc-default-face) 4270 (concat
4213 (erc-propertize nick 'face 'erc-my-nick-face) 4271 (erc-propertize open 'face 'erc-default-face)
4214 (erc-propertize close 'face 'erc-default-face))) 4272 (erc-propertize mode 'face 'erc-my-nick-prefix-face)
4273 (erc-propertize nick 'face 'erc-my-nick-face)
4274 (erc-propertize close 'face 'erc-default-face)))
4215 (let ((prefix "> ")) 4275 (let ((prefix "> "))
4216 (erc-propertize prefix 'face 'erc-default-face)))) 4276 (erc-propertize prefix 'face 'erc-default-face))))
4217 4277
@@ -4275,7 +4335,7 @@ See also: `erc-echo-notice-in-first-user-buffer',
4275`erc-buffer-list-with-nick'." 4335`erc-buffer-list-with-nick'."
4276 (let ((buffers (erc-buffer-list-with-nick sender erc-server-process))) 4336 (let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
4277 (if buffers 4337 (if buffers
4278 (progn (erc-display-message parsed nil buffers s) t) 4338 (progn (erc-display-message parsed nil buffers s) t)
4279 nil))) 4339 nil)))
4280 4340
4281(defun erc-echo-notice-in-user-and-target-buffers (s parsed buffer sender) 4341(defun erc-echo-notice-in-user-and-target-buffers (s parsed buffer sender)
@@ -4290,8 +4350,8 @@ See also: `erc-echo-notice-in-user-buffers',
4290`erc-buffer-list-with-nick'." 4350`erc-buffer-list-with-nick'."
4291 (let ((buffers (erc-buffer-list-with-nick sender erc-server-process))) 4351 (let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
4292 (unless (memq buffer buffers) (push buffer buffers)) 4352 (unless (memq buffer buffers) (push buffer buffers))
4293 (if buffers ;FIXME: How could it be nil? 4353 (if buffers ;FIXME: How could it be nil?
4294 (progn (erc-display-message parsed nil buffers s) t) 4354 (progn (erc-display-message parsed nil buffers s) t)
4295 nil))) 4355 nil)))
4296 4356
4297(defun erc-echo-notice-in-first-user-buffer (s parsed _buffer sender) 4357(defun erc-echo-notice-in-first-user-buffer (s parsed _buffer sender)
@@ -4305,7 +4365,7 @@ See also: `erc-echo-notice-in-user-buffers',
4305`erc-buffer-list-with-nick'." 4365`erc-buffer-list-with-nick'."
4306 (let ((buffers (erc-buffer-list-with-nick sender erc-server-process))) 4366 (let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
4307 (if buffers 4367 (if buffers
4308 (progn (erc-display-message parsed nil (car buffers) s) t) 4368 (progn (erc-display-message parsed nil (car buffers) s) t)
4309 nil))) 4369 nil)))
4310 4370
4311;;; Ban manipulation 4371;;; Ban manipulation
@@ -4313,61 +4373,61 @@ See also: `erc-echo-notice-in-user-buffers',
4313(defun erc-banlist-store (proc parsed) 4373(defun erc-banlist-store (proc parsed)
4314 "Record ban entries for a channel." 4374 "Record ban entries for a channel."
4315 (pcase-let ((`(,channel ,mask ,whoset) 4375 (pcase-let ((`(,channel ,mask ,whoset)
4316 (cdr (erc-response.command-args parsed)))) 4376 (cdr (erc-response.command-args parsed))))
4317 ;; Determine to which buffer the message corresponds 4377 ;; Determine to which buffer the message corresponds
4318 (let ((buffer (erc-get-buffer channel proc))) 4378 (let ((buffer (erc-get-buffer channel proc)))
4319 (with-current-buffer buffer 4379 (with-current-buffer buffer
4320 (unless (member (cons whoset mask) erc-channel-banlist) 4380 (unless (member (cons whoset mask) erc-channel-banlist)
4321 (setq erc-channel-banlist (cons (cons whoset mask) 4381 (setq erc-channel-banlist (cons (cons whoset mask)
4322 erc-channel-banlist)))))) 4382 erc-channel-banlist))))))
4323 nil) 4383 nil)
4324 4384
4325(defun erc-banlist-finished (proc parsed) 4385(defun erc-banlist-finished (proc parsed)
4326 "Record that we have received the banlist." 4386 "Record that we have received the banlist."
4327 (let* ((channel (nth 1 (erc-response.command-args parsed))) 4387 (let* ((channel (nth 1 (erc-response.command-args parsed)))
4328 (buffer (erc-get-buffer channel proc))) 4388 (buffer (erc-get-buffer channel proc)))
4329 (with-current-buffer buffer 4389 (with-current-buffer buffer
4330 (put 'erc-channel-banlist 'received-from-server t))) 4390 (put 'erc-channel-banlist 'received-from-server t)))
4331 t) ; suppress the 'end of banlist' message 4391 t) ; suppress the 'end of banlist' message
4332 4392
4333(defun erc-banlist-update (proc parsed) 4393(defun erc-banlist-update (proc parsed)
4334 "Check MODE commands for bans and update the banlist appropriately." 4394 "Check MODE commands for bans and update the banlist appropriately."
4335 ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11 4395 ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11
4336 (let* ((tgt (car (erc-response.command-args parsed))) 4396 (let* ((tgt (car (erc-response.command-args parsed)))
4337 (mode (erc-response.contents parsed)) 4397 (mode (erc-response.contents parsed))
4338 (whoset (erc-response.sender parsed)) 4398 (whoset (erc-response.sender parsed))
4339 (buffer (erc-get-buffer tgt proc))) 4399 (buffer (erc-get-buffer tgt proc)))
4340 (when buffer 4400 (when buffer
4341 (with-current-buffer buffer 4401 (with-current-buffer buffer
4342 (cond ((not (get 'erc-channel-banlist 'received-from-server)) nil) 4402 (cond ((not (get 'erc-channel-banlist 'received-from-server)) nil)
4343 ((string-match "^\\([+-]\\)b" mode) 4403 ((string-match "^\\([+-]\\)b" mode)
4344 ;; This is a ban 4404 ;; This is a ban
4345 (cond 4405 (cond
4346 ((string-match "^-" mode) 4406 ((string-match "^-" mode)
4347 ;; Remove the unbanned masks from the ban list 4407 ;; Remove the unbanned masks from the ban list
4348 (setq erc-channel-banlist 4408 (setq erc-channel-banlist
4349 (erc-delete-if 4409 (erc-delete-if
4350 #'(lambda (y) 4410 #'(lambda (y)
4351 (member (upcase (cdr y)) 4411 (member (upcase (cdr y))
4352 (mapcar #'upcase 4412 (mapcar #'upcase
4353 (cdr (split-string mode))))) 4413 (cdr (split-string mode)))))
4354 erc-channel-banlist))) 4414 erc-channel-banlist)))
4355 ((string-match "^+" mode) 4415 ((string-match "^+" mode)
4356 ;; Add the banned mask(s) to the ban list 4416 ;; Add the banned mask(s) to the ban list
4357 (mapc 4417 (mapc
4358 (lambda (mask) 4418 (lambda (mask)
4359 (unless (member (cons whoset mask) erc-channel-banlist) 4419 (unless (member (cons whoset mask) erc-channel-banlist)
4360 (setq erc-channel-banlist 4420 (setq erc-channel-banlist
4361 (cons (cons whoset mask) erc-channel-banlist)))) 4421 (cons (cons whoset mask) erc-channel-banlist))))
4362 (cdr (split-string mode)))))))))) 4422 (cdr (split-string mode))))))))))
4363 nil) 4423 nil)
4364 4424
4365;; used for the banlist cmds 4425;; used for the banlist cmds
4366(defun erc-group-list (list n) 4426(defun erc-group-list (list n)
4367 "Group LIST into sublists of length N." 4427 "Group LIST into sublists of length N."
4368 (cond ((null list) nil) 4428 (cond ((null list) nil)
4369 ((null (nthcdr n list)) (list list)) 4429 ((null (nthcdr n list)) (list list))
4370 (t (cons (erc-subseq list 0 n) (erc-group-list (nthcdr n list) n))))) 4430 (t (cons (erc-subseq list 0 n) (erc-group-list (nthcdr n list) n)))))
4371 4431
4372 4432
4373;;; MOTD numreplies 4433;;; MOTD numreplies
@@ -4380,7 +4440,7 @@ See also: `erc-echo-notice-in-user-buffers',
4380 ;; execute a startup script 4440 ;; execute a startup script
4381 (let ((f (erc-select-startup-file))) 4441 (let ((f (erc-select-startup-file)))
4382 (when f 4442 (when f
4383 (erc-load-script f))))) 4443 (erc-load-script f)))))
4384 4444
4385(defun erc-connection-established (proc parsed) 4445(defun erc-connection-established (proc parsed)
4386 "Run just after connection. 4446 "Run just after connection.
@@ -4389,14 +4449,14 @@ Set user modes and run `erc-after-connect' hook."
4389 (with-current-buffer (process-buffer proc) 4449 (with-current-buffer (process-buffer proc)
4390 (unless erc-server-connected ; only once per session 4450 (unless erc-server-connected ; only once per session
4391 (let ((server (or erc-server-announced-name 4451 (let ((server (or erc-server-announced-name
4392 (erc-response.sender parsed))) 4452 (erc-response.sender parsed)))
4393 (nick (car (erc-response.command-args parsed))) 4453 (nick (car (erc-response.command-args parsed)))
4394 (buffer (process-buffer proc))) 4454 (buffer (process-buffer proc)))
4395 (setq erc-server-connected t) 4455 (setq erc-server-connected t)
4396 (erc-update-mode-line) 4456 (erc-update-mode-line)
4397 (erc-set-initial-user-mode nick buffer) 4457 (erc-set-initial-user-mode nick buffer)
4398 (erc-server-setup-periodical-ping buffer) 4458 (erc-server-setup-periodical-ping buffer)
4399 (run-hook-with-args 'erc-after-connect server nick))))) 4459 (run-hook-with-args 'erc-after-connect server nick)))))
4400 4460
4401(defun erc-set-initial-user-mode (nick buffer) 4461(defun erc-set-initial-user-mode (nick buffer)
4402 "If `erc-user-mode' is non-nil for NICK, set the user modes. 4462 "If `erc-user-mode' is non-nil for NICK, set the user modes.
@@ -4404,11 +4464,11 @@ The server buffer is given by BUFFER."
4404 (with-current-buffer buffer 4464 (with-current-buffer buffer
4405 (when erc-user-mode 4465 (when erc-user-mode
4406 (let ((mode (if (functionp erc-user-mode) 4466 (let ((mode (if (functionp erc-user-mode)
4407 (funcall erc-user-mode) 4467 (funcall erc-user-mode)
4408 erc-user-mode))) 4468 erc-user-mode)))
4409 (when (stringp mode) 4469 (when (stringp mode)
4410 (erc-log (format "changing mode for %s to %s" nick mode)) 4470 (erc-log (format "changing mode for %s to %s" nick mode))
4411 (erc-server-send (format "MODE %s %s" nick mode))))))) 4471 (erc-server-send (format "MODE %s %s" nick mode)))))))
4412 4472
4413(defun erc-display-error-notice (parsed string) 4473(defun erc-display-error-notice (parsed string)
4414 "Display STRING as an error notice. 4474 "Display STRING as an error notice.
@@ -4421,41 +4481,41 @@ See also `erc-display-message'."
4421 ;; FIXME: This needs a proper docstring -- Lawrence 2004-01-08 4481 ;; FIXME: This needs a proper docstring -- Lawrence 2004-01-08
4422 "Process a CTCP query." 4482 "Process a CTCP query."
4423 (let ((queries (delete "" (split-string (erc-response.contents parsed) 4483 (let ((queries (delete "" (split-string (erc-response.contents parsed)
4424 "\C-a")))) 4484 "\C-a"))))
4425 (if (> (length queries) 4) 4485 (if (> (length queries) 4)
4426 (erc-display-message 4486 (erc-display-message
4427 parsed (list 'notice 'error) proc 'ctcp-too-many) 4487 parsed (list 'notice 'error) proc 'ctcp-too-many)
4428 (if (= 0 (length queries)) 4488 (if (= 0 (length queries))
4429 (erc-display-message 4489 (erc-display-message
4430 parsed (list 'notice 'error) proc 4490 parsed (list 'notice 'error) proc
4431 'ctcp-empty ?n nick) 4491 'ctcp-empty ?n nick)
4432 (while queries 4492 (while queries
4433 (let* ((type (upcase (car (split-string (car queries))))) 4493 (let* ((type (upcase (car (split-string (car queries)))))
4434 (hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))) 4494 (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))))
4435 (if (and hook (boundp hook)) 4495 (if (and hook (boundp hook))
4436 (if (string-equal type "ACTION") 4496 (if (string-equal type "ACTION")
4437 (run-hook-with-args-until-success 4497 (run-hook-with-args-until-success
4438 hook proc parsed nick login host 4498 hook proc parsed nick login host
4439 (car (erc-response.command-args parsed)) 4499 (car (erc-response.command-args parsed))
4440 (car queries)) 4500 (car queries))
4441 (when erc-paranoid 4501 (when erc-paranoid
4442 (if (erc-current-nick-p 4502 (if (erc-current-nick-p
4443 (car (erc-response.command-args parsed))) 4503 (car (erc-response.command-args parsed)))
4444 (erc-display-message 4504 (erc-display-message
4445 parsed 'error 'active 'ctcp-request 4505 parsed 'error 'active 'ctcp-request
4446 ?n nick ?u login ?h host ?r (car queries)) 4506 ?n nick ?u login ?h host ?r (car queries))
4447 (erc-display-message 4507 (erc-display-message
4448 parsed 'error 'active 'ctcp-request-to 4508 parsed 'error 'active 'ctcp-request-to
4449 ?n nick ?u login ?h host ?r (car queries) 4509 ?n nick ?u login ?h host ?r (car queries)
4450 ?t (car (erc-response.command-args parsed))))) 4510 ?t (car (erc-response.command-args parsed)))))
4451 (run-hook-with-args-until-success 4511 (run-hook-with-args-until-success
4452 hook proc nick login host 4512 hook proc nick login host
4453 (car (erc-response.command-args parsed)) 4513 (car (erc-response.command-args parsed))
4454 (car queries))) 4514 (car queries)))
4455 (erc-display-message 4515 (erc-display-message
4456 parsed (list 'notice 'error) proc 4516 parsed (list 'notice 'error) proc
4457 'undefined-ctcp))) 4517 'undefined-ctcp)))
4458 (setq queries (cdr queries))))))) 4518 (setq queries (cdr queries)))))))
4459 4519
4460(defvar erc-ctcp-query-ACTION-hook '(erc-ctcp-query-ACTION)) 4520(defvar erc-ctcp-query-ACTION-hook '(erc-ctcp-query-ACTION))
4461 4521
@@ -4463,9 +4523,9 @@ See also `erc-display-message'."
4463 "Respond to a CTCP ACTION query." 4523 "Respond to a CTCP ACTION query."
4464 (when (string-match "^ACTION\\s-\\(.*\\)\\s-*$" msg) 4524 (when (string-match "^ACTION\\s-\\(.*\\)\\s-*$" msg)
4465 (let ((s (match-string 1 msg)) 4525 (let ((s (match-string 1 msg))
4466 (buf (or (erc-get-buffer to proc) 4526 (buf (or (erc-get-buffer to proc)
4467 (erc-get-buffer nick proc) 4527 (erc-get-buffer nick proc)
4468 (process-buffer proc)))) 4528 (process-buffer proc))))
4469 (erc-display-message 4529 (erc-display-message
4470 parsed 'action buf 4530 parsed 'action buf
4471 'ACTION ?n nick ?u login ?h host ?a s)))) 4531 'ACTION ?n nick ?u login ?h host ?a s))))
@@ -4477,7 +4537,7 @@ See also `erc-display-message'."
4477 (when (string-match "^CLIENTINFO\\(\\s-*\\|\\s-+.*\\)$" msg) 4537 (when (string-match "^CLIENTINFO\\(\\s-*\\|\\s-+.*\\)$" msg)
4478 (let ((s (erc-client-info (erc-trim-string (match-string 1 msg))))) 4538 (let ((s (erc-client-info (erc-trim-string (match-string 1 msg)))))
4479 (unless erc-disable-ctcp-replies 4539 (unless erc-disable-ctcp-replies
4480 (erc-send-ctcp-notice nick (format "CLIENTINFO %s" s))))) 4540 (erc-send-ctcp-notice nick (format "CLIENTINFO %s" s)))))
4481 nil) 4541 nil)
4482 4542
4483(defvar erc-ctcp-query-ECHO-hook '(erc-ctcp-query-ECHO)) 4543(defvar erc-ctcp-query-ECHO-hook '(erc-ctcp-query-ECHO))
@@ -4486,7 +4546,7 @@ See also `erc-display-message'."
4486 (when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg) 4546 (when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg)
4487 (let ((s (match-string 1 msg))) 4547 (let ((s (match-string 1 msg)))
4488 (unless erc-disable-ctcp-replies 4548 (unless erc-disable-ctcp-replies
4489 (erc-send-ctcp-notice nick (format "ECHO %s" s))))) 4549 (erc-send-ctcp-notice nick (format "ECHO %s" s)))))
4490 nil) 4550 nil)
4491 4551
4492(defvar erc-ctcp-query-FINGER-hook '(erc-ctcp-query-FINGER)) 4552(defvar erc-ctcp-query-FINGER-hook '(erc-ctcp-query-FINGER))
@@ -4494,15 +4554,15 @@ See also `erc-display-message'."
4494 "Respond to a CTCP FINGER query." 4554 "Respond to a CTCP FINGER query."
4495 (unless erc-disable-ctcp-replies 4555 (unless erc-disable-ctcp-replies
4496 (let ((s (if erc-anonymous-login 4556 (let ((s (if erc-anonymous-login
4497 (format "FINGER I'm %s." (erc-current-nick)) 4557 (format "FINGER I'm %s." (erc-current-nick))
4498 (format "FINGER %s (%s@%s)." 4558 (format "FINGER %s (%s@%s)."
4499 (user-full-name) 4559 (user-full-name)
4500 (user-login-name) 4560 (user-login-name)
4501 (system-name)))) 4561 (system-name))))
4502 (ns (erc-time-diff erc-server-last-sent-time (erc-current-time)))) 4562 (ns (erc-time-diff erc-server-last-sent-time (erc-current-time))))
4503 (when (> ns 0) 4563 (when (> ns 0)
4504 (setq s (concat s " Idle for " (erc-sec-to-time ns)))) 4564 (setq s (concat s " Idle for " (erc-sec-to-time ns))))
4505 (erc-send-ctcp-notice nick s))) 4565 (erc-send-ctcp-notice nick s)))
4506 nil) 4566 nil)
4507 4567
4508(defvar erc-ctcp-query-PING-hook '(erc-ctcp-query-PING)) 4568(defvar erc-ctcp-query-PING-hook '(erc-ctcp-query-PING))
@@ -4511,7 +4571,7 @@ See also `erc-display-message'."
4511 (when (string-match "^PING\\s-+\\(.*\\)" msg) 4571 (when (string-match "^PING\\s-+\\(.*\\)" msg)
4512 (unless erc-disable-ctcp-replies 4572 (unless erc-disable-ctcp-replies
4513 (let ((arg (match-string 1 msg))) 4573 (let ((arg (match-string 1 msg)))
4514 (erc-send-ctcp-notice nick (format "PING %s" arg))))) 4574 (erc-send-ctcp-notice nick (format "PING %s" arg)))))
4515 nil) 4575 nil)
4516 4576
4517(defvar erc-ctcp-query-TIME-hook '(erc-ctcp-query-TIME)) 4577(defvar erc-ctcp-query-TIME-hook '(erc-ctcp-query-TIME))
@@ -4534,19 +4594,19 @@ See also `erc-display-message'."
4534 (unless erc-disable-ctcp-replies 4594 (unless erc-disable-ctcp-replies
4535 (erc-send-ctcp-notice 4595 (erc-send-ctcp-notice
4536 nick (format 4596 nick (format
4537 "VERSION \C-bERC\C-b %s - an IRC client for emacs (\C-b%s\C-b)" 4597 "VERSION \C-bERC\C-b - an IRC client for Emacs %s (\C-b%s\C-b)"
4538 erc-version-string 4598 emacs-version
4539 erc-official-location))) 4599 erc-official-location)))
4540 nil) 4600 nil)
4541 4601
4542(defun erc-process-ctcp-reply (proc parsed nick login host msg) 4602(defun erc-process-ctcp-reply (proc parsed nick login host msg)
4543 "Process MSG as a CTCP reply." 4603 "Process MSG as a CTCP reply."
4544 (let* ((type (car (split-string msg))) 4604 (let* ((type (car (split-string msg)))
4545 (hook (intern (concat "erc-ctcp-reply-" type "-hook")))) 4605 (hook (intern (concat "erc-ctcp-reply-" type "-hook"))))
4546 (if (boundp hook) 4606 (if (boundp hook)
4547 (run-hook-with-args-until-success 4607 (run-hook-with-args-until-success
4548 hook proc nick login host 4608 hook proc nick login host
4549 (car (erc-response.command-args parsed)) msg) 4609 (car (erc-response.command-args parsed)) msg)
4550 (erc-display-message 4610 (erc-display-message
4551 parsed 'notice 'active 4611 parsed 'notice 'active
4552 'CTCP-UNKNOWN ?n nick ?u login ?h host ?m msg)))) 4612 'CTCP-UNKNOWN ?n nick ?u login ?h host ?m msg))))
@@ -4588,16 +4648,16 @@ See also `erc-display-message'."
4588 nil 4648 nil
4589 (let ((time (match-string 1 msg))) 4649 (let ((time (match-string 1 msg)))
4590 (condition-case nil 4650 (condition-case nil
4591 (let ((delta (erc-time-diff (string-to-number time) 4651 (let ((delta (erc-time-diff (string-to-number time)
4592 (erc-current-time)))) 4652 (erc-current-time))))
4593 (erc-display-message 4653 (erc-display-message
4594 nil 'notice 'active 4654 nil 'notice 'active
4595 'CTCP-PING ?n nick 4655 'CTCP-PING ?n nick
4596 ?t (erc-sec-to-time delta))) 4656 ?t (erc-sec-to-time delta)))
4597 (range-error 4657 (range-error
4598 (erc-display-message 4658 (erc-display-message
4599 nil 'error 'active 4659 nil 'error 'active
4600 'bad-ping-response ?n nick ?t time)))))) 4660 'bad-ping-response ?n nick ?t time))))))
4601 4661
4602(defvar erc-ctcp-reply-TIME-hook '(erc-ctcp-reply-TIME)) 4662(defvar erc-ctcp-reply-TIME-hook '(erc-ctcp-reply-TIME))
4603(defun erc-ctcp-reply-TIME (_proc nick _login _host _to msg) 4663(defun erc-ctcp-reply-TIME (_proc nick _login _host _to msg)
@@ -4627,31 +4687,31 @@ If non-nil, return from being away."
4627 (let ((sessionbuf (process-buffer proc))) 4687 (let ((sessionbuf (process-buffer proc)))
4628 (when sessionbuf 4688 (when sessionbuf
4629 (with-current-buffer sessionbuf 4689 (with-current-buffer sessionbuf
4630 (when erc-away-nickname 4690 (when erc-away-nickname
4631 (erc-log (format "erc-process-away: away-nick: %s, away-p: %s" 4691 (erc-log (format "erc-process-away: away-nick: %s, away-p: %s"
4632 erc-away-nickname away-p)) 4692 erc-away-nickname away-p))
4633 (erc-cmd-NICK (if away-p 4693 (erc-cmd-NICK (if away-p
4634 erc-away-nickname 4694 erc-away-nickname
4635 erc-nick))) 4695 erc-nick)))
4636 (cond 4696 (cond
4637 (away-p 4697 (away-p
4638 (setq erc-away (current-time))) 4698 (setq erc-away (current-time)))
4639 (t 4699 (t
4640 (let ((away-time erc-away)) 4700 (let ((away-time erc-away))
4641 ;; away must be set to NIL BEFORE sending anything to prevent 4701 ;; away must be set to NIL BEFORE sending anything to prevent
4642 ;; an infinite recursion 4702 ;; an infinite recursion
4643 (setq erc-away nil) 4703 (setq erc-away nil)
4644 (with-current-buffer (erc-active-buffer) 4704 (with-current-buffer (erc-active-buffer)
4645 (when erc-public-away-p 4705 (when erc-public-away-p
4646 (erc-send-action 4706 (erc-send-action
4647 (erc-default-target) 4707 (erc-default-target)
4648 (if away-time 4708 (if away-time
4649 (format "is back (gone for %s)" 4709 (format "is back (gone for %s)"
4650 (erc-sec-to-time 4710 (erc-sec-to-time
4651 (erc-time-diff 4711 (erc-time-diff
4652 (erc-emacs-time-to-erc-time away-time) 4712 (erc-emacs-time-to-erc-time away-time)
4653 (erc-current-time)))) 4713 (erc-current-time))))
4654 "is back"))))))))) 4714 "is back")))))))))
4655 (erc-update-mode-line))) 4715 (erc-update-mode-line)))
4656 4716
4657;;;; List of channel members handling 4717;;;; List of channel members handling
@@ -4674,30 +4734,30 @@ channel buffer.
4674 4734
4675See also `erc-channel-begin-receiving-names'." 4735See also `erc-channel-begin-receiving-names'."
4676 (maphash (lambda (nick _user) 4736 (maphash (lambda (nick _user)
4677 (if (null (gethash nick erc-channel-new-member-names)) 4737 (if (null (gethash nick erc-channel-new-member-names))
4678 (erc-remove-channel-user nick))) 4738 (erc-remove-channel-user nick)))
4679 erc-channel-users) 4739 erc-channel-users)
4680 (setq erc-channel-new-member-names nil)) 4740 (setq erc-channel-new-member-names nil))
4681 4741
4682(defun erc-parse-prefix () 4742(defun erc-parse-prefix ()
4683 "Return an alist of valid prefix character types and their representations. 4743 "Return an alist of valid prefix character types and their representations.
4684Example: (operator) o => @, (voiced) v => +." 4744Example: (operator) o => @, (voiced) v => +."
4685 (let ((str (or (cdr (assoc "PREFIX" (erc-with-server-buffer 4745 (let ((str (or (cdr (assoc "PREFIX" (erc-with-server-buffer
4686 erc-server-parameters))) 4746 erc-server-parameters)))
4687 ;; provide a sane default 4747 ;; provide a sane default
4688 "(ov)@+")) 4748 "(qaohv)~&@%+"))
4689 types chars) 4749 types chars)
4690 (when (string-match "^(\\([^)]+\\))\\(.+\\)$" str) 4750 (when (string-match "^(\\([^)]+\\))\\(.+\\)$" str)
4691 (setq types (match-string 1 str) 4751 (setq types (match-string 1 str)
4692 chars (match-string 2 str)) 4752 chars (match-string 2 str))
4693 (let ((len (min (length types) (length chars))) 4753 (let ((len (min (length types) (length chars)))
4694 (i 0) 4754 (i 0)
4695 (alist nil)) 4755 (alist nil))
4696 (while (< i len) 4756 (while (< i len)
4697 (setq alist (cons (cons (elt types i) (elt chars i)) 4757 (setq alist (cons (cons (elt types i) (elt chars i))
4698 alist)) 4758 alist))
4699 (setq i (1+ i))) 4759 (setq i (1+ i)))
4700 alist)))) 4760 alist))))
4701 4761
4702(defun erc-channel-receive-names (names-string) 4762(defun erc-channel-receive-names (names-string)
4703 "This function is for internal use only. 4763 "This function is for internal use only.
@@ -4705,40 +4765,39 @@ Example: (operator) o => @, (voiced) v => +."
4705Update `erc-channel-users' according to NAMES-STRING. 4765Update `erc-channel-users' according to NAMES-STRING.
4706NAMES-STRING is a string listing some of the names on the 4766NAMES-STRING is a string listing some of the names on the
4707channel." 4767channel."
4708 (let (prefix op-ch voice-ch names name op voice) 4768 (let* ((prefix (erc-parse-prefix))
4709 (setq prefix (erc-parse-prefix)) 4769 (voice-ch (cdr (assq ?v prefix)))
4710 (setq op-ch (cdr (assq ?o prefix)) 4770 (op-ch (cdr (assq ?o prefix)))
4711 voice-ch (cdr (assq ?v prefix))) 4771 (hop-ch (cdr (assq ?h prefix)))
4712 ;; We need to delete "" because in XEmacs, (split-string "a ") 4772 (adm-ch (cdr (assq ?a prefix)))
4713 ;; returns ("a" ""). 4773 (own-ch (cdr (assq ?q prefix)))
4714 (setq names (delete "" (split-string names-string))) 4774 (names (delete "" (split-string names-string)))
4775 name op voice halfop admin owner)
4715 (let ((erc-channel-members-changed-hook nil)) 4776 (let ((erc-channel-members-changed-hook nil))
4716 (dolist (item names) 4777 (dolist (item names)
4717 (let ((updatep t)) 4778 (let ((updatep t)
4718 (if (rassq (elt item 0) prefix) 4779 (ch (aref item 0)))
4719 (cond ((= (length item) 1) 4780 (setq name item op 'off voice 'off halfop 'off admin 'off owner 'off)
4720 (setq updatep nil)) 4781 (if (rassq ch prefix)
4721 ((eq (elt item 0) op-ch) 4782 (if (= (length item) 1)
4722 (setq name (substring item 1) 4783 (setq updatep nil)
4723 op 'on 4784 (setq name (substring item 1))
4724 voice 'off)) 4785 (setf (pcase ch
4725 ((eq (elt item 0) voice-ch) 4786 ((pred (eq voice-ch)) voice)
4726 (setq name (substring item 1) 4787 ((pred (eq hop-ch)) halfop)
4727 op 'off 4788 ((pred (eq op-ch)) op)
4728 voice 'on)) 4789 ((pred (eq adm-ch)) admin)
4729 (t (setq name (substring item 1) 4790 ((pred (eq own-ch)) owner)
4730 op 'off 4791 (_ (error "Unknown prefix char `%S'" ch) voice))
4731 voice 'off))) 4792 'on)))
4732 (setq name item 4793 (when updatep
4733 op 'off 4794 (puthash (erc-downcase name) t
4734 voice 'off)) 4795 erc-channel-new-member-names)
4735 (when updatep 4796 (erc-update-current-channel-member
4736 (puthash (erc-downcase name) t 4797 name name t voice halfop op admin owner)))))
4737 erc-channel-new-member-names)
4738 (erc-update-current-channel-member
4739 name name t op voice)))))
4740 (run-hooks 'erc-channel-members-changed-hook))) 4798 (run-hooks 'erc-channel-members-changed-hook)))
4741 4799
4800
4742(defcustom erc-channel-members-changed-hook nil 4801(defcustom erc-channel-members-changed-hook nil
4743 "This hook is called every time the variable `channel-members' changes. 4802 "This hook is called every time the variable `channel-members' changes.
4744The buffer where the change happened is current while this hook is called." 4803The buffer where the change happened is current while this hook is called."
@@ -4746,15 +4805,15 @@ The buffer where the change happened is current while this hook is called."
4746 :type 'hook) 4805 :type 'hook)
4747 4806
4748(defun erc-update-user-nick (nick &optional new-nick 4807(defun erc-update-user-nick (nick &optional new-nick
4749 host login full-name info) 4808 host login full-name info)
4750 "Update the stored user information for the user with nickname NICK. 4809 "Update the stored user information for the user with nickname NICK.
4751 4810
4752See also: `erc-update-user'." 4811See also: `erc-update-user'."
4753 (erc-update-user (erc-get-server-user nick) new-nick 4812 (erc-update-user (erc-get-server-user nick) new-nick
4754 host login full-name info)) 4813 host login full-name info))
4755 4814
4756(defun erc-update-user (user &optional new-nick 4815(defun erc-update-user (user &optional new-nick
4757 host login full-name info) 4816 host login full-name info)
4758 "Update user info for USER. USER must be an erc-server-user 4817 "Update user info for USER. USER must be an erc-server-user
4759struct. Any of NEW-NICK, HOST, LOGIN, FULL-NAME, INFO which are 4818struct. Any of NEW-NICK, HOST, LOGIN, FULL-NAME, INFO which are
4760non-nil and not equal to the existing values for USER are used to 4819non-nil and not equal to the existing values for USER are used to
@@ -4766,45 +4825,44 @@ which USER is a member, and t is returned."
4766 (let (changed) 4825 (let (changed)
4767 (when user 4826 (when user
4768 (when (and new-nick 4827 (when (and new-nick
4769 (not (equal (erc-server-user-nickname user) 4828 (not (equal (erc-server-user-nickname user)
4770 new-nick))) 4829 new-nick)))
4771 (setq changed t) 4830 (setq changed t)
4772 (erc-change-user-nickname user new-nick)) 4831 (erc-change-user-nickname user new-nick))
4773 (when (and host 4832 (when (and host
4774 (not (equal (erc-server-user-host user) host))) 4833 (not (equal (erc-server-user-host user) host)))
4775 (setq changed t) 4834 (setq changed t)
4776 (setf (erc-server-user-host user) host)) 4835 (setf (erc-server-user-host user) host))
4777 (when (and login 4836 (when (and login
4778 (not (equal (erc-server-user-login user) login))) 4837 (not (equal (erc-server-user-login user) login)))
4779 (setq changed t) 4838 (setq changed t)
4780 (setf (erc-server-user-login user) login)) 4839 (setf (erc-server-user-login user) login))
4781 (when (and full-name 4840 (when (and full-name
4782 (not (equal (erc-server-user-full-name user) 4841 (not (equal (erc-server-user-full-name user)
4783 full-name))) 4842 full-name)))
4784 (setq changed t) 4843 (setq changed t)
4785 (setf (erc-server-user-full-name user) full-name)) 4844 (setf (erc-server-user-full-name user) full-name))
4786 (when (and info 4845 (when (and info
4787 (not (equal (erc-server-user-info user) info))) 4846 (not (equal (erc-server-user-info user) info)))
4788 (setq changed t) 4847 (setq changed t)
4789 (setf (erc-server-user-info user) info)) 4848 (setf (erc-server-user-info user) info))
4790 (if changed 4849 (if changed
4791 (dolist (buf (erc-server-user-buffers user)) 4850 (dolist (buf (erc-server-user-buffers user))
4792 (if (buffer-live-p buf) 4851 (if (buffer-live-p buf)
4793 (with-current-buffer buf 4852 (with-current-buffer buf
4794 (run-hooks 'erc-channel-members-changed-hook)))))) 4853 (run-hooks 'erc-channel-members-changed-hook))))))
4795 changed)) 4854 changed))
4796 4855
4797(defun erc-update-current-channel-member 4856(defun erc-update-current-channel-member
4798 (nick new-nick &optional add op voice host login full-name info 4857 (nick new-nick &optional add voice halfop op admin owner host login full-name info
4799 update-message-time) 4858 update-message-time)
4800 "Update the stored user information for the user with nickname NICK. 4859 "Update the stored user information for the user with nickname NICK.
4801`erc-update-user' is called to handle changes to nickname, 4860`erc-update-user' is called to handle changes to nickname,
4802HOST, LOGIN, FULL-NAME, and INFO. If OP or VOICE are non-nil, 4861HOST, LOGIN, FULL-NAME, and INFO. If VOICE HALFOP OP ADMIN or OWNER
4803they must be equal to either `on' or `off', in which case the 4862are non-nil, they must be equal to either `on' or `off', in which
4804operator or voice status of the user in the current channel is 4863case the status of the user in the current channel is changed accordingly.
4805changed accordingly. If UPDATE-MESSAGE-TIME is non-nil, the 4864If UPDATE-MESSAGE-TIME is non-nil, the last-message-time of the user
4806last-message-time of the user in the current channel is set 4865 in the current channel is set to (current-time).
4807to (current-time).
4808 4866
4809If ADD is non-nil, the user will be added with the specified 4867If ADD is non-nil, the user will be added with the specified
4810information if it is not already present in the user or channel 4868information if it is not already present in the user or channel
@@ -4815,74 +4873,104 @@ If, and only if, changes are made, or the user is added,
4815 4873
4816See also: `erc-update-user' and `erc-update-channel-member'." 4874See also: `erc-update-user' and `erc-update-channel-member'."
4817 (let* (changed user-changed 4875 (let* (changed user-changed
4818 (channel-data (erc-get-channel-user nick)) 4876 (channel-data (erc-get-channel-user nick))
4819 (cuser (cdr channel-data)) 4877 (cuser (cdr channel-data))
4820 (user (if channel-data (car channel-data) 4878 (user (if channel-data (car channel-data)
4821 (erc-get-server-user nick)))) 4879 (erc-get-server-user nick))))
4822 (if cuser 4880 (if cuser
4823 (progn 4881 (progn
4824 (erc-log (format "update-member: user = %S, cuser = %S" user cuser)) 4882 (erc-log (format "update-member: user = %S, cuser = %S" user cuser))
4825 (when (and op 4883 (when (and voice
4826 (not (eq (erc-channel-user-op cuser) op))) 4884 (not (eq (erc-channel-user-voice cuser) voice)))
4827 (setq changed t) 4885 (setq changed t)
4828 (setf (erc-channel-user-op cuser) 4886 (setf (erc-channel-user-voice cuser)
4829 (cond ((eq op 'on) t) 4887 (cond ((eq voice 'on) t)
4830 ((eq op 'off) nil) 4888 ((eq voice 'off) nil)
4831 (t op)))) 4889 (t voice))))
4832 (when (and voice 4890 (when (and halfop
4833 (not (eq (erc-channel-user-voice cuser) voice))) 4891 (not (eq (erc-channel-user-halfop cuser) halfop)))
4834 (setq changed t) 4892 (setq changed t)
4835 (setf (erc-channel-user-voice cuser) 4893 (setf (erc-channel-user-halfop cuser)
4836 (cond ((eq voice 'on) t) 4894 (cond ((eq halfop 'on) t)
4837 ((eq voice 'off) nil) 4895 ((eq halfop 'off) nil)
4838 (t voice)))) 4896 (t halfop))))
4839 (when update-message-time 4897 (when (and op
4840 (setf (erc-channel-user-last-message-time cuser) (current-time))) 4898 (not (eq (erc-channel-user-op cuser) op)))
4841 (setq user-changed 4899 (setq changed t)
4842 (erc-update-user user new-nick 4900 (setf (erc-channel-user-op cuser)
4843 host login full-name info))) 4901 (cond ((eq op 'on) t)
4902 ((eq op 'off) nil)
4903 (t op))))
4904 (when (and admin
4905 (not (eq (erc-channel-user-admin cuser) admin)))
4906 (setq changed t)
4907 (setf (erc-channel-user-admin cuser)
4908 (cond ((eq admin 'on) t)
4909 ((eq admin 'off) nil)
4910 (t admin))))
4911 (when (and owner
4912 (not (eq (erc-channel-user-owner cuser) owner)))
4913 (setq changed t)
4914 (setf (erc-channel-user-owner cuser)
4915 (cond ((eq owner 'on) t)
4916 ((eq owner 'off) nil)
4917 (t owner))))
4918 (when update-message-time
4919 (setf (erc-channel-user-last-message-time cuser) (current-time)))
4920 (setq user-changed
4921 (erc-update-user user new-nick
4922 host login full-name info)))
4844 (when add 4923 (when add
4845 (if (null user) 4924 (if (null user)
4846 (progn 4925 (progn
4847 (setq user (make-erc-server-user 4926 (setq user (make-erc-server-user
4848 :nickname nick 4927 :nickname nick
4849 :host host 4928 :host host
4850 :full-name full-name 4929 :full-name full-name
4851 :login login 4930 :login login
4852 :info info 4931 :info info
4853 :buffers (list (current-buffer)))) 4932 :buffers (list (current-buffer))))
4854 (erc-add-server-user nick user)) 4933 (erc-add-server-user nick user))
4855 (setf (erc-server-user-buffers user) 4934 (setf (erc-server-user-buffers user)
4856 (cons (current-buffer) 4935 (cons (current-buffer)
4857 (erc-server-user-buffers user)))) 4936 (erc-server-user-buffers user))))
4858 (setq cuser (make-erc-channel-user 4937 (setq cuser (make-erc-channel-user
4859 :op (cond ((eq op 'on) t) 4938 :voice (cond ((eq voice 'on) t)
4860 ((eq op 'off) nil) 4939 ((eq voice 'off) nil)
4861 (t op)) 4940 (t voice))
4862 :voice (cond ((eq voice 'on) t) 4941 :halfop (cond ((eq halfop 'on) t)
4863 ((eq voice 'off) nil) 4942 ((eq halfop 'off) nil)
4864 (t voice)) 4943 (t halfop))
4865 :last-message-time 4944 :op (cond ((eq op 'on) t)
4866 (if update-message-time (current-time)))) 4945 ((eq op 'off) nil)
4867 (puthash (erc-downcase nick) (cons user cuser) 4946 (t op))
4868 erc-channel-users) 4947 :admin (cond ((eq admin 'on) t)
4869 (setq changed t))) 4948 ((eq admin 'off) nil)
4949 (t admin))
4950 :owner (cond ((eq owner 'on) t)
4951 ((eq owner 'off) nil)
4952 (t owner))
4953 :last-message-time
4954 (if update-message-time (current-time))))
4955 (puthash (erc-downcase nick) (cons user cuser)
4956 erc-channel-users)
4957 (setq changed t)))
4870 (when (and changed (null user-changed)) 4958 (when (and changed (null user-changed))
4871 (run-hooks 'erc-channel-members-changed-hook)) 4959 (run-hooks 'erc-channel-members-changed-hook))
4872 (or changed user-changed add))) 4960 (or changed user-changed add)))
4873 4961
4874(defun erc-update-channel-member (channel nick new-nick 4962(defun erc-update-channel-member (channel nick new-nick
4875 &optional add op voice host login 4963 &optional add voice halfop op admin owner host login
4876 full-name info update-message-time) 4964 full-name info update-message-time)
4877 "Update user and channel information for the user with 4965 "Update user and channel information for the user with
4878nickname NICK in channel CHANNEL. 4966nickname NICK in channel CHANNEL.
4879 4967
4880See also: `erc-update-current-channel-member'." 4968See also: `erc-update-current-channel-member'."
4881 (erc-with-buffer 4969 (erc-with-buffer
4882 (channel) 4970 (channel)
4883 (erc-update-current-channel-member nick new-nick add op voice host 4971 (erc-update-current-channel-member nick new-nick add voice halfop op admin owner host
4884 login full-name info 4972 login full-name info
4885 update-message-time))) 4973 update-message-time)))
4886 4974
4887(defun erc-remove-current-channel-member (nick) 4975(defun erc-remove-current-channel-member (nick)
4888 "Remove NICK from current channel membership list. 4976 "Remove NICK from current channel membership list.
@@ -4897,8 +4985,8 @@ Runs `erc-channel-members-changed-hook'."
4897 4985
4898See also `erc-remove-current-channel-member'." 4986See also `erc-remove-current-channel-member'."
4899 (erc-with-buffer 4987 (erc-with-buffer
4900 (channel) 4988 (channel)
4901 (erc-remove-current-channel-member nick))) 4989 (erc-remove-current-channel-member nick)))
4902 4990
4903(defun erc-update-channel-topic (channel topic &optional modify) 4991(defun erc-update-channel-topic (channel topic &optional modify)
4904 "Find a buffer for CHANNEL and set the TOPIC for it. 4992 "Find a buffer for CHANNEL and set the TOPIC for it.
@@ -4907,40 +4995,40 @@ If optional MODIFY is 'append or 'prepend, then append or prepend the
4907TOPIC string to the current topic." 4995TOPIC string to the current topic."
4908 (erc-with-buffer (channel) 4996 (erc-with-buffer (channel)
4909 (cond ((eq modify 'append) 4997 (cond ((eq modify 'append)
4910 (setq erc-channel-topic (concat erc-channel-topic topic))) 4998 (setq erc-channel-topic (concat erc-channel-topic topic)))
4911 ((eq modify 'prepend) 4999 ((eq modify 'prepend)
4912 (setq erc-channel-topic (concat topic erc-channel-topic))) 5000 (setq erc-channel-topic (concat topic erc-channel-topic)))
4913 (t (setq erc-channel-topic topic))) 5001 (t (setq erc-channel-topic topic)))
4914 (erc-update-mode-line-buffer (current-buffer)))) 5002 (erc-update-mode-line-buffer (current-buffer))))
4915 5003
4916(defun erc-set-modes (tgt mode-string) 5004(defun erc-set-modes (tgt mode-string)
4917 "Set the modes for the TGT provided as MODE-STRING." 5005 "Set the modes for the TGT provided as MODE-STRING."
4918 (let* ((modes (erc-parse-modes mode-string)) 5006 (let* ((modes (erc-parse-modes mode-string))
4919 (add-modes (nth 0 modes)) 5007 (add-modes (nth 0 modes))
4920 ;; list of triples: (mode-char 'on/'off argument) 5008 ;; list of triples: (mode-char 'on/'off argument)
4921 (arg-modes (nth 2 modes))) 5009 (arg-modes (nth 2 modes)))
4922 (cond ((erc-channel-p tgt); channel modes 5010 (cond ((erc-channel-p tgt); channel modes
4923 (let ((buf (and erc-server-process 5011 (let ((buf (and erc-server-process
4924 (erc-get-buffer tgt erc-server-process)))) 5012 (erc-get-buffer tgt erc-server-process))))
4925 (when buf 5013 (when buf
4926 (with-current-buffer buf 5014 (with-current-buffer buf
4927 (setq erc-channel-modes add-modes) 5015 (setq erc-channel-modes add-modes)
4928 (setq erc-channel-user-limit nil) 5016 (setq erc-channel-user-limit nil)
4929 (setq erc-channel-key nil) 5017 (setq erc-channel-key nil)
4930 (while arg-modes 5018 (while arg-modes
4931 (let ((mode (nth 0 (car arg-modes))) 5019 (let ((mode (nth 0 (car arg-modes)))
4932 (onoff (nth 1 (car arg-modes))) 5020 (onoff (nth 1 (car arg-modes)))
4933 (arg (nth 2 (car arg-modes)))) 5021 (arg (nth 2 (car arg-modes))))
4934 (cond ((string-match "^[Ll]" mode) 5022 (cond ((string-match "^[Ll]" mode)
4935 (erc-update-channel-limit tgt onoff arg)) 5023 (erc-update-channel-limit tgt onoff arg))
4936 ((string-match "^[Kk]" mode) 5024 ((string-match "^[Kk]" mode)
4937 (erc-update-channel-key tgt onoff arg)) 5025 (erc-update-channel-key tgt onoff arg))
4938 (t nil))) 5026 (t nil)))
4939 (setq arg-modes (cdr arg-modes))) 5027 (setq arg-modes (cdr arg-modes)))
4940 (erc-update-mode-line-buffer buf))))) 5028 (erc-update-mode-line-buffer buf)))))
4941 ;; we do not keep our nick's modes yet 5029 ;; we do not keep our nick's modes yet
4942 ;;(t (setq erc-user-modes add-modes)) 5030 ;;(t (setq erc-user-modes add-modes))
4943 ) 5031 )
4944 )) 5032 ))
4945 5033
4946(defun erc-sort-strings (list-of-strings) 5034(defun erc-sort-strings (list-of-strings)
@@ -4963,109 +5051,114 @@ arg-modes is a list of triples of the form:
4963 (MODE-CHAR ON/OFF ARGUMENT)." 5051 (MODE-CHAR ON/OFF ARGUMENT)."
4964 (if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string) 5052 (if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string)
4965 (let ((chars (mapcar 'char-to-string (match-string 1 mode-string))) 5053 (let ((chars (mapcar 'char-to-string (match-string 1 mode-string)))
4966 ;; arguments in channel modes 5054 ;; arguments in channel modes
4967 (args-str (match-string 2 mode-string)) 5055 (args-str (match-string 2 mode-string))
4968 (args nil) 5056 (args nil)
4969 (add-modes nil) 5057 (add-modes nil)
4970 (remove-modes nil) 5058 (remove-modes nil)
4971 (arg-modes nil); list of triples: (mode-char 'on/'off argument) 5059 (arg-modes nil); list of triples: (mode-char 'on/'off argument)
4972 (add-p t)) 5060 (add-p t))
4973 ;; make the argument list 5061 ;; make the argument list
4974 (while (string-match "^\\s-*\\(\\S-+\\)\\(\\s-+.*$\\|$\\)" args-str) 5062 (while (string-match "^\\s-*\\(\\S-+\\)\\(\\s-+.*$\\|$\\)" args-str)
4975 (setq args (cons (match-string 1 args-str) args)) 5063 (setq args (cons (match-string 1 args-str) args))
4976 (setq args-str (match-string 2 args-str))) 5064 (setq args-str (match-string 2 args-str)))
4977 (setq args (nreverse args)) 5065 (setq args (nreverse args))
4978 ;; collect what modes changed, and match them with arguments 5066 ;; collect what modes changed, and match them with arguments
4979 (while chars 5067 (while chars
4980 (cond ((string= (car chars) "+") (setq add-p t)) 5068 (cond ((string= (car chars) "+") (setq add-p t))
4981 ((string= (car chars) "-") (setq add-p nil)) 5069 ((string= (car chars) "-") (setq add-p nil))
4982 ((string-match "^[ovbOVB]" (car chars)) 5070 ((string-match "^[qaovhbQAOVHB]" (car chars))
4983 (setq arg-modes (cons (list (car chars) 5071 (setq arg-modes (cons (list (car chars)
4984 (if add-p 'on 'off) 5072 (if add-p 'on 'off)
4985 (if args (car args) nil)) 5073 (if args (car args) nil))
4986 arg-modes)) 5074 arg-modes))
4987 (if args (setq args (cdr args)))) 5075 (if args (setq args (cdr args))))
4988 ((string-match "^[LlKk]" (car chars)) 5076 ((string-match "^[LlKk]" (car chars))
4989 (setq arg-modes (cons (list (car chars) 5077 (setq arg-modes (cons (list (car chars)
4990 (if add-p 'on 'off) 5078 (if add-p 'on 'off)
4991 (if (and add-p args) 5079 (if (and add-p args)
4992 (car args) nil)) 5080 (car args) nil))
4993 arg-modes)) 5081 arg-modes))
4994 (if (and add-p args) (setq args (cdr args)))) 5082 (if (and add-p args) (setq args (cdr args))))
4995 (add-p (setq add-modes (cons (car chars) add-modes))) 5083 (add-p (setq add-modes (cons (car chars) add-modes)))
4996 (t (setq remove-modes (cons (car chars) remove-modes)))) 5084 (t (setq remove-modes (cons (car chars) remove-modes))))
4997 (setq chars (cdr chars))) 5085 (setq chars (cdr chars)))
4998 (setq add-modes (nreverse add-modes)) 5086 (setq add-modes (nreverse add-modes))
4999 (setq remove-modes (nreverse remove-modes)) 5087 (setq remove-modes (nreverse remove-modes))
5000 (setq arg-modes (nreverse arg-modes)) 5088 (setq arg-modes (nreverse arg-modes))
5001 (list add-modes remove-modes arg-modes)) 5089 (list add-modes remove-modes arg-modes))
5002 nil)) 5090 nil))
5003 5091
5004(defun erc-update-modes (tgt mode-string &optional nick host login) 5092(defun erc-update-modes (tgt mode-string &optional _nick _host _login)
5005 "Update the mode information for TGT, provided as MODE-STRING. 5093 "Update the mode information for TGT, provided as MODE-STRING.
5006Optional arguments: NICK, HOST and LOGIN - the attributes of the 5094Optional arguments: NICK, HOST and LOGIN - the attributes of the
5007person who changed the modes." 5095person who changed the modes."
5008 ;; FIXME: neither of nick, host, and login are used! 5096 ;; FIXME: neither of nick, host, and login are used!
5009 (let* ((modes (erc-parse-modes mode-string)) 5097 (let* ((modes (erc-parse-modes mode-string))
5010 (add-modes (nth 0 modes)) 5098 (add-modes (nth 0 modes))
5011 (remove-modes (nth 1 modes)) 5099 (remove-modes (nth 1 modes))
5012 ;; list of triples: (mode-char 'on/'off argument) 5100 ;; list of triples: (mode-char 'on/'off argument)
5013 (arg-modes (nth 2 modes))) 5101 (arg-modes (nth 2 modes)))
5014 ;; now parse the modes changes and do the updates 5102 ;; now parse the modes changes and do the updates
5015 (cond ((erc-channel-p tgt); channel modes 5103 (cond ((erc-channel-p tgt); channel modes
5016 (let ((buf (and erc-server-process 5104 (let ((buf (and erc-server-process
5017 (erc-get-buffer tgt erc-server-process)))) 5105 (erc-get-buffer tgt erc-server-process))))
5018 (when buf 5106 (when buf
5019 ;; FIXME! This used to have an original buffer 5107 ;; FIXME! This used to have an original buffer
5020 ;; variable, but it never switched back to the original 5108 ;; variable, but it never switched back to the original
5021 ;; buffer. Is this wanted behavior? 5109 ;; buffer. Is this wanted behavior?
5022 (set-buffer buf) 5110 (set-buffer buf)
5023 (if (not (boundp 'erc-channel-modes)) 5111 (if (not (boundp 'erc-channel-modes))
5024 (setq erc-channel-modes nil)) 5112 (setq erc-channel-modes nil))
5025 (while remove-modes 5113 (while remove-modes
5026 (setq erc-channel-modes (delete (car remove-modes) 5114 (setq erc-channel-modes (delete (car remove-modes)
5027 erc-channel-modes) 5115 erc-channel-modes)
5028 remove-modes (cdr remove-modes))) 5116 remove-modes (cdr remove-modes)))
5029 (while add-modes 5117 (while add-modes
5030 (setq erc-channel-modes (cons (car add-modes) 5118 (setq erc-channel-modes (cons (car add-modes)
5031 erc-channel-modes) 5119 erc-channel-modes)
5032 add-modes (cdr add-modes))) 5120 add-modes (cdr add-modes)))
5033 (setq erc-channel-modes (erc-sort-strings erc-channel-modes)) 5121 (setq erc-channel-modes (erc-sort-strings erc-channel-modes))
5034 (while arg-modes 5122 (while arg-modes
5035 (let ((mode (nth 0 (car arg-modes))) 5123 (let ((mode (nth 0 (car arg-modes)))
5036 (onoff (nth 1 (car arg-modes))) 5124 (onoff (nth 1 (car arg-modes)))
5037 (arg (nth 2 (car arg-modes)))) 5125 (arg (nth 2 (car arg-modes))))
5038 (cond ((string-match "^[oO]" mode) 5126 (cond ((string-match "^[Vv]" mode)
5039 (erc-update-channel-member tgt arg arg nil onoff)) 5127 (erc-update-channel-member tgt arg arg nil onoff))
5040 ((string-match "^[Vv]" mode) 5128 ((string-match "^[hH]" mode)
5041 (erc-update-channel-member tgt arg arg nil nil 5129 (erc-update-channel-member tgt arg arg nil nil onoff))
5042 onoff)) 5130 ((string-match "^[oO]" mode)
5043 ((string-match "^[Ll]" mode) 5131 (erc-update-channel-member tgt arg arg nil nil nil onoff))
5044 (erc-update-channel-limit tgt onoff arg)) 5132 ((string-match "^[aA]" mode)
5045 ((string-match "^[Kk]" mode) 5133 (erc-update-channel-member tgt arg arg nil nil nil nil onoff))
5046 (erc-update-channel-key tgt onoff arg)) 5134 ((string-match "^[qQ]" mode)
5047 (t nil)); only ops are tracked now 5135 (erc-update-channel-member tgt arg arg nil nil nil nil nil onoff))
5048 (setq arg-modes (cdr arg-modes)))) 5136 ((string-match "^[Ll]" mode)
5049 (erc-update-mode-line buf)))) 5137 (erc-update-channel-limit tgt onoff arg))
5050 ;; nick modes - ignored at this point 5138 ((string-match "^[Kk]" mode)
5051 (t nil)))) 5139 (erc-update-channel-key tgt onoff arg))
5140 (t nil)); only ops are tracked now
5141 (setq arg-modes (cdr arg-modes))))
5142 (erc-update-mode-line buf))))
5143 ;; nick modes - ignored at this point
5144 (t nil))))
5052 5145
5053(defun erc-update-channel-limit (channel onoff n) 5146(defun erc-update-channel-limit (channel onoff n)
5054 ;; FIXME: what does ONOFF actually do? -- Lawrence 2004-01-08 5147 ;; FIXME: what does ONOFF actually do? -- Lawrence 2004-01-08
5055 "Update CHANNEL's user limit to N." 5148 "Update CHANNEL's user limit to N."
5056 (if (or (not (eq onoff 'on)) 5149 (if (or (not (eq onoff 'on))
5057 (and (stringp n) (string-match "^[0-9]+$" n))) 5150 (and (stringp n) (string-match "^[0-9]+$" n)))
5058 (erc-with-buffer 5151 (erc-with-buffer
5059 (channel) 5152 (channel)
5060 (cond ((eq onoff 'on) (setq erc-channel-user-limit (string-to-number n))) 5153 (cond ((eq onoff 'on) (setq erc-channel-user-limit (string-to-number n)))
5061 (t (setq erc-channel-user-limit nil)))))) 5154 (t (setq erc-channel-user-limit nil))))))
5062 5155
5063(defun erc-update-channel-key (channel onoff key) 5156(defun erc-update-channel-key (channel onoff key)
5064 "Update CHANNEL's key to KEY if ONOFF is 'on or to nil if it's 'off." 5157 "Update CHANNEL's key to KEY if ONOFF is 'on or to nil if it's 'off."
5065 (erc-with-buffer 5158 (erc-with-buffer
5066 (channel) 5159 (channel)
5067 (cond ((eq onoff 'on) (setq erc-channel-key key)) 5160 (cond ((eq onoff 'on) (setq erc-channel-key key))
5068 (t (setq erc-channel-key nil))))) 5161 (t (setq erc-channel-key nil)))))
5069 5162
5070(defun erc-handle-user-status-change (type nlh &optional l) 5163(defun erc-handle-user-status-change (type nlh &optional l)
5071 "Handle changes in any user's status. 5164 "Handle changes in any user's status.
@@ -5078,9 +5171,9 @@ and L is a list containing additional TYPE-specific arguments.
5078 5171
5079So far the following TYPE/L pairs are supported: 5172So far the following TYPE/L pairs are supported:
5080 5173
5081 Event TYPE L 5174 Event TYPE L
5082 5175
5083 nickname change 'nick (NEW-NICK)" 5176 nickname change 'nick (NEW-NICK)"
5084 (erc-log (format "user-change: type: %S nlh: %S l: %S" type nlh l)) 5177 (erc-log (format "user-change: type: %S nlh: %S l: %S" type nlh l))
5085 (cond 5178 (cond
5086 ;; nickname change 5179 ;; nickname change
@@ -5095,7 +5188,7 @@ See also variable `erc-notice-highlight-type'."
5095 (cond 5188 (cond
5096 ((eq erc-notice-highlight-type 'prefix) 5189 ((eq erc-notice-highlight-type 'prefix)
5097 (erc-put-text-property 0 (length erc-notice-prefix) 5190 (erc-put-text-property 0 (length erc-notice-prefix)
5098 'face 'erc-notice-face s) 5191 'face 'erc-notice-face s)
5099 s) 5192 s)
5100 ((eq erc-notice-highlight-type 'all) 5193 ((eq erc-notice-highlight-type 'all)
5101 (erc-put-text-property 0 (length s) 'face 'erc-notice-face s) 5194 (erc-put-text-property 0 (length s) 'face 'erc-notice-face s)
@@ -5139,13 +5232,13 @@ Return a list of the three separate tokens."
5139 (cond 5232 (cond
5140 ((string-match "^\\([^!\n]*\\)!\\([^@\n]*\\)@\\(.*\\)$" string) 5233 ((string-match "^\\([^!\n]*\\)!\\([^@\n]*\\)@\\(.*\\)$" string)
5141 (list (match-string 1 string) 5234 (list (match-string 1 string)
5142 (match-string 2 string) 5235 (match-string 2 string)
5143 (match-string 3 string))) 5236 (match-string 3 string)))
5144 ;; Some bogus bouncers send Nick!(null), try to live with that. 5237 ;; Some bogus bouncers send Nick!(null), try to live with that.
5145 ((string-match "^\\([^!\n]*\\)!\\(.*\\)$" string) 5238 ((string-match "^\\([^!\n]*\\)!\\(.*\\)$" string)
5146 (list (match-string 1 string) 5239 (list (match-string 1 string)
5147 "" 5240 ""
5148 (match-string 2 string))) 5241 (match-string 2 string)))
5149 (t 5242 (t
5150 (list string "" "")))) 5243 (list string "" ""))))
5151 5244
@@ -5156,7 +5249,7 @@ See also `erc-parse-user'."
5156 (car (erc-parse-user string))) 5249 (car (erc-parse-user string)))
5157 5250
5158(defun erc-put-text-properties (start end properties 5251(defun erc-put-text-properties (start end properties
5159 &optional object value-list) 5252 &optional object value-list)
5160 "Set text-properties for OBJECT. 5253 "Set text-properties for OBJECT.
5161 5254
5162START and END describe positions in OBJECT. 5255START and END describe positions in OBJECT.
@@ -5164,7 +5257,7 @@ If VALUE-LIST is nil, set each property in PROPERTIES to t, else set
5164each property to the corresponding value in VALUE-LIST." 5257each property to the corresponding value in VALUE-LIST."
5165 (unless value-list 5258 (unless value-list
5166 (setq value-list (mapcar (lambda (_x) t) 5259 (setq value-list (mapcar (lambda (_x) t)
5167 properties))) 5260 properties)))
5168 (while (and properties value-list) 5261 (while (and properties value-list)
5169 (erc-put-text-property 5262 (erc-put-text-property
5170 start end (pop properties) (pop value-list) object))) 5263 start end (pop properties) (pop value-list) object)))
@@ -5176,7 +5269,7 @@ each property to the corresponding value in VALUE-LIST."
5176 5269
5177Specifically, return the position of `erc-insert-marker'." 5270Specifically, return the position of `erc-insert-marker'."
5178 (or (and (boundp 'erc-insert-marker) 5271 (or (and (boundp 'erc-insert-marker)
5179 (markerp erc-insert-marker)) 5272 (markerp erc-insert-marker))
5180 (error "erc-insert-marker has no value, please report a bug")) 5273 (error "erc-insert-marker has no value, please report a bug"))
5181 (marker-position erc-insert-marker)) 5274 (marker-position erc-insert-marker))
5182 5275
@@ -5206,43 +5299,43 @@ submitted line to be intentional."
5206 (interactive) 5299 (interactive)
5207 (let ((now (float-time))) 5300 (let ((now (float-time)))
5208 (if (or (not erc-accidental-paste-threshold-seconds) 5301 (if (or (not erc-accidental-paste-threshold-seconds)
5209 (< erc-accidental-paste-threshold-seconds 5302 (< erc-accidental-paste-threshold-seconds
5210 (- now erc-last-input-time))) 5303 (- now erc-last-input-time)))
5211 (save-restriction 5304 (save-restriction
5212 (widen) 5305 (widen)
5213 (if (< (point) (erc-beg-of-input-line)) 5306 (if (< (point) (erc-beg-of-input-line))
5214 (erc-error "Point is not in the input area") 5307 (erc-error "Point is not in the input area")
5215 (let ((inhibit-read-only t) 5308 (let ((inhibit-read-only t)
5216 (str (erc-user-input)) 5309 (str (erc-user-input))
5217 (old-buf (current-buffer))) 5310 (old-buf (current-buffer)))
5218 (if (and (not (erc-server-buffer-live-p)) 5311 (if (and (not (erc-server-buffer-live-p))
5219 (not (erc-command-no-process-p str))) 5312 (not (erc-command-no-process-p str)))
5220 (erc-error "ERC: No process running") 5313 (erc-error "ERC: No process running")
5221 (erc-set-active-buffer (current-buffer)) 5314 (erc-set-active-buffer (current-buffer))
5222 ;; Kill the input and the prompt 5315 ;; Kill the input and the prompt
5223 (delete-region (erc-beg-of-input-line) 5316 (delete-region (erc-beg-of-input-line)
5224 (erc-end-of-input-line)) 5317 (erc-end-of-input-line))
5225 (unwind-protect 5318 (unwind-protect
5226 (erc-send-input str) 5319 (erc-send-input str)
5227 ;; Fix the buffer if the command didn't kill it 5320 ;; Fix the buffer if the command didn't kill it
5228 (when (buffer-live-p old-buf) 5321 (when (buffer-live-p old-buf)
5229 (with-current-buffer old-buf 5322 (with-current-buffer old-buf
5230 (save-restriction 5323 (save-restriction
5231 (widen) 5324 (widen)
5232 (goto-char (point-max)) 5325 (goto-char (point-max))
5233 (when (processp erc-server-process) 5326 (when (processp erc-server-process)
5234 (set-marker (process-mark erc-server-process) (point))) 5327 (set-marker (process-mark erc-server-process) (point)))
5235 (set-marker erc-insert-marker (point)) 5328 (set-marker erc-insert-marker (point))
5236 (let ((buffer-modified (buffer-modified-p))) 5329 (let ((buffer-modified (buffer-modified-p)))
5237 (erc-display-prompt) 5330 (erc-display-prompt)
5238 (set-buffer-modified-p buffer-modified)))))) 5331 (set-buffer-modified-p buffer-modified))))))
5239 5332
5240 ;; Only when last hook has been run... 5333 ;; Only when last hook has been run...
5241 (run-hook-with-args 'erc-send-completed-hook str)))) 5334 (run-hook-with-args 'erc-send-completed-hook str))))
5242 (setq erc-last-input-time now)) 5335 (setq erc-last-input-time now))
5243 (switch-to-buffer "*ERC Accidental Paste Overflow*") 5336 (switch-to-buffer "*ERC Accidental Paste Overflow*")
5244 (lwarn 'erc :warning 5337 (lwarn 'erc :warning
5245 "You seem to have accidentally pasted some text!")))) 5338 "You seem to have accidentally pasted some text!"))))
5246 5339
5247(defun erc-user-input () 5340(defun erc-user-input ()
5248 "Return the input of the user in the current buffer." 5341 "Return the input of the user in the current buffer."
@@ -5261,7 +5354,7 @@ This returns non-nil only if we actually send anything."
5261 (cond 5354 (cond
5262 ;; Ignore empty input 5355 ;; Ignore empty input
5263 ((if erc-send-whitespace-lines 5356 ((if erc-send-whitespace-lines
5264 (string= input "") 5357 (string= input "")
5265 (string-match "\\`[ \t\r\f\n]*\\'" input)) 5358 (string-match "\\`[ \t\r\f\n]*\\'" input))
5266 (when erc-warn-about-blank-lines 5359 (when erc-warn-about-blank-lines
5267 (message "Blank line - ignoring...") 5360 (message "Blank line - ignoring...")
@@ -5270,48 +5363,46 @@ This returns non-nil only if we actually send anything."
5270 (t 5363 (t
5271 (defvar str) ;; FIXME: Make it obey the "erc-" prefix convention. 5364 (defvar str) ;; FIXME: Make it obey the "erc-" prefix convention.
5272 (let ((str input) 5365 (let ((str input)
5273 (erc-insert-this t)) 5366 (erc-insert-this t))
5274 (setq erc-send-this t) 5367 (setq erc-send-this t)
5275 (run-hook-with-args 'erc-send-pre-hook input) 5368 (run-hook-with-args 'erc-send-pre-hook input)
5276 (when erc-send-this 5369 (when erc-send-this
5277 (if (or (string-match "\n" str) 5370 (if (or (string-match "\n" str)
5278 (not (string-match erc-command-regexp str))) 5371 (not (string-match erc-command-regexp str)))
5279 (mapc 5372 (mapc
5280 (lambda (line) 5373 (lambda (line)
5281 (mapc 5374 (mapc
5282 (lambda (line) 5375 (lambda (line)
5283 ;; Insert what has to be inserted for this. 5376 ;; Insert what has to be inserted for this.
5284 (erc-display-msg line) 5377 (erc-display-msg line)
5285 (erc-process-input-line (concat line "\n") 5378 (erc-process-input-line (concat line "\n")
5286 (null erc-flood-protect) t)) 5379 (null erc-flood-protect) t))
5287 (or (and erc-flood-protect (erc-split-line line)) 5380 (or (and erc-flood-protect (erc-split-line line))
5288 (list line)))) 5381 (list line))))
5289 (split-string str "\n")) 5382 (split-string str "\n"))
5290 ;; Insert the prompt along with the command. 5383 (erc-process-input-line (concat str "\n") t nil))
5291 (erc-display-command str) 5384 t)))))
5292 (erc-process-input-line (concat str "\n") t nil))
5293 t)))))
5294 5385
5295(defun erc-display-command (line) 5386(defun erc-display-command (line)
5296 (when erc-insert-this 5387 (when erc-insert-this
5297 (let ((insert-position (point))) 5388 (let ((insert-position (point)))
5298 (unless erc-hide-prompt 5389 (unless erc-hide-prompt
5299 (erc-display-prompt nil nil (erc-command-indicator) 5390 (erc-display-prompt nil nil (erc-command-indicator)
5300 (and (erc-command-indicator) 5391 (and (erc-command-indicator)
5301 'erc-command-indicator-face))) 5392 'erc-command-indicator-face)))
5302 (let ((beg (point))) 5393 (let ((beg (point)))
5303 (insert line) 5394 (insert line)
5304 (erc-put-text-property beg (point) 5395 (erc-put-text-property beg (point)
5305 'face 'erc-command-indicator-face) 5396 'face 'erc-command-indicator-face)
5306 (insert "\n")) 5397 (insert "\n"))
5307 (when (processp erc-server-process) 5398 (when (processp erc-server-process)
5308 (set-marker (process-mark erc-server-process) (point))) 5399 (set-marker (process-mark erc-server-process) (point)))
5309 (set-marker erc-insert-marker (point)) 5400 (set-marker erc-insert-marker (point))
5310 (save-excursion 5401 (save-excursion
5311 (save-restriction 5402 (save-restriction
5312 (narrow-to-region insert-position (point)) 5403 (narrow-to-region insert-position (point))
5313 (run-hooks 'erc-send-modify-hook) 5404 (run-hooks 'erc-send-modify-hook)
5314 (run-hooks 'erc-send-post-hook)))))) 5405 (run-hooks 'erc-send-post-hook))))))
5315 5406
5316(defun erc-display-msg (line) 5407(defun erc-display-msg (line)
5317 "Display LINE as a message of the user to the current target at the 5408 "Display LINE as a message of the user to the current target at the
@@ -5320,18 +5411,18 @@ current position."
5320 (let ((insert-position (point))) 5411 (let ((insert-position (point)))
5321 (insert (erc-format-my-nick)) 5412 (insert (erc-format-my-nick))
5322 (let ((beg (point))) 5413 (let ((beg (point)))
5323 (insert line) 5414 (insert line)
5324 (erc-put-text-property beg (point) 5415 (erc-put-text-property beg (point)
5325 'face 'erc-input-face)) 5416 'face 'erc-input-face))
5326 (insert "\n") 5417 (insert "\n")
5327 (when (processp erc-server-process) 5418 (when (processp erc-server-process)
5328 (set-marker (process-mark erc-server-process) (point))) 5419 (set-marker (process-mark erc-server-process) (point)))
5329 (set-marker erc-insert-marker (point)) 5420 (set-marker erc-insert-marker (point))
5330 (save-excursion 5421 (save-excursion
5331 (save-restriction 5422 (save-restriction
5332 (narrow-to-region insert-position (point)) 5423 (narrow-to-region insert-position (point))
5333 (run-hooks 'erc-send-modify-hook) 5424 (run-hooks 'erc-send-modify-hook)
5334 (run-hooks 'erc-send-post-hook)))))) 5425 (run-hooks 'erc-send-post-hook))))))
5335 5426
5336(defun erc-command-symbol (command) 5427(defun erc-command-symbol (command)
5337 "Return the ERC command symbol for COMMAND if it exists and is bound." 5428 "Return the ERC command symbol for COMMAND if it exists and is bound."
@@ -5344,16 +5435,16 @@ If no command was given, return nil. If command matches, return a
5344list of the form: (command args) where both elements are strings." 5435list of the form: (command args) where both elements are strings."
5345 (when (string-match erc-command-regexp line) 5436 (when (string-match erc-command-regexp line)
5346 (let* ((cmd (erc-command-symbol (match-string 1 line))) 5437 (let* ((cmd (erc-command-symbol (match-string 1 line)))
5347 ;; note: return is nil, we apply this simply for side effects 5438 ;; note: return is nil, we apply this simply for side effects
5348 (_canon-defun (while (and cmd (symbolp (symbol-function cmd))) 5439 (_canon-defun (while (and cmd (symbolp (symbol-function cmd)))
5349 (setq cmd (symbol-function cmd)))) 5440 (setq cmd (symbol-function cmd))))
5350 (cmd-fun (or cmd #'erc-cmd-default)) 5441 (cmd-fun (or cmd #'erc-cmd-default))
5351 (arg (if cmd 5442 (arg (if cmd
5352 (if (get cmd-fun 'do-not-parse-args) 5443 (if (get cmd-fun 'do-not-parse-args)
5353 (format "%s" (match-string 2 line)) 5444 (format "%s" (match-string 2 line))
5354 (delete "" (split-string (erc-trim-string 5445 (delete "" (split-string (erc-trim-string
5355 (match-string 2 line)) " "))) 5446 (match-string 2 line)) " ")))
5356 line))) 5447 line)))
5357 (list cmd-fun arg)))) 5448 (list cmd-fun arg))))
5358 5449
5359(defun erc-split-multiline-safe (string) 5450(defun erc-split-multiline-safe (string)
@@ -5361,16 +5452,16 @@ list of the form: (command args) where both elements are strings."
5361Do it only for STRING as the complete input, do not carry unfinished 5452Do it only for STRING as the complete input, do not carry unfinished
5362strings over to the next call." 5453strings over to the next call."
5363 (let ((l ()) 5454 (let ((l ())
5364 (i0 0) 5455 (i0 0)
5365 (doit t)) 5456 (doit t))
5366 (while doit 5457 (while doit
5367 (let ((i (string-match "\r?\n" string i0)) 5458 (let ((i (string-match "\r?\n" string i0))
5368 (s (substring string i0))) 5459 (s (substring string i0)))
5369 (cond (i (setq l (cons (substring string i0 i) l)) 5460 (cond (i (setq l (cons (substring string i0 i) l))
5370 (setq i0 (match-end 0))) 5461 (setq i0 (match-end 0)))
5371 ((> (length s) 0) 5462 ((> (length s) 0)
5372 (setq l (cons s l))(setq doit nil)) 5463 (setq l (cons s l))(setq doit nil))
5373 (t (setq doit nil))))) 5464 (t (setq doit nil)))))
5374 (nreverse l))) 5465 (nreverse l)))
5375 5466
5376;; nick handling 5467;; nick handling
@@ -5378,15 +5469,15 @@ strings over to the next call."
5378(defun erc-set-current-nick (nick) 5469(defun erc-set-current-nick (nick)
5379 "Set the current nickname to NICK." 5470 "Set the current nickname to NICK."
5380 (with-current-buffer (if (buffer-live-p (erc-server-buffer)) 5471 (with-current-buffer (if (buffer-live-p (erc-server-buffer))
5381 (erc-server-buffer) 5472 (erc-server-buffer)
5382 (current-buffer)) 5473 (current-buffer))
5383 (setq erc-server-current-nick nick))) 5474 (setq erc-server-current-nick nick)))
5384 5475
5385(defun erc-current-nick () 5476(defun erc-current-nick ()
5386 "Return the current nickname." 5477 "Return the current nickname."
5387 (with-current-buffer (if (buffer-live-p (erc-server-buffer)) 5478 (with-current-buffer (if (buffer-live-p (erc-server-buffer))
5388 (erc-server-buffer) 5479 (erc-server-buffer)
5389 (current-buffer)) 5480 (current-buffer))
5390 erc-server-current-nick)) 5481 erc-server-current-nick))
5391 5482
5392(defun erc-current-nick-p (nick) 5483(defun erc-current-nick-p (nick)
@@ -5400,7 +5491,7 @@ This matches strings according to the IRC protocol's case convention.
5400 5491
5401See also `erc-downcase'." 5492See also `erc-downcase'."
5402 (string= (erc-downcase nick1) 5493 (string= (erc-downcase nick1)
5403 (erc-downcase nick2))) 5494 (erc-downcase nick2)))
5404 5495
5405;; default target handling 5496;; default target handling
5406 5497
@@ -5415,38 +5506,38 @@ See also `erc-downcase'."
5415(defun erc-add-default-channel (channel) 5506(defun erc-add-default-channel (channel)
5416 "Add CHANNEL to the default channel list." 5507 "Add CHANNEL to the default channel list."
5417 (let ((chl (downcase channel))) 5508 (let ((chl (downcase channel)))
5418 (setq erc-default-recipients 5509 (setq erc-default-recipients
5419 (cons chl erc-default-recipients)))) 5510 (cons chl erc-default-recipients))))
5420 5511
5421(defun erc-delete-default-channel (channel &optional buffer) 5512(defun erc-delete-default-channel (channel &optional buffer)
5422 "Delete CHANNEL from the default channel list." 5513 "Delete CHANNEL from the default channel list."
5423 (with-current-buffer (if (and buffer 5514 (with-current-buffer (if (and buffer
5424 (bufferp buffer)) 5515 (bufferp buffer))
5425 buffer 5516 buffer
5426 (current-buffer)) 5517 (current-buffer))
5427 (setq erc-default-recipients (delete (downcase channel) 5518 (setq erc-default-recipients (delete (downcase channel)
5428 erc-default-recipients)))) 5519 erc-default-recipients))))
5429 5520
5430(defun erc-add-query (nickname) 5521(defun erc-add-query (nickname)
5431 "Add QUERY'd NICKNAME to the default channel list. 5522 "Add QUERY'd NICKNAME to the default channel list.
5432 5523
5433The previous default target of QUERY type gets removed." 5524The previous default target of QUERY type gets removed."
5434 (let ((d1 (car erc-default-recipients)) 5525 (let ((d1 (car erc-default-recipients))
5435 (d2 (cdr erc-default-recipients)) 5526 (d2 (cdr erc-default-recipients))
5436 (qt (cons 'QUERY (downcase nickname)))) 5527 (qt (cons 'QUERY (downcase nickname))))
5437 (setq erc-default-recipients (cons qt (if (and (listp d1) 5528 (setq erc-default-recipients (cons qt (if (and (listp d1)
5438 (eq (car d1) 'QUERY)) 5529 (eq (car d1) 'QUERY))
5439 d2 5530 d2
5440 erc-default-recipients))))) 5531 erc-default-recipients)))))
5441 5532
5442(defun erc-delete-query () 5533(defun erc-delete-query ()
5443 "Delete the topmost target if it is a QUERY." 5534 "Delete the topmost target if it is a QUERY."
5444 5535
5445 (let ((d1 (car erc-default-recipients)) 5536 (let ((d1 (car erc-default-recipients))
5446 (d2 (cdr erc-default-recipients))) 5537 (d2 (cdr erc-default-recipients)))
5447 (if (and (listp d1) 5538 (if (and (listp d1)
5448 (eq (car d1) 'QUERY)) 5539 (eq (car d1) 'QUERY))
5449 (setq erc-default-recipients d2) 5540 (setq erc-default-recipients d2)
5450 (error "Current target is not a QUERY")))) 5541 (error "Current target is not a QUERY"))))
5451 5542
5452(defun erc-ignored-user-p (spec) 5543(defun erc-ignored-user-p (spec)
@@ -5458,7 +5549,7 @@ match, returns that regexp."
5458 (catch 'found 5549 (catch 'found
5459 (dolist (ignored (erc-with-server-buffer erc-ignore-list)) 5550 (dolist (ignored (erc-with-server-buffer erc-ignore-list))
5460 (if (string-match ignored spec) 5551 (if (string-match ignored spec)
5461 (throw 'found ignored))))) 5552 (throw 'found ignored)))))
5462 5553
5463(defun erc-ignored-reply-p (msg tgt proc) 5554(defun erc-ignored-reply-p (msg tgt proc)
5464 ;; FIXME: this docstring needs fixing -- Lawrence 2004-01-08 5555 ;; FIXME: this docstring needs fixing -- Lawrence 2004-01-08
@@ -5468,12 +5559,12 @@ Takes a message MSG to a channel and returns non-nil if the addressed
5468user matches any regexp in `erc-ignore-reply-list'." 5559user matches any regexp in `erc-ignore-reply-list'."
5469 (let ((target-nick (erc-message-target msg))) 5560 (let ((target-nick (erc-message-target msg)))
5470 (if (not target-nick) 5561 (if (not target-nick)
5471 nil 5562 nil
5472 (erc-with-buffer (tgt proc) 5563 (erc-with-buffer (tgt proc)
5473 (let ((user (erc-get-server-user target-nick))) 5564 (let ((user (erc-get-server-user target-nick)))
5474 (when user 5565 (when user
5475 (erc-list-match erc-ignore-reply-list 5566 (erc-list-match erc-ignore-reply-list
5476 (erc-user-spec user)))))))) 5567 (erc-user-spec user))))))))
5477 5568
5478(defun erc-message-target (msg) 5569(defun erc-message-target (msg)
5479 "Return the addressed target in MSG. 5570 "Return the addressed target in MSG.
@@ -5486,19 +5577,19 @@ The addressed target is the string before the first colon in MSG."
5486(defun erc-user-spec (user) 5577(defun erc-user-spec (user)
5487 "Create a nick!user@host spec from a user struct." 5578 "Create a nick!user@host spec from a user struct."
5488 (let ((nick (erc-server-user-nickname user)) 5579 (let ((nick (erc-server-user-nickname user))
5489 (host (erc-server-user-host user)) 5580 (host (erc-server-user-host user))
5490 (login (erc-server-user-login user))) 5581 (login (erc-server-user-login user)))
5491 (concat (or nick "") 5582 (concat (or nick "")
5492 "!" 5583 "!"
5493 (or login "") 5584 (or login "")
5494 "@" 5585 "@"
5495 (or host "")))) 5586 (or host ""))))
5496 5587
5497(defun erc-list-match (lst str) 5588(defun erc-list-match (lst str)
5498 "Return non-nil if any regexp in LST matches STR." 5589 "Return non-nil if any regexp in LST matches STR."
5499 (memq nil (mapcar (lambda (regexp) 5590 (memq nil (mapcar (lambda (regexp)
5500 (not (string-match regexp str))) 5591 (not (string-match regexp str)))
5501 lst))) 5592 lst)))
5502 5593
5503;; other "toggles" 5594;; other "toggles"
5504 5595
@@ -5510,9 +5601,9 @@ If ARG is positive, turns CTCP replies on.
5510If ARG is non-nil and not positive, turns CTCP replies off." 5601If ARG is non-nil and not positive, turns CTCP replies off."
5511 (interactive "P") 5602 (interactive "P")
5512 (cond ((and (numberp arg) (> arg 0)) 5603 (cond ((and (numberp arg) (> arg 0))
5513 (setq erc-disable-ctcp-replies t)) 5604 (setq erc-disable-ctcp-replies t))
5514 (arg (setq erc-disable-ctcp-replies nil)) 5605 (arg (setq erc-disable-ctcp-replies nil))
5515 (t (setq erc-disable-ctcp-replies (not erc-disable-ctcp-replies)))) 5606 (t (setq erc-disable-ctcp-replies (not erc-disable-ctcp-replies))))
5516 (message "ERC CTCP replies are %s" (if erc-disable-ctcp-replies "OFF" "ON"))) 5607 (message "ERC CTCP replies are %s" (if erc-disable-ctcp-replies "OFF" "ON")))
5517 5608
5518(defun erc-toggle-flood-control (&optional arg) 5609(defun erc-toggle-flood-control (&optional arg)
@@ -5525,12 +5616,12 @@ See `erc-server-flood-margin' for an explanation of the available
5525flood control parameters." 5616flood control parameters."
5526 (interactive "P") 5617 (interactive "P")
5527 (cond ((and (numberp arg) (> arg 0)) 5618 (cond ((and (numberp arg) (> arg 0))
5528 (setq erc-flood-protect t)) 5619 (setq erc-flood-protect t))
5529 (arg (setq erc-flood-protect nil)) 5620 (arg (setq erc-flood-protect nil))
5530 (t (setq erc-flood-protect (not erc-flood-protect)))) 5621 (t (setq erc-flood-protect (not erc-flood-protect))))
5531 (message "ERC flood control is %s" 5622 (message "ERC flood control is %s"
5532 (cond (erc-flood-protect "ON") 5623 (cond (erc-flood-protect "ON")
5533 (t "OFF")))) 5624 (t "OFF"))))
5534 5625
5535;; Some useful channel and nick commands for fast key bindings 5626;; Some useful channel and nick commands for fast key bindings
5536 5627
@@ -5543,12 +5634,11 @@ This command is sent even if excess flood is detected."
5543 (interactive "P") 5634 (interactive "P")
5544 (erc-set-active-buffer (current-buffer)) 5635 (erc-set-active-buffer (current-buffer))
5545 (let ((tgt (erc-default-target))) 5636 (let ((tgt (erc-default-target)))
5546 (cond ((or (not tgt) (not (erc-channel-p tgt))) 5637 (if (or (not tgt) (not (erc-channel-p tgt)))
5547 (erc-display-message nil 'error (current-buffer) 'no-target)) 5638 (erc-display-message nil 'error (current-buffer) 'no-target)
5548 (arg (erc-load-irc-script-lines (list (concat "/mode " tgt " -i")) 5639 (erc-load-irc-script-lines
5549 t)) 5640 (list (concat "/mode " tgt (if arg " -i" " +i")))
5550 (t (erc-load-irc-script-lines (list (concat "/mode " tgt " +i")) 5641 t))))
5551 t)))))
5552 5642
5553(defun erc-get-channel-mode-from-keypress (key) 5643(defun erc-get-channel-mode-from-keypress (key)
5554 "Read a key sequence and call the corresponding channel mode function. 5644 "Read a key sequence and call the corresponding channel mode function.
@@ -5563,14 +5653,14 @@ Anything else will be sent to `erc-toggle-channel-mode'."
5563 (when (featurep 'xemacs) 5653 (when (featurep 'xemacs)
5564 (setq key (char-to-string (event-to-character (aref key 0))))) 5654 (setq key (char-to-string (event-to-character (aref key 0)))))
5565 (cond ((equal key "\C-g") 5655 (cond ((equal key "\C-g")
5566 (keyboard-quit)) 5656 (keyboard-quit))
5567 ((equal key "\C-m") 5657 ((equal key "\C-m")
5568 (erc-insert-mode-command)) 5658 (erc-insert-mode-command))
5569 ((equal key "l") 5659 ((equal key "l")
5570 (call-interactively 'erc-set-channel-limit)) 5660 (call-interactively 'erc-set-channel-limit))
5571 ((equal key "k") 5661 ((equal key "k")
5572 (call-interactively 'erc-set-channel-key)) 5662 (call-interactively 'erc-set-channel-key))
5573 (t (erc-toggle-channel-mode key)))) 5663 (t (erc-toggle-channel-mode key))))
5574 5664
5575(defun erc-toggle-channel-mode (mode &optional channel) 5665(defun erc-toggle-channel-mode (mode &optional channel)
5576 "Toggle channel MODE. 5666 "Toggle channel MODE.
@@ -5580,15 +5670,14 @@ If CHANNEL is non-nil, toggle MODE for that channel, otherwise use
5580 (interactive "P") 5670 (interactive "P")
5581 (erc-set-active-buffer (current-buffer)) 5671 (erc-set-active-buffer (current-buffer))
5582 (let ((tgt (or channel (erc-default-target)))) 5672 (let ((tgt (or channel (erc-default-target))))
5583 (cond ((or (null tgt) (null (erc-channel-p tgt))) 5673 (if (or (null tgt) (null (erc-channel-p tgt)))
5584 (erc-display-message nil 'error 'active 'no-target)) 5674 (erc-display-message nil 'error 'active 'no-target)
5585 ((member mode erc-channel-modes) 5675 (let* ((active (member mode erc-channel-modes))
5586 (erc-log (format "%s: Toggle mode %s OFF" tgt mode)) 5676 (newstate (if active "OFF" "ON")))
5587 (message "Toggle channel mode %s OFF" mode) 5677 (erc-log (format "%s: Toggle mode %s %s" tgt mode newstate))
5588 (erc-server-send (format "MODE %s -%s" tgt mode))) 5678 (message "Toggle channel mode %s %s" mode newstate)
5589 (t (erc-log (format "%s: Toggle channel mode %s ON" tgt mode)) 5679 (erc-server-send (format "MODE %s %s%s"
5590 (message "Toggle channel mode %s ON" mode) 5680 tgt (if active "-" "+") mode))))))
5591 (erc-server-send (format "MODE %s +%s" tgt mode))))))
5592 5681
5593(defun erc-insert-mode-command () 5682(defun erc-insert-mode-command ()
5594 "Insert the line \"/mode <current target> \" at `point'." 5683 "Insert the line \"/mode <current target> \" at `point'."
@@ -5624,9 +5713,9 @@ If FILE is found, return the path to it."
5624 (let ((filepath file)) 5713 (let ((filepath file))
5625 (if (file-readable-p filepath) filepath 5714 (if (file-readable-p filepath) filepath
5626 (while (and path 5715 (while (and path
5627 (progn (setq filepath (expand-file-name file (car path))) 5716 (progn (setq filepath (expand-file-name file (car path)))
5628 (not (file-readable-p filepath)))) 5717 (not (file-readable-p filepath))))
5629 (setq path (cdr path))) 5718 (setq path (cdr path)))
5630 (if path filepath nil)))) 5719 (if path filepath nil))))
5631 5720
5632(defun erc-select-startup-file () 5721(defun erc-select-startup-file ()
@@ -5636,7 +5725,7 @@ See also `erc-startup-file-list'."
5636 (dolist (f erc-startup-file-list) 5725 (dolist (f erc-startup-file-list)
5637 (setq f (convert-standard-filename f)) 5726 (setq f (convert-standard-filename f))
5638 (when (file-readable-p f) 5727 (when (file-readable-p f)
5639 (throw 'found f))))) 5728 (throw 'found f)))))
5640 5729
5641(defun erc-find-script-file (file) 5730(defun erc-find-script-file (file)
5642 "Search for FILE in `default-directory', and any in `erc-script-path'." 5731 "Search for FILE in `default-directory', and any in `erc-script-path'."
@@ -5651,7 +5740,7 @@ as an Emacs Lisp program. Otherwise, treat it as a regular IRC
5651script." 5740script."
5652 (erc-log (concat "erc-load-script: " file)) 5741 (erc-log (concat "erc-load-script: " file))
5653 (cond 5742 (cond
5654 ((string-match "\\.el$" file) 5743 ((string-match "\\.el\\'" file)
5655 (load file)) 5744 (load file))
5656 (t 5745 (t
5657 (erc-load-irc-script file)))) 5746 (erc-load-irc-script file))))
@@ -5669,15 +5758,15 @@ $* = the entire argument string, $1 = the first argument, $2 = the second,
5669and so on." 5758and so on."
5670 (if (not args) (setq args "")) 5759 (if (not args) (setq args ""))
5671 (let* ((arg-esc-regexp "\\(\\$\\(\\*\\|[1-9][0-9]*\\)\\)\\([^0-9]\\|$\\)") 5760 (let* ((arg-esc-regexp "\\(\\$\\(\\*\\|[1-9][0-9]*\\)\\)\\([^0-9]\\|$\\)")
5672 (percent-regexp "\\(%.\\)") 5761 (percent-regexp "\\(%.\\)")
5673 (esc-regexp (concat arg-esc-regexp "\\|" percent-regexp)) 5762 (esc-regexp (concat arg-esc-regexp "\\|" percent-regexp))
5674 (tgt (erc-default-target)) 5763 (tgt (erc-default-target))
5675 (server (and (boundp 'erc-session-server) erc-session-server)) 5764 (server (and (boundp 'erc-session-server) erc-session-server))
5676 (nick (erc-current-nick)) 5765 (nick (erc-current-nick))
5677 (res "") 5766 (res "")
5678 (tmp nil) 5767 (tmp nil)
5679 (arg-list nil) 5768 (arg-list nil)
5680 (arg-num 0)) 5769 (arg-num 0))
5681 (if (not tgt) (setq tgt "")) 5770 (if (not tgt) (setq tgt ""))
5682 (if (not server) (setq server "")) 5771 (if (not server) (setq server ""))
5683 (if (not nick) (setq nick "")) 5772 (if (not nick) (setq nick ""))
@@ -5693,36 +5782,36 @@ and so on."
5693 (while tmp 5782 (while tmp
5694 ;;(message "beginning of while: tmp=%S" tmp) 5783 ;;(message "beginning of while: tmp=%S" tmp)
5695 (let* ((hd (substring line 0 tmp)) 5784 (let* ((hd (substring line 0 tmp))
5696 (esc "") 5785 (esc "")
5697 (subst "") 5786 (subst "")
5698 (tail (substring line tmp))) 5787 (tail (substring line tmp)))
5699 (cond ((string-match (concat "^" arg-esc-regexp) tail) 5788 (cond ((string-match (concat "^" arg-esc-regexp) tail)
5700 (setq esc (match-string 1 tail)) 5789 (setq esc (match-string 1 tail))
5701 (setq tail (substring tail (match-end 1)))) 5790 (setq tail (substring tail (match-end 1))))
5702 ((string-match (concat "^" percent-regexp) tail) 5791 ((string-match (concat "^" percent-regexp) tail)
5703 (setq esc (match-string 1 tail)) 5792 (setq esc (match-string 1 tail))
5704 (setq tail (substring tail (match-end 1))))) 5793 (setq tail (substring tail (match-end 1)))))
5705 ;;(message "hd=%S, esc=%S, tail=%S, arg-num=%S" hd esc tail arg-num) 5794 ;;(message "hd=%S, esc=%S, tail=%S, arg-num=%S" hd esc tail arg-num)
5706 (setq res (concat res hd)) 5795 (setq res (concat res hd))
5707 (setq subst 5796 (setq subst
5708 (cond ((string= esc "") "") 5797 (cond ((string= esc "") "")
5709 ((string-match "^\\$\\*$" esc) args) 5798 ((string-match "^\\$\\*$" esc) args)
5710 ((string-match "^\\$\\([0-9]+\\)$" esc) 5799 ((string-match "^\\$\\([0-9]+\\)$" esc)
5711 (let ((n (string-to-number (match-string 1 esc)))) 5800 (let ((n (string-to-number (match-string 1 esc))))
5712 (message "n = %S, integerp(n)=%S" n (integerp n)) 5801 (message "n = %S, integerp(n)=%S" n (integerp n))
5713 (if (<= n arg-num) (nth (1- n) arg-list) ""))) 5802 (if (<= n arg-num) (nth (1- n) arg-list) "")))
5714 ((string-match "^%[Cc]$" esc) tgt) 5803 ((string-match "^%[Cc]$" esc) tgt)
5715 ((string-match "^%[Ss]$" esc) server) 5804 ((string-match "^%[Ss]$" esc) server)
5716 ((string-match "^%[Nn]$" esc) nick) 5805 ((string-match "^%[Nn]$" esc) nick)
5717 ((string-match "^%\\(.\\)$" esc) (match-string 1 esc)) 5806 ((string-match "^%\\(.\\)$" esc) (match-string 1 esc))
5718 (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc)) 5807 (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc))
5719 (message "BUG IN ERC: esc=%S" esc) 5808 (message "BUG IN ERC: esc=%S" esc)
5720 ""))) 5809 "")))
5721 (setq line tail) 5810 (setq line tail)
5722 (setq tmp (string-match esc-regexp line)) 5811 (setq tmp (string-match esc-regexp line))
5723 (setq res (concat res subst)) 5812 (setq res (concat res subst))
5724 ;;(message "end of while: line=%S, res=%S, tmp=%S" line res tmp) 5813 ;;(message "end of while: line=%S, res=%S, tmp=%S" line res tmp)
5725 )) 5814 ))
5726 (setq res (concat res line)) 5815 (setq res (concat res line))
5727 res)) 5816 res))
5728 5817
@@ -5730,8 +5819,8 @@ and so on."
5730 "Load an IRC script from FILE." 5819 "Load an IRC script from FILE."
5731 (erc-log (concat "erc-load-script: " file)) 5820 (erc-log (concat "erc-load-script: " file))
5732 (let ((str (with-temp-buffer 5821 (let ((str (with-temp-buffer
5733 (insert-file-contents file) 5822 (insert-file-contents file)
5734 (buffer-string)))) 5823 (buffer-string))))
5735 (erc-load-irc-script-lines (erc-split-multiline-safe str) force))) 5824 (erc-load-irc-script-lines (erc-split-multiline-safe str) force)))
5736 5825
5737(defun erc-load-irc-script-lines (lines &optional force noexpand) 5826(defun erc-load-irc-script-lines (lines &optional force noexpand)
@@ -5741,25 +5830,25 @@ If optional NOEXPAND is non-nil, do not expand script-specific
5741sequences, process the lines verbatim. Use this for multiline 5830sequences, process the lines verbatim. Use this for multiline
5742user input." 5831user input."
5743 (let* ((cb (current-buffer)) 5832 (let* ((cb (current-buffer))
5744 (s "") 5833 (s "")
5745 (sp (or (erc-command-indicator) (erc-prompt))) 5834 (sp (or (erc-command-indicator) (erc-prompt)))
5746 (args (and (boundp 'erc-script-args) erc-script-args))) 5835 (args (and (boundp 'erc-script-args) erc-script-args)))
5747 (if (and args (string-match "^ " args)) 5836 (if (and args (string-match "^ " args))
5748 (setq args (substring args 1))) 5837 (setq args (substring args 1)))
5749 ;; prepare the prompt string for echo 5838 ;; prepare the prompt string for echo
5750 (erc-put-text-property 0 (length sp) 5839 (erc-put-text-property 0 (length sp)
5751 'face 'erc-command-indicator-face sp) 5840 'face 'erc-command-indicator-face sp)
5752 (while lines 5841 (while lines
5753 (setq s (car lines)) 5842 (setq s (car lines))
5754 (erc-log (concat "erc-load-script: CMD: " s)) 5843 (erc-log (concat "erc-load-script: CMD: " s))
5755 (unless (string-match "^\\s-*$" s) 5844 (unless (string-match "^\\s-*$" s)
5756 (let ((line (if noexpand s (erc-process-script-line s args)))) 5845 (let ((line (if noexpand s (erc-process-script-line s args))))
5757 (if (and (erc-process-input-line line force) 5846 (if (and (erc-process-input-line line force)
5758 erc-script-echo) 5847 erc-script-echo)
5759 (progn 5848 (progn
5760 (erc-put-text-property 0 (length line) 5849 (erc-put-text-property 0 (length line)
5761 'face 'erc-input-face line) 5850 'face 'erc-input-face line)
5762 (erc-display-line (concat sp line) cb))))) 5851 (erc-display-line (concat sp line) cb)))))
5763 (setq lines (cdr lines))))) 5852 (setq lines (cdr lines)))))
5764 5853
5765;; authentication 5854;; authentication
@@ -5767,21 +5856,21 @@ user input."
5767(defun erc-login () 5856(defun erc-login ()
5768 "Perform user authentication at the IRC server." 5857 "Perform user authentication at the IRC server."
5769 (erc-log (format "login: nick: %s, user: %s %s %s :%s" 5858 (erc-log (format "login: nick: %s, user: %s %s %s :%s"
5770 (erc-current-nick) 5859 (erc-current-nick)
5771 (user-login-name) 5860 (user-login-name)
5772 (or erc-system-name (system-name)) 5861 (or erc-system-name (system-name))
5773 erc-session-server 5862 erc-session-server
5774 erc-session-user-full-name)) 5863 erc-session-user-full-name))
5775 (if erc-session-password 5864 (if erc-session-password
5776 (erc-server-send (format "PASS %s" erc-session-password)) 5865 (erc-server-send (format "PASS %s" erc-session-password))
5777 (message "Logging in without password")) 5866 (message "Logging in without password"))
5778 (erc-server-send (format "NICK %s" (erc-current-nick))) 5867 (erc-server-send (format "NICK %s" (erc-current-nick)))
5779 (erc-server-send 5868 (erc-server-send
5780 (format "USER %s %s %s :%s" 5869 (format "USER %s %s %s :%s"
5781 ;; hacked - S.B. 5870 ;; hacked - S.B.
5782 (if erc-anonymous-login erc-email-userid (user-login-name)) 5871 (if erc-anonymous-login erc-email-userid (user-login-name))
5783 "0" "*" 5872 "0" "*"
5784 erc-session-user-full-name)) 5873 erc-session-user-full-name))
5785 (erc-update-mode-line)) 5874 (erc-update-mode-line))
5786 5875
5787;; connection properties' heuristics 5876;; connection properties' heuristics
@@ -5797,8 +5886,8 @@ Sets the buffer local variables:
5797- `erc-server-current-nick'" 5886- `erc-server-current-nick'"
5798 (setq erc-session-connector erc-server-connect-function 5887 (setq erc-session-connector erc-server-connect-function
5799 erc-session-server (erc-compute-server server) 5888 erc-session-server (erc-compute-server server)
5800 erc-session-port (or port erc-default-port) 5889 erc-session-port (or port erc-default-port)
5801 erc-session-user-full-name (erc-compute-full-name name)) 5890 erc-session-user-full-name (erc-compute-full-name name))
5802 (erc-set-current-nick (erc-compute-nick nick))) 5891 (erc-set-current-nick (erc-compute-nick nick)))
5803 5892
5804(defun erc-compute-server (&optional server) 5893(defun erc-compute-server (&optional server)
@@ -5866,19 +5955,12 @@ non-nil value is found.
5866Returns a list of the form (HIGH LOW), compatible with Emacs time format." 5955Returns a list of the form (HIGH LOW), compatible with Emacs time format."
5867 (let* ((n (string-to-number (concat string ".0")))) 5956 (let* ((n (string-to-number (concat string ".0"))))
5868 (list (truncate (/ n 65536)) 5957 (list (truncate (/ n 65536))
5869 (truncate (mod n 65536))))) 5958 (truncate (mod n 65536)))))
5870
5871(defun erc-emacs-time-to-erc-time (time)
5872 "Convert Emacs TIME to a number of seconds since the epoch."
5873 (when time
5874 (+ (* (nth 0 time) 65536.0) (nth 1 time))))
5875; (round (+ (* (nth 0 tm) 65536.0) (nth 1 tm))))
5876 5959
5877(defun erc-current-time () 5960(defalias 'erc-emacs-time-to-erc-time
5878 "Return the `current-time' as a number of seconds since the epoch. 5961 (if (featurep 'xemacs) 'time-to-seconds 'float-time))
5879 5962
5880See also `erc-emacs-time-to-erc-time'." 5963(defalias 'erc-current-time 'erc-emacs-time-to-erc-time)
5881 (erc-emacs-time-to-erc-time (current-time)))
5882 5964
5883(defun erc-time-diff (t1 t2) 5965(defun erc-time-diff (t1 t2)
5884 "Return the time difference in seconds between T1 and T2." 5966 "Return the time difference in seconds between T1 and T2."
@@ -5892,33 +5974,33 @@ See also `erc-emacs-time-to-erc-time'."
5892 "Convert NS to a time string HH:MM.SS." 5974 "Convert NS to a time string HH:MM.SS."
5893 (setq ns (truncate ns)) 5975 (setq ns (truncate ns))
5894 (format "%02d:%02d.%02d" 5976 (format "%02d:%02d.%02d"
5895 (/ ns 3600) 5977 (/ ns 3600)
5896 (/ (% ns 3600) 60) 5978 (/ (% ns 3600) 60)
5897 (% ns 60))) 5979 (% ns 60)))
5898 5980
5899(defun erc-seconds-to-string (seconds) 5981(defun erc-seconds-to-string (seconds)
5900 "Convert a number of SECONDS into an English phrase." 5982 "Convert a number of SECONDS into an English phrase."
5901 (let (days hours minutes format-args output) 5983 (let (days hours minutes format-args output)
5902 (setq days (/ seconds 86400) 5984 (setq days (/ seconds 86400)
5903 seconds (% seconds 86400) 5985 seconds (% seconds 86400)
5904 hours (/ seconds 3600) 5986 hours (/ seconds 3600)
5905 seconds (% seconds 3600) 5987 seconds (% seconds 3600)
5906 minutes (/ seconds 60) 5988 minutes (/ seconds 60)
5907 seconds (% seconds 60) 5989 seconds (% seconds 60)
5908 format-args (if (> days 0) 5990 format-args (if (> days 0)
5909 `("%d days, %d hours, %d minutes, %d seconds" 5991 `("%d days, %d hours, %d minutes, %d seconds"
5910 ,days ,hours ,minutes ,seconds) 5992 ,days ,hours ,minutes ,seconds)
5911 (if (> hours 0) 5993 (if (> hours 0)
5912 `("%d hours, %d minutes, %d seconds" 5994 `("%d hours, %d minutes, %d seconds"
5913 ,hours ,minutes ,seconds) 5995 ,hours ,minutes ,seconds)
5914 (if (> minutes 0) 5996 (if (> minutes 0)
5915 `("%d minutes, %d seconds" ,minutes ,seconds) 5997 `("%d minutes, %d seconds" ,minutes ,seconds)
5916 `("%d seconds" ,seconds)))) 5998 `("%d seconds" ,seconds))))
5917 output (apply 'format format-args)) 5999 output (apply 'format format-args))
5918 ;; Change all "1 units" to "1 unit". 6000 ;; Change all "1 units" to "1 unit".
5919 (while (string-match "\\([^0-9]\\|^\\)1 \\S-+\\(s\\)" output) 6001 (while (string-match "\\([^0-9]\\|^\\)1 \\S-+\\(s\\)" output)
5920 (setq output (erc-replace-match-subexpression-in-string 6002 (setq output (erc-replace-match-subexpression-in-string
5921 "" output (match-string 2 output) 2 (match-beginning 2)))) 6003 "" output (match-string 2 output) 2 (match-beginning 2))))
5922 output)) 6004 output))
5923 6005
5924 6006
@@ -5941,14 +6023,14 @@ If S is nil or an empty string then return general CLIENTINFO."
5941 (if (or (not s) (string= s "")) 6023 (if (or (not s) (string= s ""))
5942 (concat 6024 (concat
5943 (apply #'concat 6025 (apply #'concat
5944 (mapcar (lambda (e) 6026 (mapcar (lambda (e)
5945 (concat (car e) " ")) 6027 (concat (car e) " "))
5946 erc-clientinfo-alist)) 6028 erc-clientinfo-alist))
5947 ": use CLIENTINFO <COMMAND> to get more specific information") 6029 ": use CLIENTINFO <COMMAND> to get more specific information")
5948 (let ((h (assoc (upcase s) erc-clientinfo-alist))) 6030 (let ((h (assoc (upcase s) erc-clientinfo-alist)))
5949 (if h 6031 (if h
5950 (concat s " " (cdr h)) 6032 (concat s " " (cdr h))
5951 (concat s ": unknown command"))))) 6033 (concat s ": unknown command")))))
5952 6034
5953;; Hook functions 6035;; Hook functions
5954 6036
@@ -5963,9 +6045,9 @@ If it doesn't exist, create it."
5963 ;; here, we only want to match the channel buffers, to avoid 6045 ;; here, we only want to match the channel buffers, to avoid
5964 ;; "selecting killed buffers" b0rkage. 6046 ;; "selecting killed buffers" b0rkage.
5965 (erc-with-all-buffers-of-server process 6047 (erc-with-all-buffers-of-server process
5966 (lambda () 6048 (lambda ()
5967 (not (erc-server-buffer-p))) 6049 (not (erc-server-buffer-p)))
5968 (kill-buffer (current-buffer)))) 6050 (kill-buffer (current-buffer))))
5969 6051
5970(defun erc-nick-at-point () 6052(defun erc-nick-at-point ()
5971 "Give information about the nickname at `point'. 6053 "Give information about the nickname at `point'.
@@ -5976,31 +6058,37 @@ entry of `channel-members'."
5976 (interactive) 6058 (interactive)
5977 (require 'thingatpt) 6059 (require 'thingatpt)
5978 (let* ((word (word-at-point)) 6060 (let* ((word (word-at-point))
5979 (channel-data (erc-get-channel-user word)) 6061 (channel-data (erc-get-channel-user word))
5980 (cuser (cdr channel-data)) 6062 (cuser (cdr channel-data))
5981 (user (if channel-data 6063 (user (if channel-data
5982 (car channel-data) 6064 (car channel-data)
5983 (erc-get-server-user word))) 6065 (erc-get-server-user word)))
5984 host login full-name nick op voice) 6066 host login full-name nick voice halfop op admin owner)
5985 (when user 6067 (when user
5986 (setq nick (erc-server-user-nickname user) 6068 (setq nick (erc-server-user-nickname user)
5987 host (erc-server-user-host user) 6069 host (erc-server-user-host user)
5988 login (erc-server-user-login user) 6070 login (erc-server-user-login user)
5989 full-name (erc-server-user-full-name user)) 6071 full-name (erc-server-user-full-name user))
5990 (if cuser 6072 (if cuser
5991 (setq op (erc-channel-user-op cuser) 6073 (setq voice (erc-channel-user-voice cuser)
5992 voice (erc-channel-user-voice cuser))) 6074 halfop (erc-channel-user-halfop cuser)
5993 (if (called-interactively-p 'interactive) 6075 op (erc-channel-user-op cuser)
5994 (message "%s is %s@%s%s%s" 6076 admin (erc-channel-user-admin cuser)
5995 nick login host 6077 owner (erc-channel-user-owner cuser))))
5996 (if full-name (format " (%s)" full-name) "") 6078 (if (called-interactively-p 'interactive)
5997 (if (or op voice) 6079 (message "%s is %s@%s%s%s"
5998 (format " and is +%s%s on %s" 6080 nick login host
5999 (if op "o" "") 6081 (if full-name (format " (%s)" full-name) "")
6000 (if voice "v" "") 6082 (if (or voice halfop op admin owner)
6001 (erc-default-target)) 6083 (format " and is +%s%s%s%s%s on %s"
6002 "")) 6084 (if voice "v" "")
6003 user)))) 6085 (if halfop "h" "")
6086 (if op "o" "")
6087 (if admin "a" "")
6088 (if owner "q" "")
6089 (erc-default-target))
6090 ""))
6091 user)))
6004 6092
6005(defun erc-away-time () 6093(defun erc-away-time ()
6006 "Return non-nil if the current ERC process is set away. 6094 "Return non-nil if the current ERC process is set away.
@@ -6045,11 +6133,11 @@ displayed.
6045See `erc-mode-line-format' for which characters are can be used." 6133See `erc-mode-line-format' for which characters are can be used."
6046 :group 'erc-mode-line-and-header 6134 :group 'erc-mode-line-and-header
6047 :set (lambda (sym val) 6135 :set (lambda (sym val)
6048 (set sym val) 6136 (set sym val)
6049 (when (fboundp 'erc-update-mode-line) 6137 (when (fboundp 'erc-update-mode-line)
6050 (erc-update-mode-line nil))) 6138 (erc-update-mode-line nil)))
6051 :type '(choice (const :tag "Disabled" nil) 6139 :type '(choice (const :tag "Disabled" nil)
6052 string)) 6140 string))
6053 6141
6054(defcustom erc-header-line-uses-tabbar-p nil 6142(defcustom erc-header-line-uses-tabbar-p nil
6055 "Use tabbar mode instead of the header line to display the header." 6143 "Use tabbar mode instead of the header line to display the header."
@@ -6070,8 +6158,8 @@ If given a function, call it and use the resulting face name.
6070Otherwise, use the `erc-header-line' face." 6158Otherwise, use the `erc-header-line' face."
6071 :group 'erc-mode-line-and-header 6159 :group 'erc-mode-line-and-header
6072 :type '(choice (const :tag "Don't colorize" nil) 6160 :type '(choice (const :tag "Don't colorize" nil)
6073 (const :tag "Use the erc-header-line face" t) 6161 (const :tag "Use the erc-header-line face" t)
6074 (function :tag "Call a function"))) 6162 (function :tag "Call a function")))
6075 6163
6076(defcustom erc-show-channel-key-p t 6164(defcustom erc-show-channel-key-p t
6077 "Show the channel key in the header line." 6165 "Show the channel key in the header line."
@@ -6090,40 +6178,40 @@ This should be a string with substitution variables recognized by
6090 "Shorten SERVER-NAME according to `erc-common-server-suffixes'." 6178 "Shorten SERVER-NAME according to `erc-common-server-suffixes'."
6091 (if (stringp server-name) 6179 (if (stringp server-name)
6092 (with-temp-buffer 6180 (with-temp-buffer
6093 (insert server-name) 6181 (insert server-name)
6094 (let ((alist erc-common-server-suffixes)) 6182 (let ((alist erc-common-server-suffixes))
6095 (while alist 6183 (while alist
6096 (goto-char (point-min)) 6184 (goto-char (point-min))
6097 (if (re-search-forward (caar alist) nil t) 6185 (if (re-search-forward (caar alist) nil t)
6098 (replace-match (cdar alist))) 6186 (replace-match (cdar alist)))
6099 (setq alist (cdr alist)))) 6187 (setq alist (cdr alist))))
6100 (buffer-string)))) 6188 (buffer-string))))
6101 6189
6102(defun erc-format-target () 6190(defun erc-format-target ()
6103 "Return the name of the target (channel or nickname or servername:port)." 6191 "Return the name of the target (channel or nickname or servername:port)."
6104 (let ((target (erc-default-target))) 6192 (let ((target (erc-default-target)))
6105 (or target 6193 (or target
6106 (concat (erc-shorten-server-name 6194 (concat (erc-shorten-server-name
6107 (or erc-server-announced-name 6195 (or erc-server-announced-name
6108 erc-session-server)) 6196 erc-session-server))
6109 ":" (erc-port-to-string erc-session-port))))) 6197 ":" (erc-port-to-string erc-session-port)))))
6110 6198
6111(defun erc-format-target-and/or-server () 6199(defun erc-format-target-and/or-server ()
6112 "Return the server name or the current target and server name combined." 6200 "Return the server name or the current target and server name combined."
6113 (let ((server-name (erc-shorten-server-name 6201 (let ((server-name (erc-shorten-server-name
6114 (or erc-server-announced-name 6202 (or erc-server-announced-name
6115 erc-session-server)))) 6203 erc-session-server))))
6116 (cond ((erc-default-target) 6204 (cond ((erc-default-target)
6117 (concat (erc-string-no-properties (erc-default-target)) 6205 (concat (erc-string-no-properties (erc-default-target))
6118 "@" server-name)) 6206 "@" server-name))
6119 (server-name server-name) 6207 (server-name server-name)
6120 (t (buffer-name (current-buffer)))))) 6208 (t (buffer-name (current-buffer))))))
6121 6209
6122(defun erc-format-network () 6210(defun erc-format-network ()
6123 "Return the name of the network we are currently on." 6211 "Return the name of the network we are currently on."
6124 (let ((network (and (fboundp 'erc-network-name) (erc-network-name)))) 6212 (let ((network (and (fboundp 'erc-network-name) (erc-network-name))))
6125 (if (and network (symbolp network)) 6213 (if (and network (symbolp network))
6126 (symbol-name network) 6214 (symbol-name network)
6127 ""))) 6215 "")))
6128 6216
6129(defun erc-format-target-and/or-network () 6217(defun erc-format-target-and/or-network ()
@@ -6131,48 +6219,52 @@ This should be a string with substitution variables recognized by
6131If the name of the network is not available, then use the 6219If the name of the network is not available, then use the
6132shortened server name instead." 6220shortened server name instead."
6133 (let ((network-name (or (and (fboundp 'erc-network-name) (erc-network-name)) 6221 (let ((network-name (or (and (fboundp 'erc-network-name) (erc-network-name))
6134 (erc-shorten-server-name 6222 (erc-shorten-server-name
6135 (or erc-server-announced-name 6223 (or erc-server-announced-name
6136 erc-session-server))))) 6224 erc-session-server)))))
6137 (when (and network-name (symbolp network-name)) 6225 (when (and network-name (symbolp network-name))
6138 (setq network-name (symbol-name network-name))) 6226 (setq network-name (symbol-name network-name)))
6139 (cond ((erc-default-target) 6227 (cond ((erc-default-target)
6140 (concat (erc-string-no-properties (erc-default-target)) 6228 (concat (erc-string-no-properties (erc-default-target))
6141 "@" network-name)) 6229 "@" network-name))
6142 (network-name network-name) 6230 ((and network-name
6143 (t (buffer-name (current-buffer)))))) 6231 (not (get-buffer network-name)))
6232 (when erc-rename-buffers
6233 (rename-buffer network-name))
6234 network-name)
6235 (t (buffer-name (current-buffer))))))
6144 6236
6145(defun erc-format-away-status () 6237(defun erc-format-away-status ()
6146 "Return a formatted `erc-mode-line-away-status-format' 6238 "Return a formatted `erc-mode-line-away-status-format'
6147if `erc-away' is non-nil." 6239if `erc-away' is non-nil."
6148 (let ((a (erc-away-time))) 6240 (let ((a (erc-away-time)))
6149 (if a 6241 (if a
6150 (format-time-string erc-mode-line-away-status-format a) 6242 (format-time-string erc-mode-line-away-status-format a)
6151 ""))) 6243 "")))
6152 6244
6153(defun erc-format-channel-modes () 6245(defun erc-format-channel-modes ()
6154 "Return the current channel's modes." 6246 "Return the current channel's modes."
6155 (concat (apply 'concat 6247 (concat (apply 'concat
6156 "+" erc-channel-modes) 6248 "+" erc-channel-modes)
6157 (cond ((and erc-channel-user-limit erc-channel-key) 6249 (cond ((and erc-channel-user-limit erc-channel-key)
6158 (if erc-show-channel-key-p 6250 (if erc-show-channel-key-p
6159 (format "lk %.0f %s" erc-channel-user-limit 6251 (format "lk %.0f %s" erc-channel-user-limit
6160 erc-channel-key) 6252 erc-channel-key)
6161 (format "kl %.0f" erc-channel-user-limit))) 6253 (format "kl %.0f" erc-channel-user-limit)))
6162 (erc-channel-user-limit 6254 (erc-channel-user-limit
6163 ;; Emacs has no bignums 6255 ;; Emacs has no bignums
6164 (format "l %.0f" erc-channel-user-limit)) 6256 (format "l %.0f" erc-channel-user-limit))
6165 (erc-channel-key 6257 (erc-channel-key
6166 (if erc-show-channel-key-p 6258 (if erc-show-channel-key-p
6167 (format "k %s" erc-channel-key) 6259 (format "k %s" erc-channel-key)
6168 "k")) 6260 "k"))
6169 (t nil)))) 6261 (t nil))))
6170 6262
6171(defun erc-format-lag-time () 6263(defun erc-format-lag-time ()
6172 "Return the estimated lag time to server, `erc-server-lag'." 6264 "Return the estimated lag time to server, `erc-server-lag'."
6173 (let ((lag (erc-with-server-buffer erc-server-lag))) 6265 (let ((lag (erc-with-server-buffer erc-server-lag)))
6174 (cond (lag (format "lag:%.0f" lag)) 6266 (cond (lag (format "lag:%.0f" lag))
6175 (t "")))) 6267 (t ""))))
6176 6268
6177;; erc-goodies is required at end of this file. 6269;; erc-goodies is required at end of this file.
6178(declare-function erc-controls-strip "erc-goodies" (str)) 6270(declare-function erc-controls-strip "erc-goodies" (str))
@@ -6183,66 +6275,66 @@ if `erc-away' is non-nil."
6183 "Update the mode line in a single ERC buffer BUFFER." 6275 "Update the mode line in a single ERC buffer BUFFER."
6184 (with-current-buffer buffer 6276 (with-current-buffer buffer
6185 (let ((spec (format-spec-make 6277 (let ((spec (format-spec-make
6186 ?a (erc-format-away-status) 6278 ?a (erc-format-away-status)
6187 ?l (erc-format-lag-time) 6279 ?l (erc-format-lag-time)
6188 ?m (erc-format-channel-modes) 6280 ?m (erc-format-channel-modes)
6189 ?n (or (erc-current-nick) "") 6281 ?n (or (erc-current-nick) "")
6190 ?N (erc-format-network) 6282 ?N (erc-format-network)
6191 ?o (or (erc-controls-strip erc-channel-topic) "") 6283 ?o (or (erc-controls-strip erc-channel-topic) "")
6192 ?p (erc-port-to-string erc-session-port) 6284 ?p (erc-port-to-string erc-session-port)
6193 ?s (erc-format-target-and/or-server) 6285 ?s (erc-format-target-and/or-server)
6194 ?S (erc-format-target-and/or-network) 6286 ?S (erc-format-target-and/or-network)
6195 ?t (erc-format-target))) 6287 ?t (erc-format-target)))
6196 (process-status (cond ((and (erc-server-process-alive) 6288 (process-status (cond ((and (erc-server-process-alive)
6197 (not erc-server-connected)) 6289 (not erc-server-connected))
6198 ":connecting") 6290 ":connecting")
6199 ((erc-server-process-alive) 6291 ((erc-server-process-alive)
6200 "") 6292 "")
6201 (t 6293 (t
6202 ": CLOSED"))) 6294 ": CLOSED")))
6203 (face (cond ((eq erc-header-line-face-method nil) 6295 (face (cond ((eq erc-header-line-face-method nil)
6204 nil) 6296 nil)
6205 ((functionp erc-header-line-face-method) 6297 ((functionp erc-header-line-face-method)
6206 (funcall erc-header-line-face-method)) 6298 (funcall erc-header-line-face-method))
6207 (t 6299 (t
6208 'erc-header-line)))) 6300 'erc-header-line))))
6209 (cond ((featurep 'xemacs) 6301 (cond ((featurep 'xemacs)
6210 (setq modeline-buffer-identification 6302 (setq modeline-buffer-identification
6211 (list (format-spec erc-mode-line-format spec))) 6303 (list (format-spec erc-mode-line-format spec)))
6212 (setq modeline-process (list process-status))) 6304 (setq modeline-process (list process-status)))
6213 (t 6305 (t
6214 (setq mode-line-buffer-identification 6306 (setq mode-line-buffer-identification
6215 (list (format-spec erc-mode-line-format spec))) 6307 (list (format-spec erc-mode-line-format spec)))
6216 (setq mode-line-process (list process-status)))) 6308 (setq mode-line-process (list process-status))))
6217 (when (boundp 'header-line-format) 6309 (when (boundp 'header-line-format)
6218 (let ((header (if erc-header-line-format 6310 (let ((header (if erc-header-line-format
6219 (format-spec erc-header-line-format spec) 6311 (format-spec erc-header-line-format spec)
6220 nil))) 6312 nil)))
6221 (cond (erc-header-line-uses-tabbar-p 6313 (cond (erc-header-line-uses-tabbar-p
6222 (set (make-local-variable 'tabbar--local-hlf) 6314 (set (make-local-variable 'tabbar--local-hlf)
6223 header-line-format) 6315 header-line-format)
6224 (kill-local-variable 'header-line-format)) 6316 (kill-local-variable 'header-line-format))
6225 ((null header) 6317 ((null header)
6226 (setq header-line-format nil)) 6318 (setq header-line-format nil))
6227 (erc-header-line-uses-help-echo-p 6319 (erc-header-line-uses-help-echo-p
6228 (let ((help-echo (with-temp-buffer 6320 (let ((help-echo (with-temp-buffer
6229 (insert header) 6321 (insert header)
6230 (fill-region (point-min) (point-max)) 6322 (fill-region (point-min) (point-max))
6231 (buffer-string)))) 6323 (buffer-string))))
6232 (setq header-line-format 6324 (setq header-line-format
6233 (erc-replace-regexp-in-string 6325 (erc-replace-regexp-in-string
6234 "%" 6326 "%"
6235 "%%" 6327 "%%"
6236 (if face 6328 (if face
6237 (erc-propertize header 'help-echo help-echo 6329 (erc-propertize header 'help-echo help-echo
6238 'face face) 6330 'face face)
6239 (erc-propertize header 'help-echo help-echo)))))) 6331 (erc-propertize header 'help-echo help-echo))))))
6240 (t (setq header-line-format 6332 (t (setq header-line-format
6241 (if face 6333 (if face
6242 (erc-propertize header 'face face) 6334 (erc-propertize header 'face face)
6243 header))))))) 6335 header)))))))
6244 (if (featurep 'xemacs) 6336 (if (featurep 'xemacs)
6245 (redraw-modeline) 6337 (redraw-modeline)
6246 (force-mode-line-update)))) 6338 (force-mode-line-update))))
6247 6339
6248(defun erc-update-mode-line (&optional buffer) 6340(defun erc-update-mode-line (&optional buffer)
@@ -6253,7 +6345,7 @@ If BUFFER is nil, update the mode line in all ERC buffers."
6253 (erc-update-mode-line-buffer buffer) 6345 (erc-update-mode-line-buffer buffer)
6254 (dolist (buf (erc-buffer-list)) 6346 (dolist (buf (erc-buffer-list))
6255 (when (buffer-live-p buf) 6347 (when (buffer-live-p buf)
6256 (erc-update-mode-line-buffer buf))))) 6348 (erc-update-mode-line-buffer buf)))))
6257 6349
6258;; Miscellaneous 6350;; Miscellaneous
6259 6351
@@ -6270,40 +6362,40 @@ P may be an integer or a service name."
6270 s 6362 s
6271 (let ((n (string-to-number s))) 6363 (let ((n (string-to-number s)))
6272 (if (= n 0) 6364 (if (= n 0)
6273 s 6365 s
6274 n)))) 6366 n))))
6275 6367
6276(defun erc-version (&optional here) 6368(defun erc-version (&optional here)
6277 "Show the version number of ERC in the minibuffer. 6369 "Show the version number of ERC in the minibuffer.
6278If optional argument HERE is non-nil, insert version number at point." 6370If optional argument HERE is non-nil, insert version number at point."
6279 (interactive "P") 6371 (interactive "P")
6280 (let ((version-string 6372 (let ((version-string
6281 (format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version))) 6373 (format "ERC (IRC client for Emacs %s)" emacs-version)))
6282 (if here 6374 (if here
6283 (insert version-string) 6375 (insert version-string)
6284 (if (called-interactively-p 'interactive) 6376 (if (called-interactively-p 'interactive)
6285 (message "%s" version-string) 6377 (message "%s" version-string)
6286 version-string)))) 6378 version-string))))
6287 6379
6288(defun erc-modes (&optional here) 6380(defun erc-modes (&optional here)
6289 "Show the active ERC modes in the minibuffer. 6381 "Show the active ERC modes in the minibuffer.
6290If optional argument HERE is non-nil, insert version number at point." 6382If optional argument HERE is non-nil, insert version number at point."
6291 (interactive "P") 6383 (interactive "P")
6292 (let ((string 6384 (let ((string
6293 (mapconcat 'identity 6385 (mapconcat 'identity
6294 (let (modes (case-fold-search nil)) 6386 (let (modes (case-fold-search nil))
6295 (dolist (var (apropos-internal "^erc-.*mode$")) 6387 (dolist (var (apropos-internal "^erc-.*mode$"))
6296 (when (and (boundp var) 6388 (when (and (boundp var)
6297 (symbol-value var)) 6389 (symbol-value var))
6298 (setq modes (cons (symbol-name var) 6390 (setq modes (cons (symbol-name var)
6299 modes)))) 6391 modes))))
6300 modes) 6392 modes)
6301 ", "))) 6393 ", ")))
6302 (if here 6394 (if here
6303 (insert string) 6395 (insert string)
6304 (if (called-interactively-p 'interactive) 6396 (if (called-interactively-p 'interactive)
6305 (message "%s" string) 6397 (message "%s" string)
6306 string)))) 6398 string))))
6307 6399
6308(defun erc-trim-string (s) 6400(defun erc-trim-string (s)
6309 "Trim leading and trailing spaces off S." 6401 "Trim leading and trailing spaces off S."
@@ -6329,34 +6421,34 @@ All windows are opened in the current frame."
6329 (switch-to-buffer (car bufs)) 6421 (switch-to-buffer (car bufs))
6330 (setq bufs (cdr bufs)) 6422 (setq bufs (cdr bufs))
6331 (while bufs 6423 (while bufs
6332 (split-window) 6424 (split-window)
6333 (other-window 1) 6425 (other-window 1)
6334 (switch-to-buffer (car bufs)) 6426 (switch-to-buffer (car bufs))
6335 (setq bufs (cdr bufs)) 6427 (setq bufs (cdr bufs))
6336 (balance-windows))))) 6428 (balance-windows)))))
6337 6429
6338(defun erc-popup-input-buffer () 6430(defun erc-popup-input-buffer ()
6339 "Provide an input buffer." 6431 "Provide an input buffer."
6340 (interactive) 6432 (interactive)
6341 (let ((buffer-name (generate-new-buffer-name "*ERC input*")) 6433 (let ((buffer-name (generate-new-buffer-name "*ERC input*"))
6342 (mode (intern 6434 (mode (intern
6343 (completing-read 6435 (completing-read
6344 "Mode: " 6436 "Mode: "
6345 (mapcar (lambda (e) 6437 (mapcar (lambda (e)
6346 (list (symbol-name e))) 6438 (list (symbol-name e)))
6347 (apropos-internal "-mode$" 'commandp)) 6439 (apropos-internal "-mode$" 'commandp))
6348 nil t)))) 6440 nil t))))
6349 (pop-to-buffer (make-indirect-buffer (current-buffer) buffer-name)) 6441 (pop-to-buffer (make-indirect-buffer (current-buffer) buffer-name))
6350 (funcall mode) 6442 (funcall mode)
6351 (narrow-to-region (point) (point)) 6443 (narrow-to-region (point) (point))
6352 (shrink-window-if-larger-than-buffer))) 6444 (shrink-window-if-larger-than-buffer)))
6353 6445
6354;;; Message catalog 6446;;; Message catalog
6355 6447
6356(defun erc-make-message-variable-name (catalog entry) 6448(defun erc-make-message-variable-name (catalog entry)
6357 "Create a variable name corresponding to CATALOG's ENTRY." 6449 "Create a variable name corresponding to CATALOG's ENTRY."
6358 (intern (concat "erc-message-" 6450 (intern (concat "erc-message-"
6359 (symbol-name catalog) "-" (symbol-name entry)))) 6451 (symbol-name catalog) "-" (symbol-name entry))))
6360 6452
6361(defun erc-define-catalog-entry (catalog entry format-spec) 6453(defun erc-define-catalog-entry (catalog entry format-spec)
6362 "Set CATALOG's ENTRY to FORMAT-SPEC." 6454 "Set CATALOG's ENTRY to FORMAT-SPEC."
@@ -6498,18 +6590,18 @@ All windows are opened in the current frame."
6498This function is an example on what could be done with formatting 6590This function is an example on what could be done with formatting
6499functions." 6591functions."
6500 (let ((nick (cadr (memq ?n args))) 6592 (let ((nick (cadr (memq ?n args)))
6501 (user (cadr (memq ?u args))) 6593 (user (cadr (memq ?u args)))
6502 (host (cadr (memq ?h args))) 6594 (host (cadr (memq ?h args)))
6503 (channel (cadr (memq ?c args))) 6595 (channel (cadr (memq ?c args)))
6504 (reason (cadr (memq ?r args)))) 6596 (reason (cadr (memq ?r args))))
6505 (if (string= nick (erc-current-nick)) 6597 (if (string= nick (erc-current-nick))
6506 (format "You have left channel %s" channel) 6598 (format "You have left channel %s" channel)
6507 (format "%s (%s@%s) has left channel %s%s" 6599 (format "%s (%s@%s) has left channel %s%s"
6508 nick user host channel 6600 nick user host channel
6509 (if (not (string= reason "")) 6601 (if (not (string= reason ""))
6510 (format ": %s" 6602 (format ": %s"
6511 (erc-replace-regexp-in-string "%" "%%" reason)) 6603 (erc-replace-regexp-in-string "%" "%%" reason))
6512 ""))))) 6604 "")))))
6513 6605
6514 6606
6515(defvar erc-current-message-catalog 'english) 6607(defvar erc-current-message-catalog 'english)
@@ -6525,15 +6617,15 @@ english, catalog."
6525 (unless catalog (setq catalog erc-current-message-catalog)) 6617 (unless catalog (setq catalog erc-current-message-catalog))
6526 (let ((var (erc-make-message-variable-name catalog entry))) 6618 (let ((var (erc-make-message-variable-name catalog entry)))
6527 (if (boundp var) 6619 (if (boundp var)
6528 (symbol-value var) 6620 (symbol-value var)
6529 (when (boundp (erc-make-message-variable-name 'english entry)) 6621 (when (boundp (erc-make-message-variable-name 'english entry))
6530 (symbol-value (erc-make-message-variable-name 'english entry)))))) 6622 (symbol-value (erc-make-message-variable-name 'english entry))))))
6531 6623
6532(defun erc-format-message (msg &rest args) 6624(defun erc-format-message (msg &rest args)
6533 "Format MSG according to ARGS. 6625 "Format MSG according to ARGS.
6534 6626
6535See also `format-spec'." 6627See also `format-spec'."
6536 (when (eq (logand (length args) 1) 1) ; oddp 6628 (when (eq (logand (length args) 1) 1) ; oddp
6537 (error "Obscure usage of this function appeared")) 6629 (error "Obscure usage of this function appeared"))
6538 (let ((entry (erc-retrieve-catalog-entry msg))) 6630 (let ((entry (erc-retrieve-catalog-entry msg)))
6539 (when (not entry) 6631 (when (not entry)
@@ -6594,8 +6686,8 @@ This function should be on `erc-kill-channel-hook'."
6594 (when (erc-server-process-alive) 6686 (when (erc-server-process-alive)
6595 (let ((tgt (erc-default-target))) 6687 (let ((tgt (erc-default-target)))
6596 (erc-server-send (format "PART %s :%s" tgt 6688 (erc-server-send (format "PART %s :%s" tgt
6597 (funcall erc-part-reason nil)) 6689 (funcall erc-part-reason nil))
6598 nil tgt)))) 6690 nil tgt))))
6599 6691
6600;;; Dealing with `erc-parsed' 6692;;; Dealing with `erc-parsed'
6601 6693
@@ -6617,10 +6709,10 @@ This function should be on `erc-kill-channel-hook'."
6617(defun erc-get-parsed-vector-nick (vect) 6709(defun erc-get-parsed-vector-nick (vect)
6618 "Return nickname in the parsed vector VECT." 6710 "Return nickname in the parsed vector VECT."
6619 (let* ((untreated-nick (and vect (erc-response.sender vect))) 6711 (let* ((untreated-nick (and vect (erc-response.sender vect)))
6620 (maybe-nick (when untreated-nick 6712 (maybe-nick (when untreated-nick
6621 (car (split-string untreated-nick "!"))))) 6713 (car (split-string untreated-nick "!")))))
6622 (when (and (not (null maybe-nick)) 6714 (when (and (not (null maybe-nick))
6623 (erc-is-valid-nick-p maybe-nick)) 6715 (erc-is-valid-nick-p maybe-nick))
6624 untreated-nick))) 6716 untreated-nick)))
6625 6717
6626(defun erc-get-parsed-vector-type (vect) 6718(defun erc-get-parsed-vector-type (vect)
@@ -6637,18 +6729,18 @@ This function should be on `erc-kill-channel-hook'."
6637If ERC is already connected to HOST:PORT, simply /join CHANNEL. 6729If ERC is already connected to HOST:PORT, simply /join CHANNEL.
6638Otherwise, connect to HOST:PORT as USER and /join CHANNEL." 6730Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
6639 (let ((server-buffer 6731 (let ((server-buffer
6640 (car (erc-buffer-filter 6732 (car (erc-buffer-filter
6641 (lambda () 6733 (lambda ()
6642 (and (string-equal erc-session-server host) 6734 (and (string-equal erc-session-server host)
6643 (= erc-session-port port) 6735 (= erc-session-port port)
6644 (erc-open-server-buffer-p))))))) 6736 (erc-open-server-buffer-p)))))))
6645 (with-current-buffer (or server-buffer (current-buffer)) 6737 (with-current-buffer (or server-buffer (current-buffer))
6646 (if (and server-buffer channel) 6738 (if (and server-buffer channel)
6647 (erc-cmd-JOIN channel) 6739 (erc-cmd-JOIN channel)
6648 (erc-open host port (or user (erc-compute-nick)) (erc-compute-full-name) 6740 (erc-open host port (or user (erc-compute-nick)) (erc-compute-full-name)
6649 (not server-buffer) password nil channel 6741 (not server-buffer) password nil channel
6650 (when server-buffer 6742 (when server-buffer
6651 (get-buffer-process server-buffer))))))) 6743 (get-buffer-process server-buffer)))))))
6652 6744
6653(provide 'erc) 6745(provide 'erc)
6654 6746