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