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 riece-gather-channel-modes
111 (riece-send-string (format "MODE %s\r\n" (car channels))))
112 (let* ((channel-identity (riece-make-identity (car channels)
114 (buffer (riece-channel-buffer channel-identity)))
117 (format "%s (%s) has joined %s\n"
118 (riece-format-identity user-identity t)
119 (riece-user-get-user-at-host user)
120 (riece-format-identity channel-identity t)))
122 (if (and riece-channel-buffer-mode
123 (not (eq buffer riece-channel-buffer)))
124 (list riece-dialogue-buffer riece-others-buffer)
125 riece-dialogue-buffer)
127 (riece-concat-server-name
128 (format "%s (%s) has joined %s"
129 (riece-format-identity user-identity t)
130 (riece-user-get-user-at-host user)
131 (riece-format-identity channel-identity t)))
133 (setq channels (cdr channels)))
134 (riece-redisplay-buffers)))
136 (defun riece-handle-part-message (prefix string)
137 (let* ((user (riece-prefix-nickname prefix))
138 (parameters (riece-split-parameters string))
139 ;; RFC2812 3.2.2 doesn't recommend server to send part
140 ;; messages which contain multiple targets.
141 (channels (split-string (car parameters) ","))
142 (message (nth 1 parameters))
143 (user-identity (riece-make-identity user riece-server-name)))
145 (riece-naming-assert-part user (car channels))
146 (let* ((channel-identity (riece-make-identity (car channels)
148 (buffer (riece-channel-buffer channel-identity)))
152 (riece-concat-message
153 (format "%s has left %s"
154 (riece-format-identity user-identity t)
155 (riece-format-identity channel-identity t))
159 (if (and riece-channel-buffer-mode
160 (not (eq buffer riece-channel-buffer)))
161 (list riece-dialogue-buffer riece-others-buffer)
162 riece-dialogue-buffer)
164 (riece-concat-server-name
165 (riece-concat-message
166 (format "%s has left %s"
167 (riece-format-identity user-identity t)
168 (riece-format-identity channel-identity t))
171 (setq channels (cdr channels)))
172 (riece-redisplay-buffers)))
174 (defun riece-handle-kick-message (prefix string)
175 (let* ((kicker (riece-prefix-nickname prefix))
176 (parameters (riece-split-parameters string))
177 (channel (car parameters))
178 (user (nth 1 parameters))
179 (message (nth 2 parameters))
180 (kicker-identity (riece-make-identity kicker riece-server-name))
181 (channel-identity (riece-make-identity channel riece-server-name))
182 (user-identity (riece-make-identity user riece-server-name)))
183 (riece-naming-assert-part user channel)
184 (let ((buffer (riece-channel-buffer channel-identity)))
188 (riece-concat-message
189 (format "%s kicked %s out from %s"
190 (riece-format-identity kicker-identity t)
191 (riece-format-identity user-identity t)
192 (riece-format-identity channel-identity t))
196 (if (and riece-channel-buffer-mode
197 (not (eq buffer riece-channel-buffer)))
198 (list riece-dialogue-buffer riece-others-buffer)
199 riece-dialogue-buffer)
201 (riece-concat-server-name
202 (riece-concat-message
203 (format "%s kicked %s out from %s\n"
204 (riece-format-identity kicker-identity t)
205 (riece-format-identity user-identity t)
206 (riece-format-identity channel-identity t))
209 (riece-redisplay-buffers)))
211 (defun riece-handle-quit-message (prefix string)
212 (let* ((user (riece-prefix-nickname prefix))
213 (channels (copy-sequence (riece-user-get-channels user)))
215 (parameters (riece-split-parameters string))
216 (message (car parameters))
217 (user-identity (riece-make-identity user riece-server-name)))
218 ;; If you are talking with the user, quit it.
219 (if (riece-identity-member user-identity riece-current-channels)
220 (riece-part-channel user))
221 (setq pointer channels)
223 (riece-naming-assert-part user (car pointer))
224 (setq pointer (cdr pointer)))
228 (riece-channel-buffer (riece-make-identity channel
234 (riece-concat-message
235 (format "%s has left IRC"
236 (riece-format-identity user-identity t))
240 (if (and riece-channel-buffer-mode
241 (not (memq riece-channel-buffer buffers)))
242 (list riece-dialogue-buffer riece-others-buffer)
243 riece-dialogue-buffer)
245 (riece-concat-server-name
246 (riece-concat-message
247 (format "%s has left IRC"
248 (riece-format-identity user-identity t))
251 (riece-redisplay-buffers))
253 (defun riece-handle-kill-message (prefix string)
254 (let* ((killer (riece-prefix-nickname prefix))
255 (parameters (riece-split-parameters string))
256 (user (car parameters))
257 (message (nth 1 parameters))
258 (channels (copy-sequence (riece-user-get-channels user)))
259 (killer-identity (riece-make-identity killer riece-server-name))
260 (user-identity (riece-make-identity user riece-server-name))
262 ;; If you are talking with the user, quit it.
263 (if (riece-identity-member user-identity riece-current-channels)
264 (riece-part-channel user))
265 (setq pointer channels)
267 (riece-naming-assert-part user (car pointer))
268 (setq pointer (cdr pointer)))
272 (riece-channel-buffer (riece-make-identity channel
278 (riece-concat-message
279 (format "%s killed %s"
280 (riece-format-identity killer-identity t)
281 (riece-format-identity user-identity t))
285 (if (and riece-channel-buffer-mode
286 (not (memq riece-channel-buffer buffers)))
287 (list riece-dialogue-buffer riece-others-buffer)
288 riece-dialogue-buffer)
290 (riece-concat-server-name
291 (riece-concat-message
292 (format "%s killed %s"
293 (riece-format-identity killer-identity t)
294 (riece-format-identity user-identity t))
297 (riece-redisplay-buffers)))
299 (defun riece-handle-invite-message (prefix string)
300 (let* ((user (riece-prefix-nickname prefix))
301 (parameters (riece-split-parameters string))
302 (invited (car parameters))
303 (channel (nth 1 parameters))
304 (channel-identity (riece-make-identity channel riece-server-name)))
305 (if (riece-identity-equal-no-server invited riece-real-nickname)
306 (setq riece-join-channel-candidate channel-identity))
308 (list riece-dialogue-buffer riece-others-buffer)
310 (riece-concat-server-name
311 (format "%s invites %s to %s"
312 (riece-format-identity (riece-make-identity
313 user riece-server-name))
314 (riece-format-identity (riece-make-identity
315 invited riece-server-name))
316 (riece-format-identity channel-identity)))
319 (defun riece-handle-topic-message (prefix string)
320 (let* ((user (riece-prefix-nickname prefix))
321 (parameters (riece-split-parameters string))
322 (channel (car parameters))
323 (topic (nth 1 parameters))
324 (user-identity (riece-make-identity user riece-server-name))
325 (channel-identity (riece-make-identity channel riece-server-name)))
326 (riece-channel-set-topic (riece-get-channel channel) topic)
327 (let ((buffer (riece-channel-buffer channel-identity)))
330 (format "Topic by %s: %s\n"
331 (riece-format-identity user-identity t)
334 (if (and riece-channel-buffer-mode
335 (not (eq buffer riece-channel-buffer)))
336 (list riece-dialogue-buffer riece-others-buffer)
337 riece-dialogue-buffer)
339 (riece-concat-server-name
340 (format "Topic on %s by %s: %s"
341 (riece-format-identity channel-identity t)
342 (riece-format-identity user-identity t)
345 (riece-redisplay-buffers))))
347 (defsubst riece-parse-channel-modes (string channel)
348 (while (string-match "^[-+]\\([^ ]*\\) *" string)
349 (let ((toggle (aref string 0))
350 (modes (string-to-list (match-string 1 string))))
351 (setq string (substring string (match-end 0)))
353 (if (and (memq (car modes) '(?O ?o ?v ?k ?l ?b ?e ?I))
354 (string-match "\\([^-+][^ ]*\\) *" string))
355 (let ((parameter (match-string 1 string)))
356 (setq string (substring string (match-end 0)))
359 (riece-channel-toggle-operator channel parameter
362 (riece-channel-toggle-speaker channel parameter
365 (riece-channel-toggle-banned channel parameter
368 (riece-channel-toggle-uninvited channel parameter
371 (riece-channel-toggle-invited channel parameter
373 (riece-channel-toggle-mode channel (car modes)
375 (setq modes (cdr modes))))))
377 (defun riece-handle-mode-message (prefix string)
378 (let* ((user (riece-prefix-nickname prefix))
379 (user-identity (riece-make-identity user riece-server-name))
381 (when (string-match "\\([^ ]+\\) *:?" string)
382 (setq channel (match-string 1 string)
383 string (substring string (match-end 0)))
384 (riece-parse-channel-modes string channel)
385 (let* ((channel-identity (riece-make-identity channel riece-server-name))
386 (buffer (riece-channel-buffer channel-identity)))
389 (format "Mode by %s: %s\n"
390 (riece-format-identity user-identity t)
393 (if (and riece-channel-buffer-mode
394 (not (eq buffer riece-channel-buffer)))
395 (list riece-dialogue-buffer riece-others-buffer)
396 riece-dialogue-buffer)
398 (riece-concat-server-name
399 (format "Mode on %s by %s: %s"
400 (riece-format-identity channel-identity t)
401 (riece-format-identity user-identity t)
404 (riece-redisplay-buffers)))))
406 (provide 'riece-handle)
408 ;;; riece-handle.el ends here