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