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