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