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