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