.gitignore: Add aclocal.m4, configure, lib/Makefile.in, src/config.in.
[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
c47971d7 2452 (add-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t t)
72d2c2e3
DD
2453 (rcirc-authenticate))
2454 (rcirc-authenticate)
2455 (rcirc-join-channels process rcirc-startup-channels))
2456 (rcirc-join-channels process rcirc-startup-channels))))
2457
2458(defun rcirc-join-channels-post-auth (process)
2459 "Join `rcirc-startup-channels' after authenticating."
2460 (with-rcirc-process-buffer process
adf794e4 2461 (rcirc-join-channels process rcirc-startup-channels)))
bd43c990
RS
2462
2463(defun rcirc-handler-PRIVMSG (process sender args text)
72d2c2e3 2464 (rcirc-check-auth-status process sender args text)
bd43c990
RS
2465 (let ((target (if (rcirc-channel-p (car args))
2466 (car args)
db58efbf 2467 sender))
bd43c990
RS
2468 (message (or (cadr args) "")))
2469 (if (string-match "^\C-a\\(.*\\)\C-a$" message)
2470 (rcirc-handler-CTCP process target sender (match-string 1 message))
2471 (rcirc-print process sender "PRIVMSG" target message t))
a0a5c583
GM
2472 ;; update nick linestamp
2473 (with-current-buffer (rcirc-get-buffer process target t)
2474 (rcirc-put-nick-channel process sender target rcirc-current-line))))
bd43c990
RS
2475
2476(defun rcirc-handler-NOTICE (process sender args text)
72d2c2e3 2477 (rcirc-check-auth-status process sender args text)
bd43c990
RS
2478 (let ((target (car args))
2479 (message (cadr args)))
adf794e4
EZ
2480 (if (string-match "^\C-a\\(.*\\)\C-a$" message)
2481 (rcirc-handler-CTCP-response process target sender
2482 (match-string 1 message))
2483 (rcirc-print process sender "NOTICE"
2484 (cond ((rcirc-channel-p target)
2485 target)
2486 ;;; -ChanServ- [#gnu] Welcome...
02f47e86 2487 ((string-match "\\[\\(#[^\] ]+\\)\\]" message)
adf794e4
EZ
2488 (match-string 1 message))
2489 (sender
a2524d26 2490 (if (string= sender (rcirc-server-name process))
db58efbf
EZ
2491 nil ; server notice
2492 sender)))
adf794e4 2493 message t))))
bd43c990 2494
72d2c2e3
DD
2495(defun rcirc-check-auth-status (process sender args text)
2496 "Check if the user just authenticated.
2497If authenticated, runs `rcirc-authenticated-hook' with PROCESS as
2498the only argument."
2499 (with-rcirc-process-buffer process
2500 (when (and (not rcirc-user-authenticated)
2501 rcirc-authenticate-before-join
2502 rcirc-auto-authenticate-flag)
2503 (let ((target (car args))
2504 (message (cadr args)))
2505 (when (or
2506 (and ;; nickserv
2507 (string= sender "NickServ")
2508 (string= target rcirc-nick)
2509 (member message
2510 (list
2511 (format "You are now identified for \C-b%s\C-b." rcirc-nick)
2512 "Password accepted - you are now recognized."
2513 )))
77f63d30
DD
2514 (and ;; quakenet
2515 (string= sender "Q")
2516 (string= target rcirc-nick)
c47971d7 2517 (string-match "\\`You are now logged in as .+\\.\\'" message)))
72d2c2e3
DD
2518 (setq rcirc-user-authenticated t)
2519 (run-hook-with-args 'rcirc-authenticated-hook process)
2520 (remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t))))))
2521
bd43c990 2522(defun rcirc-handler-WALLOPS (process sender args text)
db58efbf 2523 (rcirc-print process sender "WALLOPS" sender (car args) t))
bd43c990
RS
2524
2525(defun rcirc-handler-JOIN (process sender args text)
db58efbf 2526 (let ((channel (car args)))
a0a5c583
GM
2527 (with-current-buffer (rcirc-get-buffer-create process channel)
2528 ;; when recently rejoining, restore the linestamp
2529 (rcirc-put-nick-channel process sender channel
2530 (let ((last-activity-lines
683b7dc6 2531 (rcirc-elapsed-lines process sender channel)))
a0a5c583
GM
2532 (when (and last-activity-lines
2533 (< last-activity-lines rcirc-omit-threshold))
827b77e9
DD
2534 (rcirc-last-line process sender channel))))
2535 ;; reset mode-line-process in case joining a channel with an
2536 ;; already open buffer (after getting kicked e.g.)
2537 (setq mode-line-process nil))
a0a5c583 2538
bd43c990
RS
2539 (rcirc-print process sender "JOIN" channel "")
2540
2541 ;; print in private chat buffer if it exists
a2524d26 2542 (when (rcirc-get-buffer (rcirc-buffer-process) sender)
a0a5c583 2543 (rcirc-print process sender "JOIN" sender channel))))
bd43c990
RS
2544
2545;; PART and KICK are handled the same way
2546(defun rcirc-handler-PART-or-KICK (process response channel sender nick args)
a2524d26 2547 (rcirc-ignore-update-automatic nick)
bd43c990
RS
2548 (if (not (string= nick (rcirc-nick process)))
2549 ;; this is someone else leaving
a0a5c583
GM
2550 (progn
2551 (rcirc-maybe-remember-nick-quit process nick channel)
2552 (rcirc-remove-nick-channel process nick channel))
adf794e4
EZ
2553 ;; this is us leaving
2554 (mapc (lambda (n)
2555 (rcirc-remove-nick-channel process n channel))
2556 (rcirc-channel-nicks process channel))
2557
2558 ;; if the buffer is still around, make it inactive
2559 (let ((buffer (rcirc-get-buffer process channel)))
2560 (when buffer
195eca78 2561 (rcirc-disconnect-buffer buffer)))))
bd43c990
RS
2562
2563(defun rcirc-handler-PART (process sender args text)
a2524d26
EZ
2564 (let* ((channel (car args))
2565 (reason (cadr args))
2566 (message (concat channel " " reason)))
2567 (rcirc-print process sender "PART" channel message)
2568 ;; print in private chat buffer if it exists
2569 (when (rcirc-get-buffer (rcirc-buffer-process) sender)
2570 (rcirc-print process sender "PART" sender message))
2571
2572 (rcirc-handler-PART-or-KICK process "PART" channel sender sender reason)))
bd43c990
RS
2573
2574(defun rcirc-handler-KICK (process sender args text)
a2524d26
EZ
2575 (let* ((channel (car args))
2576 (nick (cadr args))
2577 (reason (caddr args))
2578 (message (concat nick " " channel " " reason)))
2579 (rcirc-print process sender "KICK" channel message t)
2580 ;; print in private chat buffer if it exists
2581 (when (rcirc-get-buffer (rcirc-buffer-process) nick)
2582 (rcirc-print process sender "KICK" nick message))
2583
2584 (rcirc-handler-PART-or-KICK process "KICK" channel sender nick reason)))
bd43c990 2585
a0a5c583
GM
2586(defun rcirc-maybe-remember-nick-quit (process nick channel)
2587 "Remember NICK as leaving CHANNEL if they recently spoke."
683b7dc6 2588 (let ((elapsed-lines (rcirc-elapsed-lines process nick channel)))
a0a5c583
GM
2589 (when (and elapsed-lines
2590 (< elapsed-lines rcirc-omit-threshold))
2591 (let ((buffer (rcirc-get-buffer process channel)))
2592 (when buffer
2593 (with-current-buffer buffer
683b7dc6
GM
2594 (let ((record (assoc-string nick rcirc-recent-quit-alist t))
2595 (line (rcirc-last-line process nick channel)))
a0a5c583
GM
2596 (if record
2597 (setcdr record line)
2598 (setq rcirc-recent-quit-alist
2599 (cons (cons nick line)
2600 rcirc-recent-quit-alist))))))))))
2601
bd43c990 2602(defun rcirc-handler-QUIT (process sender args text)
db58efbf
EZ
2603 (rcirc-ignore-update-automatic sender)
2604 (mapc (lambda (channel)
a0a5c583
GM
2605 ;; broadcast quit message each channel
2606 (rcirc-print process sender "QUIT" channel (apply 'concat args))
2607 ;; record nick in quit table if they recently spoke
2608 (rcirc-maybe-remember-nick-quit process sender channel))
db58efbf 2609 (rcirc-nick-channels process sender))
db58efbf 2610 (rcirc-nick-remove process sender))
bd43c990
RS
2611
2612(defun rcirc-handler-NICK (process sender args text)
db58efbf 2613 (let* ((old-nick sender)
bd43c990
RS
2614 (new-nick (car args))
2615 (channels (rcirc-nick-channels process old-nick)))
2c8abe90
AS
2616 ;; update list of ignored nicks
2617 (rcirc-ignore-update-automatic old-nick)
2618 (when (member old-nick rcirc-ignore-list)
2619 (add-to-list 'rcirc-ignore-list new-nick)
2620 (add-to-list 'rcirc-ignore-list-automatic new-nick))
bd43c990
RS
2621 ;; print message to nick's channels
2622 (dolist (target channels)
2623 (rcirc-print process sender "NICK" target new-nick))
2624 ;; update private chat buffer, if it exists
adf794e4
EZ
2625 (let ((chat-buffer (rcirc-get-buffer process old-nick)))
2626 (when chat-buffer
2627 (with-current-buffer chat-buffer
2628 (rcirc-print process sender "NICK" old-nick new-nick)
2629 (setq rcirc-target new-nick)
2630 (rename-buffer (rcirc-generate-new-buffer-name process new-nick)))))
bd43c990 2631 ;; remove old nick and add new one
adf794e4 2632 (with-rcirc-process-buffer process
bd43c990
RS
2633 (let ((v (gethash old-nick rcirc-nick-table)))
2634 (remhash old-nick rcirc-nick-table)
2635 (puthash new-nick v rcirc-nick-table))
2636 ;; if this is our nick...
2637 (when (string= old-nick rcirc-nick)
2638 (setq rcirc-nick new-nick)
adf794e4 2639 (rcirc-update-prompt t)
bd43c990
RS
2640 ;; reauthenticate
2641 (when rcirc-auto-authenticate-flag (rcirc-authenticate))))))
2642
2643(defun rcirc-handler-PING (process sender args text)
195eca78 2644 (rcirc-send-string process (concat "PONG :" (car args))))
bd43c990
RS
2645
2646(defun rcirc-handler-PONG (process sender args text)
2647 ;; do nothing
2648 )
2649
2650(defun rcirc-handler-TOPIC (process sender args text)
2651 (let ((topic (cadr args)))
2652 (rcirc-print process sender "TOPIC" (car args) topic)
2653 (with-current-buffer (rcirc-get-buffer process (car args))
2654 (setq rcirc-topic topic))))
2655
a2524d26
EZ
2656(defvar rcirc-nick-away-alist nil)
2657(defun rcirc-handler-301 (process sender args text)
2658 "RPL_AWAY"
2659 (let* ((nick (cadr args))
2660 (rec (assoc-string nick rcirc-nick-away-alist))
2661 (away-message (caddr args)))
2662 (when (or (not rec)
2663 (not (string= (cdr rec) away-message)))
2664 ;; away message has changed
2665 (rcirc-handler-generic process "AWAY" nick (cdr args) text)
2666 (if rec
2667 (setcdr rec away-message)
2668 (setq rcirc-nick-away-alist (cons (cons nick away-message)
2669 rcirc-nick-away-alist))))))
2670
c5aff743
DD
2671(defun rcirc-handler-317 (process sender args text)
2672 "RPL_WHOISIDLE"
2673 (let* ((nick (nth 1 args))
2674 (idle-secs (string-to-number (nth 2 args)))
2675 (idle-string
2676 (if (< idle-secs most-positive-fixnum)
2677 (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs)
2678 "a very long time"))
2679 (signon-time (seconds-to-time (string-to-number (nth 3 args))))
2680 (signon-string (format-time-string "%c" signon-time))
2681 (message (format "%s idle for %s, signed on %s"
2682 nick idle-string signon-string)))
2683 (rcirc-print process sender "317" nil message t)))
2684
bd43c990
RS
2685(defun rcirc-handler-332 (process sender args text)
2686 "RPL_TOPIC"
adf794e4
EZ
2687 (let ((buffer (or (rcirc-get-buffer process (cadr args))
2688 (rcirc-get-temp-buffer-create process (cadr args)))))
2689 (with-current-buffer buffer
2690 (setq rcirc-topic (caddr args)))))
bd43c990
RS
2691
2692(defun rcirc-handler-333 (process sender args text)
2693 "Not in rfc1459.txt"
adf794e4
EZ
2694 (let ((buffer (or (rcirc-get-buffer process (cadr args))
2695 (rcirc-get-temp-buffer-create process (cadr args)))))
2696 (with-current-buffer buffer
2697 (let ((setter (caddr args))
2698 (time (current-time-string
2699 (seconds-to-time
2700 (string-to-number (cadddr args))))))
2701 (rcirc-print process sender "TOPIC" (cadr args)
2702 (format "%s (%s on %s)" rcirc-topic setter time))))))
bd43c990
RS
2703
2704(defun rcirc-handler-477 (process sender args text)
2705 "ERR_NOCHANMODES"
2706 (rcirc-print process sender "477" (cadr args) (caddr args)))
2707
2708(defun rcirc-handler-MODE (process sender args text)
2709 (let ((target (car args))
2710 (msg (mapconcat 'identity (cdr args) " ")))
2711 (rcirc-print process sender "MODE"
2712 (if (string= target (rcirc-nick process))
2713 nil
2714 target)
2715 msg)
2716
2717 ;; print in private chat buffers if they exist
2718 (mapc (lambda (nick)
db58efbf
EZ
2719 (when (rcirc-get-buffer process nick)
2720 (rcirc-print process sender "MODE" nick msg)))
adf794e4 2721 (cddr args))))
bd43c990
RS
2722
2723(defun rcirc-get-temp-buffer-create (process channel)
2724 "Return a buffer based on PROCESS and CHANNEL."
2725 (let ((tmpnam (concat " " (downcase channel) "TMP" (process-name process))))
2726 (get-buffer-create tmpnam)))
2727
2728(defun rcirc-handler-353 (process sender args text)
2729 "RPL_NAMREPLY"
adf794e4 2730 (let ((channel (caddr args)))
bd43c990
RS
2731 (mapc (lambda (nick)
2732 (rcirc-put-nick-channel process nick channel))
adf794e4 2733 (split-string (cadddr args) " " t))
bd43c990
RS
2734 (with-current-buffer (rcirc-get-temp-buffer-create process channel)
2735 (goto-char (point-max))
2736 (insert (car (last args)) " "))))
2737
2738(defun rcirc-handler-366 (process sender args text)
2739 "RPL_ENDOFNAMES"
2740 (let* ((channel (cadr args))
2741 (buffer (rcirc-get-temp-buffer-create process channel)))
2742 (with-current-buffer buffer
2743 (rcirc-print process sender "NAMES" channel
c62bf05a 2744 (let ((content (buffer-substring (point-min) (point-max))))
aa1bc616 2745 (rcirc-sort-nicknames-join content " "))))
bd43c990
RS
2746 (kill-buffer buffer)))
2747
2748(defun rcirc-handler-433 (process sender args text)
2749 "ERR_NICKNAMEINUSE"
2750 (rcirc-handler-generic process "433" sender args text)
2751 (let* ((new-nick (concat (cadr args) "`")))
adf794e4 2752 (with-rcirc-process-buffer process
bd43c990
RS
2753 (rcirc-cmd-nick new-nick nil process))))
2754
2755(defun rcirc-authenticate ()
2756 "Send authentication to process associated with current buffer.
db58efbf 2757Passwords are stored in `rcirc-authinfo' (which see)."
bd43c990 2758 (interactive)
a2524d26 2759 (with-rcirc-server-buffer
db58efbf 2760 (dolist (i rcirc-authinfo)
a2524d26
EZ
2761 (let ((process (rcirc-buffer-process))
2762 (server (car i))
db58efbf
EZ
2763 (nick (caddr i))
2764 (method (cadr i))
2765 (args (cdddr i)))
77f63d30
DD
2766 (when (and (string-match server rcirc-server))
2767 (if (and (memq method '(nickserv chanserv bitlbee))
2768 (string-match nick rcirc-nick))
2769 ;; the following methods rely on the user's nickname.
2770 (case method
2771 (nickserv
2772 (rcirc-send-privmsg
2773 process
1be1d1e9 2774 (or (cadr args) "NickServ")
77f63d30
DD
2775 (concat "IDENTIFY " (car args))))
2776 (chanserv
2777 (rcirc-send-privmsg
2778 process
1be1d1e9 2779 "ChanServ"
77f63d30
DD
2780 (format "IDENTIFY %s %s" (car args) (cadr args))))
2781 (bitlbee
2782 (rcirc-send-privmsg
2783 process
1be1d1e9 2784 "&bitlbee"
77f63d30
DD
2785 (concat "IDENTIFY " (car args)))))
2786 ;; quakenet authentication doesn't rely on the user's nickname.
2787 ;; the variable `nick' here represents the Q account name.
2788 (when (eq method 'quakenet)
2789 (rcirc-send-privmsg
2790 process
2791 "Q@CServe.quakenet.org"
2792 (format "AUTH %s %s" nick (car args))))))))))
adf794e4 2793
bd43c990
RS
2794(defun rcirc-handler-INVITE (process sender args text)
2795 (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t))
2796
2797(defun rcirc-handler-ERROR (process sender args text)
2798 (rcirc-print process sender "ERROR" nil (mapconcat 'identity args " ")))
2799
2800(defun rcirc-handler-CTCP (process target sender text)
2801 (if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text)
2802 (let* ((request (upcase (match-string 1 text)))
2803 (args (match-string 2 text))
bd43c990
RS
2804 (handler (intern-soft (concat "rcirc-handler-ctcp-" request))))
2805 (if (not (fboundp handler))
db58efbf
EZ
2806 (rcirc-print process sender "ERROR" target
2807 (format "%s sent unsupported ctcp: %s" sender text)
adf794e4 2808 t)
bd43c990 2809 (funcall handler process target sender args)
195eca78
SM
2810 (unless (or (string= request "ACTION")
2811 (string= request "KEEPALIVE"))
db58efbf 2812 (rcirc-print process sender "CTCP" target
adf794e4 2813 (format "%s" text) t))))))
bd43c990
RS
2814
2815(defun rcirc-handler-ctcp-VERSION (process target sender args)
2816 (rcirc-send-string process
db58efbf 2817 (concat "NOTICE " sender
adf794e4 2818 " :\C-aVERSION " rcirc-id-string
bd43c990
RS
2819 "\C-a")))
2820
2821(defun rcirc-handler-ctcp-ACTION (process target sender args)
2822 (rcirc-print process sender "ACTION" target args t))
2823
2824(defun rcirc-handler-ctcp-TIME (process target sender args)
2825 (rcirc-send-string process
db58efbf 2826 (concat "NOTICE " sender
bd43c990 2827 " :\C-aTIME " (current-time-string) "\C-a")))
adf794e4
EZ
2828
2829(defun rcirc-handler-CTCP-response (process target sender message)
2830 (rcirc-print process sender "CTCP" nil message t))
bd43c990 2831\f
adf794e4
EZ
2832(defgroup rcirc-faces nil
2833 "Faces for rcirc."
2834 :group 'rcirc
2835 :group 'faces)
2836
ad8121fe
EZ
2837(defface rcirc-my-nick ; font-lock-function-name-face
2838 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
2839 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
2840 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
2841 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
2842 (((class color) (min-colors 8)) (:foreground "blue" :weight bold))
2843 (t (:inverse-video t :weight bold)))
adf794e4
EZ
2844 "The face used to highlight my messages."
2845 :group 'rcirc-faces)
bd43c990 2846
ad8121fe
EZ
2847(defface rcirc-other-nick ; font-lock-variable-name-face
2848 '((((class grayscale) (background light))
2849 (:foreground "Gray90" :weight bold :slant italic))
bd43c990 2850 (((class grayscale) (background dark))
ad8121fe
EZ
2851 (:foreground "DimGray" :weight bold :slant italic))
2852 (((class color) (min-colors 88) (background light)) (:foreground "DarkGoldenrod"))
2853 (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod"))
2854 (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
2855 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
2856 (((class color) (min-colors 8)) (:foreground "yellow" :weight light))
2857 (t (:weight bold :slant italic)))
adf794e4
EZ
2858 "The face used to highlight other messages."
2859 :group 'rcirc-faces)
bd43c990 2860
02f47e86
MB
2861(defface rcirc-bright-nick
2862 '((((class grayscale) (background light))
2863 (:foreground "LightGray" :weight bold :underline t))
2864 (((class grayscale) (background dark))
2865 (:foreground "Gray50" :weight bold :underline t))
2866 (((class color) (min-colors 88) (background light)) (:foreground "CadetBlue"))
2867 (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
2868 (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
2869 (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
2870 (((class color) (min-colors 8)) (:foreground "magenta"))
2871 (t (:weight bold :underline t)))
f8db61b2 2872 "Face used for nicks matched by `rcirc-bright-nicks'."
02f47e86
MB
2873 :group 'rcirc-faces)
2874
2875(defface rcirc-dim-nick
2876 '((t :inherit default))
f8db61b2 2877 "Face used for nicks in `rcirc-dim-nicks'."
02f47e86
MB
2878 :group 'rcirc-faces)
2879
ad8121fe
EZ
2880(defface rcirc-server ; font-lock-comment-face
2881 '((((class grayscale) (background light))
2882 (:foreground "DimGray" :weight bold :slant italic))
bd43c990 2883 (((class grayscale) (background dark))
ad8121fe
EZ
2884 (:foreground "LightGray" :weight bold :slant italic))
2885 (((class color) (min-colors 88) (background light))
2886 (:foreground "Firebrick"))
2887 (((class color) (min-colors 88) (background dark))
2888 (:foreground "chocolate1"))
2889 (((class color) (min-colors 16) (background light))
2890 (:foreground "red"))
2891 (((class color) (min-colors 16) (background dark))
2892 (:foreground "red1"))
2893 (((class color) (min-colors 8) (background light))
2894 )
2895 (((class color) (min-colors 8) (background dark))
2896 )
2897 (t (:weight bold :slant italic)))
adf794e4
EZ
2898 "The face used to highlight server messages."
2899 :group 'rcirc-faces)
bd43c990 2900
ad8121fe 2901(defface rcirc-server-prefix ; font-lock-comment-delimiter-face
db58efbf 2902 '((default :inherit rcirc-server)
ad8121fe
EZ
2903 (((class grayscale)))
2904 (((class color) (min-colors 16)))
2905 (((class color) (min-colors 8) (background light))
2906 :foreground "red")
2907 (((class color) (min-colors 8) (background dark))
2908 :foreground "red1"))
2909 "The face used to highlight server prefixes."
2910 :group 'rcirc-faces)
2911
2912(defface rcirc-timestamp
2913 '((t (:inherit default)))
2914 "The face used to highlight timestamps."
2915 :group 'rcirc-faces)
2916
2917(defface rcirc-nick-in-message ; font-lock-keyword-face
2918 '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold))
2919 (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold))
2920 (((class color) (min-colors 88) (background light)) (:foreground "Purple"))
2921 (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
2922 (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
2923 (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
2924 (((class color) (min-colors 8)) (:foreground "cyan" :weight bold))
2925 (t (:weight bold)))
f8db61b2 2926 "The face used to highlight instances of your nick within messages."
adf794e4 2927 :group 'rcirc-faces)
bd43c990 2928
f8db61b2
EZ
2929(defface rcirc-nick-in-message-full-line
2930 '((t (:bold t)))
2931 "The face used emphasize the entire message when your nick is mentioned."
92c4adc1 2932 :group 'rcirc-faces)
f8db61b2 2933
ad8121fe
EZ
2934(defface rcirc-prompt ; comint-highlight-prompt
2935 '((((min-colors 88) (background dark)) (:foreground "cyan1"))
2936 (((background dark)) (:foreground "cyan"))
bd43c990 2937 (t (:foreground "dark blue")))
2e398771 2938 "The face used to highlight prompts."
adf794e4 2939 :group 'rcirc-faces)
bd43c990 2940
f8db61b2 2941(defface rcirc-track-nick
8216fbaf
EZ
2942 '((((type tty)) (:inherit default))
2943 (t (:inverse-video t)))
f8db61b2
EZ
2944 "The face used in the mode-line when your nick is mentioned."
2945 :group 'rcirc-faces)
2946
2947(defface rcirc-track-keyword
2948 '((t (:bold t )))
2949 "The face used in the mode-line when keywords are mentioned."
2950 :group 'rcirc-faces)
2951
2952(defface rcirc-url
bd43c990 2953 '((t (:bold t)))
f8db61b2
EZ
2954 "The face used to highlight urls."
2955 :group 'rcirc-faces)
2956
2957(defface rcirc-keyword
2958 '((t (:inherit highlight)))
2959 "The face used to highlight keywords."
adf794e4 2960 :group 'rcirc-faces)
a2524d26 2961
bd43c990 2962\f
adf794e4 2963;; When using M-x flyspell-mode, only check words after the prompt
bd43c990
RS
2964(put 'rcirc-mode 'flyspell-mode-predicate 'rcirc-looking-at-input)
2965(defun rcirc-looking-at-input ()
2966 "Returns true if point is past the input marker."
2967 (>= (point) rcirc-prompt-end-marker))
2968\f
2969
2970(provide 'rcirc)
e636ae15 2971
bd43c990 2972;;; rcirc.el ends here