1 ;;; riece-handle.el --- basic message handlers
2 ;; Copyright (C) 1998-2003 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: IRC, riece
8 ;; This file is part of Riece.
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
28 (require 'riece-message)
29 (require 'riece-channel)
30 (require 'riece-naming)
31 (require 'riece-display)
33 (defun riece-handle-nick-message (prefix string)
34 (let* ((old (riece-prefix-nickname prefix))
35 (new (car (riece-split-parameters string)))
36 (old-identity (riece-make-identity old riece-server-name))
37 (new-identity (riece-make-identity new riece-server-name))
38 (channels (riece-user-get-channels old))
39 (visible (riece-identity-member
41 (mapcar (lambda (channel)
42 (riece-make-identity channel riece-server-name))
44 (riece-naming-assert-rename old new)
45 (if (riece-identity-member old-identity riece-current-channels)
46 (setq channels (cons new channels)))
47 (riece-insert-change (mapcar
49 (riece-channel-buffer (riece-make-identity
50 channel riece-server-name)))
53 (riece-format-identity old-identity t)
54 (riece-format-identity new-identity t)))
55 (riece-insert-change (if visible
57 (list riece-dialogue-buffer riece-others-buffer))
59 (riece-concat-server-name
61 (riece-format-identity old-identity t)
62 (riece-format-identity new-identity t)))
64 (riece-redisplay-buffers)))
66 (defun riece-handle-privmsg-message (prefix string)
67 (let* ((user (riece-prefix-nickname prefix))
68 (parameters (riece-split-parameters string))
69 (targets (split-string (car parameters) ","))
70 (message (nth 1 parameters)))
71 (riece-display-message
72 (riece-make-message (riece-make-identity user
74 (riece-make-identity (car targets)
78 (defun riece-handle-notice-message (prefix string)
79 (let* ((user (if prefix
80 (riece-prefix-nickname prefix)))
81 (parameters (riece-split-parameters string))
82 (targets (split-string (car parameters) ","))
83 (message (nth 1 parameters)))
85 (riece-display-message
86 (riece-make-message (riece-make-identity user
88 (riece-make-identity (car targets)
91 ;; message from server
93 (list riece-dialogue-buffer riece-others-buffer)
94 (concat (riece-concat-server-name message) "\n")))))
96 (defun riece-handle-ping-message (prefix string)
97 (riece-send-string (format "PONG :%s\r\n"
98 (if (eq (aref string 0) ?:)
102 (defun riece-handle-join-message (prefix string)
103 (let* ((user (riece-prefix-nickname prefix))
104 ;; RFC2812 3.2.1 doesn't recommend server to send join
105 ;; messages which contain multiple targets.
106 (channels (split-string (car (riece-split-parameters string)) ","))
107 (user-identity (riece-make-identity user riece-server-name)))
109 (riece-naming-assert-join user (car channels))
110 (if (and riece-gather-channel-modes
111 (riece-identity-equal-no-server user riece-real-nickname))
112 (riece-send-string (format "MODE %s\r\n" (car channels))))
113 (let* ((channel-identity (riece-make-identity (car channels)
115 (buffer (riece-channel-buffer channel-identity)))
118 (format "%s (%s) has joined %s\n"
119 (riece-format-identity user-identity t)
120 (riece-user-get-user-at-host user)
121 (riece-format-identity channel-identity t)))
123 (if (and riece-channel-buffer-mode
124 (not (eq buffer riece-channel-buffer)))
125 (list riece-dialogue-buffer riece-others-buffer)
126 riece-dialogue-buffer)
128 (riece-concat-server-name
129 (format "%s (%s) has joined %s"
130 (riece-format-identity user-identity t)
131 (riece-user-get-user-at-host user)
132 (riece-format-identity channel-identity t)))
134 (setq channels (cdr channels)))
135 (riece-redisplay-buffers)))
137 (defun riece-handle-part-message (prefix string)
138 (let* ((user (riece-prefix-nickname prefix))
139 (parameters (riece-split-parameters string))
140 ;; RFC2812 3.2.2 doesn't recommend server to send part
141 ;; messages which contain multiple targets.
142 (channels (split-string (car parameters) ","))
143 (message (nth 1 parameters))
144 (user-identity (riece-make-identity user riece-server-name)))
146 (riece-naming-assert-part user (car channels))
147 (let* ((channel-identity (riece-make-identity (car channels)
149 (buffer (riece-channel-buffer channel-identity)))
153 (riece-concat-message
154 (format "%s has left %s"
155 (riece-format-identity user-identity t)
156 (riece-format-identity channel-identity t))
160 (if (and riece-channel-buffer-mode
161 (not (eq buffer riece-channel-buffer)))
162 (list riece-dialogue-buffer riece-others-buffer)
163 riece-dialogue-buffer)
165 (riece-concat-server-name
166 (riece-concat-message
167 (format "%s has left %s"
168 (riece-format-identity user-identity t)
169 (riece-format-identity channel-identity t))
172 (setq channels (cdr channels)))
173 (riece-redisplay-buffers)))
175 (defun riece-handle-kick-message (prefix string)
176 (let* ((kicker (riece-prefix-nickname prefix))
177 (parameters (riece-split-parameters string))
178 (channel (car parameters))
179 (user (nth 1 parameters))
180 (message (nth 2 parameters))
181 (kicker-identity (riece-make-identity kicker riece-server-name))
182 (channel-identity (riece-make-identity channel riece-server-name))
183 (user-identity (riece-make-identity user riece-server-name)))
184 (riece-naming-assert-part user channel)
185 (let ((buffer (riece-channel-buffer channel-identity)))
189 (riece-concat-message
190 (format "%s kicked %s out from %s"
191 (riece-format-identity kicker-identity t)
192 (riece-format-identity user-identity t)
193 (riece-format-identity channel-identity t))
197 (if (and riece-channel-buffer-mode
198 (not (eq buffer riece-channel-buffer)))
199 (list riece-dialogue-buffer riece-others-buffer)
200 riece-dialogue-buffer)
202 (riece-concat-server-name
203 (riece-concat-message
204 (format "%s kicked %s out from %s\n"
205 (riece-format-identity kicker-identity t)
206 (riece-format-identity user-identity t)
207 (riece-format-identity channel-identity t))
210 (riece-redisplay-buffers)))
212 (defun riece-handle-quit-message (prefix string)
213 (let* ((user (riece-prefix-nickname prefix))
214 (channels (copy-sequence (riece-user-get-channels user)))
216 (parameters (riece-split-parameters string))
217 (message (car parameters))
218 (user-identity (riece-make-identity user riece-server-name)))
219 ;; If you are talking with the user, quit it.
220 (if (riece-identity-member user-identity riece-current-channels)
221 (riece-part-channel user))
222 (setq pointer channels)
224 (riece-naming-assert-part user (car pointer))
225 (setq pointer (cdr pointer)))
229 (riece-channel-buffer (riece-make-identity channel
235 (riece-concat-message
236 (format "%s has left IRC"
237 (riece-format-identity user-identity t))
241 (if (and riece-channel-buffer-mode
242 (not (memq riece-channel-buffer buffers)))
243 (list riece-dialogue-buffer riece-others-buffer)
244 riece-dialogue-buffer)
246 (riece-concat-server-name
247 (riece-concat-message
248 (format "%s has left IRC"
249 (riece-format-identity user-identity t))
252 (riece-redisplay-buffers))
254 (defun riece-handle-kill-message (prefix string)
255 (let* ((killer (riece-prefix-nickname prefix))
256 (parameters (riece-split-parameters string))
257 (user (car parameters))
258 (message (nth 1 parameters))
259 (channels (copy-sequence (riece-user-get-channels user)))
260 (killer-identity (riece-make-identity killer riece-server-name))
261 (user-identity (riece-make-identity user riece-server-name))
263 ;; If you are talking with the user, quit it.
264 (if (riece-identity-member user-identity riece-current-channels)
265 (riece-part-channel user))
266 (setq pointer channels)
268 (riece-naming-assert-part user (car pointer))
269 (setq pointer (cdr pointer)))
273 (riece-channel-buffer (riece-make-identity channel
279 (riece-concat-message
280 (format "%s killed %s"
281 (riece-format-identity killer-identity t)
282 (riece-format-identity user-identity t))
286 (if (and riece-channel-buffer-mode
287 (not (memq riece-channel-buffer buffers)))
288 (list riece-dialogue-buffer riece-others-buffer)
289 riece-dialogue-buffer)
291 (riece-concat-server-name
292 (riece-concat-message
293 (format "%s killed %s"
294 (riece-format-identity killer-identity t)
295 (riece-format-identity user-identity t))
298 (riece-redisplay-buffers)))
300 (defun riece-handle-invite-message (prefix string)
301 (let* ((user (riece-prefix-nickname prefix))
302 (parameters (riece-split-parameters string))
303 (invited (car parameters))
304 (channel (nth 1 parameters))
305 (channel-identity (riece-make-identity channel riece-server-name)))
306 (if (riece-identity-equal-no-server invited riece-real-nickname)
307 (setq riece-join-channel-candidate channel-identity))
309 (list riece-dialogue-buffer riece-others-buffer)
311 (riece-concat-server-name
312 (format "%s invites %s to %s"
313 (riece-format-identity (riece-make-identity
314 user riece-server-name))
315 (riece-format-identity (riece-make-identity
316 invited riece-server-name))
317 (riece-format-identity channel-identity)))
320 (defun riece-handle-topic-message (prefix string)
321 (let* ((user (riece-prefix-nickname prefix))
322 (parameters (riece-split-parameters string))
323 (channel (car parameters))
324 (topic (nth 1 parameters))
325 (user-identity (riece-make-identity user riece-server-name))
326 (channel-identity (riece-make-identity channel riece-server-name)))
327 (riece-channel-set-topic (riece-get-channel channel) topic)
328 (let ((buffer (riece-channel-buffer channel-identity)))
331 (format "Topic by %s: %s\n"
332 (riece-format-identity user-identity t)
335 (if (and riece-channel-buffer-mode
336 (not (eq buffer riece-channel-buffer)))
337 (list riece-dialogue-buffer riece-others-buffer)
338 riece-dialogue-buffer)
340 (riece-concat-server-name
341 (format "Topic on %s by %s: %s"
342 (riece-format-identity channel-identity t)
343 (riece-format-identity user-identity t)
346 (riece-redisplay-buffers))))
348 (defsubst riece-parse-channel-modes (string channel)
349 (while (string-match "^[-+]\\([^ ]*\\) *" string)
350 (let ((toggle (aref string 0))
351 (modes (string-to-list (match-string 1 string))))
352 (setq string (substring string (match-end 0)))
354 (if (and (memq (car modes) '(?O ?o ?v ?k ?l ?b ?e ?I))
355 (string-match "\\([^-+][^ ]*\\) *" string))
356 (let ((parameter (match-string 1 string)))
357 (setq string (substring string (match-end 0)))
360 (riece-channel-toggle-operator channel parameter
363 (riece-channel-toggle-speaker channel parameter
366 (riece-channel-toggle-banned channel parameter
369 (riece-channel-toggle-uninvited channel parameter
372 (riece-channel-toggle-invited channel parameter
374 (riece-channel-toggle-mode channel (car modes)
376 (setq modes (cdr modes))))))
378 (defun riece-handle-mode-message (prefix string)
379 (let* ((user (riece-prefix-nickname prefix))
380 (user-identity (riece-make-identity user riece-server-name))
382 (when (string-match "\\([^ ]+\\) *:?" string)
383 (setq channel (match-string 1 string)
384 string (substring string (match-end 0)))
385 (riece-parse-channel-modes string channel)
386 (let* ((channel-identity (riece-make-identity channel riece-server-name))
387 (buffer (riece-channel-buffer channel-identity)))
390 (format "Mode by %s: %s\n"
391 (riece-format-identity user-identity t)
394 (if (and riece-channel-buffer-mode
395 (not (eq buffer riece-channel-buffer)))
396 (list riece-dialogue-buffer riece-others-buffer)
397 riece-dialogue-buffer)
399 (riece-concat-server-name
400 (format "Mode on %s by %s: %s"
401 (riece-format-identity channel-identity t)
402 (riece-format-identity user-identity t)
405 (riece-redisplay-buffers)))))
407 (provide 'riece-handle)
409 ;;; riece-handle.el ends here