TUTORIAL.he: Use LRE instead of LRO.
[bpt/emacs.git] / lisp / net / rcirc.el
CommitLineData
bd43c990
RS
1;;; rcirc.el --- default, simple IRC client.
2
95df8112 3;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
bd43c990 4
9cf56b2c
DD
5;; Author: Ryan Yeske <rcyeske@gmail.com>
6;; Maintainers: Ryan Yeske <rcyeske@gmail.com>,
b87a8200 7;; Deniz Dogan <deniz@dogan.se>
bd43c990
RS
8;; Keywords: comm
9
b71cef5c 10;; This file is part of GNU Emacs.
bd43c990 11
874a927a 12;; GNU Emacs is free software: you can redistribute it and/or modify
bd43c990 13;; it under the terms of the GNU General Public License as published by
874a927a
GM
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
bd43c990 16
874a927a 17;; GNU Emacs is distributed in the hope that it will be useful,
bd43c990 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
92c4adc1 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
bd43c990
RS
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
874a927a 23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
bd43c990
RS
24
25;;; Commentary:
26
adf794e4
EZ
27;; Internet Relay Chat (IRC) is a form of instant communication over
28;; the Internet. It is mainly designed for group (many-to-many)
29;; communication in discussion forums called channels, but also allows
30;; one-to-one communication.
31
fffa137c 32;; Rcirc has simple defaults and clear and consistent behavior.
adf794e4
EZ
33;; Message arrival timestamps, activity notification on the modeline,
34;; message filling, nick completion, and keepalive pings are all
35;; enabled by default, but can easily be adjusted or turned off. Each
36;; discussion takes place in its own buffer and there is a single
37;; server buffer per connection.
bd43c990 38
bd43c990
RS
39;; Open a new irc connection with:
40;; M-x irc RET
41
7faa3f8c
MB
42;;; Todo:
43
bd43c990
RS
44;;; Code:
45
46(require 'ring)
47(require 'time-date)
48(eval-when-compile (require 'cl))
49
adf794e4
EZ
50(defgroup rcirc nil
51 "Simple IRC client."
52 :version "22.1"
2fbed782 53 :prefix "rcirc-"
e8f10ddb 54 :link '(custom-manual "(rcirc)")
adf794e4
EZ
55 :group 'applications)
56
0ffab1eb 57(defcustom rcirc-server-alist
488086f4
SM
58 '(("irc.freenode.net" :channels ("#rcirc")
59 ;; Don't use the TLS port by default, in case gnutls is not available.
60 ;; :port 7000 :encryption tls
61 ))
195eca78
SM
62 "An alist of IRC connections to establish when running `rcirc'.
63Each element looks like (SERVER-NAME PARAMETERS).
64
65SERVER-NAME is a string describing the server to connect
66to.
67
0ffab1eb
TTN
68The optional PARAMETERS come in pairs PARAMETER VALUE.
69
70The following parameters are recognized:
71
72`:nick'
73
74VALUE must be a string. If absent, `rcirc-default-nick' is used
75for this connection.
76
77`:port'
78
79VALUE must be a number or string. If absent,
80`rcirc-default-port' is used.
81
82`:user-name'
83
84VALUE must be a string. If absent, `rcirc-default-user-name' is
85used.
86
a71832f7
SM
87`:password'
88
89VALUE must be a string. If absent, no PASS command will be sent
90to the server.
91
0ffab1eb
TTN
92`:full-name'
93
94VALUE must be a string. If absent, `rcirc-default-full-name' is
95used.
96
97`:channels'
98
99VALUE must be a list of strings describing which channels to join
100when connecting to this server. If absent, no channels will be
488086f4
SM
101connected to automatically.
102
103`:encryption'
104
105VALUE must be `plain' (the default) for unencrypted connections, or `tls'
106for connections using SSL/TLS."
0ffab1eb 107 :type '(alist :key-type string
488086f4
SM
108 :value-type (plist :options
109 ((:nick string)
110 (:port integer)
111 (:user-name string)
112 (:password string)
113 (:full-name string)
114 (:channels (repeat string))
115 (:encryption (choice (const tls)
116 (const plain))))))
adf794e4 117 :group 'rcirc)
bd43c990 118
a2524d26 119(defcustom rcirc-default-port 6667
adf794e4
EZ
120 "The default port to connect to."
121 :type 'integer
122 :group 'rcirc)
bd43c990 123
a2524d26 124(defcustom rcirc-default-nick (user-login-name)
adf794e4
EZ
125 "Your nick."
126 :type 'string
127 :group 'rcirc)
bd43c990 128
d26781af 129(defcustom rcirc-default-user-name "user"
adf794e4 130 "Your user name sent to the server when connecting."
6169260b 131 :version "24.1" ; changed default
adf794e4
EZ
132 :type 'string
133 :group 'rcirc)
bd43c990 134
d26781af 135(defcustom rcirc-default-full-name "unknown"
adf794e4 136 "The full name sent to the server when connecting."
6169260b 137 :version "24.1" ; changed default
adf794e4
EZ
138 :type 'string
139 :group 'rcirc)
bd43c990 140
adf794e4
EZ
141(defcustom rcirc-fill-flag t
142 "*Non-nil means line-wrap messages printed in channel buffers."
143 :type 'boolean
144 :group 'rcirc)
bd43c990 145
adf794e4
EZ
146(defcustom rcirc-fill-column nil
147 "*Column beyond which automatic line-wrapping should happen.
195eca78
SM
148If nil, use value of `fill-column'. If 'frame-width, use the
149maximum frame width."
adf794e4
EZ
150 :type '(choice (const :tag "Value of `fill-column'")
151 (const :tag "Full frame width" frame-width)
152 (integer :tag "Number of columns"))
153 :group 'rcirc)
bd43c990 154
adf794e4 155(defcustom rcirc-fill-prefix nil
bd43c990
RS
156 "*Text to insert before filled lines.
157If nil, calculate the prefix dynamically to line up text
adf794e4
EZ
158underneath each nick."
159 :type '(choice (const :tag "Dynamic" nil)
160 (string :tag "Prefix text"))
161 :group 'rcirc)
bd43c990 162
adf794e4
EZ
163(defvar rcirc-ignore-buffer-activity-flag nil
164 "If non-nil, ignore activity in this buffer.")
165(make-variable-buffer-local 'rcirc-ignore-buffer-activity-flag)
bd43c990 166
a2524d26
EZ
167(defvar rcirc-low-priority-flag nil
168 "If non-nil, activity in this buffer is considered low priority.")
169(make-variable-buffer-local 'rcirc-low-priority-flag)
170
195eca78
SM
171(defvar rcirc-omit-mode nil
172 "Non-nil if Rcirc-Omit mode is enabled.
173Use the command `rcirc-omit-mode' to change this variable.")
174(make-variable-buffer-local 'rcirc-omit-mode)
175
adf794e4 176(defcustom rcirc-time-format "%H:%M "
bd43c990 177 "*Describes how timestamps are printed.
adf794e4
EZ
178Used as the first arg to `format-time-string'."
179 :type 'string
180 :group 'rcirc)
bd43c990 181
adf794e4
EZ
182(defcustom rcirc-input-ring-size 1024
183 "*Size of input history ring."
184 :type 'integer
185 :group 'rcirc)
bd43c990 186
adf794e4 187(defcustom rcirc-read-only-flag t
2e398771 188 "*Non-nil means make text in IRC buffers read-only."
adf794e4
EZ
189 :type 'boolean
190 :group 'rcirc)
bd43c990 191
adf794e4 192(defcustom rcirc-buffer-maximum-lines nil
bd43c990
RS
193 "*The maximum size in lines for rcirc buffers.
194Channel buffers are truncated from the top to be no greater than this
92c4adc1 195number. If zero or nil, no truncating is done."
adf794e4
EZ
196 :type '(choice (const :tag "No truncation" nil)
197 (integer :tag "Number of lines"))
198 :group 'rcirc)
bd43c990 199
d40ac716 200(defcustom rcirc-scroll-show-maximum-output t
195eca78
SM
201 "*If non-nil, scroll buffer to keep the point at the bottom of
202the window."
f8db61b2
EZ
203 :type 'boolean
204 :group 'rcirc)
7faa3f8c 205
db58efbf
EZ
206(defcustom rcirc-authinfo nil
207 "List of authentication passwords.
208Each element of the list is a list with a SERVER-REGEXP string
209and a method symbol followed by method specific arguments.
210
211The valid METHOD symbols are `nickserv', `chanserv' and
212`bitlbee'.
bd43c990 213
d7a0fd6f
GM
214The ARGUMENTS for each METHOD symbol are:
215 `nickserv': NICK PASSWORD [NICKSERV-NICK]
db58efbf
EZ
216 `chanserv': NICK CHANNEL PASSWORD
217 `bitlbee': NICK PASSWORD
77f63d30 218 `quakenet': ACCOUNT PASSWORD
bd43c990 219
d7a0fd6f 220Examples:
db58efbf
EZ
221 ((\"freenode\" nickserv \"bob\" \"p455w0rd\")
222 (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\")
d7a0fd6f 223 (\"bitlbee\" bitlbee \"robert\" \"sekrit\")
77f63d30
DD
224 (\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\")
225 (\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))"
db58efbf
EZ
226 :type '(alist :key-type (string :tag "Server")
227 :value-type (choice (list :tag "NickServ"
228 (const nickserv)
229 (string :tag "Nick")
230 (string :tag "Password"))
231 (list :tag "ChanServ"
232 (const chanserv)
233 (string :tag "Nick")
234 (string :tag "Channel")
235 (string :tag "Password"))
236 (list :tag "BitlBee"
237 (const bitlbee)
238 (string :tag "Nick")
77f63d30
DD
239 (string :tag "Password"))
240 (list :tag "QuakeNet"
241 (const quakenet)
242 (string :tag "Account")
243 (string :tag "Password"))))
adf794e4 244 :group 'rcirc)
bd43c990 245
db58efbf 246(defcustom rcirc-auto-authenticate-flag t
bd43c990 247 "*Non-nil means automatically send authentication string to server.
db58efbf 248See also `rcirc-authinfo'."
adf794e4
EZ
249 :type 'boolean
250 :group 'rcirc)
bd43c990 251
72d2c2e3
DD
252(defcustom rcirc-authenticate-before-join t
253 "*Non-nil means authenticate to services before joining channels.
254Currently only works with NickServ on some networks."
255 :version "24.1"
256 :type 'boolean
257 :group 'rcirc)
258
adf794e4 259(defcustom rcirc-prompt "> "
2e398771 260 "Prompt string to use in IRC buffers.
bd43c990
RS
261
262The following replacements are made:
263%n is your nick.
264%s is the server.
265%t is the buffer target, a channel or a user.
266
adf794e4
EZ
267Setting this alone will not affect the prompt;
268use either M-x customize or also call `rcirc-update-prompt'."
269 :type 'string
270 :set 'rcirc-set-changed
271 :initialize 'custom-initialize-default
272 :group 'rcirc)
273
f8db61b2
EZ
274(defcustom rcirc-keywords nil
275 "List of keywords to highlight in message text."
276 :type '(repeat string)
277 :group 'rcirc)
278
2c8abe90
AS
279(defcustom rcirc-ignore-list ()
280 "List of ignored nicks.
281Use /ignore to list them, use /ignore NICK to add or remove a nick."
282 :type '(repeat string)
283 :group 'rcirc)
284
285(defvar rcirc-ignore-list-automatic ()
286 "List of ignored nicks added to `rcirc-ignore-list' because of renaming.
287When an ignored person renames, their nick is added to both lists.
288Nicks will be removed from the automatic list on follow-up renamings or
289parts.")
290
f8db61b2
EZ
291(defcustom rcirc-bright-nicks nil
292 "List of nicks to be emphasized.
02f47e86 293See `rcirc-bright-nick' face."
f8db61b2 294 :type '(repeat string)
02f47e86
MB
295 :group 'rcirc)
296
f8db61b2
EZ
297(defcustom rcirc-dim-nicks nil
298 "List of nicks to be deemphasized.
02f47e86 299See `rcirc-dim-nick' face."
f8db61b2 300 :type '(repeat string)
02f47e86
MB
301 :group 'rcirc)
302
adf794e4
EZ
303(defcustom rcirc-print-hooks nil
304 "Hook run after text is printed.
305Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
306 :type 'hook
307 :group 'rcirc)
bd43c990 308
72d2c2e3
DD
309(defvar rcirc-authenticated-hook nil
310 "Hook run after successfully authenticated.")
311
db58efbf
EZ
312(defcustom rcirc-always-use-server-buffer-flag nil
313 "Non-nil means messages without a channel target will go to the server buffer."
314 :type 'boolean
315 :group 'rcirc)
316
108bf785 317(defcustom rcirc-decode-coding-system 'utf-8
5ab33f2b 318 "Coding system used to decode incoming irc messages.
108bf785
LL
319Set to 'undecided if you want the encoding of the incoming
320messages autodetected."
a2524d26
EZ
321 :type 'coding-system
322 :group 'rcirc)
323
324(defcustom rcirc-encode-coding-system 'utf-8
325 "Coding system used to encode outgoing irc messages."
326 :type 'coding-system
327 :group 'rcirc)
328
329(defcustom rcirc-coding-system-alist nil
f8db61b2 330 "Alist to decide a coding system to use for a channel I/O operation.
a2524d26
EZ
331The format is ((PATTERN . VAL) ...).
332PATTERN is either a string or a cons of strings.
333If PATTERN is a string, it is used to match a target.
334If PATTERN is a cons of strings, the car part is used to match a
335target, and the cdr part is used to match a server.
336VAL is either a coding system or a cons of coding systems.
337If VAL is a coding system, it is used for both decoding and encoding
338messages.
339If VAL is a cons of coding systems, the car part is used for decoding,
340and the cdr part is used for encoding."
341 :type '(alist :key-type (choice (string :tag "Channel Regexp")
342 (cons (string :tag "Channel Regexp")
343 (string :tag "Server Regexp")))
344 :value-type (choice coding-system
345 (cons (coding-system :tag "Decode")
346 (coding-system :tag "Encode"))))
347 :group 'rcirc)
348
349(defcustom rcirc-multiline-major-mode 'fundamental-mode
350 "Major-mode function to use in multiline edit buffers."
351 :type 'function
352 :group 'rcirc)
353
2a4466ca
DD
354(defcustom rcirc-nick-completion-format "%s: "
355 "Format string to use in nick completions.
356
357The format string is only used when completing at the beginning
358of a line. The string is passed as the first argument to
359`format' with the nickname as the second argument."
2d7d6439 360 :version "24.1"
2a4466ca
DD
361 :type 'string
362 :group 'rcirc)
363
a2524d26
EZ
364(defvar rcirc-nick nil)
365
bd43c990
RS
366(defvar rcirc-prompt-start-marker nil)
367(defvar rcirc-prompt-end-marker nil)
368
369(defvar rcirc-nick-table nil)
370
a0a5c583
GM
371(defvar rcirc-recent-quit-alist nil
372 "Alist of nicks that have recently quit or parted the channel.")
373
2c8abe90
AS
374(defvar rcirc-nick-syntax-table
375 (let ((table (make-syntax-table text-mode-syntax-table)))
376 (mapc (lambda (c) (modify-syntax-entry c "w" table))
377 "[]\\`_^{|}-")
378 (modify-syntax-entry ?' "_" table)
379 table)
380 "Syntax table which includes all nick characters as word constituents.")
381
adf794e4
EZ
382;; each process has an alist of (target . buffer) pairs
383(defvar rcirc-buffer-alist nil)
384
bd43c990 385(defvar rcirc-activity nil
a2524d26 386 "List of buffers with unviewed activity.")
bd43c990
RS
387
388(defvar rcirc-activity-string ""
389 "String displayed in modeline representing `rcirc-activity'.")
390(put 'rcirc-activity-string 'risky-local-variable t)
391
a2524d26
EZ
392(defvar rcirc-server-buffer nil
393 "The server buffer associated with this channel buffer.")
bd43c990
RS
394
395(defvar rcirc-target nil
396 "The channel or user associated with this buffer.")
397
bd43c990
RS
398(defvar rcirc-urls nil
399 "List of urls seen in the current buffer.")
7faa3f8c 400(put 'rcirc-urls 'permanent-local t)
bd43c990 401
2e875089 402(defvar rcirc-timeout-seconds 600
8216fbaf 403 "Kill connection after this many seconds if there is no activity.")
bd43c990 404
adf794e4 405(defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version))
bd43c990 406\f
bd43c990 407(defvar rcirc-startup-channels nil)
195eca78 408
c0db3477
CY
409(defvar rcirc-server-name-history nil
410 "History variable for \\[rcirc] call.")
411
412(defvar rcirc-server-port-history nil
413 "History variable for \\[rcirc] call.")
414
415(defvar rcirc-nick-name-history nil
416 "History variable for \\[rcirc] call.")
417
d26781af
RY
418(defvar rcirc-user-name-history nil
419 "History variable for \\[rcirc] call.")
420
bd43c990 421;;;###autoload
db58efbf 422(defun rcirc (arg)
0ffab1eb 423 "Connect to all servers in `rcirc-server-alist'.
195eca78
SM
424
425Do not connect to a server if it is already connected.
426
427If ARG is non-nil, instead prompt for connection parameters."
db58efbf
EZ
428 (interactive "P")
429 (if arg
0ffab1eb
TTN
430 (let* ((server (completing-read "IRC Server: "
431 rcirc-server-alist
195eca78 432 nil nil
c0db3477
CY
433 (caar rcirc-server-alist)
434 'rcirc-server-name-history))
0ffab1eb
TTN
435 (server-plist (cdr (assoc-string server rcirc-server-alist)))
436 (port (read-string "IRC Port: "
195eca78 437 (number-to-string
d8937064 438 (or (plist-get server-plist :port)
c0db3477
CY
439 rcirc-default-port))
440 'rcirc-server-port-history))
195eca78 441 (nick (read-string "IRC Nick: "
d8937064 442 (or (plist-get server-plist :nick)
c0db3477
CY
443 rcirc-default-nick)
444 'rcirc-nick-name-history))
d26781af
RY
445 (user-name (read-string "IRC Username: "
446 (or (plist-get server-plist :user-name)
447 rcirc-default-user-name)
448 'rcirc-user-name-history))
a71832f7
SM
449 (password (read-passwd "IRC Password: " nil
450 (plist-get server-plist :password)))
db58efbf
EZ
451 (channels (split-string
452 (read-string "IRC Channels: "
0ffab1eb 453 (mapconcat 'identity
195eca78 454 (plist-get server-plist
d8937064 455 :channels)
195eca78 456 " "))
488086f4 457 "[, ]+" t))
ac09b8a1 458 (encryption (rcirc-prompt-for-encryption server-plist)))
a71832f7 459 (rcirc-connect server port nick user-name
0ffab1eb 460 rcirc-default-full-name
488086f4 461 channels password encryption))
0ffab1eb 462 ;; connect to servers in `rcirc-server-alist'
195eca78 463 (let (connected-servers)
0ffab1eb 464 (dolist (c rcirc-server-alist)
195eca78 465 (let ((server (car c))
0ffab1eb
TTN
466 (nick (or (plist-get (cdr c) :nick) rcirc-default-nick))
467 (port (or (plist-get (cdr c) :port) rcirc-default-port))
468 (user-name (or (plist-get (cdr c) :user-name)
195eca78 469 rcirc-default-user-name))
0ffab1eb
TTN
470 (full-name (or (plist-get (cdr c) :full-name)
471 rcirc-default-full-name))
a71832f7 472 (channels (plist-get (cdr c) :channels))
488086f4
SM
473 (password (plist-get (cdr c) :password))
474 (encryption (plist-get (cdr c) :encryption)))
195eca78
SM
475 (when server
476 (let (connected)
477 (dolist (p (rcirc-process-list))
478 (when (string= server (process-name p))
479 (setq connected p)))
480 (if (not connected)
481 (condition-case e
a71832f7 482 (rcirc-connect server port nick user-name
488086f4 483 full-name channels password encryption)
0ffab1eb 484 (quit (message "Quit connecting to %s" server)))
195eca78
SM
485 (with-current-buffer (process-buffer connected)
486 (setq connected-servers
487 (cons (process-contact (get-buffer-process
488 (current-buffer)) :host)
489 connected-servers))))))))
490 (when connected-servers
491 (message "Already connected to %s"
a0a5c583
GM
492 (if (cdr connected-servers)
493 (concat (mapconcat 'identity (butlast connected-servers) ", ")
494 ", and "
495 (car (last connected-servers)))
496 (car connected-servers)))))))
195eca78 497
bd43c990
RS
498;;;###autoload
499(defalias 'irc 'rcirc)
500
501\f
502(defvar rcirc-process-output nil)
bd43c990
RS
503(defvar rcirc-topic nil)
504(defvar rcirc-keepalive-timer nil)
ad8121fe 505(defvar rcirc-last-server-message-time nil)
8216fbaf
EZ
506(defvar rcirc-server nil) ; server provided by server
507(defvar rcirc-server-name nil) ; server name given by 001 response
508(defvar rcirc-timeout-timer nil)
9882e214 509(defvar rcirc-user-authenticated nil)
8216fbaf
EZ
510(defvar rcirc-user-disconnect nil)
511(defvar rcirc-connecting nil)
512(defvar rcirc-process nil)
8d214091
RF
513
514;;;###autoload
a71832f7 515(defun rcirc-connect (server &optional port nick user-name
488086f4 516 full-name startup-channels password encryption)
bd43c990
RS
517 (save-excursion
518 (message "Connecting to %s..." server)
519 (let* ((inhibit-eol-conversion)
2fbed782
EZ
520 (port-number (if port
521 (if (stringp port)
522 (string-to-number port)
523 port)
a2524d26 524 rcirc-default-port))
a2524d26
EZ
525 (nick (or nick rcirc-default-nick))
526 (user-name (or user-name rcirc-default-user-name))
0ffab1eb 527 (full-name (or full-name rcirc-default-full-name))
a2524d26 528 (startup-channels startup-channels)
488086f4
SM
529 (process (open-network-stream
530 server nil server port-number
531 :type (or encryption 'plain))))
bd43c990
RS
532 ;; set up process
533 (set-process-coding-system process 'raw-text 'raw-text)
adf794e4 534 (switch-to-buffer (rcirc-generate-new-buffer-name process nil))
bd43c990 535 (set-process-buffer process (current-buffer))
bd43c990 536 (rcirc-mode process nil)
a2524d26
EZ
537 (set-process-sentinel process 'rcirc-sentinel)
538 (set-process-filter process 'rcirc-filter)
488086f4
SM
539
540 (set (make-local-variable 'rcirc-process) process)
541 (set (make-local-variable 'rcirc-server) server)
542 (set (make-local-variable 'rcirc-server-name) server) ; Update when we get 001 response.
543 (set (make-local-variable 'rcirc-buffer-alist) nil)
544 (set (make-local-variable 'rcirc-nick-table)
545 (make-hash-table :test 'equal))
546 (set (make-local-variable 'rcirc-nick) nick)
547 (set (make-local-variable 'rcirc-process-output) nil)
548 (set (make-local-variable 'rcirc-startup-channels) startup-channels)
549 (set (make-local-variable 'rcirc-last-server-message-time)
550 (current-time))
551
552 (set (make-local-variable 'rcirc-timeout-timer) nil)
553 (set (make-local-variable 'rcirc-user-disconnect) nil)
554 (set (make-local-variable 'rcirc-user-authenticated) nil)
555 (set (make-local-variable 'rcirc-connecting) t)
bd43c990 556
195eca78
SM
557 (add-hook 'auto-save-hook 'rcirc-log-write)
558
bd43c990 559 ;; identify
fa7062f6 560 (unless (zerop (length password))
a71832f7 561 (rcirc-send-string process (concat "PASS " password)))
bd43c990
RS
562 (rcirc-send-string process (concat "NICK " nick))
563 (rcirc-send-string process (concat "USER " user-name
d26781af 564 " 0 * :" full-name))
bd43c990
RS
565
566 ;; setup ping timer if necessary
8216fbaf
EZ
567 (unless rcirc-keepalive-timer
568 (setq rcirc-keepalive-timer
569 (run-at-time 0 (/ rcirc-timeout-seconds 2) 'rcirc-keepalive)))
bd43c990
RS
570
571 (message "Connecting to %s...done" server)
572
573 ;; return process object
574 process)))
575
adf794e4
EZ
576(defmacro with-rcirc-process-buffer (process &rest body)
577 (declare (indent 1) (debug t))
578 `(with-current-buffer (process-buffer ,process)
579 ,@body))
580
a2524d26
EZ
581(defmacro with-rcirc-server-buffer (&rest body)
582 (declare (indent 0) (debug t))
583 `(with-current-buffer rcirc-server-buffer
584 ,@body))
585
73057ba9
DD
586(defun rcirc-float-time ()
587 (if (featurep 'xemacs)
588 (time-to-seconds (current-time))
589 (float-time)))
590
ac09b8a1
DD
591(defun rcirc-prompt-for-encryption (server-plist)
592 "Prompt the user for the encryption method to use.
593SERVER-PLIST is the property list for the server."
594 (let ((msg "Encryption (default %s): ")
595 (choices '("plain" "tls"))
596 (default (or (plist-get server-plist :encryption)
7e821d0d 597 'plain)))
ac09b8a1
DD
598 (intern
599 (completing-read (format msg default)
7e821d0d 600 choices nil t nil nil (symbol-name default)))))
ac09b8a1 601
bd43c990 602(defun rcirc-keepalive ()
ad8121fe
EZ
603 "Send keep alive pings to active rcirc processes.
604Kill processes that have not received a server message since the
605last ping."
bd43c990
RS
606 (if (rcirc-process-list)
607 (mapc (lambda (process)
8216fbaf
EZ
608 (with-rcirc-process-buffer process
609 (when (not rcirc-connecting)
1be1d1e9
DD
610 (rcirc-send-ctcp process
611 rcirc-nick
612 (format "KEEPALIVE %f"
73057ba9 613 (rcirc-float-time))))))
bd43c990 614 (rcirc-process-list))
8216fbaf 615 ;; no processes, clean up timer
bd43c990
RS
616 (cancel-timer rcirc-keepalive-timer)
617 (setq rcirc-keepalive-timer nil)))
618
195eca78
SM
619(defun rcirc-handler-ctcp-KEEPALIVE (process target sender message)
620 (with-rcirc-process-buffer process
73057ba9 621 (setq header-line-format (format "%f" (- (rcirc-float-time)
195eca78
SM
622 (string-to-number message))))))
623
3767e706 624(defvar rcirc-debug-buffer "*rcirc debug*")
adf794e4
EZ
625(defvar rcirc-debug-flag nil
626 "If non-nil, write information to `rcirc-debug-buffer'.")
627(defun rcirc-debug (process text)
bd43c990 628 "Add an entry to the debug log including PROCESS and TEXT.
2e398771 629Debug text is written to `rcirc-debug-buffer' if `rcirc-debug-flag'
adf794e4
EZ
630is non-nil."
631 (when rcirc-debug-flag
9a529312 632 (with-current-buffer (get-buffer-create rcirc-debug-buffer)
195eca78
SM
633 (goto-char (point-max))
634 (insert (concat
635 "["
636 (format-time-string "%Y-%m-%dT%T ") (process-name process)
637 "] "
638 text)))))
adf794e4 639
bd43c990
RS
640(defvar rcirc-sentinel-hooks nil
641 "Hook functions called when the process sentinel is called.
642Functions are called with PROCESS and SENTINEL arguments.")
643
644(defun rcirc-sentinel (process sentinel)
645 "Called when PROCESS receives SENTINEL."
646 (let ((sentinel (replace-regexp-in-string "\n" "" sentinel)))
adf794e4
EZ
647 (rcirc-debug process (format "SENTINEL: %S %S\n" process sentinel))
648 (with-rcirc-process-buffer process
649 (dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
adf794e4 650 (with-current-buffer (or buffer (current-buffer))
db58efbf
EZ
651 (rcirc-print process "rcirc.el" "ERROR" rcirc-target
652 (format "%s: %s (%S)"
653 (process-name process)
654 sentinel
8216fbaf 655 (process-status process)) (not rcirc-target))
195eca78 656 (rcirc-disconnect-buffer)))
8216fbaf 657 (run-hook-with-args 'rcirc-sentinel-hooks process sentinel))))
bd43c990 658
195eca78
SM
659(defun rcirc-disconnect-buffer (&optional buffer)
660 (with-current-buffer (or buffer (current-buffer))
661 ;; set rcirc-target to nil for each channel so cleanup
662 ;; doesnt happen when we reconnect
663 (setq rcirc-target nil)
0ffab1eb 664 (setq mode-line-process ":disconnected")))
195eca78 665
bd43c990
RS
666(defun rcirc-process-list ()
667 "Return a list of rcirc processes."
668 (let (ps)
669 (mapc (lambda (p)
18aa2c90 670 (when (buffer-live-p (process-buffer p))
adf794e4 671 (with-rcirc-process-buffer p
bd43c990
RS
672 (when (eq major-mode 'rcirc-mode)
673 (setq ps (cons p ps))))))
674 (process-list))
675 ps))
676
677(defvar rcirc-receive-message-hooks nil
2e398771
JB
678 "Hook functions run when a message is received from server.
679Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
bd43c990
RS
680(defun rcirc-filter (process output)
681 "Called when PROCESS receives OUTPUT."
adf794e4 682 (rcirc-debug process output)
8216fbaf 683 (rcirc-reschedule-timeout process)
adf794e4 684 (with-rcirc-process-buffer process
ad8121fe 685 (setq rcirc-last-server-message-time (current-time))
bd43c990
RS
686 (setq rcirc-process-output (concat rcirc-process-output output))
687 (when (= (aref rcirc-process-output
688 (1- (length rcirc-process-output))) ?\n)
689 (mapc (lambda (line)
690 (rcirc-process-server-response process line))
adf794e4 691 (split-string rcirc-process-output "[\n\r]" t))
bd43c990
RS
692 (setq rcirc-process-output nil))))
693
8216fbaf
EZ
694(defun rcirc-reschedule-timeout (process)
695 (with-rcirc-process-buffer process
696 (when (not rcirc-connecting)
697 (with-rcirc-process-buffer process
698 (when rcirc-timeout-timer (cancel-timer rcirc-timeout-timer))
699 (setq rcirc-timeout-timer (run-at-time rcirc-timeout-seconds nil
700 'rcirc-delete-process
701 process))))))
702
703(defun rcirc-delete-process (process)
8216fbaf
EZ
704 (delete-process process))
705
adf794e4 706(defvar rcirc-trap-errors-flag t)
bd43c990 707(defun rcirc-process-server-response (process text)
adf794e4 708 (if rcirc-trap-errors-flag
bd43c990
RS
709 (condition-case err
710 (rcirc-process-server-response-1 process text)
711 (error
712 (rcirc-print process "RCIRC" "ERROR" nil
adf794e4 713 (format "\"%s\" %s" text err) t)))
bd43c990
RS
714 (rcirc-process-server-response-1 process text)))
715
716(defun rcirc-process-server-response-1 (process text)
717 (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\) \\(.+\\)$" text)
db58efbf
EZ
718 (let* ((user (match-string 2 text))
719 (sender (rcirc-user-nick user))
bd43c990
RS
720 (cmd (match-string 3 text))
721 (args (match-string 4 text))
722 (handler (intern-soft (concat "rcirc-handler-" cmd))))
723 (string-match "^\\([^:]*\\):?\\(.+\\)?$" args)
724 (let* ((args1 (match-string 1 args))
725 (args2 (match-string 2 args))
adf794e4
EZ
726 (args (delq nil (append (split-string args1 " " t)
727 (list args2)))))
bd43c990
RS
728 (if (not (fboundp handler))
729 (rcirc-handler-generic process cmd sender args text)
730 (funcall handler process sender args text))
731 (run-hook-with-args 'rcirc-receive-message-hooks
732 process cmd sender args text)))
733 (message "UNHANDLED: %s" text)))
734
f8db61b2
EZ
735(defvar rcirc-responses-no-activity '("305" "306")
736 "Responses that don't trigger activity in the mode-line indicator.")
737
738(defun rcirc-handler-generic (process response sender args text)
bd43c990 739 "Generic server response handler."
f8db61b2
EZ
740 (rcirc-print process sender response nil
741 (mapconcat 'identity (cdr args) " ")
742 (not (member response rcirc-responses-no-activity))))
bd43c990 743
488086f4
SM
744(defun rcirc--connection-open-p (process)
745 (memq (process-status process) '(run open)))
746
bd43c990
RS
747(defun rcirc-send-string (process string)
748 "Send PROCESS a STRING plus a newline."
a2524d26 749 (let ((string (concat (encode-coding-string string rcirc-encode-coding-system)
bd43c990 750 "\n")))
488086f4 751 (unless (rcirc--connection-open-p process)
53f831f3 752 (error "Network connection to %s is not open"
a2524d26 753 (process-name process)))
adf794e4 754 (rcirc-debug process string)
bd43c990
RS
755 (process-send-string process string)))
756
1be1d1e9
DD
757(defun rcirc-send-privmsg (process target string)
758 (rcirc-send-string process (format "PRIVMSG %s :%s" target string)))
759
760(defun rcirc-send-ctcp (process target request &optional args)
761 (let ((args (if args (concat " " args) "")))
762 (rcirc-send-privmsg process target
5708ce5e 763 (format "\C-a%s%s\C-a" request args))))
1be1d1e9 764
a2524d26
EZ
765(defun rcirc-buffer-process (&optional buffer)
766 "Return the process associated with channel BUFFER.
767With no argument or nil as argument, use the current buffer."
8216fbaf
EZ
768 (or (get-buffer-process (if buffer
769 (with-current-buffer buffer
770 rcirc-server-buffer)
771 rcirc-server-buffer))
772 rcirc-process))
a2524d26
EZ
773
774(defun rcirc-server-name (process)
775 "Return PROCESS server name, given by the 001 response."
adf794e4 776 (with-rcirc-process-buffer process
195eca78
SM
777 (or rcirc-server-name
778 (warn "server name for process %S unknown" process))))
bd43c990
RS
779
780(defun rcirc-nick (process)
781 "Return PROCESS nick."
92c4adc1 782 (with-rcirc-process-buffer process
a2524d26
EZ
783 (or rcirc-nick rcirc-default-nick)))
784
785(defun rcirc-buffer-nick (&optional buffer)
786 "Return the nick associated with BUFFER.
787With no argument or nil as argument, use the current buffer."
788 (with-current-buffer (or buffer (current-buffer))
789 (with-current-buffer rcirc-server-buffer
790 (or rcirc-nick rcirc-default-nick))))
bd43c990 791
02f47e86 792(defvar rcirc-max-message-length 420
bd43c990
RS
793 "Messages longer than this value will be split.")
794
195eca78 795(defun rcirc-send-message (process target message &optional noticep silent)
bd43c990 796 "Send TARGET associated with PROCESS a privmsg with text MESSAGE.
195eca78
SM
797If NOTICEP is non-nil, send a notice instead of privmsg.
798If SILENT is non-nil, do not print the message in any irc buffer."
bd43c990
RS
799 ;; max message length is 512 including CRLF
800 (let* ((response (if noticep "NOTICE" "PRIVMSG"))
801 (oversize (> (length message) rcirc-max-message-length))
802 (text (if oversize
803 (substring message 0 rcirc-max-message-length)
804 message))
805 (text (if (string= text "")
806 " "
807 text))
808 (more (if oversize
809 (substring message rcirc-max-message-length))))
db58efbf 810 (rcirc-get-buffer-create process target)
bd43c990 811 (rcirc-send-string process (concat response " " target " :" text))
195eca78
SM
812 (unless silent
813 (rcirc-print process (rcirc-nick process) response target text))
db58efbf 814 (when more (rcirc-send-message process target more noticep))))
bd43c990
RS
815
816(defvar rcirc-input-ring nil)
817(defvar rcirc-input-ring-index 0)
818(defun rcirc-prev-input-string (arg)
819 (ring-ref rcirc-input-ring (+ rcirc-input-ring-index arg)))
820
821(defun rcirc-insert-prev-input (arg)
822 (interactive "p")
823 (when (<= rcirc-prompt-end-marker (point))
824 (delete-region rcirc-prompt-end-marker (point-max))
825 (insert (rcirc-prev-input-string 0))
826 (setq rcirc-input-ring-index (1+ rcirc-input-ring-index))))
827
828(defun rcirc-insert-next-input (arg)
829 (interactive "p")
830 (when (<= rcirc-prompt-end-marker (point))
831 (delete-region rcirc-prompt-end-marker (point-max))
832 (setq rcirc-input-ring-index (1- rcirc-input-ring-index))
833 (insert (rcirc-prev-input-string -1))))
834
94c7243b
LL
835(defvar rcirc-server-commands
836 '("/admin" "/away" "/connect" "/die" "/error" "/info"
837 "/invite" "/ison" "/join" "/kick" "/kill" "/links"
838 "/list" "/lusers" "/mode" "/motd" "/names" "/nick"
839 "/notice" "/oper" "/part" "/pass" "/ping" "/pong"
840 "/privmsg" "/quit" "/rehash" "/restart" "/service" "/servlist"
841 "/server" "/squery" "/squit" "/stats" "/summon" "/time"
842 "/topic" "/trace" "/user" "/userhost" "/users" "/version"
843 "/wallops" "/who" "/whois" "/whowas")
844 "A list of user commands by IRC server.
845The value defaults to RFCs 1459 and 2812.")
846
847;; /me and /ctcp are not defined by `defun-rcirc-command'.
848(defvar rcirc-client-commands '("/me" "/ctcp")
849 "A list of user commands defined by IRC client rcirc.
850The list is updated automatically by `defun-rcirc-command'.")
851
852(defun rcirc-completion-at-point ()
853 "Function used for `completion-at-point-functions' in `rcirc-mode'."
0b4e93f1
LL
854 (and (rcirc-looking-at-input)
855 (let* ((beg (save-excursion
856 (if (re-search-backward " " rcirc-prompt-end-marker t)
857 (1+ (point))
858 rcirc-prompt-end-marker)))
859 (table (if (and (= beg rcirc-prompt-end-marker)
860 (eq (char-after beg) ?/))
861 (delete-dups
862 (nconc (sort (copy-sequence rcirc-client-commands)
863 'string-lessp)
864 (sort (copy-sequence rcirc-server-commands)
865 'string-lessp)))
866 (rcirc-channel-nicks (rcirc-buffer-process)
867 rcirc-target))))
868 (list beg (point) table))))
94c7243b
LL
869
870(defvar rcirc-completions nil)
871(defvar rcirc-completion-start nil)
872
873(defun rcirc-complete ()
874 "Cycle through completions from list of nicks in channel or IRC commands.
875IRC command completion is performed only if '/' is the first input char."
bd43c990 876 (interactive)
0b4e93f1
LL
877 (unless (rcirc-looking-at-input)
878 (error "Point not located after rcirc prompt"))
7faa3f8c 879 (if (eq last-command this-command)
94c7243b
LL
880 (setq rcirc-completions
881 (append (cdr rcirc-completions) (list (car rcirc-completions))))
882 (let ((completion-ignore-case t)
883 (table (rcirc-completion-at-point)))
884 (setq rcirc-completion-start (car table))
885 (setq rcirc-completions
0b4e93f1
LL
886 (and rcirc-completion-start
887 (all-completions (buffer-substring rcirc-completion-start
888 (cadr table))
889 (nth 2 table))))))
94c7243b 890 (let ((completion (car rcirc-completions)))
bd43c990 891 (when completion
94c7243b
LL
892 (delete-region rcirc-completion-start (point))
893 (insert
2a4466ca
DD
894 (cond
895 ((= (aref completion 0) ?/) (concat completion " "))
896 ((= rcirc-completion-start rcirc-prompt-end-marker)
897 (format rcirc-nick-completion-format completion))
898 (t completion))))))
bd43c990 899
a2524d26
EZ
900(defun set-rcirc-decode-coding-system (coding-system)
901 "Set the decode coding system used in this channel."
902 (interactive "zCoding system for incoming messages: ")
488086f4 903 (set (make-local-variable 'rcirc-decode-coding-system) coding-system))
a2524d26
EZ
904
905(defun set-rcirc-encode-coding-system (coding-system)
906 "Set the encode coding system used in this channel."
907 (interactive "zCoding system for outgoing messages: ")
488086f4 908 (set (make-local-variable 'rcirc-encode-coding-system) coding-system))
bd43c990 909
b016851c
SM
910(defvar rcirc-mode-map
911 (let ((map (make-sparse-keymap)))
912 (define-key map (kbd "RET") 'rcirc-send-input)
913 (define-key map (kbd "M-p") 'rcirc-insert-prev-input)
914 (define-key map (kbd "M-n") 'rcirc-insert-next-input)
915 (define-key map (kbd "TAB") 'rcirc-complete)
916 (define-key map (kbd "C-c C-b") 'rcirc-browse-url)
917 (define-key map (kbd "C-c C-c") 'rcirc-edit-multiline)
918 (define-key map (kbd "C-c C-j") 'rcirc-cmd-join)
919 (define-key map (kbd "C-c C-k") 'rcirc-cmd-kick)
920 (define-key map (kbd "C-c C-l") 'rcirc-toggle-low-priority)
921 (define-key map (kbd "C-c C-d") 'rcirc-cmd-mode)
922 (define-key map (kbd "C-c C-m") 'rcirc-cmd-msg)
923 (define-key map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename
924 (define-key map (kbd "C-c C-o") 'rcirc-omit-mode)
b016851c
SM
925 (define-key map (kbd "C-c C-p") 'rcirc-cmd-part)
926 (define-key map (kbd "C-c C-q") 'rcirc-cmd-query)
927 (define-key map (kbd "C-c C-t") 'rcirc-cmd-topic)
928 (define-key map (kbd "C-c C-n") 'rcirc-cmd-names)
929 (define-key map (kbd "C-c C-w") 'rcirc-cmd-whois)
930 (define-key map (kbd "C-c C-x") 'rcirc-cmd-quit)
931 (define-key map (kbd "C-c TAB") ; C-i
932 'rcirc-toggle-ignore-buffer-activity)
933 (define-key map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer)
934 (define-key map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line)
935 map)
bd43c990
RS
936 "Keymap for rcirc mode.")
937
adf794e4
EZ
938(defvar rcirc-short-buffer-name nil
939 "Generated abbreviation to use to indicate buffer activity.")
940
bd43c990
RS
941(defvar rcirc-mode-hook nil
942 "Hook run when setting up rcirc buffer.")
943
a2524d26
EZ
944(defvar rcirc-last-post-time nil)
945
195eca78
SM
946(defvar rcirc-log-alist nil
947 "Alist of lines to log to disk when `rcirc-log-flag' is non-nil.
948Each element looks like (FILENAME . TEXT).")
949
a0a5c583
GM
950(defvar rcirc-current-line 0
951 "The current number of responses printed in this channel.
952This number is independent of the number of lines in the buffer.")
953
bd43c990 954(defun rcirc-mode (process target)
4d789d84 955 ;; FIXME: Use define-derived-mode.
2e398771 956 "Major mode for IRC channel buffers.
bd43c990
RS
957
958\\{rcirc-mode-map}"
959 (kill-all-local-variables)
960 (use-local-map rcirc-mode-map)
961 (setq mode-name "rcirc")
962 (setq major-mode 'rcirc-mode)
195eca78 963 (setq mode-line-process nil)
bd43c990 964
488086f4
SM
965 (set (make-local-variable 'rcirc-input-ring)
966 (make-ring rcirc-input-ring-size))
967 (set (make-local-variable 'rcirc-server-buffer) (process-buffer process))
968 (set (make-local-variable 'rcirc-target) target)
969 (set (make-local-variable 'rcirc-topic) nil)
970 (set (make-local-variable 'rcirc-last-post-time) (current-time))
971 (set (make-local-variable 'fill-paragraph-function) 'rcirc-fill-paragraph)
972 (set (make-local-variable 'rcirc-recent-quit-alist) nil)
973 (set (make-local-variable 'rcirc-current-line) 0)
974
975 (set (make-local-variable 'rcirc-short-buffer-name) nil)
82745640 976 (set (make-local-variable 'rcirc-urls) nil)
bd43c990 977
a0a5c583
GM
978 ;; setup for omitting responses
979 (setq buffer-invisibility-spec '())
980 (setq buffer-display-table (make-display-table))
981 (set-display-table-slot buffer-display-table 4
aebf69c8 982 (let ((glyph (make-glyph-code
a0a5c583
GM
983 ?. 'font-lock-keyword-face)))
984 (make-vector 3 glyph)))
985
a2524d26
EZ
986 (dolist (i rcirc-coding-system-alist)
987 (let ((chan (if (consp (car i)) (caar i) (car i)))
988 (serv (if (consp (car i)) (cdar i) "")))
989 (when (and (string-match chan (or target ""))
990 (string-match serv (rcirc-server-name process)))
488086f4
SM
991 (set (make-local-variable 'rcirc-decode-coding-system)
992 (if (consp (cdr i)) (cadr i) (cdr i)))
993 (set (make-local-variable 'rcirc-encode-coding-system)
994 (if (consp (cdr i)) (cddr i) (cdr i))))))
a2524d26 995
bd43c990 996 ;; setup the prompt and markers
488086f4
SM
997 (set (make-local-variable 'rcirc-prompt-start-marker) (point-max-marker))
998 (set (make-local-variable 'rcirc-prompt-end-marker) (point-max-marker))
bd43c990
RS
999 (rcirc-update-prompt)
1000 (goto-char rcirc-prompt-end-marker)
488086f4
SM
1001
1002 (set (make-local-variable 'overlay-arrow-position) (make-marker))
bd43c990 1003
a2524d26
EZ
1004 ;; if the user changes the major mode or kills the buffer, there is
1005 ;; cleanup work to do
f8db61b2
EZ
1006 (add-hook 'change-major-mode-hook 'rcirc-change-major-mode-hook nil t)
1007 (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook nil t)
a2524d26 1008
adf794e4
EZ
1009 ;; add to buffer list, and update buffer abbrevs
1010 (when target ; skip server buffer
1011 (let ((buffer (current-buffer)))
1012 (with-rcirc-process-buffer process
1013 (setq rcirc-buffer-alist (cons (cons target buffer)
1014 rcirc-buffer-alist))))
1015 (rcirc-update-short-buffer-names))
1016
94c7243b
LL
1017 (add-hook 'completion-at-point-functions
1018 'rcirc-completion-at-point nil 'local)
1019
4d789d84 1020 (run-mode-hooks 'rcirc-mode-hook))
bd43c990 1021
adf794e4
EZ
1022(defun rcirc-update-prompt (&optional all)
1023 "Reset the prompt string in the current buffer.
c18a54de 1024
adf794e4
EZ
1025If ALL is non-nil, update prompts in all IRC buffers."
1026 (if all
1027 (mapc (lambda (process)
1028 (mapc (lambda (buffer)
1029 (with-current-buffer buffer
1030 (rcirc-update-prompt)))
1031 (with-rcirc-process-buffer process
1032 (mapcar 'cdr rcirc-buffer-alist))))
1033 (rcirc-process-list))
1034 (let ((inhibit-read-only t)
1035 (prompt (or rcirc-prompt "")))
1036 (mapc (lambda (rep)
1037 (setq prompt
a2524d26
EZ
1038 (replace-regexp-in-string (car rep) (cdr rep) prompt)))
1039 (list (cons "%n" (rcirc-buffer-nick))
8216fbaf 1040 (cons "%s" (with-rcirc-server-buffer rcirc-server-name))
adf794e4
EZ
1041 (cons "%t" (or rcirc-target ""))))
1042 (save-excursion
1043 (delete-region rcirc-prompt-start-marker rcirc-prompt-end-marker)
1044 (goto-char rcirc-prompt-start-marker)
1045 (let ((start (point)))
1046 (insert-before-markers prompt)
1047 (set-marker rcirc-prompt-start-marker start)
1048 (when (not (zerop (- rcirc-prompt-end-marker
1049 rcirc-prompt-start-marker)))
1050 (add-text-properties rcirc-prompt-start-marker
1051 rcirc-prompt-end-marker
1052 (list 'face 'rcirc-prompt
1053 'read-only t 'field t
1054 'front-sticky t 'rear-nonsticky t))))))))
1055
1056(defun rcirc-set-changed (option value)
1057 "Set OPTION to VALUE and do updates after a customization change."
1058 (set-default option value)
1059 (cond ((eq option 'rcirc-prompt)
1060 (rcirc-update-prompt 'all))
1061 (t
1062 (error "Bad option %s" option))))
bd43c990
RS
1063
1064(defun rcirc-channel-p (target)
1065 "Return t if TARGET is a channel name."
1066 (and target
1067 (not (zerop (length target)))
1068 (or (eq (aref target 0) ?#)
1069 (eq (aref target 0) ?&))))
1070
2d7d6439
GM
1071(defcustom rcirc-log-directory "~/.emacs.d/rcirc-log"
1072 "Directory to keep IRC logfiles."
1073 :type 'directory
1074 :group 'rcirc)
1075
1076(defcustom rcirc-log-flag nil
1077 "Non-nil means log IRC activity to disk.
1078Logfiles are kept in `rcirc-log-directory'."
1079 :type 'boolean
1080 :group 'rcirc)
1081
bd43c990
RS
1082(defun rcirc-kill-buffer-hook ()
1083 "Part the channel when killing an rcirc buffer."
1084 (when (eq major-mode 'rcirc-mode)
80094035
GK
1085 (when (and rcirc-log-flag
1086 rcirc-log-directory)
1087 (rcirc-log-write))
a2524d26
EZ
1088 (rcirc-clean-up-buffer "Killed buffer")))
1089
1090(defun rcirc-change-major-mode-hook ()
1091 "Part the channel when changing the major-mode."
1092 (rcirc-clean-up-buffer "Changed major mode"))
1093
1094(defun rcirc-clean-up-buffer (reason)
adf794e4
EZ
1095 (let ((buffer (current-buffer)))
1096 (rcirc-clear-activity buffer)
a2524d26 1097 (when (and (rcirc-buffer-process)
488086f4 1098 (rcirc--connection-open-p (rcirc-buffer-process)))
a2524d26
EZ
1099 (with-rcirc-server-buffer
1100 (setq rcirc-buffer-alist
1101 (rassq-delete-all buffer rcirc-buffer-alist)))
adf794e4 1102 (rcirc-update-short-buffer-names)
bd43c990 1103 (if (rcirc-channel-p rcirc-target)
a2524d26
EZ
1104 (rcirc-send-string (rcirc-buffer-process)
1105 (concat "PART " rcirc-target " :" reason))
adf794e4 1106 (when rcirc-target
a2524d26
EZ
1107 (rcirc-remove-nick-channel (rcirc-buffer-process)
1108 (rcirc-buffer-nick)
195eca78
SM
1109 rcirc-target))))
1110 (setq rcirc-target nil)))
adf794e4 1111
adf794e4
EZ
1112(defun rcirc-generate-new-buffer-name (process target)
1113 "Return a buffer name based on PROCESS and TARGET.
2e398771 1114This is used for the initial name given to IRC buffers."
195eca78
SM
1115 (substring-no-properties
1116 (if target
1117 (concat target "@" (process-name process))
1118 (concat "*" (process-name process) "*"))))
bd43c990 1119
adf794e4 1120(defun rcirc-get-buffer (process target &optional server)
bd43c990 1121 "Return the buffer associated with the PROCESS and TARGET.
adf794e4 1122
adf794e4
EZ
1123If optional argument SERVER is non-nil, return the server buffer
1124if there is no existing buffer for TARGET, otherwise return nil."
1125 (with-rcirc-process-buffer process
1126 (if (null target)
1127 (current-buffer)
1128 (let ((buffer (cdr (assoc-string target rcirc-buffer-alist t))))
1129 (or buffer (when server (current-buffer)))))))
bd43c990
RS
1130
1131(defun rcirc-get-buffer-create (process target)
adf794e4
EZ
1132 "Return the buffer associated with the PROCESS and TARGET.
1133Create the buffer if it doesn't exist."
1134 (let ((buffer (rcirc-get-buffer process target)))
a2524d26 1135 (if (and buffer (buffer-live-p buffer))
2fbed782 1136 (with-current-buffer buffer
db58efbf 1137 (when (not rcirc-target)
2fbed782 1138 (setq rcirc-target target))
db58efbf 1139 buffer)
195eca78
SM
1140 ;; create the buffer
1141 (with-rcirc-process-buffer process
1142 (let ((new-buffer (get-buffer-create
1143 (rcirc-generate-new-buffer-name process target))))
1144 (with-current-buffer new-buffer
a0a5c583 1145 (rcirc-mode process target)
aebf69c8 1146 (rcirc-put-nick-channel process (rcirc-nick process) target
a0a5c583 1147 rcirc-current-line))
195eca78 1148 new-buffer)))))
bd43c990
RS
1149
1150(defun rcirc-send-input ()
1151 "Send input to target associated with the current buffer."
1152 (interactive)
53f831f3
AS
1153 (if (< (point) rcirc-prompt-end-marker)
1154 ;; copy the line down to the input area
1155 (progn
1156 (forward-line 0)
1157 (let ((start (if (eq (point) (point-min))
1158 (point)
1159 (if (get-text-property (1- (point)) 'hard)
1160 (point)
1161 (previous-single-property-change (point) 'hard))))
1162 (end (next-single-property-change (1+ (point)) 'hard)))
1163 (goto-char (point-max))
1164 (insert (replace-regexp-in-string
1165 "\n\\s-+" " "
1166 (buffer-substring-no-properties start end)))))
1167 ;; process input
1168 (goto-char (point-max))
a2524d26
EZ
1169 (when (not (equal 0 (- (point) rcirc-prompt-end-marker)))
1170 ;; delete a trailing newline
1171 (when (eq (point) (point-at-bol))
d355a0b7 1172 (delete-char -1))
a2524d26
EZ
1173 (let ((input (buffer-substring-no-properties
1174 rcirc-prompt-end-marker (point))))
1175 (dolist (line (split-string input "\n"))
1176 (rcirc-process-input-line line))
1177 ;; add to input-ring
1178 (save-excursion
1179 (ring-insert rcirc-input-ring input)
1180 (setq rcirc-input-ring-index 0))))))
1181
195eca78
SM
1182(defun rcirc-fill-paragraph (&optional arg)
1183 (interactive "p")
1184 (when (> (point) rcirc-prompt-end-marker)
1185 (save-restriction
1186 (narrow-to-region rcirc-prompt-end-marker (point-max))
1187 (let ((fill-column rcirc-max-message-length))
1188 (fill-region (point-min) (point-max))))))
1189
a2524d26 1190(defun rcirc-process-input-line (line)
db58efbf
EZ
1191 (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line)
1192 (rcirc-process-command (match-string 1 line)
1193 (match-string 2 line)
1194 line)
1195 (rcirc-process-message line)))
1196
1197(defun rcirc-process-message (line)
1198 (if (not rcirc-target)
a2524d26 1199 (message "Not joined (no target)")
db58efbf 1200 (delete-region rcirc-prompt-end-marker (point))
a2524d26
EZ
1201 (rcirc-send-message (rcirc-buffer-process) rcirc-target line)
1202 (setq rcirc-last-post-time (current-time))))
db58efbf
EZ
1203
1204(defun rcirc-process-command (command args line)
1205 (if (eq (aref command 0) ?/)
1206 ;; "//text" will send "/text" as a message
1207 (rcirc-process-message (substring line 1))
a2524d26
EZ
1208 (let ((fun (intern-soft (concat "rcirc-cmd-" command)))
1209 (process (rcirc-buffer-process)))
db58efbf
EZ
1210 (newline)
1211 (with-current-buffer (current-buffer)
1212 (delete-region rcirc-prompt-end-marker (point))
1213 (if (string= command "me")
a2524d26 1214 (rcirc-print process (rcirc-buffer-nick)
db58efbf 1215 "ACTION" rcirc-target args)
a2524d26 1216 (rcirc-print process (rcirc-buffer-nick)
db58efbf
EZ
1217 "COMMAND" rcirc-target line))
1218 (set-marker rcirc-prompt-end-marker (point))
1219 (if (fboundp fun)
a2524d26
EZ
1220 (funcall fun args process rcirc-target)
1221 (rcirc-send-string process
f8db61b2 1222 (concat command " :" args)))))))
db58efbf 1223
bd43c990 1224(defvar rcirc-parent-buffer nil)
488086f4
SM
1225(make-variable-buffer-local 'rcirc-parent-buffer)
1226(put 'rcirc-parent-buffer 'permanent-local t)
bd43c990
RS
1227(defvar rcirc-window-configuration nil)
1228(defun rcirc-edit-multiline ()
1229 "Move current edit to a dedicated buffer."
1230 (interactive)
1231 (let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
1232 (goto-char (point-max))
aebf69c8 1233 (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker
a0a5c583 1234 (point)))
a2524d26 1235 (parent (buffer-name)))
bd43c990
RS
1236 (delete-region rcirc-prompt-end-marker (point))
1237 (setq rcirc-window-configuration (current-window-configuration))
1238 (pop-to-buffer (concat "*multiline " parent "*"))
a2524d26
EZ
1239 (funcall rcirc-multiline-major-mode)
1240 (rcirc-multiline-minor-mode 1)
bd43c990 1241 (setq rcirc-parent-buffer parent)
bd43c990 1242 (insert text)
db58efbf
EZ
1243 (and (> pos 0) (goto-char pos))
1244 (message "Type C-c C-c to return text to %s, or C-c C-k to cancel" parent))))
bd43c990 1245
b016851c
SM
1246(defvar rcirc-multiline-minor-mode-map
1247 (let ((map (make-sparse-keymap)))
1248 (define-key map (kbd "C-c C-c") 'rcirc-multiline-minor-submit)
1249 (define-key map (kbd "C-x C-s") 'rcirc-multiline-minor-submit)
1250 (define-key map (kbd "C-c C-k") 'rcirc-multiline-minor-cancel)
1251 (define-key map (kbd "ESC ESC ESC") 'rcirc-multiline-minor-cancel)
1252 map)
a2524d26 1253 "Keymap for multiline mode in rcirc.")
a2524d26
EZ
1254
1255(define-minor-mode rcirc-multiline-minor-mode
1256 "Minor mode for editing multiple lines in rcirc."
1257 :init-value nil
1258 :lighter " rcirc-mline"
1259 :keymap rcirc-multiline-minor-mode-map
1260 :global nil
1261 :group 'rcirc
02f47e86 1262 (setq fill-column rcirc-max-message-length))
a2524d26
EZ
1263
1264(defun rcirc-multiline-minor-submit ()
bd43c990
RS
1265 "Send the text in buffer back to parent buffer."
1266 (interactive)
adf794e4 1267 (untabify (point-min) (point-max))
bd43c990
RS
1268 (let ((text (buffer-substring (point-min) (point-max)))
1269 (buffer (current-buffer))
1270 (pos (point)))
1271 (set-buffer rcirc-parent-buffer)
1272 (goto-char (point-max))
1273 (insert text)
bd43c990 1274 (kill-buffer buffer)
adf794e4
EZ
1275 (set-window-configuration rcirc-window-configuration)
1276 (goto-char (+ rcirc-prompt-end-marker (1- pos)))))
bd43c990 1277
a2524d26 1278(defun rcirc-multiline-minor-cancel ()
bd43c990
RS
1279 "Cancel the multiline edit."
1280 (interactive)
bd43c990
RS
1281 (kill-buffer (current-buffer))
1282 (set-window-configuration rcirc-window-configuration))
1283
2fbed782 1284(defun rcirc-any-buffer (process)
adf794e4 1285 "Return a buffer for PROCESS, either the one selected or the process buffer."
2fbed782
EZ
1286 (if rcirc-always-use-server-buffer-flag
1287 (process-buffer process)
1288 (let ((buffer (window-buffer (selected-window))))
1289 (if (and buffer
1290 (with-current-buffer buffer
1291 (and (eq major-mode 'rcirc-mode)
a2524d26 1292 (eq (rcirc-buffer-process) process))))
2fbed782
EZ
1293 buffer
1294 (process-buffer process)))))
bd43c990 1295
324e4da7 1296(defcustom rcirc-response-formats
195eca78
SM
1297 '(("PRIVMSG" . "<%N> %m")
1298 ("NOTICE" . "-%N- %m")
1299 ("ACTION" . "[%N %m]")
1300 ("COMMAND" . "%m")
1301 ("ERROR" . "%fw!!! %m")
1302 (t . "%fp*** %fs%n %r %m"))
324e4da7
MB
1303 "An alist of formats used for printing responses.
1304The format is looked up using the response-type as a key;
1305if no match is found, the default entry (with a key of `t') is used.
1306
1307The entry's value part should be a string, which is inserted with
1308the of the following escape sequences replaced by the described values:
1309
1310 %m The message text
2fbed782
EZ
1311 %n The sender's nick
1312 %N The sender's nick (with face `rcirc-my-nick' or `rcirc-other-nick')
324e4da7 1313 %r The response-type
324e4da7
MB
1314 %t The target
1315 %fw Following text uses the face `font-lock-warning-face'
1316 %fp Following text uses the face `rcirc-server-prefix'
1317 %fs Following text uses the face `rcirc-server'
1318 %f[FACE] Following text uses the face FACE
3715419e 1319 %f- Following text uses the default face
a2524d26 1320 %% A literal `%' character"
324e4da7
MB
1321 :type '(alist :key-type (choice (string :tag "Type")
1322 (const :tag "Default" t))
1323 :value-type string)
1324 :group 'rcirc)
1325
0ffab1eb 1326(defcustom rcirc-omit-responses
a0a5c583 1327 '("JOIN" "PART" "QUIT" "NICK")
195eca78
SM
1328 "Responses which will be hidden when `rcirc-omit-mode' is enabled."
1329 :type '(repeat string)
1330 :group 'rcirc)
1331
bd43c990 1332(defun rcirc-format-response-string (process sender response target text)
324e4da7
MB
1333 "Return a nicely-formatted response string, incorporating TEXT
1334\(and perhaps other arguments). The specific formatting used
1335is found by looking up RESPONSE in `rcirc-response-formats'."
195eca78
SM
1336 (with-temp-buffer
1337 (insert (or (cdr (assoc response rcirc-response-formats))
1338 (cdr (assq t rcirc-response-formats))))
1339 (goto-char (point-min))
1340 (let ((start (point-min))
1341 (sender (if (or (not sender)
1342 (string= (rcirc-server-name process) sender))
1343 ""
1344 sender))
1345 face)
1346 (while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t)
1347 (rcirc-add-face start (match-beginning 0) face)
1348 (setq start (match-beginning 0))
1349 (replace-match
1350 (case (aref (match-string 1) 0)
1351 (?f (setq face
1352 (case (string-to-char (match-string 3))
1353 (?w 'font-lock-warning-face)
1354 (?p 'rcirc-server-prefix)
1355 (?s 'rcirc-server)
1356 (t nil)))
1357 "")
1358 (?n sender)
1359 (?N (let ((my-nick (rcirc-nick process)))
1360 (save-match-data
1361 (with-syntax-table rcirc-nick-syntax-table
1362 (rcirc-facify sender
1363 (cond ((string= sender my-nick)
1364 'rcirc-my-nick)
1365 ((and rcirc-bright-nicks
0ffab1eb 1366 (string-match
195eca78
SM
1367 (regexp-opt rcirc-bright-nicks
1368 'words)
1369 sender))
1370 'rcirc-bright-nick)
1371 ((and rcirc-dim-nicks
1372 (string-match
1373 (regexp-opt rcirc-dim-nicks
1374 'words)
1375 sender))
1376 'rcirc-dim-nick)
1377 (t
1378 'rcirc-other-nick)))))))
1379 (?m (propertize text 'rcirc-text text))
1380 (?r response)
1381 (?t (or target ""))
1382 (t (concat "UNKNOWN CODE:" (match-string 0))))
1383 t t nil 0)
1384 (rcirc-add-face (match-beginning 0) (match-end 0) face))
1385 (rcirc-add-face start (match-beginning 0) face))
1386 (buffer-substring (point-min) (point-max))))
bd43c990 1387
db58efbf
EZ
1388(defun rcirc-target-buffer (process sender response target text)
1389 "Return a buffer to print the server response."
1390 (assert (not (bufferp target)))
1391 (with-rcirc-process-buffer process
1392 (cond ((not target)
2fbed782 1393 (rcirc-any-buffer process))
db58efbf
EZ
1394 ((not (rcirc-channel-p target))
1395 ;; message from another user
195eca78
SM
1396 (if (or (string= response "PRIVMSG")
1397 (string= response "ACTION"))
db58efbf
EZ
1398 (rcirc-get-buffer-create process (if (string= sender rcirc-nick)
1399 target
1400 sender))
1401 (rcirc-get-buffer process target t)))
1402 ((or (rcirc-get-buffer process target)
2fbed782 1403 (rcirc-any-buffer process))))))
db58efbf 1404
f8db61b2
EZ
1405(defvar rcirc-activity-types nil)
1406(make-variable-buffer-local 'rcirc-activity-types)
a2524d26
EZ
1407(defvar rcirc-last-sender nil)
1408(make-variable-buffer-local 'rcirc-last-sender)
7faa3f8c 1409
a0a5c583
GM
1410(defcustom rcirc-omit-threshold 100
1411 "Number of lines since last activity from a nick before `rcirc-omit-responses' are omitted."
1412 :type 'integer
1413 :group 'rcirc)
1414
8f10c937
DD
1415(defcustom rcirc-log-process-buffers nil
1416 "Non-nil if rcirc process buffers should be logged to disk."
1417 :group 'rcirc
1418 :type 'boolean
1419 :version "24.1")
1420
683b7dc6 1421(defun rcirc-last-quit-line (process nick target)
a0a5c583
GM
1422 "Return the line number where NICK left TARGET.
1423Returns nil if the information is not recorded."
683b7dc6 1424 (let ((chanbuf (rcirc-get-buffer process target)))
a0a5c583
GM
1425 (when chanbuf
1426 (cdr (assoc-string nick (with-current-buffer chanbuf
1427 rcirc-recent-quit-alist))))))
1428
683b7dc6 1429(defun rcirc-last-line (process nick target)
a0a5c583 1430 "Return the line from the last activity from NICK in TARGET."
683b7dc6 1431 (let* ((chanbuf (rcirc-get-buffer process target))
a0a5c583
GM
1432 (line (or (cdr (assoc-string target
1433 (gethash nick (with-rcirc-server-buffer
1434 rcirc-nick-table)) t))
683b7dc6 1435 (rcirc-last-quit-line process nick target))))
a0a5c583
GM
1436 (if line
1437 line
1438 ;;(message "line is nil for %s in %s" nick target)
1439 nil)))
1440
683b7dc6 1441(defun rcirc-elapsed-lines (process nick target)
a0a5c583 1442 "Return the number of lines since activity from NICK in TARGET."
683b7dc6 1443 (let ((last-activity-line (rcirc-last-line process nick target)))
a0a5c583
GM
1444 (when (and last-activity-line
1445 (> last-activity-line 0))
1446 (- rcirc-current-line last-activity-line))))
1447
729f1525
DN
1448(defvar rcirc-markup-text-functions
1449 '(rcirc-markup-attributes
1450 rcirc-markup-my-nick
1451 rcirc-markup-urls
1452 rcirc-markup-keywords
683b7dc6 1453 rcirc-markup-bright-nicks)
729f1525
DN
1454
1455 "List of functions used to manipulate text before it is printed.
1456
683b7dc6
GM
1457Each function takes two arguments, SENDER, and RESPONSE. The
1458buffer is narrowed with the text to be printed and the point is
1459at the beginning of the `rcirc-text' propertized text.")
729f1525 1460
bd43c990
RS
1461(defun rcirc-print (process sender response target text &optional activity)
1462 "Print TEXT in the buffer associated with TARGET.
1463Format based on SENDER and RESPONSE. If ACTIVITY is non-nil,
1464record activity."
a2524d26 1465 (or text (setq text ""))
0ffab1eb
TTN
1466 (unless (and (or (member sender rcirc-ignore-list)
1467 (member (with-syntax-table rcirc-nick-syntax-table
1468 (when (string-match "^\\([^/]\\w*\\)[:,]" text)
1469 (match-string 1 text)))
1470 rcirc-ignore-list))
a0a5c583 1471 ;; do not ignore if we sent the message
aebf69c8 1472 (not (string= sender (rcirc-nick process))))
db58efbf 1473 (let* ((buffer (rcirc-target-buffer process sender response target text))
2c8abe90
AS
1474 (inhibit-read-only t))
1475 (with-current-buffer buffer
1476 (let ((moving (= (point) rcirc-prompt-end-marker))
1477 (old-point (point-marker))
1478 (fill-start (marker-position rcirc-prompt-start-marker)))
1479
108bf785 1480 (setq text (decode-coding-string text rcirc-decode-coding-system))
2c8abe90 1481 (unless (string= sender (rcirc-nick process))
2c8abe90
AS
1482 ;; mark the line with overlay arrow
1483 (unless (or (marker-position overlay-arrow-position)
195eca78
SM
1484 (get-buffer-window (current-buffer))
1485 (member response rcirc-omit-responses))
2c8abe90
AS
1486 (set-marker overlay-arrow-position
1487 (marker-position rcirc-prompt-start-marker))))
1488
1489 ;; temporarily set the marker insertion-type because
1490 ;; insert-before-markers results in hidden text in new buffers
1491 (goto-char rcirc-prompt-start-marker)
1492 (set-marker-insertion-type rcirc-prompt-start-marker t)
1493 (set-marker-insertion-type rcirc-prompt-end-marker t)
324e4da7 1494
195eca78 1495 (let ((start (point)))
0ffab1eb 1496 (insert (rcirc-format-response-string process sender response nil
195eca78
SM
1497 text)
1498 (propertize "\n" 'hard t))
1499
1500 ;; squeeze spaces out of text before rcirc-text
0ffab1eb 1501 (fill-region fill-start
195eca78
SM
1502 (1- (or (next-single-property-change fill-start
1503 'rcirc-text)
1504 rcirc-prompt-end-marker)))
1505
1506 ;; run markup functions
1507 (save-excursion
1508 (save-restriction
1509 (narrow-to-region start rcirc-prompt-start-marker)
1510 (goto-char (or (next-single-property-change start 'rcirc-text)
1511 (point)))
1512 (when (rcirc-buffer-process)
1513 (save-excursion (rcirc-markup-timestamp sender response))
1514 (dolist (fn rcirc-markup-text-functions)
1515 (save-excursion (funcall fn sender response)))
a0a5c583
GM
1516 (when rcirc-fill-flag
1517 (save-excursion (rcirc-markup-fill sender response))))
195eca78
SM
1518
1519 (when rcirc-read-only-flag
1520 (add-text-properties (point-min) (point-max)
1521 '(read-only t front-sticky t))))
1522 ;; make text omittable
683b7dc6
GM
1523 (let ((last-activity-lines (rcirc-elapsed-lines process sender target)))
1524 (if (and (not (string= (rcirc-nick process) sender))
1525 (member response rcirc-omit-responses)
1526 (or (not last-activity-lines)
1527 (< rcirc-omit-threshold last-activity-lines)))
1528 (put-text-property (1- start) (1- rcirc-prompt-start-marker)
1529 'invisible 'rcirc-omit)
1530 ;; otherwise increment the line count
1531 (setq rcirc-current-line (1+ rcirc-current-line))))))
195eca78
SM
1532
1533 (set-marker-insertion-type rcirc-prompt-start-marker nil)
1534 (set-marker-insertion-type rcirc-prompt-end-marker nil)
2c8abe90
AS
1535
1536 ;; truncate buffer if it is very long
1537 (save-excursion
1538 (when (and rcirc-buffer-maximum-lines
1539 (> rcirc-buffer-maximum-lines 0)
1540 (= (forward-line (- rcirc-buffer-maximum-lines)) 0))
1541 (delete-region (point-min) (point))))
1542
1543 ;; set the window point for buffers show in windows
1544 (walk-windows (lambda (w)
d40ac716
CY
1545 (when (and (not (eq (selected-window) w))
1546 (eq (current-buffer)
1547 (window-buffer w))
1548 (>= (window-point w)
1549 rcirc-prompt-end-marker))
195eca78 1550 (set-window-point w (point-max))))
2c8abe90
AS
1551 nil t)
1552
1553 ;; restore the point
1554 (goto-char (if moving rcirc-prompt-end-marker old-point))
1555
195eca78 1556 ;; keep window on bottom line if it was already there
d40ac716
CY
1557 (when rcirc-scroll-show-maximum-output
1558 (walk-windows (lambda (w)
1559 (when (eq (window-buffer w) (current-buffer))
1560 (with-current-buffer (window-buffer w)
1561 (when (eq major-mode 'rcirc-mode)
1562 (with-selected-window w
195eca78
SM
1563 (when (<= (- (window-height)
1564 (count-screen-lines (window-point)
1565 (window-start))
d40ac716
CY
1566 1)
1567 0)
1568 (recenter -1)))))))
195eca78 1569 nil t))
d40ac716 1570
2c8abe90
AS
1571 ;; flush undo (can we do something smarter here?)
1572 (buffer-disable-undo)
1573 (buffer-enable-undo))
1574
1575 ;; record modeline activity
f8db61b2
EZ
1576 (when (and activity
1577 (not rcirc-ignore-buffer-activity-flag)
1578 (not (and rcirc-dim-nicks sender
195eca78
SM
1579 (string-match (regexp-opt rcirc-dim-nicks) sender)
1580 (rcirc-channel-p target))))
f8db61b2
EZ
1581 (rcirc-record-activity (current-buffer)
1582 (when (not (rcirc-channel-p rcirc-target))
1583 'nick)))
2c8abe90 1584
8f10c937
DD
1585 (when (and rcirc-log-flag
1586 (or target
1587 rcirc-log-process-buffers))
195eca78
SM
1588 (rcirc-log process sender response target text))
1589
2c8abe90
AS
1590 (sit-for 0) ; displayed text before hook
1591 (run-hook-with-args 'rcirc-print-hooks
1592 process sender response target text)))))
bd43c990 1593
8f10c937
DD
1594(defun rcirc-generate-log-filename (process target)
1595 (if target
1596 (rcirc-generate-new-buffer-name process target)
1597 (process-name process)))
1598
1599(defcustom rcirc-log-filename-function 'rcirc-generate-log-filename
aacde24f
MB
1600 "A function to generate the filename used by rcirc's logging facility.
1601
1602It is called with two arguments, PROCESS and TARGET (see
1603`rcirc-generate-new-buffer-name' for their meaning), and should
1604return the filename, or nil if no logging is desired for this
1605session.
1606
1607If the returned filename is absolute (`file-name-absolute-p'
186ecaf1
DD
1608returns t), then it is used as-is, otherwise the resulting file
1609is put into `rcirc-log-directory'.
1610
1611The filename is then cleaned using `convert-standard-filename' to
1612guarantee valid filenames for the current OS."
aacde24f
MB
1613 :group 'rcirc
1614 :type 'function)
1615
195eca78
SM
1616(defun rcirc-log (process sender response target text)
1617 "Record line in `rcirc-log', to be later written to disk."
aacde24f
MB
1618 (let ((filename (funcall rcirc-log-filename-function process target)))
1619 (unless (null filename)
1620 (let ((cell (assoc-string filename rcirc-log-alist))
1621 (line (concat (format-time-string rcirc-time-format)
1622 (substring-no-properties
1623 (rcirc-format-response-string process sender
1624 response target text))
1625 "\n")))
1626 (if cell
1627 (setcdr cell (concat (cdr cell) line))
1628 (setq rcirc-log-alist
1629 (cons (cons filename line) rcirc-log-alist)))))))
195eca78
SM
1630
1631(defun rcirc-log-write ()
1632 "Flush `rcirc-log-alist' data to disk.
1633
aacde24f
MB
1634Log data is written to `rcirc-log-directory', except for
1635log-files with absolute names (see `rcirc-log-filename-function')."
195eca78 1636 (dolist (cell rcirc-log-alist)
186ecaf1
DD
1637 (let ((filename (convert-standard-filename
1638 (expand-file-name (car cell)
1639 rcirc-log-directory)))
aacde24f
MB
1640 (coding-system-for-write 'utf-8))
1641 (make-directory (file-name-directory filename) t)
1642 (with-temp-buffer
1643 (insert (cdr cell))
1644 (write-region (point-min) (point-max) filename t 'quiet))))
195eca78 1645 (setq rcirc-log-alist nil))
bd43c990 1646
d7a0fd6f
GM
1647(defun rcirc-view-log-file ()
1648 "View logfile corresponding to the current buffer."
1649 (interactive)
aebf69c8
DD
1650 (find-file-other-window
1651 (expand-file-name (funcall rcirc-log-filename-function
d7a0fd6f
GM
1652 (rcirc-buffer-process) rcirc-target)
1653 rcirc-log-directory)))
1654
bd43c990
RS
1655(defun rcirc-join-channels (process channels)
1656 "Join CHANNELS."
1657 (save-window-excursion
db58efbf
EZ
1658 (dolist (channel channels)
1659 (with-rcirc-process-buffer process
1660 (rcirc-cmd-join channel process)))))
bd43c990
RS
1661\f
1662;;; nick management
8216fbaf 1663(defvar rcirc-nick-prefix-chars "~&@%+")
bd43c990
RS
1664(defun rcirc-user-nick (user)
1665 "Return the nick from USER. Remove any non-nick junk."
db58efbf 1666 (save-match-data
8216fbaf
EZ
1667 (if (string-match (concat "^[" rcirc-nick-prefix-chars
1668 "]?\\([^! ]+\\)!?") (or user ""))
db58efbf
EZ
1669 (match-string 1 user)
1670 user)))
bd43c990 1671
bd43c990
RS
1672(defun rcirc-nick-channels (process nick)
1673 "Return list of channels for NICK."
db58efbf
EZ
1674 (with-rcirc-process-buffer process
1675 (mapcar (lambda (x) (car x))
1676 (gethash nick rcirc-nick-table))))
bd43c990 1677
a0a5c583
GM
1678(defun rcirc-put-nick-channel (process nick channel &optional line)
1679 "Add CHANNEL to list associated with NICK.
1680Update the associated linestamp if LINE is non-nil.
1681
1682If the record doesn't exist, and LINE is nil, set the linestamp
1683to zero."
2fbed782
EZ
1684 (let ((nick (rcirc-user-nick nick)))
1685 (with-rcirc-process-buffer process
1686 (let* ((chans (gethash nick rcirc-nick-table))
1687 (record (assoc-string channel chans t)))
1688 (if record
a0a5c583
GM
1689 (when line (setcdr record line))
1690 (puthash nick (cons (cons channel (or line 0))
2fbed782
EZ
1691 chans)
1692 rcirc-nick-table))))))
bd43c990
RS
1693
1694(defun rcirc-nick-remove (process nick)
1695 "Remove NICK from table."
adf794e4 1696 (with-rcirc-process-buffer process
bd43c990
RS
1697 (remhash nick rcirc-nick-table)))
1698
1699(defun rcirc-remove-nick-channel (process nick channel)
1700 "Remove the CHANNEL from list associated with NICK."
adf794e4 1701 (with-rcirc-process-buffer process
db58efbf 1702 (let* ((chans (gethash nick rcirc-nick-table))
adf794e4
EZ
1703 (newchans
1704 ;; instead of assoc-string-delete-all:
1705 (let ((record (assoc-string channel chans t)))
1706 (when record
1707 (setcar record 'delete)
1708 (assq-delete-all 'delete chans)))))
bd43c990
RS
1709 (if newchans
1710 (puthash nick newchans rcirc-nick-table)
1711 (remhash nick rcirc-nick-table)))))
1712
a2524d26
EZ
1713(defun rcirc-channel-nicks (process target)
1714 "Return the list of nicks associated with TARGET sorted by last activity."
1715 (when target
1716 (if (rcirc-channel-p target)
1717 (with-rcirc-process-buffer process
1718 (let (nicks)
1719 (maphash
1720 (lambda (k v)
1721 (let ((record (assoc-string target v t)))
1722 (if record
1723 (setq nicks (cons (cons k (cdr record)) nicks)))))
1724 rcirc-nick-table)
1725 (mapcar (lambda (x) (car x))
a0a5c583
GM
1726 (sort nicks (lambda (x y)
1727 (let ((lx (or (cdr x) 0))
1728 (ly (or (cdr y) 0)))
1729 (< ly lx)))))))
a2524d26 1730 (list target))))
2c8abe90
AS
1731
1732(defun rcirc-ignore-update-automatic (nick)
2e398771
JB
1733 "Remove NICK from `rcirc-ignore-list'
1734if NICK is also on `rcirc-ignore-list-automatic'."
2c8abe90
AS
1735 (when (member nick rcirc-ignore-list-automatic)
1736 (setq rcirc-ignore-list-automatic
1737 (delete nick rcirc-ignore-list-automatic)
1738 rcirc-ignore-list
1739 (delete nick rcirc-ignore-list))))
bd43c990 1740\f
c62bf05a 1741(defun rcirc-nickname< (s1 s2)
44ea155d
CY
1742 "Return t if IRC nickname S1 is less than S2, and nil otherwise.
1743Operator nicknames (@) are considered less than voiced
1744nicknames (+). Any other nicknames are greater than voiced
1745nicknames. The comparison is case-insensitive."
c62bf05a
DD
1746 (setq s1 (downcase s1)
1747 s2 (downcase s2))
1748 (let* ((s1-op (eq ?@ (string-to-char s1)))
1749 (s2-op (eq ?@ (string-to-char s2))))
1750 (if s1-op
1751 (if s2-op
1752 (string< (substring s1 1) (substring s2 1))
1753 t)
1754 (if s2-op
1755 nil
1756 (string< s1 s2)))))
1757
1758(defun rcirc-sort-nicknames-join (input sep)
44ea155d 1759 "Return a string of sorted nicknames.
c62bf05a 1760INPUT is a string containing nicknames separated by SEP.
44ea155d 1761This function does not alter the INPUT string."
a91dedc4
SM
1762 (let* ((parts (split-string input sep t))
1763 (sorted (sort parts 'rcirc-nickname<)))
1764 (mapconcat 'identity sorted sep)))
c62bf05a 1765\f
bd43c990 1766;;; activity tracking
b016851c
SM
1767(defvar rcirc-track-minor-mode-map
1768 (let ((map (make-sparse-keymap)))
1769 (define-key map (kbd "C-c C-@") 'rcirc-next-active-buffer)
1770 (define-key map (kbd "C-c C-SPC") 'rcirc-next-active-buffer)
1771 map)
db58efbf
EZ
1772 "Keymap for rcirc track minor mode.")
1773
e8f10ddb 1774;;;###autoload
db58efbf
EZ
1775(define-minor-mode rcirc-track-minor-mode
1776 "Global minor mode for tracking activity in rcirc buffers."
1777 :init-value nil
1778 :lighter ""
1779 :keymap rcirc-track-minor-mode-map
1780 :global t
1781 :group 'rcirc
1782 (or global-mode-string (setq global-mode-string '("")))
1783 ;; toggle the mode-line channel indicator
1784 (if rcirc-track-minor-mode
a2524d26
EZ
1785 (progn
1786 (and (not (memq 'rcirc-activity-string global-mode-string))
1787 (setq global-mode-string
1788 (append global-mode-string '(rcirc-activity-string))))
1789 (add-hook 'window-configuration-change-hook
1790 'rcirc-window-configuration-change))
92c4adc1 1791 (setq global-mode-string
a2524d26
EZ
1792 (delete 'rcirc-activity-string global-mode-string))
1793 (remove-hook 'window-configuration-change-hook
1794 'rcirc-window-configuration-change)))
db58efbf 1795
adf794e4 1796(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist)
bd43c990 1797 (setq minor-mode-alist
adf794e4 1798 (cons '(rcirc-ignore-buffer-activity-flag " Ignore") minor-mode-alist)))
a2524d26
EZ
1799(or (assq 'rcirc-low-priority-flag minor-mode-alist)
1800 (setq minor-mode-alist
1801 (cons '(rcirc-low-priority-flag " LowPri") minor-mode-alist)))
195eca78
SM
1802(or (assq 'rcirc-omit-mode minor-mode-alist)
1803 (setq minor-mode-alist
1804 (cons '(rcirc-omit-mode " Omit") minor-mode-alist)))
bd43c990 1805
db58efbf
EZ
1806(defun rcirc-toggle-ignore-buffer-activity ()
1807 "Toggle the value of `rcirc-ignore-buffer-activity-flag'."
1808 (interactive)
1809 (setq rcirc-ignore-buffer-activity-flag
1810 (not rcirc-ignore-buffer-activity-flag))
1811 (message (if rcirc-ignore-buffer-activity-flag
1812 "Ignore activity in this buffer"
1813 "Notice activity in this buffer"))
bd43c990
RS
1814 (force-mode-line-update))
1815
a2524d26 1816(defun rcirc-toggle-low-priority ()
02f47e86 1817 "Toggle the value of `rcirc-low-priority-flag'."
a2524d26
EZ
1818 (interactive)
1819 (setq rcirc-low-priority-flag
1820 (not rcirc-low-priority-flag))
1821 (message (if rcirc-low-priority-flag
1822 "Activity in this buffer is low priority"
1823 "Activity in this buffer is normal priority"))
1824 (force-mode-line-update))
1825
195eca78
SM
1826(defun rcirc-omit-mode ()
1827 "Toggle the Rcirc-Omit mode.
0ffab1eb 1828If enabled, \"uninteresting\" lines are not shown.
195eca78
SM
1829Uninteresting lines are those whose responses are listed in
1830`rcirc-omit-responses'."
1831 (interactive)
1832 (setq rcirc-omit-mode (not rcirc-omit-mode))
a0a5c583
GM
1833 (if rcirc-omit-mode
1834 (progn
1230c3cb 1835 (add-to-invisibility-spec '(rcirc-omit . nil))
a0a5c583 1836 (message "Rcirc-Omit mode enabled"))
1230c3cb 1837 (remove-from-invisibility-spec '(rcirc-omit . nil))
a0a5c583
GM
1838 (message "Rcirc-Omit mode disabled"))
1839 (recenter (when (> (point) rcirc-prompt-start-marker) -1)))
bd43c990
RS
1840
1841(defun rcirc-switch-to-server-buffer ()
1842 "Switch to the server buffer associated with current channel buffer."
1843 (interactive)
488086f4
SM
1844 (unless (buffer-live-p rcirc-server-buffer)
1845 (error "No such buffer"))
195eca78 1846 (switch-to-buffer rcirc-server-buffer))
bd43c990
RS
1847
1848(defun rcirc-jump-to-first-unread-line ()
1849 "Move the point to the first unread line in this buffer."
1850 (interactive)
195eca78
SM
1851 (if (marker-position overlay-arrow-position)
1852 (goto-char overlay-arrow-position)
1853 (message "No unread messages")))
1854
1855(defun rcirc-non-irc-buffer ()
1856 (let ((buflist (buffer-list))
1857 buffer)
1858 (while (and buflist (not buffer))
1859 (with-current-buffer (car buflist)
1860 (unless (or (eq major-mode 'rcirc-mode)
1861 (= ?\s (aref (buffer-name) 0)) ; internal buffers
1862 (get-buffer-window (current-buffer)))
1863 (setq buffer (current-buffer))))
1864 (setq buflist (cdr buflist)))
1865 buffer))
bd43c990
RS
1866
1867(defun rcirc-next-active-buffer (arg)
195eca78
SM
1868 "Switch to the next rcirc buffer with activity.
1869With prefix ARG, go to the next low priority buffer with activity."
a2524d26
EZ
1870 (interactive "P")
1871 (let* ((pair (rcirc-split-activity rcirc-activity))
1872 (lopri (car pair))
92c4adc1 1873 (hipri (cdr pair)))
a2524d26
EZ
1874 (if (or (and (not arg) hipri)
1875 (and arg lopri))
a0a5c583
GM
1876 (progn
1877 (switch-to-buffer (car (if arg lopri hipri)))
1878 (when (> (point) rcirc-prompt-start-marker)
1879 (recenter -1)))
a2524d26 1880 (if (eq major-mode 'rcirc-mode)
195eca78 1881 (switch-to-buffer (rcirc-non-irc-buffer))
274f1353
DK
1882 (message "%s" (concat
1883 "No IRC activity."
1884 (when lopri
1885 (concat
1886 " Type C-u "
1887 (key-description (this-command-keys))
1888 " for low priority activity."))))))))
bd43c990
RS
1889
1890(defvar rcirc-activity-hooks nil
1891 "Hook to be run when there is channel activity.
1892
1893Functions are called with a single argument, the buffer with the
1894activity. Only run if the buffer is not visible and
adf794e4 1895`rcirc-ignore-buffer-activity-flag' is non-nil.")
bd43c990 1896
a2524d26 1897(defun rcirc-record-activity (buffer &optional type)
bd43c990
RS
1898 "Record BUFFER activity with TYPE."
1899 (with-current-buffer buffer
195eca78
SM
1900 (let ((old-activity rcirc-activity)
1901 (old-types rcirc-activity-types))
1902 (when (not (get-buffer-window (current-buffer) t))
1903 (setq rcirc-activity
1904 (sort (add-to-list 'rcirc-activity (current-buffer))
1905 (lambda (b1 b2)
1906 (let ((t1 (with-current-buffer b1 rcirc-last-post-time))
1907 (t2 (with-current-buffer b2 rcirc-last-post-time)))
1908 (time-less-p t2 t1)))))
1909 (pushnew type rcirc-activity-types)
1910 (unless (and (equal rcirc-activity old-activity)
1911 (member type old-types))
1912 (rcirc-update-activity-string)))))
bd43c990
RS
1913 (run-hook-with-args 'rcirc-activity-hooks buffer))
1914
1915(defun rcirc-clear-activity (buffer)
1916 "Clear the BUFFER activity."
0ffab1eb 1917 (setq rcirc-activity (remove buffer rcirc-activity))
bd43c990 1918 (with-current-buffer buffer
f8db61b2 1919 (setq rcirc-activity-types nil)))
bd43c990 1920
195eca78
SM
1921(defun rcirc-clear-unread (buffer)
1922 "Erase the last read message arrow from BUFFER."
1923 (when (buffer-live-p buffer)
1924 (with-current-buffer buffer
1925 (set-marker overlay-arrow-position nil))))
1926
a2524d26
EZ
1927(defun rcirc-split-activity (activity)
1928 "Return a cons cell with ACTIVITY split into (lopri . hipri)."
1929 (let (lopri hipri)
1930 (dolist (buf rcirc-activity)
1931 (with-current-buffer buf
1932 (if (and rcirc-low-priority-flag
f8db61b2 1933 (not (member 'nick rcirc-activity-types)))
a2524d26
EZ
1934 (add-to-list 'lopri buf t)
1935 (add-to-list 'hipri buf t))))
1936 (cons lopri hipri)))
1937
195eca78
SM
1938(defvar rcirc-update-activity-string-hook nil
1939 "Hook run whenever the activity string is updated.")
1940
adf794e4 1941;; TODO: add mouse properties
bd43c990
RS
1942(defun rcirc-update-activity-string ()
1943 "Update mode-line string."
a2524d26
EZ
1944 (let* ((pair (rcirc-split-activity rcirc-activity))
1945 (lopri (car pair))
1946 (hipri (cdr pair)))
1947 (setq rcirc-activity-string
7faa3f8c 1948 (cond ((or hipri lopri)
195eca78 1949 (concat (and hipri "[")
7faa3f8c
MB
1950 (rcirc-activity-string hipri)
1951 (and hipri lopri ",")
1952 (and lopri
1953 (concat "("
1954 (rcirc-activity-string lopri)
1955 ")"))
195eca78 1956 (and hipri "]")))
7faa3f8c 1957 ((not (null (rcirc-process-list)))
195eca78
SM
1958 "[]")
1959 (t "[]")))
1960 (run-hooks 'rcirc-update-activity-string-hook)))
a2524d26
EZ
1961
1962(defun rcirc-activity-string (buffers)
1963 (mapconcat (lambda (b)
f8db61b2 1964 (let ((s (substring-no-properties (rcirc-short-buffer-name b))))
a2524d26 1965 (with-current-buffer b
f8db61b2
EZ
1966 (dolist (type rcirc-activity-types)
1967 (rcirc-add-face 0 (length s)
1968 (case type
82741a5e
CY
1969 (nick 'rcirc-track-nick)
1970 (keyword 'rcirc-track-keyword))
f8db61b2
EZ
1971 s)))
1972 s))
a2524d26 1973 buffers ","))
bd43c990
RS
1974
1975(defun rcirc-short-buffer-name (buffer)
1976 "Return a short name for BUFFER to use in the modeline indicator."
1977 (with-current-buffer buffer
adf794e4
EZ
1978 (or rcirc-short-buffer-name (buffer-name))))
1979
195eca78
SM
1980(defun rcirc-visible-buffers ()
1981 "Return a list of the visible buffers that are in rcirc-mode."
1982 (let (acc)
adf794e4 1983 (walk-windows (lambda (w)
195eca78
SM
1984 (with-current-buffer (window-buffer w)
1985 (when (eq major-mode 'rcirc-mode)
1986 (push (current-buffer) acc)))))
1987 acc))
1988
1989(defvar rcirc-visible-buffers nil)
1990(defun rcirc-window-configuration-change ()
1991 (unless (minibuffer-window-active-p (minibuffer-window))
1992 ;; delay this until command has finished to make sure window is
1993 ;; actually visible before clearing activity
1994 (add-hook 'post-command-hook 'rcirc-window-configuration-change-1)))
1995
1996(defun rcirc-window-configuration-change-1 ()
1997 ;; clear activity and overlay arrows
1998 (let* ((old-activity rcirc-activity)
1999 (hidden-buffers rcirc-visible-buffers))
2000
2001 (setq rcirc-visible-buffers (rcirc-visible-buffers))
2002
2003 (dolist (vbuf rcirc-visible-buffers)
2004 (setq hidden-buffers (delq vbuf hidden-buffers))
2005 ;; clear activity for all visible buffers
2006 (rcirc-clear-activity vbuf))
2007
2008 ;; clear unread arrow from recently hidden buffers
2009 (dolist (hbuf hidden-buffers)
2010 (rcirc-clear-unread hbuf))
2011
2012 ;; remove any killed buffers from list
2013 (setq rcirc-activity
2014 (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf))
2015 rcirc-activity)))
2016 ;; update the mode-line string
2017 (unless (equal old-activity rcirc-activity)
2018 (rcirc-update-activity-string)))
2019
2020 (remove-hook 'post-command-hook 'rcirc-window-configuration-change-1))
bd43c990
RS
2021
2022\f
adf794e4
EZ
2023;;; buffer name abbreviation
2024(defun rcirc-update-short-buffer-names ()
2025 (let ((bufalist
2026 (apply 'append (mapcar (lambda (process)
2027 (with-rcirc-process-buffer process
2028 rcirc-buffer-alist))
2029 (rcirc-process-list)))))
2030 (dolist (i (rcirc-abbreviate bufalist))
a2524d26
EZ
2031 (when (buffer-live-p (cdr i))
2032 (with-current-buffer (cdr i)
2033 (setq rcirc-short-buffer-name (car i)))))))
adf794e4
EZ
2034
2035(defun rcirc-abbreviate (pairs)
2036 (apply 'append (mapcar 'rcirc-rebuild-tree (rcirc-make-trees pairs))))
2037
2038(defun rcirc-rebuild-tree (tree &optional acc)
2039 (let ((ch (char-to-string (car tree))))
2040 (dolist (x (cdr tree))
2041 (if (listp x)
2042 (setq acc (append acc
2043 (mapcar (lambda (y)
2044 (cons (concat ch (car y))
2045 (cdr y)))
2046 (rcirc-rebuild-tree x))))
2047 (setq acc (cons (cons ch x) acc))))
2048 acc))
2049
2050(defun rcirc-make-trees (pairs)
2051 (let (alist)
2052 (mapc (lambda (pair)
2053 (if (consp pair)
2054 (let* ((str (car pair))
2055 (data (cdr pair))
2056 (char (unless (zerop (length str))
2057 (aref str 0)))
2058 (rest (unless (zerop (length str))
2059 (substring str 1)))
2060 (part (if char (assq char alist))))
2061 (if part
2062 ;; existing partition
2063 (setcdr part (cons (cons rest data) (cdr part)))
2064 ;; new partition
2065 (setq alist (cons (if char
2066 (list char (cons rest data))
2067 data)
2068 alist))))
2069 (setq alist (cons pair alist))))
2070 pairs)
2071 ;; recurse into cdrs of alist
2072 (mapc (lambda (x)
2073 (when (and (listp x) (listp (cadr x)))
2074 (setcdr x (if (> (length (cdr x)) 1)
2075 (rcirc-make-trees (cdr x))
2076 (setcdr x (list (cdadr x)))))))
2077 alist)))
2078\f
bd43c990
RS
2079;;; /commands these are called with 3 args: PROCESS, TARGET, which is
2080;; the current buffer/channel/user, and ARGS, which is a string
2081;; containing the text following the /cmd.
2082
adf794e4 2083(defmacro defun-rcirc-command (command argument docstring interactive-form
94c7243b 2084 &rest body)
bd43c990 2085 "Define a command."
94c7243b
LL
2086 `(progn
2087 (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))
2088 (defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
2089 (,@argument &optional process target)
2090 ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given"
2091 "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
2092 ,interactive-form
2093 (let ((process (or process (rcirc-buffer-process)))
2094 (target (or target rcirc-target)))
2095 ,@body))))
bd43c990
RS
2096
2097(defun-rcirc-command msg (message)
2098 "Send private MESSAGE to TARGET."
2099 (interactive "i")
2100 (if (null message)
2101 (progn
2102 (setq target (completing-read "Message nick: "
92c4adc1 2103 (with-rcirc-server-buffer
a2524d26 2104 rcirc-nick-table)))
bd43c990
RS
2105 (when (> (length target) 0)
2106 (setq message (read-string (format "Message %s: " target)))
2107 (when (> (length message) 0)
2108 (rcirc-send-message process target message))))
2109 (if (not (string-match "\\([^ ]+\\) \\(.+\\)" message))
2110 (message "Not enough args, or something.")
2111 (setq target (match-string 1 message)
2112 message (match-string 2 message))
2113 (rcirc-send-message process target message))))
2114
2115(defun-rcirc-command query (nick)
2116 "Open a private chat buffer to NICK."
2117 (interactive (list (completing-read "Query nick: "
a2524d26 2118 (with-rcirc-server-buffer rcirc-nick-table))))
adf794e4
EZ
2119 (let ((existing-buffer (rcirc-get-buffer process nick)))
2120 (switch-to-buffer (or existing-buffer
2121 (rcirc-get-buffer-create process nick)))
2122 (when (not existing-buffer)
bd43c990
RS
2123 (rcirc-cmd-whois nick))))
2124
e0e36cac
DD
2125(defun-rcirc-command join (channels)
2126 "Join CHANNELS.
2127CHANNELS is a comma- or space-separated string of channel names."
2128 (interactive "sJoin channels: ")
2129 (let* ((split-channels (split-string channels "[ ,]" t))
2130 (buffers (mapcar (lambda (ch)
2131 (rcirc-get-buffer-create process ch))
fcd8ed1d
DD
2132 split-channels))
2133 (channels (mapconcat 'identity split-channels ",")))
e0e36cac 2134 (rcirc-send-string process (concat "JOIN " channels))
bd43c990 2135 (when (not (eq (selected-window) (minibuffer-window)))
e0e36cac
DD
2136 (dolist (b buffers) ;; order the new channel buffers in the buffer list
2137 (switch-to-buffer b)))))
bd43c990 2138
195eca78 2139;; TODO: /part #channel reason, or consider removing #channel altogether
bd43c990
RS
2140(defun-rcirc-command part (channel)
2141 "Part CHANNEL."
2142 (interactive "sPart channel: ")
2143 (let ((channel (if (> (length channel) 0) channel target)))
adf794e4 2144 (rcirc-send-string process (concat "PART " channel " :" rcirc-id-string))))
bd43c990
RS
2145
2146(defun-rcirc-command quit (reason)
2147 "Send a quit message to server with REASON."
2148 (interactive "sQuit reason: ")
adf794e4
EZ
2149 (rcirc-send-string process (concat "QUIT :"
2150 (if (not (zerop (length reason)))
2151 reason
2152 rcirc-id-string))))
bd43c990
RS
2153
2154(defun-rcirc-command nick (nick)
2155 "Change nick to NICK."
2156 (interactive "i")
2157 (when (null nick)
2158 (setq nick (read-string "New nick: " (rcirc-nick process))))
2159 (rcirc-send-string process (concat "NICK " nick)))
2160
2161(defun-rcirc-command names (channel)
2162 "Display list of names in CHANNEL or in current channel if CHANNEL is nil.
2163If called interactively, prompt for a channel when prefix arg is supplied."
2164 (interactive "P")
32226619 2165 (if (called-interactively-p 'interactive)
bd43c990
RS
2166 (if channel
2167 (setq channel (read-string "List names in channel: " target))))
2168 (let ((channel (if (> (length channel) 0)
2169 channel
2170 target)))
2171 (rcirc-send-string process (concat "NAMES " channel))))
2172
2173(defun-rcirc-command topic (topic)
2174 "List TOPIC for the TARGET channel.
2175With a prefix arg, prompt for new topic."
2176 (interactive "P")
32226619 2177 (if (and (called-interactively-p 'interactive) topic)
bd43c990
RS
2178 (setq topic (read-string "New Topic: " rcirc-topic)))
2179 (rcirc-send-string process (concat "TOPIC " target
2180 (when (> (length topic) 0)
2181 (concat " :" topic)))))
2182
2183(defun-rcirc-command whois (nick)
2184 "Request information from server about NICK."
2185 (interactive (list
2186 (completing-read "Whois: "
a2524d26 2187 (with-rcirc-server-buffer rcirc-nick-table))))
bd43c990
RS
2188 (rcirc-send-string process (concat "WHOIS " nick)))
2189
2190(defun-rcirc-command mode (args)
2191 "Set mode with ARGS."
2192 (interactive (list (concat (read-string "Mode nick or channel: ")
2193 " " (read-string "Mode: "))))
2194 (rcirc-send-string process (concat "MODE " args)))
2195
2196(defun-rcirc-command list (channels)
2197 "Request information on CHANNELS from server."
2198 (interactive "sList Channels: ")
2199 (rcirc-send-string process (concat "LIST " channels)))
2200
2201(defun-rcirc-command oper (args)
2202 "Send operator command to server."
2203 (interactive "sOper args: ")
2204 (rcirc-send-string process (concat "OPER " args)))
2205
2206(defun-rcirc-command quote (message)
2207 "Send MESSAGE literally to server."
2208 (interactive "sServer message: ")
2209 (rcirc-send-string process message))
2210
2211(defun-rcirc-command kick (arg)
2212 "Kick NICK from current channel."
2213 (interactive (list
2214 (concat (completing-read "Kick nick: "
92c4adc1 2215 (rcirc-channel-nicks
a2524d26
EZ
2216 (rcirc-buffer-process)
2217 rcirc-target))
bd43c990
RS
2218 (read-from-minibuffer "Kick reason: "))))
2219 (let* ((arglist (split-string arg))
adf794e4 2220 (argstring (concat (car arglist) " :"
bd43c990
RS
2221 (mapconcat 'identity (cdr arglist) " "))))
2222 (rcirc-send-string process (concat "KICK " target " " argstring))))
2223
2224(defun rcirc-cmd-ctcp (args &optional process target)
2225 (if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args)
ee6a57ab
DD
2226 (let* ((target (match-string 1 args))
2227 (request (upcase (match-string 2 args)))
2228 (function (intern-soft (concat "rcirc-ctcp-sender-" request))))
2229 (if (fboundp function) ;; use special function if available
2230 (funcall function process target request)
1be1d1e9 2231 (rcirc-send-ctcp process target request)))
adf794e4 2232 (rcirc-print process (rcirc-nick process) "ERROR" nil
bd43c990
RS
2233 "usage: /ctcp NICK REQUEST")))
2234
ee6a57ab
DD
2235(defun rcirc-ctcp-sender-PING (process target request)
2236 "Send a CTCP PING message to TARGET."
73057ba9 2237 (let ((timestamp (format "%.0f" (rcirc-float-time))))
1be1d1e9 2238 (rcirc-send-ctcp process target "PING" timestamp)))
ee6a57ab 2239
bd43c990 2240(defun rcirc-cmd-me (args &optional process target)
1be1d1e9 2241 (rcirc-send-ctcp process target "ACTION" args))
2c8abe90 2242
c00725d7
LL
2243(defun rcirc-add-or-remove (set &rest elements)
2244 (dolist (elt elements)
2245 (if (and elt (not (string= "" elt)))
2246 (setq set (if (member-ignore-case elt set)
2247 (delete elt set)
2248 (cons elt set)))))
2249 set)
f8db61b2 2250
2c8abe90
AS
2251(defun-rcirc-command ignore (nick)
2252 "Manage the ignore list.
2253Ignore NICK, unignore NICK if already ignored, or list ignored
2254nicks when no NICK is given. When listing ignored nicks, the
2e398771 2255ones added to the list automatically are marked with an asterisk."
2c8abe90 2256 (interactive "sToggle ignoring of nick: ")
c00725d7
LL
2257 (setq rcirc-ignore-list
2258 (apply #'rcirc-add-or-remove rcirc-ignore-list
2259 (split-string nick nil t)))
92c4adc1 2260 (rcirc-print process nil "IGNORE" target
db58efbf
EZ
2261 (mapconcat
2262 (lambda (nick)
2263 (concat nick
2264 (if (member nick rcirc-ignore-list-automatic)
2265 "*" "")))
2266 rcirc-ignore-list " ")))
2c8abe90 2267
f8db61b2
EZ
2268(defun-rcirc-command bright (nick)
2269 "Manage the bright nick list."
2270 (interactive "sToggle emphasis of nick: ")
c00725d7
LL
2271 (setq rcirc-bright-nicks
2272 (apply #'rcirc-add-or-remove rcirc-bright-nicks
2273 (split-string nick nil t)))
92c4adc1 2274 (rcirc-print process nil "BRIGHT" target
f8db61b2
EZ
2275 (mapconcat 'identity rcirc-bright-nicks " ")))
2276
2277(defun-rcirc-command dim (nick)
2278 "Manage the dim nick list."
2279 (interactive "sToggle deemphasis of nick: ")
c00725d7
LL
2280 (setq rcirc-dim-nicks
2281 (apply #'rcirc-add-or-remove rcirc-dim-nicks
2282 (split-string nick nil t)))
92c4adc1 2283 (rcirc-print process nil "DIM" target
f8db61b2
EZ
2284 (mapconcat 'identity rcirc-dim-nicks " ")))
2285
2286(defun-rcirc-command keyword (keyword)
2287 "Manage the keyword list.
2288Mark KEYWORD, unmark KEYWORD if already marked, or list marked
2289keywords when no KEYWORD is given."
2290 (interactive "sToggle highlighting of keyword: ")
c00725d7
LL
2291 (setq rcirc-keywords
2292 (apply #'rcirc-add-or-remove rcirc-keywords
2293 (split-string keyword nil t)))
92c4adc1 2294 (rcirc-print process nil "KEYWORD" target
f8db61b2
EZ
2295 (mapconcat 'identity rcirc-keywords " ")))
2296
bd43c990 2297\f
f8db61b2
EZ
2298(defun rcirc-add-face (start end name &optional object)
2299 "Add face NAME to the face text property of the text from START to END."
2300 (when name
2301 (let ((pos start)
2302 next prop)
2303 (while (< pos end)
2304 (setq prop (get-text-property pos 'face object)
2305 next (next-single-property-change pos 'face object end))
2306 (unless (member name (get-text-property pos 'face object))
2307 (add-text-properties pos next (list 'face (cons name prop)) object))
2308 (setq pos next)))))
adf794e4 2309
bd43c990
RS
2310(defun rcirc-facify (string face)
2311 "Return a copy of STRING with FACE property added."
f8db61b2
EZ
2312 (let ((string (or string "")))
2313 (rcirc-add-face 0 (length string) face string)
2314 string))
bd43c990 2315
bd43c990 2316(defvar rcirc-url-regexp
73dd622f
RS
2317 (concat
2318 "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
2319 "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
2320 "\\(//[-a-z0-9_.]+:[0-9]*\\)?"
2321 (if (string-match "[[:digit:]]" "1") ;; Support POSIX?
2322 (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
2323 (punct "!?:;.,"))
2324 (concat
2325 "\\(?:"
2326 ;; Match paired parentheses, e.g. in Wikipedia URLs:
2327 "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]"
2328 "\\|"
2329 "[" chars punct "]+" "[" chars "]"
2330 "\\)"))
2331 (concat ;; XEmacs 21.4 doesn't support POSIX.
2332 "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+"
2333 "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)"))
2334 "\\)")
2e398771 2335 "Regexp matching URLs. Set to nil to disable URL features in rcirc.")
bd43c990
RS
2336
2337(defun rcirc-browse-url (&optional arg)
2e398771 2338 "Prompt for URL to browse based on URLs in buffer."
02f47e86 2339 (interactive "P")
bd43c990
RS
2340 (let ((completions (mapcar (lambda (x) (cons x nil)) rcirc-urls))
2341 (initial-input (car rcirc-urls))
2342 (history (cdr rcirc-urls)))
2343 (browse-url (completing-read "rcirc browse-url: "
2344 completions nil nil initial-input 'history)
2345 arg)))
f8db61b2 2346\f
195eca78
SM
2347(defun rcirc-markup-timestamp (sender response)
2348 (goto-char (point-min))
0ffab1eb 2349 (insert (rcirc-facify (format-time-string rcirc-time-format)
195eca78 2350 'rcirc-timestamp)))
f8db61b2 2351
195eca78 2352(defun rcirc-markup-attributes (sender response)
f8db61b2
EZ
2353 (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t)
2354 (rcirc-add-face (match-beginning 0) (match-end 0)
2355 (case (char-after (match-beginning 1))
2356 (?\C-b 'bold)
2357 (?\C-v 'italic)
2358 (?\C-_ 'underline)))
2359 ;; keep the ^O since it could terminate other attributes
2360 (when (not (eq ?\C-o (char-before (match-end 2))))
2361 (delete-region (match-beginning 2) (match-end 2)))
2362 (delete-region (match-beginning 1) (match-end 1))
08fc78fe 2363 (goto-char (match-beginning 1)))
f8db61b2
EZ
2364 ;; remove the ^O characters now
2365 (while (re-search-forward "\C-o+" nil t)
2366 (delete-region (match-beginning 0) (match-end 0))))
2367
195eca78 2368(defun rcirc-markup-my-nick (sender response)
f8db61b2 2369 (with-syntax-table rcirc-nick-syntax-table
0ffab1eb
TTN
2370 (while (re-search-forward (concat "\\b"
2371 (regexp-quote (rcirc-nick
195eca78 2372 (rcirc-buffer-process)))
f8db61b2
EZ
2373 "\\b")
2374 nil t)
92c4adc1 2375 (rcirc-add-face (match-beginning 0) (match-end 0)
f8db61b2
EZ
2376 'rcirc-nick-in-message)
2377 (when (string= response "PRIVMSG")
0ffab1eb 2378 (rcirc-add-face (point-min) (point-max)
195eca78
SM
2379 'rcirc-nick-in-message-full-line)
2380 (rcirc-record-activity (current-buffer) 'nick)))))
f8db61b2 2381
195eca78 2382(defun rcirc-markup-urls (sender response)
9ff90d99
DD
2383 (while (and rcirc-url-regexp ;; nil means disable URL catching
2384 (re-search-forward rcirc-url-regexp nil t))
f8db61b2 2385 (let ((start (match-beginning 0))
1ddd96f5
LL
2386 (end (match-end 0))
2387 (url (match-string-no-properties 0)))
2388 (make-button start end
2389 'face 'rcirc-url
2390 'follow-link t
2391 'rcirc-url url
2392 'action (lambda (button)
2393 (browse-url (button-get button 'rcirc-url))))
f8db61b2 2394 ;; record the url
1ddd96f5 2395 (push url rcirc-urls))))
195eca78
SM
2396
2397(defun rcirc-markup-keywords (sender response)
2398 (when (and (string= response "PRIVMSG")
2399 (not (string= sender (rcirc-nick (rcirc-buffer-process)))))
2400 (let* ((target (or rcirc-target ""))
2401 (keywords (delq nil (mapcar (lambda (keyword)
2402 (when (not (string-match keyword
2403 target))
2404 keyword))
2405 rcirc-keywords))))
2406 (when keywords
2407 (while (re-search-forward (regexp-opt keywords 'words) nil t)
2408 (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword)
2409 (rcirc-record-activity (current-buffer) 'keyword))))))
2410
2411(defun rcirc-markup-bright-nicks (sender response)
f8db61b2
EZ
2412 (when (and rcirc-bright-nicks
2413 (string= response "NAMES"))
2414 (with-syntax-table rcirc-nick-syntax-table
2415 (while (re-search-forward (regexp-opt rcirc-bright-nicks 'words) nil t)
2416 (rcirc-add-face (match-beginning 0) (match-end 0)
2417 'rcirc-bright-nick)))))
195eca78
SM
2418
2419(defun rcirc-markup-fill (sender response)
2420 (when (not (string= response "372")) ; /motd
2421 (let ((fill-prefix
2422 (or rcirc-fill-prefix
2423 (make-string (- (point) (line-beginning-position)) ?\s)))
683b7dc6
GM
2424 (fill-column (- (cond ((eq rcirc-fill-column 'frame-width)
2425 (1- (frame-width)))
2426 (rcirc-fill-column
2427 rcirc-fill-column)
2428 (t fill-column))
2429 ;; make sure ... doesn't cause line wrapping
aebf69c8 2430 3)))
195eca78 2431 (fill-region (point) (point-max) nil t))))
bd43c990
RS
2432\f
2433;;; handlers
2434;; these are called with the server PROCESS, the SENDER, which is a
2435;; server or a user, depending on the command, the ARGS, which is a
2436;; list of strings, and the TEXT, which is the original server text,
2437;; verbatim
2438(defun rcirc-handler-001 (process sender args text)
2439 (rcirc-handler-generic process "001" sender args text)
adf794e4 2440 (with-rcirc-process-buffer process
8216fbaf
EZ
2441 (setq rcirc-connecting nil)
2442 (rcirc-reschedule-timeout process)
2443 (setq rcirc-server-name sender)
bd43c990
RS
2444 (setq rcirc-nick (car args))
2445 (rcirc-update-prompt)
72d2c2e3 2446 (if rcirc-auto-authenticate-flag
221ddf68
TH
2447 (if (and rcirc-authenticate-before-join
2448 ;; We have to ensure that there's an authentication
2449 ;; entry for that server. Else,
2450 ;; rcirc-authenticated-hook won't be triggered, and
2451 ;; autojoin won't happen at all.
2452 (let (auth-required)
2453 (dolist (s rcirc-authinfo auth-required)
2454 (when (string-match (car s) rcirc-server-name)
2455 (setq auth-required t)))))
72d2c2e3 2456 (progn
c47971d7 2457 (add-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t t)
72d2c2e3
DD
2458 (rcirc-authenticate))
2459 (rcirc-authenticate)
2460 (rcirc-join-channels process rcirc-startup-channels))
2461 (rcirc-join-channels process rcirc-startup-channels))))
2462
2463(defun rcirc-join-channels-post-auth (process)
2464 "Join `rcirc-startup-channels' after authenticating."
2465 (with-rcirc-process-buffer process
adf794e4 2466 (rcirc-join-channels process rcirc-startup-channels)))
bd43c990
RS
2467
2468(defun rcirc-handler-PRIVMSG (process sender args text)
72d2c2e3 2469 (rcirc-check-auth-status process sender args text)
bd43c990
RS
2470 (let ((target (if (rcirc-channel-p (car args))
2471 (car args)
db58efbf 2472 sender))
bd43c990
RS
2473 (message (or (cadr args) "")))
2474 (if (string-match "^\C-a\\(.*\\)\C-a$" message)
2475 (rcirc-handler-CTCP process target sender (match-string 1 message))
2476 (rcirc-print process sender "PRIVMSG" target message t))
a0a5c583
GM
2477 ;; update nick linestamp
2478 (with-current-buffer (rcirc-get-buffer process target t)
2479 (rcirc-put-nick-channel process sender target rcirc-current-line))))
bd43c990
RS
2480
2481(defun rcirc-handler-NOTICE (process sender args text)
72d2c2e3 2482 (rcirc-check-auth-status process sender args text)
bd43c990
RS
2483 (let ((target (car args))
2484 (message (cadr args)))
adf794e4
EZ
2485 (if (string-match "^\C-a\\(.*\\)\C-a$" message)
2486 (rcirc-handler-CTCP-response process target sender
2487 (match-string 1 message))
2488 (rcirc-print process sender "NOTICE"
2489 (cond ((rcirc-channel-p target)
2490 target)
2491 ;;; -ChanServ- [#gnu] Welcome...
02f47e86 2492 ((string-match "\\[\\(#[^\] ]+\\)\\]" message)
adf794e4
EZ
2493 (match-string 1 message))
2494 (sender
a2524d26 2495 (if (string= sender (rcirc-server-name process))
db58efbf
EZ
2496 nil ; server notice
2497 sender)))
adf794e4 2498 message t))))
bd43c990 2499
72d2c2e3
DD
2500(defun rcirc-check-auth-status (process sender args text)
2501 "Check if the user just authenticated.
2502If authenticated, runs `rcirc-authenticated-hook' with PROCESS as
2503the only argument."
2504 (with-rcirc-process-buffer process
2505 (when (and (not rcirc-user-authenticated)
2506 rcirc-authenticate-before-join
2507 rcirc-auto-authenticate-flag)
2508 (let ((target (car args))
2509 (message (cadr args)))
2510 (when (or
2511 (and ;; nickserv
2512 (string= sender "NickServ")
2513 (string= target rcirc-nick)
2514 (member message
2515 (list
2516 (format "You are now identified for \C-b%s\C-b." rcirc-nick)
2517 "Password accepted - you are now recognized."
2518 )))
77f63d30
DD
2519 (and ;; quakenet
2520 (string= sender "Q")
2521 (string= target rcirc-nick)
c47971d7 2522 (string-match "\\`You are now logged in as .+\\.\\'" message)))
72d2c2e3
DD
2523 (setq rcirc-user-authenticated t)
2524 (run-hook-with-args 'rcirc-authenticated-hook process)
2525 (remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t))))))
2526
bd43c990 2527(defun rcirc-handler-WALLOPS (process sender args text)
db58efbf 2528 (rcirc-print process sender "WALLOPS" sender (car args) t))
bd43c990
RS
2529
2530(defun rcirc-handler-JOIN (process sender args text)
db58efbf 2531 (let ((channel (car args)))
a0a5c583
GM
2532 (with-current-buffer (rcirc-get-buffer-create process channel)
2533 ;; when recently rejoining, restore the linestamp
2534 (rcirc-put-nick-channel process sender channel
2535 (let ((last-activity-lines
683b7dc6 2536 (rcirc-elapsed-lines process sender channel)))
a0a5c583
GM
2537 (when (and last-activity-lines
2538 (< last-activity-lines rcirc-omit-threshold))
827b77e9
DD
2539 (rcirc-last-line process sender channel))))
2540 ;; reset mode-line-process in case joining a channel with an
2541 ;; already open buffer (after getting kicked e.g.)
2542 (setq mode-line-process nil))
a0a5c583 2543
bd43c990
RS
2544 (rcirc-print process sender "JOIN" channel "")
2545
2546 ;; print in private chat buffer if it exists
a2524d26 2547 (when (rcirc-get-buffer (rcirc-buffer-process) sender)
a0a5c583 2548 (rcirc-print process sender "JOIN" sender channel))))
bd43c990
RS
2549
2550;; PART and KICK are handled the same way
2551(defun rcirc-handler-PART-or-KICK (process response channel sender nick args)
a2524d26 2552 (rcirc-ignore-update-automatic nick)
bd43c990
RS
2553 (if (not (string= nick (rcirc-nick process)))
2554 ;; this is someone else leaving
a0a5c583
GM
2555 (progn
2556 (rcirc-maybe-remember-nick-quit process nick channel)
2557 (rcirc-remove-nick-channel process nick channel))
adf794e4
EZ
2558 ;; this is us leaving
2559 (mapc (lambda (n)
2560 (rcirc-remove-nick-channel process n channel))
2561 (rcirc-channel-nicks process channel))
2562
2563 ;; if the buffer is still around, make it inactive
2564 (let ((buffer (rcirc-get-buffer process channel)))
2565 (when buffer
195eca78 2566 (rcirc-disconnect-buffer buffer)))))
bd43c990
RS
2567
2568(defun rcirc-handler-PART (process sender args text)
a2524d26
EZ
2569 (let* ((channel (car args))
2570 (reason (cadr args))
2571 (message (concat channel " " reason)))
2572 (rcirc-print process sender "PART" channel message)
2573 ;; print in private chat buffer if it exists
2574 (when (rcirc-get-buffer (rcirc-buffer-process) sender)
2575 (rcirc-print process sender "PART" sender message))
2576
2577 (rcirc-handler-PART-or-KICK process "PART" channel sender sender reason)))
bd43c990
RS
2578
2579(defun rcirc-handler-KICK (process sender args text)
a2524d26
EZ
2580 (let* ((channel (car args))
2581 (nick (cadr args))
2582 (reason (caddr args))
2583 (message (concat nick " " channel " " reason)))
2584 (rcirc-print process sender "KICK" channel message t)
2585 ;; print in private chat buffer if it exists
2586 (when (rcirc-get-buffer (rcirc-buffer-process) nick)
2587 (rcirc-print process sender "KICK" nick message))
2588
2589 (rcirc-handler-PART-or-KICK process "KICK" channel sender nick reason)))
bd43c990 2590
a0a5c583
GM
2591(defun rcirc-maybe-remember-nick-quit (process nick channel)
2592 "Remember NICK as leaving CHANNEL if they recently spoke."
683b7dc6 2593 (let ((elapsed-lines (rcirc-elapsed-lines process nick channel)))
a0a5c583
GM
2594 (when (and elapsed-lines
2595 (< elapsed-lines rcirc-omit-threshold))
2596 (let ((buffer (rcirc-get-buffer process channel)))
2597 (when buffer
2598 (with-current-buffer buffer
683b7dc6
GM
2599 (let ((record (assoc-string nick rcirc-recent-quit-alist t))
2600 (line (rcirc-last-line process nick channel)))
a0a5c583
GM
2601 (if record
2602 (setcdr record line)
2603 (setq rcirc-recent-quit-alist
2604 (cons (cons nick line)
2605 rcirc-recent-quit-alist))))))))))
2606
bd43c990 2607(defun rcirc-handler-QUIT (process sender args text)
db58efbf
EZ
2608 (rcirc-ignore-update-automatic sender)
2609 (mapc (lambda (channel)
a0a5c583
GM
2610 ;; broadcast quit message each channel
2611 (rcirc-print process sender "QUIT" channel (apply 'concat args))
2612 ;; record nick in quit table if they recently spoke
2613 (rcirc-maybe-remember-nick-quit process sender channel))
db58efbf 2614 (rcirc-nick-channels process sender))
db58efbf 2615 (rcirc-nick-remove process sender))
bd43c990
RS
2616
2617(defun rcirc-handler-NICK (process sender args text)
db58efbf 2618 (let* ((old-nick sender)
bd43c990
RS
2619 (new-nick (car args))
2620 (channels (rcirc-nick-channels process old-nick)))
2c8abe90
AS
2621 ;; update list of ignored nicks
2622 (rcirc-ignore-update-automatic old-nick)
2623 (when (member old-nick rcirc-ignore-list)
2624 (add-to-list 'rcirc-ignore-list new-nick)
2625 (add-to-list 'rcirc-ignore-list-automatic new-nick))
bd43c990
RS
2626 ;; print message to nick's channels
2627 (dolist (target channels)
2628 (rcirc-print process sender "NICK" target new-nick))
2629 ;; update private chat buffer, if it exists
adf794e4
EZ
2630 (let ((chat-buffer (rcirc-get-buffer process old-nick)))
2631 (when chat-buffer
2632 (with-current-buffer chat-buffer
2633 (rcirc-print process sender "NICK" old-nick new-nick)
2634 (setq rcirc-target new-nick)
2635 (rename-buffer (rcirc-generate-new-buffer-name process new-nick)))))
bd43c990 2636 ;; remove old nick and add new one
adf794e4 2637 (with-rcirc-process-buffer process
bd43c990
RS
2638 (let ((v (gethash old-nick rcirc-nick-table)))
2639 (remhash old-nick rcirc-nick-table)
2640 (puthash new-nick v rcirc-nick-table))
2641 ;; if this is our nick...
2642 (when (string= old-nick rcirc-nick)
2643 (setq rcirc-nick new-nick)
adf794e4 2644 (rcirc-update-prompt t)
bd43c990
RS
2645 ;; reauthenticate
2646 (when rcirc-auto-authenticate-flag (rcirc-authenticate))))))
2647
2648(defun rcirc-handler-PING (process sender args text)
195eca78 2649 (rcirc-send-string process (concat "PONG :" (car args))))
bd43c990
RS
2650
2651(defun rcirc-handler-PONG (process sender args text)
2652 ;; do nothing
2653 )
2654
2655(defun rcirc-handler-TOPIC (process sender args text)
2656 (let ((topic (cadr args)))
2657 (rcirc-print process sender "TOPIC" (car args) topic)
2658 (with-current-buffer (rcirc-get-buffer process (car args))
2659 (setq rcirc-topic topic))))
2660
a2524d26
EZ
2661(defvar rcirc-nick-away-alist nil)
2662(defun rcirc-handler-301 (process sender args text)
2663 "RPL_AWAY"
2664 (let* ((nick (cadr args))
2665 (rec (assoc-string nick rcirc-nick-away-alist))
2666 (away-message (caddr args)))
2667 (when (or (not rec)
2668 (not (string= (cdr rec) away-message)))
2669 ;; away message has changed
2670 (rcirc-handler-generic process "AWAY" nick (cdr args) text)
2671 (if rec
2672 (setcdr rec away-message)
2673 (setq rcirc-nick-away-alist (cons (cons nick away-message)
2674 rcirc-nick-away-alist))))))
2675
c5aff743
DD
2676(defun rcirc-handler-317 (process sender args text)
2677 "RPL_WHOISIDLE"
2678 (let* ((nick (nth 1 args))
2679 (idle-secs (string-to-number (nth 2 args)))
2680 (idle-string
2681 (if (< idle-secs most-positive-fixnum)
2682 (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs)
2683 "a very long time"))
2684 (signon-time (seconds-to-time (string-to-number (nth 3 args))))
2685 (signon-string (format-time-string "%c" signon-time))
2686 (message (format "%s idle for %s, signed on %s"
2687 nick idle-string signon-string)))
2688 (rcirc-print process sender "317" nil message t)))
2689
bd43c990
RS
2690(defun rcirc-handler-332 (process sender args text)
2691 "RPL_TOPIC"
adf794e4
EZ
2692 (let ((buffer (or (rcirc-get-buffer process (cadr args))
2693 (rcirc-get-temp-buffer-create process (cadr args)))))
2694 (with-current-buffer buffer
2695 (setq rcirc-topic (caddr args)))))
bd43c990
RS
2696
2697(defun rcirc-handler-333 (process sender args text)
027b979c
DD
2698 "333 says who set the topic and when.
2699Not in rfc1459.txt"
adf794e4
EZ
2700 (let ((buffer (or (rcirc-get-buffer process (cadr args))
2701 (rcirc-get-temp-buffer-create process (cadr args)))))
2702 (with-current-buffer buffer
2703 (let ((setter (caddr args))
2704 (time (current-time-string
2705 (seconds-to-time
2706 (string-to-number (cadddr args))))))
2707 (rcirc-print process sender "TOPIC" (cadr args)
2708 (format "%s (%s on %s)" rcirc-topic setter time))))))
bd43c990
RS
2709
2710(defun rcirc-handler-477 (process sender args text)
2711 "ERR_NOCHANMODES"
2712 (rcirc-print process sender "477" (cadr args) (caddr args)))
2713
2714(defun rcirc-handler-MODE (process sender args text)
2715 (let ((target (car args))
2716 (msg (mapconcat 'identity (cdr args) " ")))
2717 (rcirc-print process sender "MODE"
2718 (if (string= target (rcirc-nick process))
2719 nil
2720 target)
2721 msg)
2722
2723 ;; print in private chat buffers if they exist
2724 (mapc (lambda (nick)
db58efbf
EZ
2725 (when (rcirc-get-buffer process nick)
2726 (rcirc-print process sender "MODE" nick msg)))
adf794e4 2727 (cddr args))))
bd43c990
RS
2728
2729(defun rcirc-get-temp-buffer-create (process channel)
2730 "Return a buffer based on PROCESS and CHANNEL."
2731 (let ((tmpnam (concat " " (downcase channel) "TMP" (process-name process))))
2732 (get-buffer-create tmpnam)))
2733
2734(defun rcirc-handler-353 (process sender args text)
2735 "RPL_NAMREPLY"
0ba690bd
DD
2736 (let ((channel (nth 2 args))
2737 (names (or (nth 3 args) "")))
bd43c990
RS
2738 (mapc (lambda (nick)
2739 (rcirc-put-nick-channel process nick channel))
0ba690bd
DD
2740 (split-string names " " t))
2741 ;; create a temporary buffer to insert the names into
2742 ;; rcirc-handler-366 (RPL_ENDOFNAMES) will handle it
bd43c990
RS
2743 (with-current-buffer (rcirc-get-temp-buffer-create process channel)
2744 (goto-char (point-max))
2745 (insert (car (last args)) " "))))
2746
2747(defun rcirc-handler-366 (process sender args text)
2748 "RPL_ENDOFNAMES"
2749 (let* ((channel (cadr args))
2750 (buffer (rcirc-get-temp-buffer-create process channel)))
2751 (with-current-buffer buffer
2752 (rcirc-print process sender "NAMES" channel
c62bf05a 2753 (let ((content (buffer-substring (point-min) (point-max))))
aa1bc616 2754 (rcirc-sort-nicknames-join content " "))))
bd43c990
RS
2755 (kill-buffer buffer)))
2756
2757(defun rcirc-handler-433 (process sender args text)
2758 "ERR_NICKNAMEINUSE"
2759 (rcirc-handler-generic process "433" sender args text)
2760 (let* ((new-nick (concat (cadr args) "`")))
adf794e4 2761 (with-rcirc-process-buffer process
bd43c990
RS
2762 (rcirc-cmd-nick new-nick nil process))))
2763
2764(defun rcirc-authenticate ()
2765 "Send authentication to process associated with current buffer.
db58efbf 2766Passwords are stored in `rcirc-authinfo' (which see)."
bd43c990 2767 (interactive)
a2524d26 2768 (with-rcirc-server-buffer
db58efbf 2769 (dolist (i rcirc-authinfo)
a2524d26
EZ
2770 (let ((process (rcirc-buffer-process))
2771 (server (car i))
db58efbf
EZ
2772 (nick (caddr i))
2773 (method (cadr i))
2774 (args (cdddr i)))
77f63d30
DD
2775 (when (and (string-match server rcirc-server))
2776 (if (and (memq method '(nickserv chanserv bitlbee))
2777 (string-match nick rcirc-nick))
2778 ;; the following methods rely on the user's nickname.
2779 (case method
2780 (nickserv
2781 (rcirc-send-privmsg
2782 process
1be1d1e9 2783 (or (cadr args) "NickServ")
77f63d30
DD
2784 (concat "IDENTIFY " (car args))))
2785 (chanserv
2786 (rcirc-send-privmsg
2787 process
1be1d1e9 2788 "ChanServ"
77f63d30
DD
2789 (format "IDENTIFY %s %s" (car args) (cadr args))))
2790 (bitlbee
2791 (rcirc-send-privmsg
2792 process
1be1d1e9 2793 "&bitlbee"
77f63d30
DD
2794 (concat "IDENTIFY " (car args)))))
2795 ;; quakenet authentication doesn't rely on the user's nickname.
2796 ;; the variable `nick' here represents the Q account name.
2797 (when (eq method 'quakenet)
aebf69c8 2798 (rcirc-send-privmsg
77f63d30
DD
2799 process
2800 "Q@CServe.quakenet.org"
2801 (format "AUTH %s %s" nick (car args))))))))))
adf794e4 2802
bd43c990
RS
2803(defun rcirc-handler-INVITE (process sender args text)
2804 (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t))
2805
2806(defun rcirc-handler-ERROR (process sender args text)
2807 (rcirc-print process sender "ERROR" nil (mapconcat 'identity args " ")))
2808
2809(defun rcirc-handler-CTCP (process target sender text)
2810 (if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text)
2811 (let* ((request (upcase (match-string 1 text)))
2812 (args (match-string 2 text))
bd43c990
RS
2813 (handler (intern-soft (concat "rcirc-handler-ctcp-" request))))
2814 (if (not (fboundp handler))
db58efbf
EZ
2815 (rcirc-print process sender "ERROR" target
2816 (format "%s sent unsupported ctcp: %s" sender text)
adf794e4 2817 t)
bd43c990 2818 (funcall handler process target sender args)
195eca78
SM
2819 (unless (or (string= request "ACTION")
2820 (string= request "KEEPALIVE"))
db58efbf 2821 (rcirc-print process sender "CTCP" target
adf794e4 2822 (format "%s" text) t))))))
bd43c990
RS
2823
2824(defun rcirc-handler-ctcp-VERSION (process target sender args)
2825 (rcirc-send-string process
db58efbf 2826 (concat "NOTICE " sender
adf794e4 2827 " :\C-aVERSION " rcirc-id-string
bd43c990
RS
2828 "\C-a")))
2829
2830(defun rcirc-handler-ctcp-ACTION (process target sender args)
2831 (rcirc-print process sender "ACTION" target args t))
2832
2833(defun rcirc-handler-ctcp-TIME (process target sender args)
2834 (rcirc-send-string process
db58efbf 2835 (concat "NOTICE " sender
bd43c990 2836 " :\C-aTIME " (current-time-string) "\C-a")))
adf794e4
EZ
2837
2838(defun rcirc-handler-CTCP-response (process target sender message)
2839 (rcirc-print process sender "CTCP" nil message t))
bd43c990 2840\f
adf794e4
EZ
2841(defgroup rcirc-faces nil
2842 "Faces for rcirc."
2843 :group 'rcirc
2844 :group 'faces)
2845
ad8121fe
EZ
2846(defface rcirc-my-nick ; font-lock-function-name-face
2847 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
2848 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
2849 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
2850 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
2851 (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
2852 (t (:inverse-video t :weight bold)))
adf794e4
EZ
2853 "The face used to highlight my messages."
2854 :group 'rcirc-faces)
bd43c990 2855
ad8121fe
EZ
2856(defface rcirc-other-nick ; font-lock-variable-name-face
2857 '((((class grayscale) (background light))
2858 (:foreground "Gray90" :weight bold :slant italic))
bd43c990 2859 (((class grayscale) (background dark))
ad8121fe
EZ
2860 (:foreground "DimGray" :weight bold :slant italic))
2861 (((class color) (min-colors 88) (background light)) (:foreground "DarkGoldenrod"))
2862 (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod"))
2863 (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
2864 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
2865 (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
2866 (t (:weight bold :slant italic)))
adf794e4
EZ
2867 "The face used to highlight other messages."
2868 :group 'rcirc-faces)
bd43c990 2869
02f47e86
MB
2870(defface rcirc-bright-nick
2871 '((((class grayscale) (background light))
2872 (:foreground "LightGray" :weight bold :underline t))
2873 (((class grayscale) (background dark))
2874 (:foreground "Gray50" :weight bold :underline t))
2875 (((class color) (min-colors 88) (background light)) (:foreground "CadetBlue"))
2876 (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
2877 (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
2878 (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
2879 (((class color) (min-colors 8)) (:foreground "magenta"))
2880 (t (:weight bold :underline t)))
f8db61b2 2881 "Face used for nicks matched by `rcirc-bright-nicks'."
02f47e86
MB
2882 :group 'rcirc-faces)
2883
2884(defface rcirc-dim-nick
2885 '((t :inherit default))
f8db61b2 2886 "Face used for nicks in `rcirc-dim-nicks'."
02f47e86
MB
2887 :group 'rcirc-faces)
2888
ad8121fe
EZ
2889(defface rcirc-server ; font-lock-comment-face
2890 '((((class grayscale) (background light))
2891 (:foreground "DimGray" :weight bold :slant italic))
bd43c990 2892 (((class grayscale) (background dark))
ad8121fe
EZ
2893 (:foreground "LightGray" :weight bold :slant italic))
2894 (((class color) (min-colors 88) (background light))
2895 (:foreground "Firebrick"))
2896 (((class color) (min-colors 88) (background dark))
2897 (:foreground "chocolate1"))
2898 (((class color) (min-colors 16) (background light))
2899 (:foreground "red"))
2900 (((class color) (min-colors 16) (background dark))
2901 (:foreground "red1"))
2902 (((class color) (min-colors 8) (background light))
2903 )
2904 (((class color) (min-colors 8) (background dark))
2905 )
2906 (t (:weight bold :slant italic)))
adf794e4
EZ
2907 "The face used to highlight server messages."
2908 :group 'rcirc-faces)
bd43c990 2909
ad8121fe 2910(defface rcirc-server-prefix ; font-lock-comment-delimiter-face
db58efbf 2911 '((default :inherit rcirc-server)
ad8121fe
EZ
2912 (((class grayscale)))
2913 (((class color) (min-colors 16)))
2914 (((class color) (min-colors 8) (background light))
2915 :foreground "red")
2916 (((class color) (min-colors 8) (background dark))
2917 :foreground "red1"))
2918 "The face used to highlight server prefixes."
2919 :group 'rcirc-faces)
2920
2921(defface rcirc-timestamp
2922 '((t (:inherit default)))
2923 "The face used to highlight timestamps."
2924 :group 'rcirc-faces)
2925
2926(defface rcirc-nick-in-message ; font-lock-keyword-face
2927 '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
2928 (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
2929 (((class color) (min-colors 88) (background light)) (:foreground "Purple"))
2930 (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
2931 (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
2932 (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
2933 (((class color) (min-colors 8)) (:foreground "cyan" :weight bold))
2934 (t (:weight bold)))
f8db61b2 2935 "The face used to highlight instances of your nick within messages."
adf794e4 2936 :group 'rcirc-faces)
bd43c990 2937
f8db61b2
EZ
2938(defface rcirc-nick-in-message-full-line
2939 '((t (:bold t)))
2940 "The face used emphasize the entire message when your nick is mentioned."
92c4adc1 2941 :group 'rcirc-faces)
f8db61b2 2942
ad8121fe
EZ
2943(defface rcirc-prompt ; comint-highlight-prompt
2944 '((((min-colors 88) (background dark)) (:foreground "cyan1"))
2945 (((background dark)) (:foreground "cyan"))
bd43c990 2946 (t (:foreground "dark blue")))
2e398771 2947 "The face used to highlight prompts."
adf794e4 2948 :group 'rcirc-faces)
bd43c990 2949
f8db61b2 2950(defface rcirc-track-nick
8216fbaf
EZ
2951 '((((type tty)) (:inherit default))
2952 (t (:inverse-video t)))
f8db61b2
EZ
2953 "The face used in the mode-line when your nick is mentioned."
2954 :group 'rcirc-faces)
2955
2956(defface rcirc-track-keyword
2957 '((t (:bold t )))
2958 "The face used in the mode-line when keywords are mentioned."
2959 :group 'rcirc-faces)
2960
2961(defface rcirc-url
bd43c990 2962 '((t (:bold t)))
f8db61b2
EZ
2963 "The face used to highlight urls."
2964 :group 'rcirc-faces)
2965
2966(defface rcirc-keyword
2967 '((t (:inherit highlight)))
2968 "The face used to highlight keywords."
adf794e4 2969 :group 'rcirc-faces)
a2524d26 2970
bd43c990 2971\f
adf794e4 2972;; When using M-x flyspell-mode, only check words after the prompt
bd43c990
RS
2973(put 'rcirc-mode 'flyspell-mode-predicate 'rcirc-looking-at-input)
2974(defun rcirc-looking-at-input ()
2975 "Returns true if point is past the input marker."
2976 (>= (point) rcirc-prompt-end-marker))
2977\f
2978
2979(provide 'rcirc)
e636ae15 2980
bd43c990 2981;;; rcirc.el ends here