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