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