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