* help.el (help-return-method): Doc fix.
[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)
27de4e20 818
bd43c990
RS
819(defun rcirc-prev-input-string (arg)
820 (ring-ref rcirc-input-ring (+ rcirc-input-ring-index arg)))
821
27de4e20
DD
822(defun rcirc-insert-prev-input ()
823 (interactive)
bd43c990
RS
824 (when (<= rcirc-prompt-end-marker (point))
825 (delete-region rcirc-prompt-end-marker (point-max))
826 (insert (rcirc-prev-input-string 0))
827 (setq rcirc-input-ring-index (1+ rcirc-input-ring-index))))
828
27de4e20
DD
829(defun rcirc-insert-next-input ()
830 (interactive)
bd43c990
RS
831 (when (<= rcirc-prompt-end-marker (point))
832 (delete-region rcirc-prompt-end-marker (point-max))
833 (setq rcirc-input-ring-index (1- rcirc-input-ring-index))
834 (insert (rcirc-prev-input-string -1))))
835
94c7243b
LL
836(defvar rcirc-server-commands
837 '("/admin" "/away" "/connect" "/die" "/error" "/info"
838 "/invite" "/ison" "/join" "/kick" "/kill" "/links"
839 "/list" "/lusers" "/mode" "/motd" "/names" "/nick"
840 "/notice" "/oper" "/part" "/pass" "/ping" "/pong"
841 "/privmsg" "/quit" "/rehash" "/restart" "/service" "/servlist"
842 "/server" "/squery" "/squit" "/stats" "/summon" "/time"
843 "/topic" "/trace" "/user" "/userhost" "/users" "/version"
844 "/wallops" "/who" "/whois" "/whowas")
845 "A list of user commands by IRC server.
846The value defaults to RFCs 1459 and 2812.")
847
848;; /me and /ctcp are not defined by `defun-rcirc-command'.
849(defvar rcirc-client-commands '("/me" "/ctcp")
850 "A list of user commands defined by IRC client rcirc.
851The list is updated automatically by `defun-rcirc-command'.")
852
853(defun rcirc-completion-at-point ()
854 "Function used for `completion-at-point-functions' in `rcirc-mode'."
0b4e93f1
LL
855 (and (rcirc-looking-at-input)
856 (let* ((beg (save-excursion
857 (if (re-search-backward " " rcirc-prompt-end-marker t)
858 (1+ (point))
859 rcirc-prompt-end-marker)))
860 (table (if (and (= beg rcirc-prompt-end-marker)
861 (eq (char-after beg) ?/))
862 (delete-dups
863 (nconc (sort (copy-sequence rcirc-client-commands)
864 'string-lessp)
865 (sort (copy-sequence rcirc-server-commands)
866 'string-lessp)))
867 (rcirc-channel-nicks (rcirc-buffer-process)
868 rcirc-target))))
869 (list beg (point) table))))
94c7243b
LL
870
871(defvar rcirc-completions nil)
872(defvar rcirc-completion-start nil)
873
874(defun rcirc-complete ()
875 "Cycle through completions from list of nicks in channel or IRC commands.
876IRC command completion is performed only if '/' is the first input char."
bd43c990 877 (interactive)
0b4e93f1
LL
878 (unless (rcirc-looking-at-input)
879 (error "Point not located after rcirc prompt"))
7faa3f8c 880 (if (eq last-command this-command)
94c7243b
LL
881 (setq rcirc-completions
882 (append (cdr rcirc-completions) (list (car rcirc-completions))))
883 (let ((completion-ignore-case t)
884 (table (rcirc-completion-at-point)))
885 (setq rcirc-completion-start (car table))
886 (setq rcirc-completions
0b4e93f1
LL
887 (and rcirc-completion-start
888 (all-completions (buffer-substring rcirc-completion-start
889 (cadr table))
890 (nth 2 table))))))
94c7243b 891 (let ((completion (car rcirc-completions)))
bd43c990 892 (when completion
94c7243b
LL
893 (delete-region rcirc-completion-start (point))
894 (insert
2a4466ca
DD
895 (cond
896 ((= (aref completion 0) ?/) (concat completion " "))
897 ((= rcirc-completion-start rcirc-prompt-end-marker)
898 (format rcirc-nick-completion-format completion))
899 (t completion))))))
bd43c990 900
a2524d26
EZ
901(defun set-rcirc-decode-coding-system (coding-system)
902 "Set the decode coding system used in this channel."
903 (interactive "zCoding system for incoming messages: ")
488086f4 904 (set (make-local-variable 'rcirc-decode-coding-system) coding-system))
a2524d26
EZ
905
906(defun set-rcirc-encode-coding-system (coding-system)
907 "Set the encode coding system used in this channel."
908 (interactive "zCoding system for outgoing messages: ")
488086f4 909 (set (make-local-variable 'rcirc-encode-coding-system) coding-system))
bd43c990 910
b016851c
SM
911(defvar rcirc-mode-map
912 (let ((map (make-sparse-keymap)))
913 (define-key map (kbd "RET") 'rcirc-send-input)
914 (define-key map (kbd "M-p") 'rcirc-insert-prev-input)
915 (define-key map (kbd "M-n") 'rcirc-insert-next-input)
916 (define-key map (kbd "TAB") 'rcirc-complete)
917 (define-key map (kbd "C-c C-b") 'rcirc-browse-url)
918 (define-key map (kbd "C-c C-c") 'rcirc-edit-multiline)
919 (define-key map (kbd "C-c C-j") 'rcirc-cmd-join)
920 (define-key map (kbd "C-c C-k") 'rcirc-cmd-kick)
921 (define-key map (kbd "C-c C-l") 'rcirc-toggle-low-priority)
922 (define-key map (kbd "C-c C-d") 'rcirc-cmd-mode)
923 (define-key map (kbd "C-c C-m") 'rcirc-cmd-msg)
924 (define-key map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename
925 (define-key map (kbd "C-c C-o") 'rcirc-omit-mode)
b016851c
SM
926 (define-key map (kbd "C-c C-p") 'rcirc-cmd-part)
927 (define-key map (kbd "C-c C-q") 'rcirc-cmd-query)
928 (define-key map (kbd "C-c C-t") 'rcirc-cmd-topic)
929 (define-key map (kbd "C-c C-n") 'rcirc-cmd-names)
930 (define-key map (kbd "C-c C-w") 'rcirc-cmd-whois)
931 (define-key map (kbd "C-c C-x") 'rcirc-cmd-quit)
932 (define-key map (kbd "C-c TAB") ; C-i
933 'rcirc-toggle-ignore-buffer-activity)
934 (define-key map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer)
935 (define-key map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line)
936 map)
bd43c990
RS
937 "Keymap for rcirc mode.")
938
adf794e4
EZ
939(defvar rcirc-short-buffer-name nil
940 "Generated abbreviation to use to indicate buffer activity.")
941
bd43c990
RS
942(defvar rcirc-mode-hook nil
943 "Hook run when setting up rcirc buffer.")
944
a2524d26
EZ
945(defvar rcirc-last-post-time nil)
946
195eca78
SM
947(defvar rcirc-log-alist nil
948 "Alist of lines to log to disk when `rcirc-log-flag' is non-nil.
949Each element looks like (FILENAME . TEXT).")
950
a0a5c583
GM
951(defvar rcirc-current-line 0
952 "The current number of responses printed in this channel.
953This number is independent of the number of lines in the buffer.")
954
bd43c990 955(defun rcirc-mode (process target)
4d789d84 956 ;; FIXME: Use define-derived-mode.
2e398771 957 "Major mode for IRC channel buffers.
bd43c990
RS
958
959\\{rcirc-mode-map}"
960 (kill-all-local-variables)
961 (use-local-map rcirc-mode-map)
962 (setq mode-name "rcirc")
963 (setq major-mode 'rcirc-mode)
195eca78 964 (setq mode-line-process nil)
bd43c990 965
488086f4
SM
966 (set (make-local-variable 'rcirc-input-ring)
967 (make-ring rcirc-input-ring-size))
968 (set (make-local-variable 'rcirc-server-buffer) (process-buffer process))
969 (set (make-local-variable 'rcirc-target) target)
970 (set (make-local-variable 'rcirc-topic) nil)
971 (set (make-local-variable 'rcirc-last-post-time) (current-time))
972 (set (make-local-variable 'fill-paragraph-function) 'rcirc-fill-paragraph)
973 (set (make-local-variable 'rcirc-recent-quit-alist) nil)
974 (set (make-local-variable 'rcirc-current-line) 0)
975
976 (set (make-local-variable 'rcirc-short-buffer-name) nil)
82745640 977 (set (make-local-variable 'rcirc-urls) nil)
bd43c990 978
a0a5c583
GM
979 ;; setup for omitting responses
980 (setq buffer-invisibility-spec '())
981 (setq buffer-display-table (make-display-table))
982 (set-display-table-slot buffer-display-table 4
aebf69c8 983 (let ((glyph (make-glyph-code
a0a5c583
GM
984 ?. 'font-lock-keyword-face)))
985 (make-vector 3 glyph)))
986
a2524d26
EZ
987 (dolist (i rcirc-coding-system-alist)
988 (let ((chan (if (consp (car i)) (caar i) (car i)))
989 (serv (if (consp (car i)) (cdar i) "")))
990 (when (and (string-match chan (or target ""))
991 (string-match serv (rcirc-server-name process)))
488086f4
SM
992 (set (make-local-variable 'rcirc-decode-coding-system)
993 (if (consp (cdr i)) (cadr i) (cdr i)))
994 (set (make-local-variable 'rcirc-encode-coding-system)
995 (if (consp (cdr i)) (cddr i) (cdr i))))))
a2524d26 996
bd43c990 997 ;; setup the prompt and markers
488086f4
SM
998 (set (make-local-variable 'rcirc-prompt-start-marker) (point-max-marker))
999 (set (make-local-variable 'rcirc-prompt-end-marker) (point-max-marker))
bd43c990
RS
1000 (rcirc-update-prompt)
1001 (goto-char rcirc-prompt-end-marker)
488086f4
SM
1002
1003 (set (make-local-variable 'overlay-arrow-position) (make-marker))
bd43c990 1004
a2524d26
EZ
1005 ;; if the user changes the major mode or kills the buffer, there is
1006 ;; cleanup work to do
f8db61b2
EZ
1007 (add-hook 'change-major-mode-hook 'rcirc-change-major-mode-hook nil t)
1008 (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook nil t)
a2524d26 1009
adf794e4
EZ
1010 ;; add to buffer list, and update buffer abbrevs
1011 (when target ; skip server buffer
1012 (let ((buffer (current-buffer)))
1013 (with-rcirc-process-buffer process
1014 (setq rcirc-buffer-alist (cons (cons target buffer)
1015 rcirc-buffer-alist))))
1016 (rcirc-update-short-buffer-names))
1017
94c7243b
LL
1018 (add-hook 'completion-at-point-functions
1019 'rcirc-completion-at-point nil 'local)
1020
4d789d84 1021 (run-mode-hooks 'rcirc-mode-hook))
bd43c990 1022
adf794e4
EZ
1023(defun rcirc-update-prompt (&optional all)
1024 "Reset the prompt string in the current buffer.
c18a54de 1025
adf794e4
EZ
1026If ALL is non-nil, update prompts in all IRC buffers."
1027 (if all
1028 (mapc (lambda (process)
1029 (mapc (lambda (buffer)
1030 (with-current-buffer buffer
1031 (rcirc-update-prompt)))
1032 (with-rcirc-process-buffer process
1033 (mapcar 'cdr rcirc-buffer-alist))))
1034 (rcirc-process-list))
1035 (let ((inhibit-read-only t)
1036 (prompt (or rcirc-prompt "")))
1037 (mapc (lambda (rep)
1038 (setq prompt
a2524d26
EZ
1039 (replace-regexp-in-string (car rep) (cdr rep) prompt)))
1040 (list (cons "%n" (rcirc-buffer-nick))
8216fbaf 1041 (cons "%s" (with-rcirc-server-buffer rcirc-server-name))
adf794e4
EZ
1042 (cons "%t" (or rcirc-target ""))))
1043 (save-excursion
1044 (delete-region rcirc-prompt-start-marker rcirc-prompt-end-marker)
1045 (goto-char rcirc-prompt-start-marker)
1046 (let ((start (point)))
1047 (insert-before-markers prompt)
1048 (set-marker rcirc-prompt-start-marker start)
1049 (when (not (zerop (- rcirc-prompt-end-marker
1050 rcirc-prompt-start-marker)))
1051 (add-text-properties rcirc-prompt-start-marker
1052 rcirc-prompt-end-marker
1053 (list 'face 'rcirc-prompt
1054 'read-only t 'field t
1055 'front-sticky t 'rear-nonsticky t))))))))
1056
1057(defun rcirc-set-changed (option value)
1058 "Set OPTION to VALUE and do updates after a customization change."
1059 (set-default option value)
1060 (cond ((eq option 'rcirc-prompt)
1061 (rcirc-update-prompt 'all))
1062 (t
1063 (error "Bad option %s" option))))
bd43c990
RS
1064
1065(defun rcirc-channel-p (target)
1066 "Return t if TARGET is a channel name."
1067 (and target
1068 (not (zerop (length target)))
1069 (or (eq (aref target 0) ?#)
1070 (eq (aref target 0) ?&))))
1071
2d7d6439
GM
1072(defcustom rcirc-log-directory "~/.emacs.d/rcirc-log"
1073 "Directory to keep IRC logfiles."
1074 :type 'directory
1075 :group 'rcirc)
1076
1077(defcustom rcirc-log-flag nil
1078 "Non-nil means log IRC activity to disk.
1079Logfiles are kept in `rcirc-log-directory'."
1080 :type 'boolean
1081 :group 'rcirc)
1082
bd43c990
RS
1083(defun rcirc-kill-buffer-hook ()
1084 "Part the channel when killing an rcirc buffer."
1085 (when (eq major-mode 'rcirc-mode)
80094035
GK
1086 (when (and rcirc-log-flag
1087 rcirc-log-directory)
1088 (rcirc-log-write))
a2524d26
EZ
1089 (rcirc-clean-up-buffer "Killed buffer")))
1090
1091(defun rcirc-change-major-mode-hook ()
1092 "Part the channel when changing the major-mode."
1093 (rcirc-clean-up-buffer "Changed major mode"))
1094
1095(defun rcirc-clean-up-buffer (reason)
adf794e4
EZ
1096 (let ((buffer (current-buffer)))
1097 (rcirc-clear-activity buffer)
a2524d26 1098 (when (and (rcirc-buffer-process)
488086f4 1099 (rcirc--connection-open-p (rcirc-buffer-process)))
a2524d26
EZ
1100 (with-rcirc-server-buffer
1101 (setq rcirc-buffer-alist
1102 (rassq-delete-all buffer rcirc-buffer-alist)))
adf794e4 1103 (rcirc-update-short-buffer-names)
bd43c990 1104 (if (rcirc-channel-p rcirc-target)
a2524d26
EZ
1105 (rcirc-send-string (rcirc-buffer-process)
1106 (concat "PART " rcirc-target " :" reason))
adf794e4 1107 (when rcirc-target
a2524d26
EZ
1108 (rcirc-remove-nick-channel (rcirc-buffer-process)
1109 (rcirc-buffer-nick)
195eca78
SM
1110 rcirc-target))))
1111 (setq rcirc-target nil)))
adf794e4 1112
adf794e4
EZ
1113(defun rcirc-generate-new-buffer-name (process target)
1114 "Return a buffer name based on PROCESS and TARGET.
2e398771 1115This is used for the initial name given to IRC buffers."
195eca78
SM
1116 (substring-no-properties
1117 (if target
1118 (concat target "@" (process-name process))
1119 (concat "*" (process-name process) "*"))))
bd43c990 1120
adf794e4 1121(defun rcirc-get-buffer (process target &optional server)
bd43c990 1122 "Return the buffer associated with the PROCESS and TARGET.
adf794e4 1123
adf794e4
EZ
1124If optional argument SERVER is non-nil, return the server buffer
1125if there is no existing buffer for TARGET, otherwise return nil."
1126 (with-rcirc-process-buffer process
1127 (if (null target)
1128 (current-buffer)
1129 (let ((buffer (cdr (assoc-string target rcirc-buffer-alist t))))
1130 (or buffer (when server (current-buffer)))))))
bd43c990
RS
1131
1132(defun rcirc-get-buffer-create (process target)
adf794e4
EZ
1133 "Return the buffer associated with the PROCESS and TARGET.
1134Create the buffer if it doesn't exist."
1135 (let ((buffer (rcirc-get-buffer process target)))
a2524d26 1136 (if (and buffer (buffer-live-p buffer))
2fbed782 1137 (with-current-buffer buffer
db58efbf 1138 (when (not rcirc-target)
2fbed782 1139 (setq rcirc-target target))
db58efbf 1140 buffer)
195eca78
SM
1141 ;; create the buffer
1142 (with-rcirc-process-buffer process
1143 (let ((new-buffer (get-buffer-create
1144 (rcirc-generate-new-buffer-name process target))))
1145 (with-current-buffer new-buffer
a0a5c583 1146 (rcirc-mode process target)
aebf69c8 1147 (rcirc-put-nick-channel process (rcirc-nick process) target
a0a5c583 1148 rcirc-current-line))
195eca78 1149 new-buffer)))))
bd43c990
RS
1150
1151(defun rcirc-send-input ()
1152 "Send input to target associated with the current buffer."
1153 (interactive)
53f831f3
AS
1154 (if (< (point) rcirc-prompt-end-marker)
1155 ;; copy the line down to the input area
1156 (progn
1157 (forward-line 0)
1158 (let ((start (if (eq (point) (point-min))
1159 (point)
1160 (if (get-text-property (1- (point)) 'hard)
1161 (point)
1162 (previous-single-property-change (point) 'hard))))
1163 (end (next-single-property-change (1+ (point)) 'hard)))
1164 (goto-char (point-max))
1165 (insert (replace-regexp-in-string
1166 "\n\\s-+" " "
1167 (buffer-substring-no-properties start end)))))
1168 ;; process input
1169 (goto-char (point-max))
a2524d26
EZ
1170 (when (not (equal 0 (- (point) rcirc-prompt-end-marker)))
1171 ;; delete a trailing newline
1172 (when (eq (point) (point-at-bol))
d355a0b7 1173 (delete-char -1))
a2524d26
EZ
1174 (let ((input (buffer-substring-no-properties
1175 rcirc-prompt-end-marker (point))))
1176 (dolist (line (split-string input "\n"))
1177 (rcirc-process-input-line line))
1178 ;; add to input-ring
1179 (save-excursion
1180 (ring-insert rcirc-input-ring input)
1181 (setq rcirc-input-ring-index 0))))))
1182
195eca78
SM
1183(defun rcirc-fill-paragraph (&optional arg)
1184 (interactive "p")
1185 (when (> (point) rcirc-prompt-end-marker)
1186 (save-restriction
1187 (narrow-to-region rcirc-prompt-end-marker (point-max))
1188 (let ((fill-column rcirc-max-message-length))
1189 (fill-region (point-min) (point-max))))))
1190
a2524d26 1191(defun rcirc-process-input-line (line)
db58efbf
EZ
1192 (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line)
1193 (rcirc-process-command (match-string 1 line)
1194 (match-string 2 line)
1195 line)
1196 (rcirc-process-message line)))
1197
1198(defun rcirc-process-message (line)
1199 (if (not rcirc-target)
a2524d26 1200 (message "Not joined (no target)")
db58efbf 1201 (delete-region rcirc-prompt-end-marker (point))
a2524d26
EZ
1202 (rcirc-send-message (rcirc-buffer-process) rcirc-target line)
1203 (setq rcirc-last-post-time (current-time))))
db58efbf
EZ
1204
1205(defun rcirc-process-command (command args line)
1206 (if (eq (aref command 0) ?/)
1207 ;; "//text" will send "/text" as a message
1208 (rcirc-process-message (substring line 1))
a2524d26
EZ
1209 (let ((fun (intern-soft (concat "rcirc-cmd-" command)))
1210 (process (rcirc-buffer-process)))
db58efbf
EZ
1211 (newline)
1212 (with-current-buffer (current-buffer)
1213 (delete-region rcirc-prompt-end-marker (point))
1214 (if (string= command "me")
a2524d26 1215 (rcirc-print process (rcirc-buffer-nick)
db58efbf 1216 "ACTION" rcirc-target args)
a2524d26 1217 (rcirc-print process (rcirc-buffer-nick)
db58efbf
EZ
1218 "COMMAND" rcirc-target line))
1219 (set-marker rcirc-prompt-end-marker (point))
1220 (if (fboundp fun)
a2524d26
EZ
1221 (funcall fun args process rcirc-target)
1222 (rcirc-send-string process
f8db61b2 1223 (concat command " :" args)))))))
db58efbf 1224
bd43c990 1225(defvar rcirc-parent-buffer nil)
488086f4
SM
1226(make-variable-buffer-local 'rcirc-parent-buffer)
1227(put 'rcirc-parent-buffer 'permanent-local t)
bd43c990
RS
1228(defvar rcirc-window-configuration nil)
1229(defun rcirc-edit-multiline ()
1230 "Move current edit to a dedicated buffer."
1231 (interactive)
1232 (let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
1233 (goto-char (point-max))
aebf69c8 1234 (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker
a0a5c583 1235 (point)))
a2524d26 1236 (parent (buffer-name)))
bd43c990
RS
1237 (delete-region rcirc-prompt-end-marker (point))
1238 (setq rcirc-window-configuration (current-window-configuration))
1239 (pop-to-buffer (concat "*multiline " parent "*"))
a2524d26
EZ
1240 (funcall rcirc-multiline-major-mode)
1241 (rcirc-multiline-minor-mode 1)
bd43c990 1242 (setq rcirc-parent-buffer parent)
bd43c990 1243 (insert text)
db58efbf
EZ
1244 (and (> pos 0) (goto-char pos))
1245 (message "Type C-c C-c to return text to %s, or C-c C-k to cancel" parent))))
bd43c990 1246
b016851c
SM
1247(defvar rcirc-multiline-minor-mode-map
1248 (let ((map (make-sparse-keymap)))
1249 (define-key map (kbd "C-c C-c") 'rcirc-multiline-minor-submit)
1250 (define-key map (kbd "C-x C-s") 'rcirc-multiline-minor-submit)
1251 (define-key map (kbd "C-c C-k") 'rcirc-multiline-minor-cancel)
1252 (define-key map (kbd "ESC ESC ESC") 'rcirc-multiline-minor-cancel)
1253 map)
a2524d26 1254 "Keymap for multiline mode in rcirc.")
a2524d26
EZ
1255
1256(define-minor-mode rcirc-multiline-minor-mode
1257 "Minor mode for editing multiple lines in rcirc."
1258 :init-value nil
1259 :lighter " rcirc-mline"
1260 :keymap rcirc-multiline-minor-mode-map
1261 :global nil
1262 :group 'rcirc
02f47e86 1263 (setq fill-column rcirc-max-message-length))
a2524d26
EZ
1264
1265(defun rcirc-multiline-minor-submit ()
bd43c990
RS
1266 "Send the text in buffer back to parent buffer."
1267 (interactive)
adf794e4 1268 (untabify (point-min) (point-max))
bd43c990
RS
1269 (let ((text (buffer-substring (point-min) (point-max)))
1270 (buffer (current-buffer))
1271 (pos (point)))
1272 (set-buffer rcirc-parent-buffer)
1273 (goto-char (point-max))
1274 (insert text)
bd43c990 1275 (kill-buffer buffer)
adf794e4
EZ
1276 (set-window-configuration rcirc-window-configuration)
1277 (goto-char (+ rcirc-prompt-end-marker (1- pos)))))
bd43c990 1278
a2524d26 1279(defun rcirc-multiline-minor-cancel ()
bd43c990
RS
1280 "Cancel the multiline edit."
1281 (interactive)
bd43c990
RS
1282 (kill-buffer (current-buffer))
1283 (set-window-configuration rcirc-window-configuration))
1284
2fbed782 1285(defun rcirc-any-buffer (process)
adf794e4 1286 "Return a buffer for PROCESS, either the one selected or the process buffer."
2fbed782
EZ
1287 (if rcirc-always-use-server-buffer-flag
1288 (process-buffer process)
1289 (let ((buffer (window-buffer (selected-window))))
1290 (if (and buffer
1291 (with-current-buffer buffer
1292 (and (eq major-mode 'rcirc-mode)
a2524d26 1293 (eq (rcirc-buffer-process) process))))
2fbed782
EZ
1294 buffer
1295 (process-buffer process)))))
bd43c990 1296
324e4da7 1297(defcustom rcirc-response-formats
195eca78
SM
1298 '(("PRIVMSG" . "<%N> %m")
1299 ("NOTICE" . "-%N- %m")
1300 ("ACTION" . "[%N %m]")
1301 ("COMMAND" . "%m")
1302 ("ERROR" . "%fw!!! %m")
1303 (t . "%fp*** %fs%n %r %m"))
324e4da7
MB
1304 "An alist of formats used for printing responses.
1305The format is looked up using the response-type as a key;
1306if no match is found, the default entry (with a key of `t') is used.
1307
1308The entry's value part should be a string, which is inserted with
1309the of the following escape sequences replaced by the described values:
1310
1311 %m The message text
2fbed782
EZ
1312 %n The sender's nick
1313 %N The sender's nick (with face `rcirc-my-nick' or `rcirc-other-nick')
324e4da7 1314 %r The response-type
324e4da7
MB
1315 %t The target
1316 %fw Following text uses the face `font-lock-warning-face'
1317 %fp Following text uses the face `rcirc-server-prefix'
1318 %fs Following text uses the face `rcirc-server'
1319 %f[FACE] Following text uses the face FACE
3715419e 1320 %f- Following text uses the default face
a2524d26 1321 %% A literal `%' character"
324e4da7
MB
1322 :type '(alist :key-type (choice (string :tag "Type")
1323 (const :tag "Default" t))
1324 :value-type string)
1325 :group 'rcirc)
1326
0ffab1eb 1327(defcustom rcirc-omit-responses
a0a5c583 1328 '("JOIN" "PART" "QUIT" "NICK")
195eca78
SM
1329 "Responses which will be hidden when `rcirc-omit-mode' is enabled."
1330 :type '(repeat string)
1331 :group 'rcirc)
1332
bd43c990 1333(defun rcirc-format-response-string (process sender response target text)
324e4da7
MB
1334 "Return a nicely-formatted response string, incorporating TEXT
1335\(and perhaps other arguments). The specific formatting used
1336is found by looking up RESPONSE in `rcirc-response-formats'."
195eca78
SM
1337 (with-temp-buffer
1338 (insert (or (cdr (assoc response rcirc-response-formats))
1339 (cdr (assq t rcirc-response-formats))))
1340 (goto-char (point-min))
1341 (let ((start (point-min))
1342 (sender (if (or (not sender)
1343 (string= (rcirc-server-name process) sender))
1344 ""
1345 sender))
1346 face)
1347 (while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t)
1348 (rcirc-add-face start (match-beginning 0) face)
1349 (setq start (match-beginning 0))
1350 (replace-match
1351 (case (aref (match-string 1) 0)
1352 (?f (setq face
1353 (case (string-to-char (match-string 3))
1354 (?w 'font-lock-warning-face)
1355 (?p 'rcirc-server-prefix)
1356 (?s 'rcirc-server)
1357 (t nil)))
1358 "")
1359 (?n sender)
1360 (?N (let ((my-nick (rcirc-nick process)))
1361 (save-match-data
1362 (with-syntax-table rcirc-nick-syntax-table
1363 (rcirc-facify sender
1364 (cond ((string= sender my-nick)
1365 'rcirc-my-nick)
1366 ((and rcirc-bright-nicks
0ffab1eb 1367 (string-match
195eca78
SM
1368 (regexp-opt rcirc-bright-nicks
1369 'words)
1370 sender))
1371 'rcirc-bright-nick)
1372 ((and rcirc-dim-nicks
1373 (string-match
1374 (regexp-opt rcirc-dim-nicks
1375 'words)
1376 sender))
1377 'rcirc-dim-nick)
1378 (t
1379 'rcirc-other-nick)))))))
1380 (?m (propertize text 'rcirc-text text))
1381 (?r response)
1382 (?t (or target ""))
1383 (t (concat "UNKNOWN CODE:" (match-string 0))))
1384 t t nil 0)
1385 (rcirc-add-face (match-beginning 0) (match-end 0) face))
1386 (rcirc-add-face start (match-beginning 0) face))
1387 (buffer-substring (point-min) (point-max))))
bd43c990 1388
db58efbf
EZ
1389(defun rcirc-target-buffer (process sender response target text)
1390 "Return a buffer to print the server response."
1391 (assert (not (bufferp target)))
1392 (with-rcirc-process-buffer process
1393 (cond ((not target)
2fbed782 1394 (rcirc-any-buffer process))
db58efbf
EZ
1395 ((not (rcirc-channel-p target))
1396 ;; message from another user
195eca78
SM
1397 (if (or (string= response "PRIVMSG")
1398 (string= response "ACTION"))
db58efbf
EZ
1399 (rcirc-get-buffer-create process (if (string= sender rcirc-nick)
1400 target
1401 sender))
1402 (rcirc-get-buffer process target t)))
1403 ((or (rcirc-get-buffer process target)
2fbed782 1404 (rcirc-any-buffer process))))))
db58efbf 1405
f8db61b2
EZ
1406(defvar rcirc-activity-types nil)
1407(make-variable-buffer-local 'rcirc-activity-types)
a2524d26
EZ
1408(defvar rcirc-last-sender nil)
1409(make-variable-buffer-local 'rcirc-last-sender)
7faa3f8c 1410
a0a5c583
GM
1411(defcustom rcirc-omit-threshold 100
1412 "Number of lines since last activity from a nick before `rcirc-omit-responses' are omitted."
1413 :type 'integer
1414 :group 'rcirc)
1415
8f10c937
DD
1416(defcustom rcirc-log-process-buffers nil
1417 "Non-nil if rcirc process buffers should be logged to disk."
1418 :group 'rcirc
1419 :type 'boolean
1420 :version "24.1")
1421
683b7dc6 1422(defun rcirc-last-quit-line (process nick target)
a0a5c583
GM
1423 "Return the line number where NICK left TARGET.
1424Returns nil if the information is not recorded."
683b7dc6 1425 (let ((chanbuf (rcirc-get-buffer process target)))
a0a5c583
GM
1426 (when chanbuf
1427 (cdr (assoc-string nick (with-current-buffer chanbuf
1428 rcirc-recent-quit-alist))))))
1429
683b7dc6 1430(defun rcirc-last-line (process nick target)
a0a5c583 1431 "Return the line from the last activity from NICK in TARGET."
683b7dc6 1432 (let* ((chanbuf (rcirc-get-buffer process target))
a0a5c583
GM
1433 (line (or (cdr (assoc-string target
1434 (gethash nick (with-rcirc-server-buffer
1435 rcirc-nick-table)) t))
683b7dc6 1436 (rcirc-last-quit-line process nick target))))
a0a5c583
GM
1437 (if line
1438 line
1439 ;;(message "line is nil for %s in %s" nick target)
1440 nil)))
1441
683b7dc6 1442(defun rcirc-elapsed-lines (process nick target)
a0a5c583 1443 "Return the number of lines since activity from NICK in TARGET."
683b7dc6 1444 (let ((last-activity-line (rcirc-last-line process nick target)))
a0a5c583
GM
1445 (when (and last-activity-line
1446 (> last-activity-line 0))
1447 (- rcirc-current-line last-activity-line))))
1448
729f1525
DN
1449(defvar rcirc-markup-text-functions
1450 '(rcirc-markup-attributes
1451 rcirc-markup-my-nick
1452 rcirc-markup-urls
1453 rcirc-markup-keywords
683b7dc6 1454 rcirc-markup-bright-nicks)
729f1525
DN
1455
1456 "List of functions used to manipulate text before it is printed.
1457
683b7dc6
GM
1458Each function takes two arguments, SENDER, and RESPONSE. The
1459buffer is narrowed with the text to be printed and the point is
1460at the beginning of the `rcirc-text' propertized text.")
729f1525 1461
bd43c990
RS
1462(defun rcirc-print (process sender response target text &optional activity)
1463 "Print TEXT in the buffer associated with TARGET.
1464Format based on SENDER and RESPONSE. If ACTIVITY is non-nil,
1465record activity."
a2524d26 1466 (or text (setq text ""))
0ffab1eb
TTN
1467 (unless (and (or (member sender rcirc-ignore-list)
1468 (member (with-syntax-table rcirc-nick-syntax-table
1469 (when (string-match "^\\([^/]\\w*\\)[:,]" text)
1470 (match-string 1 text)))
1471 rcirc-ignore-list))
a0a5c583 1472 ;; do not ignore if we sent the message
aebf69c8 1473 (not (string= sender (rcirc-nick process))))
db58efbf 1474 (let* ((buffer (rcirc-target-buffer process sender response target text))
2c8abe90
AS
1475 (inhibit-read-only t))
1476 (with-current-buffer buffer
1477 (let ((moving (= (point) rcirc-prompt-end-marker))
1478 (old-point (point-marker))
1479 (fill-start (marker-position rcirc-prompt-start-marker)))
1480
108bf785 1481 (setq text (decode-coding-string text rcirc-decode-coding-system))
2c8abe90 1482 (unless (string= sender (rcirc-nick process))
2c8abe90
AS
1483 ;; mark the line with overlay arrow
1484 (unless (or (marker-position overlay-arrow-position)
195eca78
SM
1485 (get-buffer-window (current-buffer))
1486 (member response rcirc-omit-responses))
2c8abe90
AS
1487 (set-marker overlay-arrow-position
1488 (marker-position rcirc-prompt-start-marker))))
1489
1490 ;; temporarily set the marker insertion-type because
1491 ;; insert-before-markers results in hidden text in new buffers
1492 (goto-char rcirc-prompt-start-marker)
1493 (set-marker-insertion-type rcirc-prompt-start-marker t)
1494 (set-marker-insertion-type rcirc-prompt-end-marker t)
324e4da7 1495
195eca78 1496 (let ((start (point)))
0ffab1eb 1497 (insert (rcirc-format-response-string process sender response nil
195eca78
SM
1498 text)
1499 (propertize "\n" 'hard t))
1500
1501 ;; squeeze spaces out of text before rcirc-text
0ffab1eb 1502 (fill-region fill-start
195eca78
SM
1503 (1- (or (next-single-property-change fill-start
1504 'rcirc-text)
1505 rcirc-prompt-end-marker)))
1506
1507 ;; run markup functions
1508 (save-excursion
1509 (save-restriction
1510 (narrow-to-region start rcirc-prompt-start-marker)
1511 (goto-char (or (next-single-property-change start 'rcirc-text)
1512 (point)))
1513 (when (rcirc-buffer-process)
1514 (save-excursion (rcirc-markup-timestamp sender response))
1515 (dolist (fn rcirc-markup-text-functions)
1516 (save-excursion (funcall fn sender response)))
a0a5c583
GM
1517 (when rcirc-fill-flag
1518 (save-excursion (rcirc-markup-fill sender response))))
195eca78
SM
1519
1520 (when rcirc-read-only-flag
1521 (add-text-properties (point-min) (point-max)
1522 '(read-only t front-sticky t))))
1523 ;; make text omittable
683b7dc6
GM
1524 (let ((last-activity-lines (rcirc-elapsed-lines process sender target)))
1525 (if (and (not (string= (rcirc-nick process) sender))
1526 (member response rcirc-omit-responses)
1527 (or (not last-activity-lines)
1528 (< rcirc-omit-threshold last-activity-lines)))
1529 (put-text-property (1- start) (1- rcirc-prompt-start-marker)
1530 'invisible 'rcirc-omit)
1531 ;; otherwise increment the line count
1532 (setq rcirc-current-line (1+ rcirc-current-line))))))
195eca78
SM
1533
1534 (set-marker-insertion-type rcirc-prompt-start-marker nil)
1535 (set-marker-insertion-type rcirc-prompt-end-marker nil)
2c8abe90
AS
1536
1537 ;; truncate buffer if it is very long
1538 (save-excursion
1539 (when (and rcirc-buffer-maximum-lines
1540 (> rcirc-buffer-maximum-lines 0)
1541 (= (forward-line (- rcirc-buffer-maximum-lines)) 0))
1542 (delete-region (point-min) (point))))
1543
1544 ;; set the window point for buffers show in windows
1545 (walk-windows (lambda (w)
d40ac716
CY
1546 (when (and (not (eq (selected-window) w))
1547 (eq (current-buffer)
1548 (window-buffer w))
1549 (>= (window-point w)
1550 rcirc-prompt-end-marker))
195eca78 1551 (set-window-point w (point-max))))
2c8abe90
AS
1552 nil t)
1553
1554 ;; restore the point
1555 (goto-char (if moving rcirc-prompt-end-marker old-point))
1556
195eca78 1557 ;; keep window on bottom line if it was already there
d40ac716
CY
1558 (when rcirc-scroll-show-maximum-output
1559 (walk-windows (lambda (w)
1560 (when (eq (window-buffer w) (current-buffer))
1561 (with-current-buffer (window-buffer w)
1562 (when (eq major-mode 'rcirc-mode)
1563 (with-selected-window w
195eca78
SM
1564 (when (<= (- (window-height)
1565 (count-screen-lines (window-point)
1566 (window-start))
d40ac716
CY
1567 1)
1568 0)
1569 (recenter -1)))))))
195eca78 1570 nil t))
d40ac716 1571
2c8abe90
AS
1572 ;; flush undo (can we do something smarter here?)
1573 (buffer-disable-undo)
1574 (buffer-enable-undo))
1575
1576 ;; record modeline activity
f8db61b2
EZ
1577 (when (and activity
1578 (not rcirc-ignore-buffer-activity-flag)
1579 (not (and rcirc-dim-nicks sender
195eca78
SM
1580 (string-match (regexp-opt rcirc-dim-nicks) sender)
1581 (rcirc-channel-p target))))
f8db61b2
EZ
1582 (rcirc-record-activity (current-buffer)
1583 (when (not (rcirc-channel-p rcirc-target))
1584 'nick)))
2c8abe90 1585
8f10c937
DD
1586 (when (and rcirc-log-flag
1587 (or target
1588 rcirc-log-process-buffers))
195eca78
SM
1589 (rcirc-log process sender response target text))
1590
2c8abe90
AS
1591 (sit-for 0) ; displayed text before hook
1592 (run-hook-with-args 'rcirc-print-hooks
1593 process sender response target text)))))
bd43c990 1594
8f10c937
DD
1595(defun rcirc-generate-log-filename (process target)
1596 (if target
1597 (rcirc-generate-new-buffer-name process target)
1598 (process-name process)))
1599
1600(defcustom rcirc-log-filename-function 'rcirc-generate-log-filename
aacde24f
MB
1601 "A function to generate the filename used by rcirc's logging facility.
1602
1603It is called with two arguments, PROCESS and TARGET (see
1604`rcirc-generate-new-buffer-name' for their meaning), and should
1605return the filename, or nil if no logging is desired for this
1606session.
1607
1608If the returned filename is absolute (`file-name-absolute-p'
186ecaf1
DD
1609returns t), then it is used as-is, otherwise the resulting file
1610is put into `rcirc-log-directory'.
1611
1612The filename is then cleaned using `convert-standard-filename' to
1613guarantee valid filenames for the current OS."
aacde24f
MB
1614 :group 'rcirc
1615 :type 'function)
1616
195eca78
SM
1617(defun rcirc-log (process sender response target text)
1618 "Record line in `rcirc-log', to be later written to disk."
aacde24f
MB
1619 (let ((filename (funcall rcirc-log-filename-function process target)))
1620 (unless (null filename)
1621 (let ((cell (assoc-string filename rcirc-log-alist))
1622 (line (concat (format-time-string rcirc-time-format)
1623 (substring-no-properties
1624 (rcirc-format-response-string process sender
1625 response target text))
1626 "\n")))
1627 (if cell
1628 (setcdr cell (concat (cdr cell) line))
1629 (setq rcirc-log-alist
1630 (cons (cons filename line) rcirc-log-alist)))))))
195eca78
SM
1631
1632(defun rcirc-log-write ()
1633 "Flush `rcirc-log-alist' data to disk.
1634
aacde24f
MB
1635Log data is written to `rcirc-log-directory', except for
1636log-files with absolute names (see `rcirc-log-filename-function')."
195eca78 1637 (dolist (cell rcirc-log-alist)
186ecaf1
DD
1638 (let ((filename (convert-standard-filename
1639 (expand-file-name (car cell)
1640 rcirc-log-directory)))
aacde24f
MB
1641 (coding-system-for-write 'utf-8))
1642 (make-directory (file-name-directory filename) t)
1643 (with-temp-buffer
1644 (insert (cdr cell))
1645 (write-region (point-min) (point-max) filename t 'quiet))))
195eca78 1646 (setq rcirc-log-alist nil))
bd43c990 1647
d7a0fd6f
GM
1648(defun rcirc-view-log-file ()
1649 "View logfile corresponding to the current buffer."
1650 (interactive)
aebf69c8
DD
1651 (find-file-other-window
1652 (expand-file-name (funcall rcirc-log-filename-function
d7a0fd6f
GM
1653 (rcirc-buffer-process) rcirc-target)
1654 rcirc-log-directory)))
1655
bd43c990
RS
1656(defun rcirc-join-channels (process channels)
1657 "Join CHANNELS."
1658 (save-window-excursion
db58efbf
EZ
1659 (dolist (channel channels)
1660 (with-rcirc-process-buffer process
1661 (rcirc-cmd-join channel process)))))
bd43c990
RS
1662\f
1663;;; nick management
8216fbaf 1664(defvar rcirc-nick-prefix-chars "~&@%+")
bd43c990
RS
1665(defun rcirc-user-nick (user)
1666 "Return the nick from USER. Remove any non-nick junk."
db58efbf 1667 (save-match-data
8216fbaf
EZ
1668 (if (string-match (concat "^[" rcirc-nick-prefix-chars
1669 "]?\\([^! ]+\\)!?") (or user ""))
db58efbf
EZ
1670 (match-string 1 user)
1671 user)))
bd43c990 1672
bd43c990
RS
1673(defun rcirc-nick-channels (process nick)
1674 "Return list of channels for NICK."
db58efbf
EZ
1675 (with-rcirc-process-buffer process
1676 (mapcar (lambda (x) (car x))
1677 (gethash nick rcirc-nick-table))))
bd43c990 1678
a0a5c583
GM
1679(defun rcirc-put-nick-channel (process nick channel &optional line)
1680 "Add CHANNEL to list associated with NICK.
1681Update the associated linestamp if LINE is non-nil.
1682
1683If the record doesn't exist, and LINE is nil, set the linestamp
1684to zero."
2fbed782
EZ
1685 (let ((nick (rcirc-user-nick nick)))
1686 (with-rcirc-process-buffer process
1687 (let* ((chans (gethash nick rcirc-nick-table))
1688 (record (assoc-string channel chans t)))
1689 (if record
a0a5c583
GM
1690 (when line (setcdr record line))
1691 (puthash nick (cons (cons channel (or line 0))
2fbed782
EZ
1692 chans)
1693 rcirc-nick-table))))))
bd43c990
RS
1694
1695(defun rcirc-nick-remove (process nick)
1696 "Remove NICK from table."
adf794e4 1697 (with-rcirc-process-buffer process
bd43c990
RS
1698 (remhash nick rcirc-nick-table)))
1699
1700(defun rcirc-remove-nick-channel (process nick channel)
1701 "Remove the CHANNEL from list associated with NICK."
adf794e4 1702 (with-rcirc-process-buffer process
db58efbf 1703 (let* ((chans (gethash nick rcirc-nick-table))
adf794e4
EZ
1704 (newchans
1705 ;; instead of assoc-string-delete-all:
1706 (let ((record (assoc-string channel chans t)))
1707 (when record
1708 (setcar record 'delete)
1709 (assq-delete-all 'delete chans)))))
bd43c990
RS
1710 (if newchans
1711 (puthash nick newchans rcirc-nick-table)
1712 (remhash nick rcirc-nick-table)))))
1713
a2524d26
EZ
1714(defun rcirc-channel-nicks (process target)
1715 "Return the list of nicks associated with TARGET sorted by last activity."
1716 (when target
1717 (if (rcirc-channel-p target)
1718 (with-rcirc-process-buffer process
1719 (let (nicks)
1720 (maphash
1721 (lambda (k v)
1722 (let ((record (assoc-string target v t)))
1723 (if record
1724 (setq nicks (cons (cons k (cdr record)) nicks)))))
1725 rcirc-nick-table)
1726 (mapcar (lambda (x) (car x))
a0a5c583
GM
1727 (sort nicks (lambda (x y)
1728 (let ((lx (or (cdr x) 0))
1729 (ly (or (cdr y) 0)))
1730 (< ly lx)))))))
a2524d26 1731 (list target))))
2c8abe90
AS
1732
1733(defun rcirc-ignore-update-automatic (nick)
2e398771
JB
1734 "Remove NICK from `rcirc-ignore-list'
1735if NICK is also on `rcirc-ignore-list-automatic'."
2c8abe90
AS
1736 (when (member nick rcirc-ignore-list-automatic)
1737 (setq rcirc-ignore-list-automatic
1738 (delete nick rcirc-ignore-list-automatic)
1739 rcirc-ignore-list
1740 (delete nick rcirc-ignore-list))))
bd43c990 1741\f
c62bf05a 1742(defun rcirc-nickname< (s1 s2)
44ea155d
CY
1743 "Return t if IRC nickname S1 is less than S2, and nil otherwise.
1744Operator nicknames (@) are considered less than voiced
1745nicknames (+). Any other nicknames are greater than voiced
1746nicknames. The comparison is case-insensitive."
c62bf05a
DD
1747 (setq s1 (downcase s1)
1748 s2 (downcase s2))
1749 (let* ((s1-op (eq ?@ (string-to-char s1)))
1750 (s2-op (eq ?@ (string-to-char s2))))
1751 (if s1-op
1752 (if s2-op
1753 (string< (substring s1 1) (substring s2 1))
1754 t)
1755 (if s2-op
1756 nil
1757 (string< s1 s2)))))
1758
1759(defun rcirc-sort-nicknames-join (input sep)
44ea155d 1760 "Return a string of sorted nicknames.
c62bf05a 1761INPUT is a string containing nicknames separated by SEP.
44ea155d 1762This function does not alter the INPUT string."
a91dedc4
SM
1763 (let* ((parts (split-string input sep t))
1764 (sorted (sort parts 'rcirc-nickname<)))
1765 (mapconcat 'identity sorted sep)))
c62bf05a 1766\f
bd43c990 1767;;; activity tracking
b016851c
SM
1768(defvar rcirc-track-minor-mode-map
1769 (let ((map (make-sparse-keymap)))
1770 (define-key map (kbd "C-c C-@") 'rcirc-next-active-buffer)
1771 (define-key map (kbd "C-c C-SPC") 'rcirc-next-active-buffer)
1772 map)
db58efbf
EZ
1773 "Keymap for rcirc track minor mode.")
1774
e8f10ddb 1775;;;###autoload
db58efbf
EZ
1776(define-minor-mode rcirc-track-minor-mode
1777 "Global minor mode for tracking activity in rcirc buffers."
1778 :init-value nil
1779 :lighter ""
1780 :keymap rcirc-track-minor-mode-map
1781 :global t
1782 :group 'rcirc
1783 (or global-mode-string (setq global-mode-string '("")))
1784 ;; toggle the mode-line channel indicator
1785 (if rcirc-track-minor-mode
a2524d26
EZ
1786 (progn
1787 (and (not (memq 'rcirc-activity-string global-mode-string))
1788 (setq global-mode-string
1789 (append global-mode-string '(rcirc-activity-string))))
1790 (add-hook 'window-configuration-change-hook
1791 'rcirc-window-configuration-change))
92c4adc1 1792 (setq global-mode-string
a2524d26
EZ
1793 (delete 'rcirc-activity-string global-mode-string))
1794 (remove-hook 'window-configuration-change-hook
1795 'rcirc-window-configuration-change)))
db58efbf 1796
adf794e4 1797(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist)
bd43c990 1798 (setq minor-mode-alist
adf794e4 1799 (cons '(rcirc-ignore-buffer-activity-flag " Ignore") minor-mode-alist)))
a2524d26
EZ
1800(or (assq 'rcirc-low-priority-flag minor-mode-alist)
1801 (setq minor-mode-alist
1802 (cons '(rcirc-low-priority-flag " LowPri") minor-mode-alist)))
195eca78
SM
1803(or (assq 'rcirc-omit-mode minor-mode-alist)
1804 (setq minor-mode-alist
1805 (cons '(rcirc-omit-mode " Omit") minor-mode-alist)))
bd43c990 1806
db58efbf
EZ
1807(defun rcirc-toggle-ignore-buffer-activity ()
1808 "Toggle the value of `rcirc-ignore-buffer-activity-flag'."
1809 (interactive)
1810 (setq rcirc-ignore-buffer-activity-flag
1811 (not rcirc-ignore-buffer-activity-flag))
1812 (message (if rcirc-ignore-buffer-activity-flag
1813 "Ignore activity in this buffer"
1814 "Notice activity in this buffer"))
bd43c990
RS
1815 (force-mode-line-update))
1816
a2524d26 1817(defun rcirc-toggle-low-priority ()
02f47e86 1818 "Toggle the value of `rcirc-low-priority-flag'."
a2524d26
EZ
1819 (interactive)
1820 (setq rcirc-low-priority-flag
1821 (not rcirc-low-priority-flag))
1822 (message (if rcirc-low-priority-flag
1823 "Activity in this buffer is low priority"
1824 "Activity in this buffer is normal priority"))
1825 (force-mode-line-update))
1826
195eca78
SM
1827(defun rcirc-omit-mode ()
1828 "Toggle the Rcirc-Omit mode.
0ffab1eb 1829If enabled, \"uninteresting\" lines are not shown.
195eca78
SM
1830Uninteresting lines are those whose responses are listed in
1831`rcirc-omit-responses'."
1832 (interactive)
1833 (setq rcirc-omit-mode (not rcirc-omit-mode))
a0a5c583
GM
1834 (if rcirc-omit-mode
1835 (progn
1230c3cb 1836 (add-to-invisibility-spec '(rcirc-omit . nil))
a0a5c583 1837 (message "Rcirc-Omit mode enabled"))
1230c3cb 1838 (remove-from-invisibility-spec '(rcirc-omit . nil))
a0a5c583
GM
1839 (message "Rcirc-Omit mode disabled"))
1840 (recenter (when (> (point) rcirc-prompt-start-marker) -1)))
bd43c990
RS
1841
1842(defun rcirc-switch-to-server-buffer ()
1843 "Switch to the server buffer associated with current channel buffer."
1844 (interactive)
488086f4
SM
1845 (unless (buffer-live-p rcirc-server-buffer)
1846 (error "No such buffer"))
195eca78 1847 (switch-to-buffer rcirc-server-buffer))
bd43c990
RS
1848
1849(defun rcirc-jump-to-first-unread-line ()
1850 "Move the point to the first unread line in this buffer."
1851 (interactive)
195eca78
SM
1852 (if (marker-position overlay-arrow-position)
1853 (goto-char overlay-arrow-position)
1854 (message "No unread messages")))
1855
1856(defun rcirc-non-irc-buffer ()
1857 (let ((buflist (buffer-list))
1858 buffer)
1859 (while (and buflist (not buffer))
1860 (with-current-buffer (car buflist)
1861 (unless (or (eq major-mode 'rcirc-mode)
1862 (= ?\s (aref (buffer-name) 0)) ; internal buffers
1863 (get-buffer-window (current-buffer)))
1864 (setq buffer (current-buffer))))
1865 (setq buflist (cdr buflist)))
1866 buffer))
bd43c990
RS
1867
1868(defun rcirc-next-active-buffer (arg)
195eca78
SM
1869 "Switch to the next rcirc buffer with activity.
1870With prefix ARG, go to the next low priority buffer with activity."
a2524d26
EZ
1871 (interactive "P")
1872 (let* ((pair (rcirc-split-activity rcirc-activity))
1873 (lopri (car pair))
92c4adc1 1874 (hipri (cdr pair)))
a2524d26
EZ
1875 (if (or (and (not arg) hipri)
1876 (and arg lopri))
a0a5c583
GM
1877 (progn
1878 (switch-to-buffer (car (if arg lopri hipri)))
1879 (when (> (point) rcirc-prompt-start-marker)
1880 (recenter -1)))
a2524d26 1881 (if (eq major-mode 'rcirc-mode)
195eca78 1882 (switch-to-buffer (rcirc-non-irc-buffer))
274f1353
DK
1883 (message "%s" (concat
1884 "No IRC activity."
1885 (when lopri
1886 (concat
1887 " Type C-u "
1888 (key-description (this-command-keys))
1889 " for low priority activity."))))))))
bd43c990
RS
1890
1891(defvar rcirc-activity-hooks nil
1892 "Hook to be run when there is channel activity.
1893
1894Functions are called with a single argument, the buffer with the
1895activity. Only run if the buffer is not visible and
adf794e4 1896`rcirc-ignore-buffer-activity-flag' is non-nil.")
bd43c990 1897
a2524d26 1898(defun rcirc-record-activity (buffer &optional type)
bd43c990
RS
1899 "Record BUFFER activity with TYPE."
1900 (with-current-buffer buffer
195eca78
SM
1901 (let ((old-activity rcirc-activity)
1902 (old-types rcirc-activity-types))
1903 (when (not (get-buffer-window (current-buffer) t))
1904 (setq rcirc-activity
1905 (sort (add-to-list 'rcirc-activity (current-buffer))
1906 (lambda (b1 b2)
1907 (let ((t1 (with-current-buffer b1 rcirc-last-post-time))
1908 (t2 (with-current-buffer b2 rcirc-last-post-time)))
1909 (time-less-p t2 t1)))))
1910 (pushnew type rcirc-activity-types)
1911 (unless (and (equal rcirc-activity old-activity)
1912 (member type old-types))
1913 (rcirc-update-activity-string)))))
bd43c990
RS
1914 (run-hook-with-args 'rcirc-activity-hooks buffer))
1915
1916(defun rcirc-clear-activity (buffer)
1917 "Clear the BUFFER activity."
0ffab1eb 1918 (setq rcirc-activity (remove buffer rcirc-activity))
bd43c990 1919 (with-current-buffer buffer
f8db61b2 1920 (setq rcirc-activity-types nil)))
bd43c990 1921
195eca78
SM
1922(defun rcirc-clear-unread (buffer)
1923 "Erase the last read message arrow from BUFFER."
1924 (when (buffer-live-p buffer)
1925 (with-current-buffer buffer
1926 (set-marker overlay-arrow-position nil))))
1927
a2524d26
EZ
1928(defun rcirc-split-activity (activity)
1929 "Return a cons cell with ACTIVITY split into (lopri . hipri)."
1930 (let (lopri hipri)
1931 (dolist (buf rcirc-activity)
1932 (with-current-buffer buf
1933 (if (and rcirc-low-priority-flag
f8db61b2 1934 (not (member 'nick rcirc-activity-types)))
a2524d26
EZ
1935 (add-to-list 'lopri buf t)
1936 (add-to-list 'hipri buf t))))
1937 (cons lopri hipri)))
1938
195eca78
SM
1939(defvar rcirc-update-activity-string-hook nil
1940 "Hook run whenever the activity string is updated.")
1941
adf794e4 1942;; TODO: add mouse properties
bd43c990
RS
1943(defun rcirc-update-activity-string ()
1944 "Update mode-line string."
a2524d26
EZ
1945 (let* ((pair (rcirc-split-activity rcirc-activity))
1946 (lopri (car pair))
1947 (hipri (cdr pair)))
1948 (setq rcirc-activity-string
7faa3f8c 1949 (cond ((or hipri lopri)
195eca78 1950 (concat (and hipri "[")
7faa3f8c
MB
1951 (rcirc-activity-string hipri)
1952 (and hipri lopri ",")
1953 (and lopri
1954 (concat "("
1955 (rcirc-activity-string lopri)
1956 ")"))
195eca78 1957 (and hipri "]")))
7faa3f8c 1958 ((not (null (rcirc-process-list)))
195eca78
SM
1959 "[]")
1960 (t "[]")))
1961 (run-hooks 'rcirc-update-activity-string-hook)))
a2524d26
EZ
1962
1963(defun rcirc-activity-string (buffers)
1964 (mapconcat (lambda (b)
f8db61b2 1965 (let ((s (substring-no-properties (rcirc-short-buffer-name b))))
a2524d26 1966 (with-current-buffer b
f8db61b2
EZ
1967 (dolist (type rcirc-activity-types)
1968 (rcirc-add-face 0 (length s)
1969 (case type
82741a5e
CY
1970 (nick 'rcirc-track-nick)
1971 (keyword 'rcirc-track-keyword))
f8db61b2
EZ
1972 s)))
1973 s))
a2524d26 1974 buffers ","))
bd43c990
RS
1975
1976(defun rcirc-short-buffer-name (buffer)
1977 "Return a short name for BUFFER to use in the modeline indicator."
1978 (with-current-buffer buffer
adf794e4
EZ
1979 (or rcirc-short-buffer-name (buffer-name))))
1980
195eca78
SM
1981(defun rcirc-visible-buffers ()
1982 "Return a list of the visible buffers that are in rcirc-mode."
1983 (let (acc)
adf794e4 1984 (walk-windows (lambda (w)
195eca78
SM
1985 (with-current-buffer (window-buffer w)
1986 (when (eq major-mode 'rcirc-mode)
1987 (push (current-buffer) acc)))))
1988 acc))
1989
1990(defvar rcirc-visible-buffers nil)
1991(defun rcirc-window-configuration-change ()
1992 (unless (minibuffer-window-active-p (minibuffer-window))
1993 ;; delay this until command has finished to make sure window is
1994 ;; actually visible before clearing activity
1995 (add-hook 'post-command-hook 'rcirc-window-configuration-change-1)))
1996
1997(defun rcirc-window-configuration-change-1 ()
1998 ;; clear activity and overlay arrows
1999 (let* ((old-activity rcirc-activity)
2000 (hidden-buffers rcirc-visible-buffers))
2001
2002 (setq rcirc-visible-buffers (rcirc-visible-buffers))
2003
2004 (dolist (vbuf rcirc-visible-buffers)
2005 (setq hidden-buffers (delq vbuf hidden-buffers))
2006 ;; clear activity for all visible buffers
2007 (rcirc-clear-activity vbuf))
2008
2009 ;; clear unread arrow from recently hidden buffers
2010 (dolist (hbuf hidden-buffers)
2011 (rcirc-clear-unread hbuf))
2012
2013 ;; remove any killed buffers from list
2014 (setq rcirc-activity
2015 (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf))
2016 rcirc-activity)))
2017 ;; update the mode-line string
2018 (unless (equal old-activity rcirc-activity)
2019 (rcirc-update-activity-string)))
2020
2021 (remove-hook 'post-command-hook 'rcirc-window-configuration-change-1))
bd43c990
RS
2022
2023\f
adf794e4
EZ
2024;;; buffer name abbreviation
2025(defun rcirc-update-short-buffer-names ()
2026 (let ((bufalist
2027 (apply 'append (mapcar (lambda (process)
2028 (with-rcirc-process-buffer process
2029 rcirc-buffer-alist))
2030 (rcirc-process-list)))))
2031 (dolist (i (rcirc-abbreviate bufalist))
a2524d26
EZ
2032 (when (buffer-live-p (cdr i))
2033 (with-current-buffer (cdr i)
2034 (setq rcirc-short-buffer-name (car i)))))))
adf794e4
EZ
2035
2036(defun rcirc-abbreviate (pairs)
2037 (apply 'append (mapcar 'rcirc-rebuild-tree (rcirc-make-trees pairs))))
2038
2039(defun rcirc-rebuild-tree (tree &optional acc)
2040 (let ((ch (char-to-string (car tree))))
2041 (dolist (x (cdr tree))
2042 (if (listp x)
2043 (setq acc (append acc
2044 (mapcar (lambda (y)
2045 (cons (concat ch (car y))
2046 (cdr y)))
2047 (rcirc-rebuild-tree x))))
2048 (setq acc (cons (cons ch x) acc))))
2049 acc))
2050
2051(defun rcirc-make-trees (pairs)
2052 (let (alist)
2053 (mapc (lambda (pair)
2054 (if (consp pair)
2055 (let* ((str (car pair))
2056 (data (cdr pair))
2057 (char (unless (zerop (length str))
2058 (aref str 0)))
2059 (rest (unless (zerop (length str))
2060 (substring str 1)))
2061 (part (if char (assq char alist))))
2062 (if part
2063 ;; existing partition
2064 (setcdr part (cons (cons rest data) (cdr part)))
2065 ;; new partition
2066 (setq alist (cons (if char
2067 (list char (cons rest data))
2068 data)
2069 alist))))
2070 (setq alist (cons pair alist))))
2071 pairs)
2072 ;; recurse into cdrs of alist
2073 (mapc (lambda (x)
2074 (when (and (listp x) (listp (cadr x)))
2075 (setcdr x (if (> (length (cdr x)) 1)
2076 (rcirc-make-trees (cdr x))
2077 (setcdr x (list (cdadr x)))))))
2078 alist)))
2079\f
bd43c990
RS
2080;;; /commands these are called with 3 args: PROCESS, TARGET, which is
2081;; the current buffer/channel/user, and ARGS, which is a string
2082;; containing the text following the /cmd.
2083
adf794e4 2084(defmacro defun-rcirc-command (command argument docstring interactive-form
94c7243b 2085 &rest body)
bd43c990 2086 "Define a command."
94c7243b
LL
2087 `(progn
2088 (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))
2089 (defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
2090 (,@argument &optional process target)
2091 ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given"
2092 "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
2093 ,interactive-form
2094 (let ((process (or process (rcirc-buffer-process)))
2095 (target (or target rcirc-target)))
2096 ,@body))))
bd43c990
RS
2097
2098(defun-rcirc-command msg (message)
2099 "Send private MESSAGE to TARGET."
2100 (interactive "i")
2101 (if (null message)
2102 (progn
2103 (setq target (completing-read "Message nick: "
92c4adc1 2104 (with-rcirc-server-buffer
a2524d26 2105 rcirc-nick-table)))
bd43c990
RS
2106 (when (> (length target) 0)
2107 (setq message (read-string (format "Message %s: " target)))
2108 (when (> (length message) 0)
2109 (rcirc-send-message process target message))))
2110 (if (not (string-match "\\([^ ]+\\) \\(.+\\)" message))
2111 (message "Not enough args, or something.")
2112 (setq target (match-string 1 message)
2113 message (match-string 2 message))
2114 (rcirc-send-message process target message))))
2115
2116(defun-rcirc-command query (nick)
2117 "Open a private chat buffer to NICK."
2118 (interactive (list (completing-read "Query nick: "
a2524d26 2119 (with-rcirc-server-buffer rcirc-nick-table))))
adf794e4
EZ
2120 (let ((existing-buffer (rcirc-get-buffer process nick)))
2121 (switch-to-buffer (or existing-buffer
2122 (rcirc-get-buffer-create process nick)))
2123 (when (not existing-buffer)
bd43c990
RS
2124 (rcirc-cmd-whois nick))))
2125
e0e36cac
DD
2126(defun-rcirc-command join (channels)
2127 "Join CHANNELS.
2128CHANNELS is a comma- or space-separated string of channel names."
2129 (interactive "sJoin channels: ")
2130 (let* ((split-channels (split-string channels "[ ,]" t))
2131 (buffers (mapcar (lambda (ch)
2132 (rcirc-get-buffer-create process ch))
fcd8ed1d
DD
2133 split-channels))
2134 (channels (mapconcat 'identity split-channels ",")))
e0e36cac 2135 (rcirc-send-string process (concat "JOIN " channels))
bd43c990 2136 (when (not (eq (selected-window) (minibuffer-window)))
e0e36cac
DD
2137 (dolist (b buffers) ;; order the new channel buffers in the buffer list
2138 (switch-to-buffer b)))))
bd43c990 2139
195eca78 2140;; TODO: /part #channel reason, or consider removing #channel altogether
bd43c990
RS
2141(defun-rcirc-command part (channel)
2142 "Part CHANNEL."
2143 (interactive "sPart channel: ")
2144 (let ((channel (if (> (length channel) 0) channel target)))
adf794e4 2145 (rcirc-send-string process (concat "PART " channel " :" rcirc-id-string))))
bd43c990
RS
2146
2147(defun-rcirc-command quit (reason)
2148 "Send a quit message to server with REASON."
2149 (interactive "sQuit reason: ")
adf794e4
EZ
2150 (rcirc-send-string process (concat "QUIT :"
2151 (if (not (zerop (length reason)))
2152 reason
2153 rcirc-id-string))))
bd43c990
RS
2154
2155(defun-rcirc-command nick (nick)
2156 "Change nick to NICK."
2157 (interactive "i")
2158 (when (null nick)
2159 (setq nick (read-string "New nick: " (rcirc-nick process))))
2160 (rcirc-send-string process (concat "NICK " nick)))
2161
2162(defun-rcirc-command names (channel)
2163 "Display list of names in CHANNEL or in current channel if CHANNEL is nil.
2164If called interactively, prompt for a channel when prefix arg is supplied."
2165 (interactive "P")
32226619 2166 (if (called-interactively-p 'interactive)
bd43c990
RS
2167 (if channel
2168 (setq channel (read-string "List names in channel: " target))))
2169 (let ((channel (if (> (length channel) 0)
2170 channel
2171 target)))
2172 (rcirc-send-string process (concat "NAMES " channel))))
2173
2174(defun-rcirc-command topic (topic)
2175 "List TOPIC for the TARGET channel.
2176With a prefix arg, prompt for new topic."
2177 (interactive "P")
32226619 2178 (if (and (called-interactively-p 'interactive) topic)
bd43c990
RS
2179 (setq topic (read-string "New Topic: " rcirc-topic)))
2180 (rcirc-send-string process (concat "TOPIC " target
2181 (when (> (length topic) 0)
2182 (concat " :" topic)))))
2183
2184(defun-rcirc-command whois (nick)
2185 "Request information from server about NICK."
2186 (interactive (list
2187 (completing-read "Whois: "
a2524d26 2188 (with-rcirc-server-buffer rcirc-nick-table))))
bd43c990
RS
2189 (rcirc-send-string process (concat "WHOIS " nick)))
2190
2191(defun-rcirc-command mode (args)
2192 "Set mode with ARGS."
2193 (interactive (list (concat (read-string "Mode nick or channel: ")
2194 " " (read-string "Mode: "))))
2195 (rcirc-send-string process (concat "MODE " args)))
2196
2197(defun-rcirc-command list (channels)
2198 "Request information on CHANNELS from server."
2199 (interactive "sList Channels: ")
2200 (rcirc-send-string process (concat "LIST " channels)))
2201
2202(defun-rcirc-command oper (args)
2203 "Send operator command to server."
2204 (interactive "sOper args: ")
2205 (rcirc-send-string process (concat "OPER " args)))
2206
2207(defun-rcirc-command quote (message)
2208 "Send MESSAGE literally to server."
2209 (interactive "sServer message: ")
2210 (rcirc-send-string process message))
2211
2212(defun-rcirc-command kick (arg)
2213 "Kick NICK from current channel."
2214 (interactive (list
2215 (concat (completing-read "Kick nick: "
92c4adc1 2216 (rcirc-channel-nicks
a2524d26
EZ
2217 (rcirc-buffer-process)
2218 rcirc-target))
bd43c990
RS
2219 (read-from-minibuffer "Kick reason: "))))
2220 (let* ((arglist (split-string arg))
adf794e4 2221 (argstring (concat (car arglist) " :"
bd43c990
RS
2222 (mapconcat 'identity (cdr arglist) " "))))
2223 (rcirc-send-string process (concat "KICK " target " " argstring))))
2224
2225(defun rcirc-cmd-ctcp (args &optional process target)
2226 (if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args)
ee6a57ab
DD
2227 (let* ((target (match-string 1 args))
2228 (request (upcase (match-string 2 args)))
2229 (function (intern-soft (concat "rcirc-ctcp-sender-" request))))
2230 (if (fboundp function) ;; use special function if available
2231 (funcall function process target request)
1be1d1e9 2232 (rcirc-send-ctcp process target request)))
adf794e4 2233 (rcirc-print process (rcirc-nick process) "ERROR" nil
bd43c990
RS
2234 "usage: /ctcp NICK REQUEST")))
2235
ee6a57ab
DD
2236(defun rcirc-ctcp-sender-PING (process target request)
2237 "Send a CTCP PING message to TARGET."
73057ba9 2238 (let ((timestamp (format "%.0f" (rcirc-float-time))))
1be1d1e9 2239 (rcirc-send-ctcp process target "PING" timestamp)))
ee6a57ab 2240
bd43c990 2241(defun rcirc-cmd-me (args &optional process target)
1be1d1e9 2242 (rcirc-send-ctcp process target "ACTION" args))
2c8abe90 2243
c00725d7
LL
2244(defun rcirc-add-or-remove (set &rest elements)
2245 (dolist (elt elements)
2246 (if (and elt (not (string= "" elt)))
2247 (setq set (if (member-ignore-case elt set)
2248 (delete elt set)
2249 (cons elt set)))))
2250 set)
f8db61b2 2251
2c8abe90
AS
2252(defun-rcirc-command ignore (nick)
2253 "Manage the ignore list.
2254Ignore NICK, unignore NICK if already ignored, or list ignored
2255nicks when no NICK is given. When listing ignored nicks, the
2e398771 2256ones added to the list automatically are marked with an asterisk."
2c8abe90 2257 (interactive "sToggle ignoring of nick: ")
c00725d7
LL
2258 (setq rcirc-ignore-list
2259 (apply #'rcirc-add-or-remove rcirc-ignore-list
2260 (split-string nick nil t)))
92c4adc1 2261 (rcirc-print process nil "IGNORE" target
db58efbf
EZ
2262 (mapconcat
2263 (lambda (nick)
2264 (concat nick
2265 (if (member nick rcirc-ignore-list-automatic)
2266 "*" "")))
2267 rcirc-ignore-list " ")))
2c8abe90 2268
f8db61b2
EZ
2269(defun-rcirc-command bright (nick)
2270 "Manage the bright nick list."
2271 (interactive "sToggle emphasis of nick: ")
c00725d7
LL
2272 (setq rcirc-bright-nicks
2273 (apply #'rcirc-add-or-remove rcirc-bright-nicks
2274 (split-string nick nil t)))
92c4adc1 2275 (rcirc-print process nil "BRIGHT" target
f8db61b2
EZ
2276 (mapconcat 'identity rcirc-bright-nicks " ")))
2277
2278(defun-rcirc-command dim (nick)
2279 "Manage the dim nick list."
2280 (interactive "sToggle deemphasis of nick: ")
c00725d7
LL
2281 (setq rcirc-dim-nicks
2282 (apply #'rcirc-add-or-remove rcirc-dim-nicks
2283 (split-string nick nil t)))
92c4adc1 2284 (rcirc-print process nil "DIM" target
f8db61b2
EZ
2285 (mapconcat 'identity rcirc-dim-nicks " ")))
2286
2287(defun-rcirc-command keyword (keyword)
2288 "Manage the keyword list.
2289Mark KEYWORD, unmark KEYWORD if already marked, or list marked
2290keywords when no KEYWORD is given."
2291 (interactive "sToggle highlighting of keyword: ")
c00725d7
LL
2292 (setq rcirc-keywords
2293 (apply #'rcirc-add-or-remove rcirc-keywords
2294 (split-string keyword nil t)))
92c4adc1 2295 (rcirc-print process nil "KEYWORD" target
f8db61b2
EZ
2296 (mapconcat 'identity rcirc-keywords " ")))
2297
bd43c990 2298\f
f8db61b2
EZ
2299(defun rcirc-add-face (start end name &optional object)
2300 "Add face NAME to the face text property of the text from START to END."
2301 (when name
2302 (let ((pos start)
2303 next prop)
2304 (while (< pos end)
2305 (setq prop (get-text-property pos 'face object)
2306 next (next-single-property-change pos 'face object end))
2307 (unless (member name (get-text-property pos 'face object))
2308 (add-text-properties pos next (list 'face (cons name prop)) object))
2309 (setq pos next)))))
adf794e4 2310
bd43c990
RS
2311(defun rcirc-facify (string face)
2312 "Return a copy of STRING with FACE property added."
f8db61b2
EZ
2313 (let ((string (or string "")))
2314 (rcirc-add-face 0 (length string) face string)
2315 string))
bd43c990 2316
bd43c990 2317(defvar rcirc-url-regexp
73dd622f
RS
2318 (concat
2319 "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|"
2320 "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
2321 "\\(//[-a-z0-9_.]+:[0-9]*\\)?"
2322 (if (string-match "[[:digit:]]" "1") ;; Support POSIX?
2323 (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
2324 (punct "!?:;.,"))
2325 (concat
2326 "\\(?:"
2327 ;; Match paired parentheses, e.g. in Wikipedia URLs:
2328 "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]"
2329 "\\|"
2330 "[" chars punct "]+" "[" chars "]"
2331 "\\)"))
2332 (concat ;; XEmacs 21.4 doesn't support POSIX.
2333 "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+"
2334 "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)"))
2335 "\\)")
2e398771 2336 "Regexp matching URLs. Set to nil to disable URL features in rcirc.")
bd43c990
RS
2337
2338(defun rcirc-browse-url (&optional arg)
2e398771 2339 "Prompt for URL to browse based on URLs in buffer."
02f47e86 2340 (interactive "P")
bd43c990
RS
2341 (let ((completions (mapcar (lambda (x) (cons x nil)) rcirc-urls))
2342 (initial-input (car rcirc-urls))
2343 (history (cdr rcirc-urls)))
2344 (browse-url (completing-read "rcirc browse-url: "
2345 completions nil nil initial-input 'history)
2346 arg)))
f8db61b2 2347\f
195eca78
SM
2348(defun rcirc-markup-timestamp (sender response)
2349 (goto-char (point-min))
0ffab1eb 2350 (insert (rcirc-facify (format-time-string rcirc-time-format)
195eca78 2351 'rcirc-timestamp)))
f8db61b2 2352
195eca78 2353(defun rcirc-markup-attributes (sender response)
f8db61b2
EZ
2354 (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t)
2355 (rcirc-add-face (match-beginning 0) (match-end 0)
2356 (case (char-after (match-beginning 1))
2357 (?\C-b 'bold)
2358 (?\C-v 'italic)
2359 (?\C-_ 'underline)))
2360 ;; keep the ^O since it could terminate other attributes
2361 (when (not (eq ?\C-o (char-before (match-end 2))))
2362 (delete-region (match-beginning 2) (match-end 2)))
2363 (delete-region (match-beginning 1) (match-end 1))
08fc78fe 2364 (goto-char (match-beginning 1)))
f8db61b2
EZ
2365 ;; remove the ^O characters now
2366 (while (re-search-forward "\C-o+" nil t)
2367 (delete-region (match-beginning 0) (match-end 0))))
2368
195eca78 2369(defun rcirc-markup-my-nick (sender response)
f8db61b2 2370 (with-syntax-table rcirc-nick-syntax-table
0ffab1eb
TTN
2371 (while (re-search-forward (concat "\\b"
2372 (regexp-quote (rcirc-nick
195eca78 2373 (rcirc-buffer-process)))
f8db61b2
EZ
2374 "\\b")
2375 nil t)
92c4adc1 2376 (rcirc-add-face (match-beginning 0) (match-end 0)
f8db61b2
EZ
2377 'rcirc-nick-in-message)
2378 (when (string= response "PRIVMSG")
0ffab1eb 2379 (rcirc-add-face (point-min) (point-max)
195eca78
SM
2380 'rcirc-nick-in-message-full-line)
2381 (rcirc-record-activity (current-buffer) 'nick)))))
f8db61b2 2382
195eca78 2383(defun rcirc-markup-urls (sender response)
9ff90d99
DD
2384 (while (and rcirc-url-regexp ;; nil means disable URL catching
2385 (re-search-forward rcirc-url-regexp nil t))
f8db61b2 2386 (let ((start (match-beginning 0))
1ddd96f5
LL
2387 (end (match-end 0))
2388 (url (match-string-no-properties 0)))
2389 (make-button start end
2390 'face 'rcirc-url
2391 'follow-link t
2392 'rcirc-url url
2393 'action (lambda (button)
2394 (browse-url (button-get button 'rcirc-url))))
f8db61b2 2395 ;; record the url
1ddd96f5 2396 (push url rcirc-urls))))
195eca78
SM
2397
2398(defun rcirc-markup-keywords (sender response)
2399 (when (and (string= response "PRIVMSG")
2400 (not (string= sender (rcirc-nick (rcirc-buffer-process)))))
2401 (let* ((target (or rcirc-target ""))
2402 (keywords (delq nil (mapcar (lambda (keyword)
2403 (when (not (string-match keyword
2404 target))
2405 keyword))
2406 rcirc-keywords))))
2407 (when keywords
2408 (while (re-search-forward (regexp-opt keywords 'words) nil t)
2409 (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword)
2410 (rcirc-record-activity (current-buffer) 'keyword))))))
2411
2412(defun rcirc-markup-bright-nicks (sender response)
f8db61b2
EZ
2413 (when (and rcirc-bright-nicks
2414 (string= response "NAMES"))
2415 (with-syntax-table rcirc-nick-syntax-table
2416 (while (re-search-forward (regexp-opt rcirc-bright-nicks 'words) nil t)
2417 (rcirc-add-face (match-beginning 0) (match-end 0)
2418 'rcirc-bright-nick)))))
195eca78
SM
2419
2420(defun rcirc-markup-fill (sender response)
2421 (when (not (string= response "372")) ; /motd
2422 (let ((fill-prefix
2423 (or rcirc-fill-prefix
2424 (make-string (- (point) (line-beginning-position)) ?\s)))
683b7dc6
GM
2425 (fill-column (- (cond ((eq rcirc-fill-column 'frame-width)
2426 (1- (frame-width)))
2427 (rcirc-fill-column
2428 rcirc-fill-column)
2429 (t fill-column))
2430 ;; make sure ... doesn't cause line wrapping
aebf69c8 2431 3)))
195eca78 2432 (fill-region (point) (point-max) nil t))))
bd43c990
RS
2433\f
2434;;; handlers
2435;; these are called with the server PROCESS, the SENDER, which is a
2436;; server or a user, depending on the command, the ARGS, which is a
2437;; list of strings, and the TEXT, which is the original server text,
2438;; verbatim
2439(defun rcirc-handler-001 (process sender args text)
2440 (rcirc-handler-generic process "001" sender args text)
adf794e4 2441 (with-rcirc-process-buffer process
8216fbaf
EZ
2442 (setq rcirc-connecting nil)
2443 (rcirc-reschedule-timeout process)
2444 (setq rcirc-server-name sender)
bd43c990
RS
2445 (setq rcirc-nick (car args))
2446 (rcirc-update-prompt)
72d2c2e3 2447 (if rcirc-auto-authenticate-flag
221ddf68
TH
2448 (if (and rcirc-authenticate-before-join
2449 ;; We have to ensure that there's an authentication
2450 ;; entry for that server. Else,
2451 ;; rcirc-authenticated-hook won't be triggered, and
2452 ;; autojoin won't happen at all.
2453 (let (auth-required)
2454 (dolist (s rcirc-authinfo auth-required)
2455 (when (string-match (car s) rcirc-server-name)
2456 (setq auth-required t)))))
72d2c2e3 2457 (progn
c47971d7 2458 (add-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t t)
72d2c2e3
DD
2459 (rcirc-authenticate))
2460 (rcirc-authenticate)
2461 (rcirc-join-channels process rcirc-startup-channels))
2462 (rcirc-join-channels process rcirc-startup-channels))))
2463
2464(defun rcirc-join-channels-post-auth (process)
2465 "Join `rcirc-startup-channels' after authenticating."
2466 (with-rcirc-process-buffer process
adf794e4 2467 (rcirc-join-channels process rcirc-startup-channels)))
bd43c990
RS
2468
2469(defun rcirc-handler-PRIVMSG (process sender args text)
72d2c2e3 2470 (rcirc-check-auth-status process sender args text)
bd43c990
RS
2471 (let ((target (if (rcirc-channel-p (car args))
2472 (car args)
db58efbf 2473 sender))
bd43c990
RS
2474 (message (or (cadr args) "")))
2475 (if (string-match "^\C-a\\(.*\\)\C-a$" message)
2476 (rcirc-handler-CTCP process target sender (match-string 1 message))
2477 (rcirc-print process sender "PRIVMSG" target message t))
a0a5c583
GM
2478 ;; update nick linestamp
2479 (with-current-buffer (rcirc-get-buffer process target t)
2480 (rcirc-put-nick-channel process sender target rcirc-current-line))))
bd43c990
RS
2481
2482(defun rcirc-handler-NOTICE (process sender args text)
72d2c2e3 2483 (rcirc-check-auth-status process sender args text)
bd43c990
RS
2484 (let ((target (car args))
2485 (message (cadr args)))
adf794e4
EZ
2486 (if (string-match "^\C-a\\(.*\\)\C-a$" message)
2487 (rcirc-handler-CTCP-response process target sender
2488 (match-string 1 message))
2489 (rcirc-print process sender "NOTICE"
2490 (cond ((rcirc-channel-p target)
2491 target)
2492 ;;; -ChanServ- [#gnu] Welcome...
02f47e86 2493 ((string-match "\\[\\(#[^\] ]+\\)\\]" message)
adf794e4
EZ
2494 (match-string 1 message))
2495 (sender
a2524d26 2496 (if (string= sender (rcirc-server-name process))
db58efbf
EZ
2497 nil ; server notice
2498 sender)))
adf794e4 2499 message t))))
bd43c990 2500
72d2c2e3
DD
2501(defun rcirc-check-auth-status (process sender args text)
2502 "Check if the user just authenticated.
2503If authenticated, runs `rcirc-authenticated-hook' with PROCESS as
2504the only argument."
2505 (with-rcirc-process-buffer process
2506 (when (and (not rcirc-user-authenticated)
2507 rcirc-authenticate-before-join
2508 rcirc-auto-authenticate-flag)
2509 (let ((target (car args))
2510 (message (cadr args)))
2511 (when (or
2512 (and ;; nickserv
2513 (string= sender "NickServ")
2514 (string= target rcirc-nick)
2515 (member message
2516 (list
2517 (format "You are now identified for \C-b%s\C-b." rcirc-nick)
35b1c40c 2518 (format "You are successfully identified as \C-b%s\C-b." rcirc-nick)
72d2c2e3
DD
2519 "Password accepted - you are now recognized."
2520 )))
77f63d30
DD
2521 (and ;; quakenet
2522 (string= sender "Q")
2523 (string= target rcirc-nick)
c47971d7 2524 (string-match "\\`You are now logged in as .+\\.\\'" message)))
72d2c2e3
DD
2525 (setq rcirc-user-authenticated t)
2526 (run-hook-with-args 'rcirc-authenticated-hook process)
2527 (remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t))))))
2528
bd43c990 2529(defun rcirc-handler-WALLOPS (process sender args text)
db58efbf 2530 (rcirc-print process sender "WALLOPS" sender (car args) t))
bd43c990
RS
2531
2532(defun rcirc-handler-JOIN (process sender args text)
db58efbf 2533 (let ((channel (car args)))
a0a5c583
GM
2534 (with-current-buffer (rcirc-get-buffer-create process channel)
2535 ;; when recently rejoining, restore the linestamp
2536 (rcirc-put-nick-channel process sender channel
2537 (let ((last-activity-lines
683b7dc6 2538 (rcirc-elapsed-lines process sender channel)))
a0a5c583
GM
2539 (when (and last-activity-lines
2540 (< last-activity-lines rcirc-omit-threshold))
827b77e9
DD
2541 (rcirc-last-line process sender channel))))
2542 ;; reset mode-line-process in case joining a channel with an
2543 ;; already open buffer (after getting kicked e.g.)
2544 (setq mode-line-process nil))
a0a5c583 2545
bd43c990
RS
2546 (rcirc-print process sender "JOIN" channel "")
2547
2548 ;; print in private chat buffer if it exists
a2524d26 2549 (when (rcirc-get-buffer (rcirc-buffer-process) sender)
a0a5c583 2550 (rcirc-print process sender "JOIN" sender channel))))
bd43c990
RS
2551
2552;; PART and KICK are handled the same way
2553(defun rcirc-handler-PART-or-KICK (process response channel sender nick args)
a2524d26 2554 (rcirc-ignore-update-automatic nick)
bd43c990
RS
2555 (if (not (string= nick (rcirc-nick process)))
2556 ;; this is someone else leaving
a0a5c583
GM
2557 (progn
2558 (rcirc-maybe-remember-nick-quit process nick channel)
2559 (rcirc-remove-nick-channel process nick channel))
adf794e4
EZ
2560 ;; this is us leaving
2561 (mapc (lambda (n)
2562 (rcirc-remove-nick-channel process n channel))
2563 (rcirc-channel-nicks process channel))
2564
2565 ;; if the buffer is still around, make it inactive
2566 (let ((buffer (rcirc-get-buffer process channel)))
2567 (when buffer
195eca78 2568 (rcirc-disconnect-buffer buffer)))))
bd43c990
RS
2569
2570(defun rcirc-handler-PART (process sender args text)
a2524d26
EZ
2571 (let* ((channel (car args))
2572 (reason (cadr args))
2573 (message (concat channel " " reason)))
2574 (rcirc-print process sender "PART" channel message)
2575 ;; print in private chat buffer if it exists
2576 (when (rcirc-get-buffer (rcirc-buffer-process) sender)
2577 (rcirc-print process sender "PART" sender message))
2578
2579 (rcirc-handler-PART-or-KICK process "PART" channel sender sender reason)))
bd43c990
RS
2580
2581(defun rcirc-handler-KICK (process sender args text)
a2524d26
EZ
2582 (let* ((channel (car args))
2583 (nick (cadr args))
2584 (reason (caddr args))
2585 (message (concat nick " " channel " " reason)))
2586 (rcirc-print process sender "KICK" channel message t)
2587 ;; print in private chat buffer if it exists
2588 (when (rcirc-get-buffer (rcirc-buffer-process) nick)
2589 (rcirc-print process sender "KICK" nick message))
2590
2591 (rcirc-handler-PART-or-KICK process "KICK" channel sender nick reason)))
bd43c990 2592
a0a5c583
GM
2593(defun rcirc-maybe-remember-nick-quit (process nick channel)
2594 "Remember NICK as leaving CHANNEL if they recently spoke."
683b7dc6 2595 (let ((elapsed-lines (rcirc-elapsed-lines process nick channel)))
a0a5c583
GM
2596 (when (and elapsed-lines
2597 (< elapsed-lines rcirc-omit-threshold))
2598 (let ((buffer (rcirc-get-buffer process channel)))
2599 (when buffer
2600 (with-current-buffer buffer
683b7dc6
GM
2601 (let ((record (assoc-string nick rcirc-recent-quit-alist t))
2602 (line (rcirc-last-line process nick channel)))
a0a5c583
GM
2603 (if record
2604 (setcdr record line)
2605 (setq rcirc-recent-quit-alist
2606 (cons (cons nick line)
2607 rcirc-recent-quit-alist))))))))))
2608
bd43c990 2609(defun rcirc-handler-QUIT (process sender args text)
db58efbf
EZ
2610 (rcirc-ignore-update-automatic sender)
2611 (mapc (lambda (channel)
a0a5c583
GM
2612 ;; broadcast quit message each channel
2613 (rcirc-print process sender "QUIT" channel (apply 'concat args))
2614 ;; record nick in quit table if they recently spoke
2615 (rcirc-maybe-remember-nick-quit process sender channel))
db58efbf 2616 (rcirc-nick-channels process sender))
db58efbf 2617 (rcirc-nick-remove process sender))
bd43c990
RS
2618
2619(defun rcirc-handler-NICK (process sender args text)
db58efbf 2620 (let* ((old-nick sender)
bd43c990
RS
2621 (new-nick (car args))
2622 (channels (rcirc-nick-channels process old-nick)))
2c8abe90
AS
2623 ;; update list of ignored nicks
2624 (rcirc-ignore-update-automatic old-nick)
2625 (when (member old-nick rcirc-ignore-list)
2626 (add-to-list 'rcirc-ignore-list new-nick)
2627 (add-to-list 'rcirc-ignore-list-automatic new-nick))
bd43c990
RS
2628 ;; print message to nick's channels
2629 (dolist (target channels)
2630 (rcirc-print process sender "NICK" target new-nick))
2631 ;; update private chat buffer, if it exists
adf794e4
EZ
2632 (let ((chat-buffer (rcirc-get-buffer process old-nick)))
2633 (when chat-buffer
2634 (with-current-buffer chat-buffer
2635 (rcirc-print process sender "NICK" old-nick new-nick)
2636 (setq rcirc-target new-nick)
2637 (rename-buffer (rcirc-generate-new-buffer-name process new-nick)))))
bd43c990 2638 ;; remove old nick and add new one
adf794e4 2639 (with-rcirc-process-buffer process
bd43c990
RS
2640 (let ((v (gethash old-nick rcirc-nick-table)))
2641 (remhash old-nick rcirc-nick-table)
2642 (puthash new-nick v rcirc-nick-table))
2643 ;; if this is our nick...
2644 (when (string= old-nick rcirc-nick)
2645 (setq rcirc-nick new-nick)
adf794e4 2646 (rcirc-update-prompt t)
bd43c990
RS
2647 ;; reauthenticate
2648 (when rcirc-auto-authenticate-flag (rcirc-authenticate))))))
2649
2650(defun rcirc-handler-PING (process sender args text)
195eca78 2651 (rcirc-send-string process (concat "PONG :" (car args))))
bd43c990
RS
2652
2653(defun rcirc-handler-PONG (process sender args text)
2654 ;; do nothing
2655 )
2656
2657(defun rcirc-handler-TOPIC (process sender args text)
2658 (let ((topic (cadr args)))
2659 (rcirc-print process sender "TOPIC" (car args) topic)
2660 (with-current-buffer (rcirc-get-buffer process (car args))
2661 (setq rcirc-topic topic))))
2662
a2524d26
EZ
2663(defvar rcirc-nick-away-alist nil)
2664(defun rcirc-handler-301 (process sender args text)
2665 "RPL_AWAY"
2666 (let* ((nick (cadr args))
2667 (rec (assoc-string nick rcirc-nick-away-alist))
2668 (away-message (caddr args)))
2669 (when (or (not rec)
2670 (not (string= (cdr rec) away-message)))
2671 ;; away message has changed
2672 (rcirc-handler-generic process "AWAY" nick (cdr args) text)
2673 (if rec
2674 (setcdr rec away-message)
2675 (setq rcirc-nick-away-alist (cons (cons nick away-message)
2676 rcirc-nick-away-alist))))))
2677
c5aff743
DD
2678(defun rcirc-handler-317 (process sender args text)
2679 "RPL_WHOISIDLE"
2680 (let* ((nick (nth 1 args))
2681 (idle-secs (string-to-number (nth 2 args)))
2682 (idle-string
2683 (if (< idle-secs most-positive-fixnum)
2684 (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs)
2685 "a very long time"))
2686 (signon-time (seconds-to-time (string-to-number (nth 3 args))))
2687 (signon-string (format-time-string "%c" signon-time))
2688 (message (format "%s idle for %s, signed on %s"
2689 nick idle-string signon-string)))
2690 (rcirc-print process sender "317" nil message t)))
2691
bd43c990
RS
2692(defun rcirc-handler-332 (process sender args text)
2693 "RPL_TOPIC"
adf794e4
EZ
2694 (let ((buffer (or (rcirc-get-buffer process (cadr args))
2695 (rcirc-get-temp-buffer-create process (cadr args)))))
2696 (with-current-buffer buffer
2697 (setq rcirc-topic (caddr args)))))
bd43c990
RS
2698
2699(defun rcirc-handler-333 (process sender args text)
027b979c
DD
2700 "333 says who set the topic and when.
2701Not in rfc1459.txt"
adf794e4
EZ
2702 (let ((buffer (or (rcirc-get-buffer process (cadr args))
2703 (rcirc-get-temp-buffer-create process (cadr args)))))
2704 (with-current-buffer buffer
2705 (let ((setter (caddr args))
2706 (time (current-time-string
2707 (seconds-to-time
2708 (string-to-number (cadddr args))))))
2709 (rcirc-print process sender "TOPIC" (cadr args)
2710 (format "%s (%s on %s)" rcirc-topic setter time))))))
bd43c990
RS
2711
2712(defun rcirc-handler-477 (process sender args text)
2713 "ERR_NOCHANMODES"
2714 (rcirc-print process sender "477" (cadr args) (caddr args)))
2715
2716(defun rcirc-handler-MODE (process sender args text)
2717 (let ((target (car args))
2718 (msg (mapconcat 'identity (cdr args) " ")))
2719 (rcirc-print process sender "MODE"
2720 (if (string= target (rcirc-nick process))
2721 nil
2722 target)
2723 msg)
2724
2725 ;; print in private chat buffers if they exist
2726 (mapc (lambda (nick)
db58efbf
EZ
2727 (when (rcirc-get-buffer process nick)
2728 (rcirc-print process sender "MODE" nick msg)))
adf794e4 2729 (cddr args))))
bd43c990
RS
2730
2731(defun rcirc-get-temp-buffer-create (process channel)
2732 "Return a buffer based on PROCESS and CHANNEL."
2733 (let ((tmpnam (concat " " (downcase channel) "TMP" (process-name process))))
2734 (get-buffer-create tmpnam)))
2735
2736(defun rcirc-handler-353 (process sender args text)
2737 "RPL_NAMREPLY"
0ba690bd
DD
2738 (let ((channel (nth 2 args))
2739 (names (or (nth 3 args) "")))
bd43c990
RS
2740 (mapc (lambda (nick)
2741 (rcirc-put-nick-channel process nick channel))
0ba690bd
DD
2742 (split-string names " " t))
2743 ;; create a temporary buffer to insert the names into
2744 ;; rcirc-handler-366 (RPL_ENDOFNAMES) will handle it
bd43c990
RS
2745 (with-current-buffer (rcirc-get-temp-buffer-create process channel)
2746 (goto-char (point-max))
2747 (insert (car (last args)) " "))))
2748
2749(defun rcirc-handler-366 (process sender args text)
2750 "RPL_ENDOFNAMES"
2751 (let* ((channel (cadr args))
2752 (buffer (rcirc-get-temp-buffer-create process channel)))
2753 (with-current-buffer buffer
2754 (rcirc-print process sender "NAMES" channel
c62bf05a 2755 (let ((content (buffer-substring (point-min) (point-max))))
aa1bc616 2756 (rcirc-sort-nicknames-join content " "))))
bd43c990
RS
2757 (kill-buffer buffer)))
2758
2759(defun rcirc-handler-433 (process sender args text)
2760 "ERR_NICKNAMEINUSE"
2761 (rcirc-handler-generic process "433" sender args text)
2762 (let* ((new-nick (concat (cadr args) "`")))
adf794e4 2763 (with-rcirc-process-buffer process
bd43c990
RS
2764 (rcirc-cmd-nick new-nick nil process))))
2765
2766(defun rcirc-authenticate ()
2767 "Send authentication to process associated with current buffer.
db58efbf 2768Passwords are stored in `rcirc-authinfo' (which see)."
bd43c990 2769 (interactive)
a2524d26 2770 (with-rcirc-server-buffer
db58efbf 2771 (dolist (i rcirc-authinfo)
a2524d26
EZ
2772 (let ((process (rcirc-buffer-process))
2773 (server (car i))
db58efbf
EZ
2774 (nick (caddr i))
2775 (method (cadr i))
2776 (args (cdddr i)))
77f63d30
DD
2777 (when (and (string-match server rcirc-server))
2778 (if (and (memq method '(nickserv chanserv bitlbee))
2779 (string-match nick rcirc-nick))
2780 ;; the following methods rely on the user's nickname.
2781 (case method
2782 (nickserv
2783 (rcirc-send-privmsg
2784 process
1be1d1e9 2785 (or (cadr args) "NickServ")
77f63d30
DD
2786 (concat "IDENTIFY " (car args))))
2787 (chanserv
2788 (rcirc-send-privmsg
2789 process
1be1d1e9 2790 "ChanServ"
77f63d30
DD
2791 (format "IDENTIFY %s %s" (car args) (cadr args))))
2792 (bitlbee
2793 (rcirc-send-privmsg
2794 process
1be1d1e9 2795 "&bitlbee"
77f63d30
DD
2796 (concat "IDENTIFY " (car args)))))
2797 ;; quakenet authentication doesn't rely on the user's nickname.
2798 ;; the variable `nick' here represents the Q account name.
2799 (when (eq method 'quakenet)
aebf69c8 2800 (rcirc-send-privmsg
77f63d30
DD
2801 process
2802 "Q@CServe.quakenet.org"
2803 (format "AUTH %s %s" nick (car args))))))))))
adf794e4 2804
bd43c990
RS
2805(defun rcirc-handler-INVITE (process sender args text)
2806 (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t))
2807
2808(defun rcirc-handler-ERROR (process sender args text)
2809 (rcirc-print process sender "ERROR" nil (mapconcat 'identity args " ")))
2810
2811(defun rcirc-handler-CTCP (process target sender text)
2812 (if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text)
2813 (let* ((request (upcase (match-string 1 text)))
2814 (args (match-string 2 text))
bd43c990
RS
2815 (handler (intern-soft (concat "rcirc-handler-ctcp-" request))))
2816 (if (not (fboundp handler))
db58efbf
EZ
2817 (rcirc-print process sender "ERROR" target
2818 (format "%s sent unsupported ctcp: %s" sender text)
adf794e4 2819 t)
bd43c990 2820 (funcall handler process target sender args)
195eca78
SM
2821 (unless (or (string= request "ACTION")
2822 (string= request "KEEPALIVE"))
db58efbf 2823 (rcirc-print process sender "CTCP" target
adf794e4 2824 (format "%s" text) t))))))
bd43c990
RS
2825
2826(defun rcirc-handler-ctcp-VERSION (process target sender args)
2827 (rcirc-send-string process
db58efbf 2828 (concat "NOTICE " sender
adf794e4 2829 " :\C-aVERSION " rcirc-id-string
bd43c990
RS
2830 "\C-a")))
2831
2832(defun rcirc-handler-ctcp-ACTION (process target sender args)
2833 (rcirc-print process sender "ACTION" target args t))
2834
2835(defun rcirc-handler-ctcp-TIME (process target sender args)
2836 (rcirc-send-string process
db58efbf 2837 (concat "NOTICE " sender
bd43c990 2838 " :\C-aTIME " (current-time-string) "\C-a")))
adf794e4
EZ
2839
2840(defun rcirc-handler-CTCP-response (process target sender message)
2841 (rcirc-print process sender "CTCP" nil message t))
bd43c990 2842\f
adf794e4
EZ
2843(defgroup rcirc-faces nil
2844 "Faces for rcirc."
2845 :group 'rcirc
2846 :group 'faces)
2847
ad8121fe
EZ
2848(defface rcirc-my-nick ; font-lock-function-name-face
2849 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
2850 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
2851 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
2852 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
2853 (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
2854 (t (:inverse-video t :weight bold)))
adf794e4
EZ
2855 "The face used to highlight my messages."
2856 :group 'rcirc-faces)
bd43c990 2857
ad8121fe
EZ
2858(defface rcirc-other-nick ; font-lock-variable-name-face
2859 '((((class grayscale) (background light))
2860 (:foreground "Gray90" :weight bold :slant italic))
bd43c990 2861 (((class grayscale) (background dark))
ad8121fe
EZ
2862 (:foreground "DimGray" :weight bold :slant italic))
2863 (((class color) (min-colors 88) (background light)) (:foreground "DarkGoldenrod"))
2864 (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod"))
2865 (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
2866 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
2867 (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
2868 (t (:weight bold :slant italic)))
adf794e4
EZ
2869 "The face used to highlight other messages."
2870 :group 'rcirc-faces)
bd43c990 2871
02f47e86
MB
2872(defface rcirc-bright-nick
2873 '((((class grayscale) (background light))
2874 (:foreground "LightGray" :weight bold :underline t))
2875 (((class grayscale) (background dark))
2876 (:foreground "Gray50" :weight bold :underline t))
2877 (((class color) (min-colors 88) (background light)) (:foreground "CadetBlue"))
2878 (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
2879 (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
2880 (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
2881 (((class color) (min-colors 8)) (:foreground "magenta"))
2882 (t (:weight bold :underline t)))
f8db61b2 2883 "Face used for nicks matched by `rcirc-bright-nicks'."
02f47e86
MB
2884 :group 'rcirc-faces)
2885
2886(defface rcirc-dim-nick
2887 '((t :inherit default))
f8db61b2 2888 "Face used for nicks in `rcirc-dim-nicks'."
02f47e86
MB
2889 :group 'rcirc-faces)
2890
ad8121fe
EZ
2891(defface rcirc-server ; font-lock-comment-face
2892 '((((class grayscale) (background light))
2893 (:foreground "DimGray" :weight bold :slant italic))
bd43c990 2894 (((class grayscale) (background dark))
ad8121fe
EZ
2895 (:foreground "LightGray" :weight bold :slant italic))
2896 (((class color) (min-colors 88) (background light))
2897 (:foreground "Firebrick"))
2898 (((class color) (min-colors 88) (background dark))
2899 (:foreground "chocolate1"))
2900 (((class color) (min-colors 16) (background light))
2901 (:foreground "red"))
2902 (((class color) (min-colors 16) (background dark))
2903 (:foreground "red1"))
2904 (((class color) (min-colors 8) (background light))
2905 )
2906 (((class color) (min-colors 8) (background dark))
2907 )
2908 (t (:weight bold :slant italic)))
adf794e4
EZ
2909 "The face used to highlight server messages."
2910 :group 'rcirc-faces)
bd43c990 2911
ad8121fe 2912(defface rcirc-server-prefix ; font-lock-comment-delimiter-face
db58efbf 2913 '((default :inherit rcirc-server)
ad8121fe
EZ
2914 (((class grayscale)))
2915 (((class color) (min-colors 16)))
2916 (((class color) (min-colors 8) (background light))
2917 :foreground "red")
2918 (((class color) (min-colors 8) (background dark))
2919 :foreground "red1"))
2920 "The face used to highlight server prefixes."
2921 :group 'rcirc-faces)
2922
2923(defface rcirc-timestamp
2924 '((t (:inherit default)))
2925 "The face used to highlight timestamps."
2926 :group 'rcirc-faces)
2927
2928(defface rcirc-nick-in-message ; font-lock-keyword-face
2929 '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
2930 (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
2931 (((class color) (min-colors 88) (background light)) (:foreground "Purple"))
2932 (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
2933 (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
2934 (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
2935 (((class color) (min-colors 8)) (:foreground "cyan" :weight bold))
2936 (t (:weight bold)))
f8db61b2 2937 "The face used to highlight instances of your nick within messages."
adf794e4 2938 :group 'rcirc-faces)
bd43c990 2939
f8db61b2
EZ
2940(defface rcirc-nick-in-message-full-line
2941 '((t (:bold t)))
2942 "The face used emphasize the entire message when your nick is mentioned."
92c4adc1 2943 :group 'rcirc-faces)
f8db61b2 2944
ad8121fe
EZ
2945(defface rcirc-prompt ; comint-highlight-prompt
2946 '((((min-colors 88) (background dark)) (:foreground "cyan1"))
2947 (((background dark)) (:foreground "cyan"))
bd43c990 2948 (t (:foreground "dark blue")))
2e398771 2949 "The face used to highlight prompts."
adf794e4 2950 :group 'rcirc-faces)
bd43c990 2951
f8db61b2 2952(defface rcirc-track-nick
8216fbaf
EZ
2953 '((((type tty)) (:inherit default))
2954 (t (:inverse-video t)))
f8db61b2
EZ
2955 "The face used in the mode-line when your nick is mentioned."
2956 :group 'rcirc-faces)
2957
2958(defface rcirc-track-keyword
2959 '((t (:bold t )))
2960 "The face used in the mode-line when keywords are mentioned."
2961 :group 'rcirc-faces)
2962
2963(defface rcirc-url
bd43c990 2964 '((t (:bold t)))
f8db61b2
EZ
2965 "The face used to highlight urls."
2966 :group 'rcirc-faces)
2967
2968(defface rcirc-keyword
2969 '((t (:inherit highlight)))
2970 "The face used to highlight keywords."
adf794e4 2971 :group 'rcirc-faces)
a2524d26 2972
bd43c990 2973\f
adf794e4 2974;; When using M-x flyspell-mode, only check words after the prompt
bd43c990
RS
2975(put 'rcirc-mode 'flyspell-mode-predicate 'rcirc-looking-at-input)
2976(defun rcirc-looking-at-input ()
2977 "Returns true if point is past the input marker."
2978 (>= (point) rcirc-prompt-end-marker))
2979\f
2980
2981(provide 'rcirc)
e636ae15 2982
bd43c990 2983;;; rcirc.el ends here